;;   gui-1.scm - Implementation-independent GUI code for NanoCAD
;;   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 .

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; GUI variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define center-x false)
(define center-y false)
(define start-mouse ())
(define selected-atom 0)
(define current-element "C")
(define current-bond-order 1)
(define atom-drawing-diameter 15)
(define draw-force-vectors false)
(define current-mouse-button false)
(define scale-factor 25.0)

(define (atom-color z) false)  ;; redefine these in gui-2.xxx
(define (select-pen z) false)
(define (delete-all) false)
(define (draw-ellipse x1 y1 d) false)
(define (draw-line x1 y1 x2 y2) false)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; other stuff
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (set-scale-factor x) (set! scale-factor x))
(define (su2a x) (/ x scale-factor))
(define (a2su x) (* x scale-factor))

(define (select-atom x y)
  (set! x (su2a x))
  (set! y (su2a y))
  (do ((n false)
       (i 0 (+ i 1))
       (p 0.0)
       (sq-dist 0.0)
       (min-sq-dist 0.0)
       (L atom-list (cdr L)))
      ((null? L) n)
    (set! p (- x (vector-ref (atm-position (car L)) 0)))
    (set! sq-dist (* p p))
    (set! p (- y (vector-ref (atm-position (car L)) 1)))
    (set! sq-dist (+ sq-dist (* p p)))
    (if (or (not n) (< sq-dist min-sq-dist))
        (begin
          (set! min-sq-dist sq-dist)
          (set! n i)))))

(define (move-atom n x y)
  (let ((a (list-ref atom-list n)))
    (atm-set-pos a
       (vector (su2a x)
               (su2a y)
               (vector-ref (atm-position a) 2)))))






;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Drawing Lists, z-sorting
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (select-an-atom x y)
  (set! selected-atom
        (select-atom (- x center-x)
                     (- y center-y))))

(define (rotate-press x y)
  (center-structure)
  (set! start-mouse (list x y)))

(define (rotate-drag x y)
  (rotate-structure
   (* 0.01 (- x (car start-mouse)))
   (* -0.01 (- y (cadr start-mouse))))
  (set! start-mouse (list x y))
  (update-display false))

(define (rotate-release x y)
  (update-display true))

(define (moveatom-drag x y)
  (move-atom selected-atom
             (- x center-x)
             (- y center-y))
  (update-display true))

(define (addatom-press x y)
  (let ((x1 (- x center-x))
        (y1 (- y center-y)))
    (add-atom current-element
              (vector (su2a (- x center-x)) (su2a (- y center-y)) 0.0))
    (update-display true)))

(define (deleteatom-press x y)
  (select-an-atom x y)
  (delete-atom selected-atom)
  (update-display true))

(define (deletebond-release x y)
  (let ((n selected-atom))
    (select-an-atom x y)
    (delete-bond n selected-atom)
    (update-display true)))

(define (addbond-release x y)
  (let ((n selected-atom))
    (select-an-atom x y)
    (if (not (= n selected-atom))
        (add-bond current-bond-order selected-atom n))
    (update-display true)))

