;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: DEMOS-CONTROLLER; Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;         The Garnet User Interface Development Environment.      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This code was written as part of the Garnet project at          ;;;
;;; Carnegie Mellon University, and has been placed in the public   ;;;
;;; domain.  If you are using this code or any part of Garnet,      ;;;
;;; please contact garnet@cs.cmu.edu to be put on the mailing list. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; This file contains the main demos controller
;;;
;;; ** Call (Do-Go) to start and (Do-Stop) to stop **
;;;
;;; Designed and implemented by Osamu Hashimoto
;;; 27-Oct-92 Mickish - Added export to work around CMUCL bug
;;;  4-Jun-92 Myers/Pervin - Added demo-animator; changed "animate" to "logo".
;;;  13-Apr-92 Brad Myers -  Changed demo-fade to demo-logo
;;;  3-Apr-92 Mickish - Added Demo-Gesture
;;;  2-Apr-92 McDaniel - New multifont
;;; 30-Mar-92 Pervin - Added demo-circle, demo-array.
;;; 25-Feb-92 Pervin - Removed some unnecessary demos like mode, clock, truck.
;;;			Also, added some :constant slots.
;;; 13-Feb-92 Pervin - Merged color and non-color versions of demos.
;;; 10-Oct-91 Mickish - Added color-demo-fade
;;; 14-Mar-91 Mickish - Added demo-graph
;;; 13-Mar-91 Pervin Test whether using color screen.
;;;           If so, use color versions of demos.
;;; 13-Mar-91 Mickish - Added demo-motif and demo-truck
;;; 15-Nov-90 Pervin In Do-Stop, added test that item is not "animate".
;:;  5-Nov-90 Pervin In Garnet-Note-Quitted, added a test that win is boundp.

