;;   gui-2.mrd - Implementation-dependent GUI code, MrEd
;;   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 my-frame%
  (make-class wx:frame%
              (public
		   (on-size (lambda (w h) '()))
		   (change-resize-function
		     (lambda (f)
			 (set! on-size f))))))

(define my-canvas%
  (make-class wx:canvas%
	      (private
	       (which-button 0))
              (public
               (on-event
		(lambda (event)
		  (let ((which-button
			 (cond ((send event button? 1) 1)
			       ((send event button? 2) 2)
			       (else 3)))
			(x (send event get-x))
			(y (send event get-y)))
		    (cond ((send event button-down? -1)
			   (set! current-mouse-button which-button)
			   (press-function-b x y))
			  ((send event button-up? -1)
			   (release-function-b x y)
			   (set! current-mouse-button #f))
			  ((and current-mouse-button
				(send event dragging?))
			   (drag-function-b x y))
			  (else #f))))))))

;; annoying little hack, because the name of the command changed after
;; version 42
(if (equal? (version) "42")
    (define (get-cursor-hack panel u v)
      (send panel get-cursor u v))
    (define (get-cursor-hack panel u v)
      (send panel get-item-cursor u v)))

(define session%
  (class () ()
	 (public
	  (PANEL-WIDTH
	   (if (eq? (system-type) 'unix) 530 390))
	  (PANEL-HEIGHT
	   (if (eq? (system-type) 'unix) 200 230))
	  (CANVAS-WIDTH 400)
	  (CANVAS-HEIGHT 400)
	  (a-frame
	   (make-object my-frame%
			'() ; No parent frame
			"NanoCAD Control Panel"
			-1 -1 ; Use the default position
			PANEL-WIDTH PANEL-HEIGHT))
	  (b-frame
	   (make-object my-frame%
			'() ; No parent frame
			"NanoCAD Structure View"
			-1 -1 ; Use the default position
			CANVAS-WIDTH CANVAS-HEIGHT))
	  (canvas-height 10)
	  (canvas-width 10)
	  (canvas
	   (make-object my-canvas%
			b-frame
			0 0
			canvas-width canvas-height
			wx:const-retained ""))
	  (canvas-dc
	   (send canvas get-dc))
	  (awaken
	   (lambda ()
	     (send a-frame show #t)
	     (send b-frame show #t)))
	  (snooze
	   (lambda ()
	     (send canvas-dc end-drawing)
	     (send a-frame show #f)
	     (send b-frame show #f))))

	 (private
	  (carbon-brush
	   (make-object wx:brush% "BLACK" wx:const-solid))
	  (hydrogen-brush
	   (make-object wx:brush% "WHITE" wx:const-solid))
	  (oxygen-brush
	   (make-object wx:brush% "RED" wx:const-solid))
	  (nitrogen-brush
	   (make-object wx:brush% "BLUE" wx:const-solid))

	  (normal-pen
	   (make-object wx:pen% "BLACK" 1 wx:const-solid))
	  (double-bond-pen
	   (make-object wx:pen% "BLACK" 3 wx:const-solid))
	  (triple-bond-pen
	   (make-object wx:pen% "BLACK" 5 wx:const-solid))
	  (force-vector-pen
	   (make-object wx:pen% "RED" 1 wx:const-solid))

	  (a-panel
	   (make-object wx:panel%
			a-frame
			0 0 PANEL-WIDTH PANEL-HEIGHT))
	  (load-button
	   (make-object wx:button%
			a-panel
			(lambda (self event)
			  (load-structure (wx:file-selector ""))
			  (update-display #t))
			"Load"))
	  (save-button
	   (make-object wx:button%
			a-panel
			(lambda (self event)
			  (save-structure (wx:file-selector ""))
			  (update-display #t))
			"Save"))
	  (save-xyz-button
	   (make-object wx:button%
			a-panel
			(lambda (self event)
			  (save-structure-xyz (wx:file-selector ""))
			  (update-display #t))
			"SaveXYZ"))
	  (clear-button
	   (make-object wx:button%
			a-panel
			(lambda (self event)
			  (clear-structure)
			  (update-display #t))
			"Clear"))
	  (emin-button
	   (make-object wx:button%
			a-panel
			(lambda (self event)
			  (emin-step)
			  (update-display #t))
			"Emin"))
	  (hide-button
	   (make-object wx:button%
			a-panel
			(lambda (self event)
			  (snooze))
			"HideGUI")))
	 (sequence
	   (send a-panel new-line))
	 (private
	  (show-forces-checkbox
	   (make-object wx:check-box%
			a-panel
			(lambda (self event)
			  (set! draw-force-vectors (send event checked?))
			  (update-display #t))
			"Show Force Vectors"))
	  (use-torsion-checkbox
	   (make-object wx:check-box%
			a-panel
			(lambda (self event)
			  (set! use-torsion-forces (send event checked?)))
			"Use Torsion Forces"))
	  (use-vdw-checkbox
	   (make-object wx:check-box%
			a-panel
			(lambda (self event)
			  (set! use-vdw-forces (send event checked?)))
			"Use VDW Forces")))
	 (sequence
	   (send a-panel new-line))
	 (public
	  (select-pen
	   (lambda (n)
	     (case n
	       ('force-vector (send canvas-dc set-pen force-vector-pen))
	       ('double-bond  (send canvas-dc set-pen double-bond-pen))
	       ('triple-bond  (send canvas-dc set-pen triple-bond-pen))
	       (else          (send canvas-dc set-pen normal-pen)))))
	  (atom-color
	   (lambda (element-name)
	     (cond
	      ((equal? element-name "C")
	       (send canvas-dc set-brush carbon-brush))
	      ((equal? element-name "H")
	       (send canvas-dc set-brush hydrogen-brush))
	      ((equal? element-name "O")
	       (send canvas-dc set-brush oxygen-brush))
	      (else
	       (send canvas-dc set-brush nitrogen-brush)))))
	  (re-center
	   (lambda ()
	      (set! center-x (* 0.5 canvas-width))
	      (set! center-y (* 0.5 canvas-height))))
	  (draw-line
	   (lambda (x1 y1 x2 y2)
	     (send canvas-dc draw-line x1 y1 x2 y2)))
	  (draw-ellipse
	   (lambda (x1 y1 d)
	     (send canvas-dc draw-ellipse x1 y1 d d)))
	  (delete-all
	   (lambda ()
	     (send canvas-dc clear))))
	 (private
	  (mode-selector
	   (make-object wx:radio-box%
			a-panel
			(lambda (self event)
			  (let ((n (send event get-command-int)))
			    (case n
			      (0 (set-action 'rotate))
			      (1 (set-action 'moveatom))
			      (2 (set-action 'addatom))
			      (3 (set-action 'deleteatom))
			      (4 (set-action 'addbond))
			      (5 (set-action 'deletebond)))))
			""
			-1 -1 -1 -1
			(list "Rotate" "MoveAtom" "AddAtom" "DeleteAtom"
			      "AddBond" "DeleteBond")))
	  (bond-order-selector
	   (make-object wx:radio-box%
			a-panel
			(lambda (self event)
			  (let ((n (send event get-command-int)))
			    (set! current-bond-order (+ n 1))))
			"Bond"
			-1 -1 -1 -1
			(list "Single" "Double" "Triple")))
	  (element-selector
	   (make-object wx:radio-box%
			a-panel
			(lambda (self event)
			  (let ((n (send event get-command-int)))
			    (case n
			      (0 (set! current-element "C"))
			      (1 (set! current-element "H"))
			      (2 (set! current-element "O"))
			      (else (set! current-element "N")))))
			""
			-1 -1 -1 -1
			(list "Carbon" "Hydrogen" "Oxygen" "Nitrogen")))
	  (zoom-factor
	   (make-object wx:radio-box%
			a-panel
			(lambda (self event)
			  (let ((n (send event get-command-int)))
			    (case n
			      (0 (set-zoomfactor 10.0))
			      (1 (set-zoomfactor 25.0))
			      (2 (set-zoomfactor 50.0))
			      (else (set-zoomfactor 100.0))))
			  (update-display #t))
			"Zoom"
			-1 -1 -1 -1
			(list "10" "25" "50" "100")))
	  (emin-convergence
	   (make-object wx:radio-box%
			a-panel
			(lambda (self event)
			  (let ((n (send event get-command-int)))
			    (case n
			      (0 (set! emin-factor fine-emin-factor))
			      (else (set! emin-factor coarse-emin-factor)))))
			"Emin"
			-1 -1 -1 -1
			(list "Fine" "Coarse"))))
	 (sequence
	   (send a-panel new-line)
	   (send a-panel fit))
	 (public
	  (force-rotate-mode
	   (lambda ()
	     (send mode-selector set-selection 0)
	     (set! press-function rotate-press)
	     (set! drag-function rotate-drag)
	     (set! release-function rotate-release))))
	 (private
	  (canvas-y
	   (let ((u (box 0)) (v (box 0)))
	     (get-cursor-hack a-panel u v)
	     (unbox v)))
	  (resize-canvas
	   (lambda (w h)
	     ;; (set! canvas-height (- h canvas-y))
	     (set! canvas-height h)
	     (set! canvas-width w)
	     (set! canvas
		   (make-object my-canvas%
				b-frame
				;; 0 canvas-y
				0 0
				canvas-width canvas-height
				wx:const-retained ""))
	     (send canvas-dc end-drawing)
	     (set! canvas-dc
		   (send canvas get-dc))
	     (send canvas-dc begin-drawing)
	     (update-display #t))))
	 (sequence
	   (set! error-msg
		 (lambda (txt)
		   (send canvas-dc draw-text txt 10 10)))
	   (set! warning-msg
		 (lambda (txt)
		   (send canvas-dc draw-text txt 10 20)))
	   (set-scale-factor 25.0)
	   (send zoom-factor set-selection 1)
	   (send use-vdw-checkbox set-value #t)
	   (send b-frame change-resize-function resize-canvas)
	   (re-center)
	   (awaken)
	   (send canvas-dc begin-drawing))))

(define (delete-all)
  (if this-session
    ((ivar this-session delete-all))))

(define (atom-color z)
  ((ivar this-session atom-color) z))

(define (select-pen z)
  ((ivar this-session select-pen) z))

(define (draw-line x1 y1 x2 y2)
  ((ivar this-session draw-line) x1 y1 x2 y2))

(define (draw-ellipse x1 y1 d)
  ((ivar this-session draw-ellipse) x1 y1 d))

(define (re-center)
  ((ivar this-session re-center)))

(define (show-gui)
  (if (not this-session)
      (set! this-session (make-object session%))
      (send this-session awaken)))

(define (hide-gui) (send this-session snooze))
(define (force-rotate-mode) (send this-session force-rotate-mode))