(define (do-nothing x y) '())

(define press-function (func rotate-press))
(define drag-function (func rotate-drag))
(define release-function (func rotate-release))

;; For now, pay attention only to the left mouse button

(define (press-function-b x y)
  (if (eq? current-mouse-button 1)
      (press-function x y)))

(define (drag-function-b x y)
  (if (eq? current-mouse-button 1)
      (drag-function x y)))

(define (release-function-b x y)
  (if (eq? current-mouse-button 1)
      (release-function x y)))

(define (create-draw-object type x1 y1 x2 y2 z xf yf pen element)
  (make-lambda (x)
      (case x
	    ('type type)
	    ('x1 x1)
	    ('y1 y1)
	    ('x2 x2)
	    ('y2 y2)
	    ('z z)
	    ('xf xf)
	    ('yf yf)
	    ('pen pen)
	    ('element element))))

(define (wireframe-drawing-list)
  (entering "wireframe-drawing-list")
  (let ((DL '()))
    (dolist
     (bond bond-list)
     (let ((pos1 (atm-position (list-ref atom-list
                                    (bond-first bond))))
           (pos2 (atm-position (list-ref atom-list
                                    (bond-second bond)))))
       (set! DL
             (cons
              (create-draw-object
               'bond
               (a2su (vector-ref pos1 0))
               (a2su (vector-ref pos1 1))
               (a2su (vector-ref pos2 0))
               (a2su (vector-ref pos2 1))
               false false false 'normal false)
              DL))))
    DL))

(define (detailed-drawing-list)
  (entering "detailed-drawing-list")
  ;; the first thing we'll be doing is sorting the drawing list by Z
  ;; coordinates, so compute them for bonds first, then for atoms
  (let ((DL '()))
    (dbgprintf "detailed-drawing-list: bonds~%")
    (dolist
     (bond bond-list)
     (let* ((pos1 (atm-position (list-ref atom-list
					  (bond-first bond))))
	    (pos2 (atm-position (list-ref atom-list
					  (bond-second bond))))
	    (p1 (vector (a2su (vector-ref pos1 0))
			(a2su (vector-ref pos1 1))
			(a2su (vector-ref pos1 2))))
	    (p2 (vector (a2su (vector-ref pos2 0))
			(a2su (vector-ref pos2 1))
			(a2su (vector-ref pos2 2))))
	    ;; (g (* 0.5 (/ atom-drawing-diameter (vlen (vdiff p1 p2)))))
	    (g (* 0.3 (/ atom-drawing-diameter (vlen (vdiff p1 p2)))))
	    (x1 (+ (* (- 1.0 g) (vector-ref p1 0))
		   (* g (vector-ref p2 0))))
	    (y1 (+ (* (- 1.0 g) (vector-ref p1 1))
		   (* g (vector-ref p2 1))))
	    (x2 (+ (* (- 1.0 g) (vector-ref p2 0))
		   (* g (vector-ref p1 0))))
	    (y2 (+ (* (- 1.0 g) (vector-ref p2 1))
		   (* g (vector-ref p1 1)))))
       (dbgprintf "pos1: ~s   pos2: ~s~%" pos1 pos2)
       (set! DL
             (cons
              (create-draw-object
               'bond x1 y1 x2 y2
               (* 0.5 (+ (vector-ref pos1 2) (vector-ref pos2 2)))
               false false
               (case (bond-order bond)
                 (2 'double-bond)
                 (3 'triple-bond)
                 (else 'normal))
               false)
              DL))))
    (dbgprintf "detailed-drawing-list: atoms~%")
    (dolist (atom atom-list)
            (let ((atm-pos (atm-position atom))
                  (atm-frc (atm-force atom)))
              (set! DL
                    (cons
                     (create-draw-object
                      'atom
                      (a2su (vector-ref atm-pos 0))
                      (a2su (vector-ref atm-pos 1))
                      false
                      false
                      (vector-ref atm-pos 2)
                      (* 0.05 (a2su (vector-ref atm-frc 0)))
                      (* 0.05 (a2su (vector-ref atm-frc 1)))
                      'normal
                      (atm-element atom))
                     DL))))
    (dbgprintf "detailed-drawing-list: sorting~%")
    (qsort DL (lambda (x y) (< (funcall x 'z) (funcall y 'z))))))

;; >>>>> In Scheme, we want to use quicksort instead of sort. <<<<<<<<


(set! center-x 200)
(set! center-y 200)

(define (update-display full-blown)
  (entering "update-display")
  (delete-all)
  (re-center)
  (if full-blown
      (let ((DL '())
            (minus-half-diameter (* -0.5 atom-drawing-diameter)))
        (if draw-force-vectors (compute-forces))
        (set! DL (detailed-drawing-list))
        (mapcar
	 (make-lambda (z)
		      (if (eq? (funcall z 'type) 'atom)
			  (begin
			    (atom-color
			     (element-name (funcall z 'element)))
			    (draw-ellipse
			     (+ (funcall z 'x1) center-x minus-half-diameter)
			     (+ (funcall z 'y1) center-y minus-half-diameter)
			     atom-drawing-diameter)
			    (if draw-force-vectors
				(begin
				  (select-pen 'force-vector)
				  (draw-line
				   (+ center-x (funcall z 'x1))
				   (+ center-y (funcall z 'y1))
				   (+ center-x
				      (funcall z 'x1) (funcall z 'xf))
				   (+ center-y
				      (funcall z 'y1) (funcall z 'yf)))))
			    (select-pen 'normal))
			(begin
			  (select-pen (funcall z 'pen))
			  (draw-line (+ center-x (funcall z 'x1))
				     (+ center-y (funcall z 'y1))
				     (+ center-x (funcall z 'x2))
				     (+ center-y (funcall z 'y2)))
			  (select-pen 'normal))))
	 DL))
    (mapcar
     (make-lambda (z)
		  (draw-line (+ center-x (funcall z 'x1))
			     (+ center-y (funcall z 'y1))
			     (+ center-x (funcall z 'x2))
			     (+ center-y (funcall z 'y2))))
     (wireframe-drawing-list))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Control Panel Stuff
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (set-action a)
  (case a
	(rotate
	 (set! press-function (func rotate-press))
	 (set! drag-function (func rotate-drag))
	 (set! release-function (func rotate-release)))
	(moveatom
	 (set! press-function (func select-an-atom))
	 (set! drag-function (func moveatom-drag))
	 (set! release-function (func do-nothing)))
	(addatom
	 (set! press-function (func addatom-press))
	 (set! drag-function (func do-nothing))
	 (set! release-function (func do-nothing)))
	(deleteatom
	 (set! press-function (func deleteatom-press))
	 (set! drag-function (func do-nothing))
	 (set! release-function (func do-nothing)))
	(addbond
	 (set! press-function (func select-an-atom))
	 (set! drag-function (func do-nothing))
	 (set! release-function (func addbond-release)))
	(deletebond
	 (set! press-function (func select-an-atom))
	 (set! drag-function (func do-nothing))
	 (set! release-function (func deletebond-release)))))

(define (set-zoomfactor z)
  (if (not (= z scale-factor))
      (begin
	(cond ((= z 10)
	       (set! scale-factor 10.0)
	       (set! atom-drawing-diameter 6))
	      ((= z 25)
	       (set! scale-factor 25.0)
	       (set! atom-drawing-diameter 15))
	      ((= z 50)
	       (set! scale-factor 50.0)
	       (set! atom-drawing-diameter 30))
	      ((= z 100)
	       (set! scale-factor 100.0)
	       (set! atom-drawing-diameter 60)))
	(update-display true))))