(in-package "DEMOS-CONTROLLER" :use '("LISP" "KR"))
(export '(Do-Go Do-Stop))

;; Load multifont stuff.
(unless (get :garnet-modules :multifont)
   (load (merge-pathnames "multifont-loader"
                          #+cmu "opal:"
                          #+(not cmu) user::Garnet-Opal-PathName)
         :verbose T)
)

(dolist (file '("x-buttons-loader"
		"text-buttons-loader"
		"scrolling-window-loader"))
  (load (merge-pathnames file
			 #+cmu "gadgets:"
			 #+(not cmu) user::Garnet-Gadgets-PathName)))

(load (merge-pathnames "demo-logo"
		       #+cmu "demos:"
		       #+(not cmu) user::Garnet-Demos-PathName))

;; export nothing, just work around a bug in CMUCL.
;; If didn't export here, CMUCL's overzealous optimizing compiler would
;; screw up the reference to demo-logo:do-go in the code below.
#+cmu (export '())

(defparameter *package-list*
   '(("3d" DEMO-3D)("angle" DEMO-ANGLE)("animator" DEMO-ANIMATOR)("arith" DEMO-ARITH)
     ("array" DEMO-ARRAY) ("circle" DEMO-CIRCLE)
     ("editor" DEMO-EDITOR)("file-browser" DEMO-FILE-BROWSER)
     ("gadgets" DEMO-GADGETS) ("gesture" DEMO-GESTURE)
     ("grow" DEMO-GROW)("manyobjs" DEMO-MANYOBJS)
     ("menu" DEMO-MENU)("moveline" DEMO-MOVELINE)("multifont" DEMO-MULTIFONT)
     ("multiwin" DEMO-MULTIWIN)("othello" DEMO-OTHELLO)("pixmap" DEMO-PIXMAP)
     ("schema-browser" DEMO-SCHEMA-BROWSER)
     ("scrollbar" DEMO-SCROLLBAR)("sequence" DEMO-SEQUENCE)("text" DEMO-TEXT)
     ("twop" DEMO-TWOP)("xasperate" DEMO-XASPERATE)
     ("calculator" DEMO-CALCULATOR)
     ("motif" DEMO-MOTIF) ("graph" DEMO-GRAPH)))

(defparameter *running* NIL)

(defparameter *unloaded*
    '("3d" "angle" "animator" "array" "arith" "calculator" "circle" "editor"
      "file-browser" "gadgets" "othello" "grow" "manyobjs" "menu" "moveline"
      "multifont" "multiwin" "pixmap" "schema-browser" "scrollbar" "sequence"
      "text" "twop" "xasperate" "motif" "graph" "gesture"))

(defun Do-Go ()
  (setq *running* NIL)
  (demo-logo:do-go :dont-enter-main-event-loop T)

  (create-instance 'win1 inter:interactor-window
    (:left 0)(:top 240)(:width 270)(:height 460)
    (:title "Demos Controller")
    (:aggregate (create-instance 'agg1 opal:aggregate)))

  (create-instance 'bt garnet-gadgets:x-button-panel
    (:constant T)
    (:left 2)(:top 40)
    (:selection-function 'dispatcher)
    (:rank-margin (o-formula (ceiling (length (gvl :items)) 2)))
    (:items
        '("3d" "angle" "animator" "arith" "array" "calculator" "circle" "editor"
          "file-browser" "gadgets" "gesture" "graph" "grow" "logo" "manyobjs" "menu"
          "motif" "moveline" "multifont" "multiwin" "othello" "pixmap"
	  "schema-browser" "scrollbar" "sequence" "text" "twop" "xasperate")))

  (create-instance 'qbt garnet-gadgets:text-button
    (:constant T)
    (:left 2)(:top 2)(:shadow-offset 3)
    (:font (create-instance NIL opal:font (:size :medium)(:face :bold)))
    (:string "Quit")
    (:selection-function #'quit*))

  (opal:add-components agg1 bt qbt)

  (create-instance 'win2 garnet-gadgets:scrolling-window-with-bars
    (:constant T :except :top :left :width :height :title :total-height)
    (:left 0)(:top 720)(:width 700)(:height 180)
    (:title "Instructions for Demos")
    (:h-scroll-bar-p NIL)
    (:total-width 700)
    (:total-height (o-formula (+ 5 (gvl :inner-aggregate :height)) 200)))

  (opal:update win1)
  (opal:update win2)

  (create-instance 'text opal:multifont-text
    (:left 5)(:top 5)
    (:strings ""))

  (opal:add-components (g-value win2 :inner-aggregate) text)

  (opal:update win2)
  ;;if not CMU CommonLisp, then start the main event loop to look for events
  #-cmu (inter:main-event-loop)
)

(defun Do-Stop ()
    (dolist (item *running*)
      (unless (string= item "logo")
        (funcall (intern "DO-STOP"
            (cadar (member item *package-list* :key #'car :test #'string=))))))
    (demo-logo:do-stop)
    (opal:destroy win1)
    (opal:destroy win2)
    (setq win1 NIL)
  ;;if not CMU CommonLisp, then exit the main event loop
    #-cmu (inter:exit-main-event-loop)
)

(defun quit* (inter obj)
    (declare (ignore inter obj))
    (do-stop))

(create-instance 'big-font (create-instance NIL opal:font
					    (:size :very-large)
					    (:face :bold-italic)))

(defun start (objlist)
    (when (string= (car objlist) "logo") 
	  (opal:set-strings text " ")
	  (opal:update win2)
	  (demo-logo:re-animate)
	  (return-from start))
    (opal:set-strings text
		     (list ""
			   (list (cons "Please wait... Loading." big-font))))
    (opal:update win2)
    (let ((kr::*warning-on-create-schema* nil))
      (when (member (car objlist) *unloaded* :test #'string=)
            (load 
              (merge-pathnames
                    (concatenate 'string
				 "demo-"
			         (car objlist))
                #+cmu "demos:"
                #-cmu user::Garnet-Demos-PathName))
            (setq *unloaded* (remove (car objlist) *unloaded* :test #'string=)))
      (opal:set-strings text (string-trim (list #\newline #\space)
       (with-output-to-string (*standard-output*)
        (funcall
         (intern "DO-GO"
          (cadar (member (car objlist) *package-list* :key #'car
                         :test #'(lambda (a b)
;  FOR DEBUGGING                   (format t "~S ~S~%" a b)
                                   (string= a b)))))
         :dont-enter-main-event-loop T)))))
    (garnet-gadgets:scroll-win-to win2 0 0)
    (opal:update win2))

(defun deselected (objlist)
    (dolist (item *running*)
        (unless (member item objlist :test #'string=)
            (return-from deselected item))))

(defun stop (item)
    (opal:set-strings text "")
    (opal:update win2)
    (when (string= item "logo") (return-from stop))
    (funcall (intern "DO-STOP"
        (cadar (member item *package-list* :key #'car :test #'string=)))))

(defun dispatcher (inter obj)
    (declare (ignore inter obj))
    (let ((objlist (g-value bt :value)))
      (if (> (length objlist) (length *running*))
        (start objlist)
        (stop (deselected objlist)))
      (setq *running* (copy-list objlist))))

(defun user::Garnet-Note-Quitted (package)
  (let ((button-name NIL))
  (when (and (boundp 'win1) win1)
    (dolist (item *package-list*)
      (when (string= package (symbol-name (cadr item)))
          (setq button-name (car item))
          (return)))
    (s-value bt :value (remove button-name (g-value bt :value) :test #'string=))
    (setq *running* (copy-list (g-value bt :value)))
    (opal:update win1)
    T)))
