;;   gui-2.lsp - Implementation-dependent GUI code, CLISP and Tcl
;;   Copyright (C) 1996,1997 Will Ware
;;   
;;   This program is free software; you can redistribute it and/or
;;   modify it under the terms of the GNU General Public License
;;   as published by the Free Software Foundation; either version 2
;;   of the License, or (at your option) any later version.
;;   
;;   This program is distributed in the hope that it will be useful,
;;   but WITHOUT ANY WARRANTY; without even the implied warranty of
;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;   GNU General Public License for more details.
;;   
;;   You should have received a copy of the GNU General Public License
;;   along with this program; if not, write to the Free Software
;;   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;
;;   I can be reached via email at <wware@world.std.com>.

(define (atom-color name)
  (cond ((equal? name "C") (tellwish "{set_color black}"))
	((equal? name "H") (tellwish "{set_color white}"))
	((equal? name "O") (tellwish "{set_color red}"))
	(else              (tellwish "{set_color blue}"))))

(defun re-center () '())

(defun select-pen (c)
  (case c
	(normal
	 (tellwish "{set_pen black 1}"))
	(double-bond
	 (tellwish "{set_pen black 3}"))
	(triple-bond
	 (tellwish "{set_pen black 5}"))
	(force-vector
	 (tellwish "{set_pen red 1}"))
	(else
	 (format t "??: (select-pen ~c)~%" c))))

(define (set-bondorder b)
  (case b
	(single (setf current-bond-order 1))
	(double (setf current-bond-order 2))
	(triple (setf current-bond-order 3))))

(define (set-element e)
  (case e
	(c (setf current-element "C"))
	(n (setf current-element "N"))
	(o (setf current-element "O"))
	(h (setf current-element "H"))))

(define (set-eminspeed s)
  (case s
	(coarse (setf emin-factor coarse-emin-factor))
	(fine (setf emin-factor fine-emin-factor))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Routines for handling Lisp-to-Wish communication
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package 'user)

;; Variable to hold stream used to communicate with Wish
(defvar *lisp-to-wish-stream*)

(defun start-wish-process ()
  (setq *lisp-to-wish-stream*  (run-shell-command
				"wish -f gui-2.tcl"
				:input :stream
				:output :stream)))

;; Send "format"-type string to Wish

(defmacro tellwish (&rest args)
  `(progn
     (format *lisp-to-wish-stream* ,(car args) ,@(cdr args))
     (terpri *lisp-to-wish-stream*)
     (force-output *lisp-to-wish-stream*)))

;; Send end-of-transmission symbol, giving control back to Wish
(defmacro finish-lisp-broadcast ()
  '(tellwish "@"))

;; Close the stream to Wish
(defun close-wish-stream ()
  (finish-lisp-broadcast)  ;; When we're done shutting down
  (close *lisp-to-wish-stream*))





;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Handle interaction between program and Wish
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun delete-all ()
  (tellwish "delete_erasable"))

(defun draw-line (x1 y1 x2 y2)
  (tellwish "{create_line ~a ~a ~a ~a}" x1 y1 x2 y2))

(defun draw-ellipse (x1 y1 d)
  (tellwish "{create_ellipse ~a ~a ~a ~a}" x1 y1 (+ x1 d) (+ y1 d)))

(defun get-file-name ()
  (format t "~%Please type the file name in double-quotes: ")
  (read *standard-input*))

(defun show-gui ()
  (start-wish-process)
  (do ((wish-read (read-line *lisp-to-wish-stream*)
		  (read-line *lisp-to-wish-stream*)))
      ;; Let user exit without closing connection
      ((equal wish-read "exit") (close-wish-stream))
      (let ((from-tcl (read-from-string wish-read)))
	(case (car from-tcl)
	      (startup (update-display true))
	      (clear (clear-structure)
		     (update-display false))
	      (emin (emin-step)
		    (update-display true))
	      (options
	       (setf draw-force-vectors (= 1 (nth 1 from-tcl)))
	       (setf use-torsion-forces (= 2 (nth 1 from-tcl)))
	       (setf use-vdw-forces     (= 3 (nth 1 from-tcl)))
	       (update-display true))
	      (controls
	       (set-action     (nth 1 from-tcl))
	       (set-bondorder  (nth 2 from-tcl))
	       (set-element    (nth 3 from-tcl))
	       (set-zoomfactor (nth 4 from-tcl))
	       (set-eminspeed  (nth 5 from-tcl)))
	      (load
	       (load-structure (get-file-name)))
	      (save
	       (save-structure (get-file-name)))
	      (savexyz
	       (save-structure-xyz (get-file-name)))
	      (press-1
	       (funcall press-function (nth 1 from-tcl) (nth 2 from-tcl)))
	      (move-1
	       (funcall drag-function (nth 1 from-tcl) (nth 2 from-tcl)))
	      (release-1
	       (funcall release-function (nth 1 from-tcl) (nth 2 from-tcl)))))
      (finish-lisp-broadcast)))