;;########################################################################
;; logoobj.lsp
;; Copyright (c) 1998 by Forrest W. Young
;; Creates a window containing the dynamic vista logo.
;;########################################################################

(defun make-logo (&key show margin (size (list 440 220))
                       (location (/ (- (screen-size) (list 440 260)) 2)) )
  (let ((object (send logo-proto :new 3 :show show :go-away nil
                      :margin margin :location location :size size)))
    object))

(defproto logo-proto 
  '(showing dynamic showable frames-per-rotation transf prev-text
            message-number lines nlines nclicks ready) ()
  graph-proto)

(defmeth logo-proto :isnew 
  (dims &key (show nil) (go-away t) (size (list 440 220))
        (location (/ (- (screen-size) (list 440 260)) 2))
        (margin nil)
        )
  (let ((object 
          (call-next-method dims :show show :go-away go-away
                 :size size 
                 :menu nil
                 :location 
#+macintosh           (/ (- (screen-size) size) 2)                            
#+X11                 (/ (- (screen-size) size) 2)                            
#+msdos               (list 0 0)
                            )))
#+msdos (send object :new-menu nil :items nil)
    (send object :title "ViSta: The Visual Statistics System")
    (send object :has-v-scroll (second size))
    (when (not *68040*) (send object :back-color 'logo-background))
    (cond 
      ((= *color-mode* 0)
       (send object :use-color nil)
       (send object :draw-color  'black)
       (send object :back-color 'white))
      (t
       (send object :use-color t)))
    (send object :message-number 1)
    (if margin
        (apply #'send object :margin margin)
        (send object :margin 0 0 0 20))
    (send object :line-data)
    (send object :draw-logo)
    (send object :prev-text " ")
    (send object :nlines (send object :num-lines))
    (send object :linestart-coordinate 2 (iseq (send object :num-lines))
          (repeat 0 (send object :num-lines)))
    (send object :scale-type 'variable)
#+macintosh(send object :menu nil)
    (send object :showing t)
    (send object :nclicks 0)
    object))

(defmeth logo-proto :showing (&optional (logical nil set))
  (if set (setf (slot-value 'showing) logical))
  (slot-value 'showing))

(defmeth logo-proto :showable (&optional (logical nil set))
  (if set (setf (slot-value 'showable) logical))
  (slot-value 'showable))

(defmeth logo-proto :dynamic (&optional (logical nil set))
  (if set (setf (slot-value 'dynamic) logical))
  (slot-value 'dynamic))

(defmeth logo-proto :ready (&optional (logical nil set))
  (if set (setf (slot-value 'ready) logical))
  (slot-value 'ready))

(defmeth logo-proto :frames-per-rotation (&optional (number nil set))
  (if set (setf (slot-value 'frames-per-rotation) number))
  (slot-value 'frames-per-rotation))

(defmeth logo-proto :transf (&optional (matrix nil set))
  (if set (setf (slot-value 'transf) matrix))
  (slot-value 'transf))

(defmeth logo-proto :lines (&optional (list nil set))
  (if set (setf (slot-value 'lines) list))
  (slot-value 'lines))

(defmeth logo-proto :nlines (&optional (list nil set))
  (if set (setf (slot-value 'nlines) list))
  (slot-value 'nlines))

(defmeth logo-proto :nclicks (&optional (number nil set))
  (if set (setf (slot-value 'nclicks) number))
  (slot-value 'nclicks))

(defmeth logo-proto :message-number (&optional (number nil set))
  (if set (setf (slot-value 'message-number) number))
  (slot-value 'message-number))

(defmeth logo-proto :prev-text (&optional (string nil set))
  (if set (setf (slot-value 'prev-text) string))
  (slot-value 'prev-text))

(defmeth logo-proto :redraw-content ()
  (call-next-method)
  (when (not (send self :dynamic)) 
        (send self :add-text (send self :message-number))))

;(defmeth logo-proto :redraw-background ()
;  (when (send self :use-color) 
;        (send self :back-color 'logo-background))
;  (call-next-method))

(defmeth logo-proto :remake (&optional (case 1))
  (send self :transformation nil :draw nil)
  (send self :clear-lines :draw nil)
  (send self :draw-logo)
  (send self :adjust-to-data :draw nil)
  (send self :add-text case))

(defmeth logo-proto :line-data ()
  (let* ((c (first (* 5000 (uniform-rand 1))))
         ( Vx '(0 3 6 3 0)) 
         ( Vy '(10 0 10 4 10))
         ( Vz (* c (uniform-rand 5)))
         ( ix '(8 10 9 9 8))
         ( iy '(0 1.5 1 5 0))
         ( iz (* c (uniform-rand 5)))
         ( idotx '(9 9 10 9))
         ( idoty '(5.5 6.5 7 5.5))
         ( idotz (* c (uniform-rand 4)))
         ( stopx '(12 15 18 15 12))
         ( stopy '(8 9 8 10 8))
         ( stopz (* c (uniform-rand 5)))
         ( smidx '(12 15 18 15 12))
         ( smidy '(8 6 2 4 8))
         ( smidz (* c (uniform-rand 5)))
         ( sbotx '(12 15 18 15 12))
         ( sboty '(2 1 2 0 2))
         ( sbotz (* c (uniform-rand 5)))
         ( tupx '(21 24 22 22 21))
         ( tupy '(0 1.5 1 7 0))
         ( tupz (* c (uniform-rand 5)))
         ( tbarx '(21 24 21 21))
         ( tbary '(5 6 4.5 5))
         ( tbarz (* c (uniform-rand 4)))
         ( ax '(26 28 30 28 26))
         ( ay '(0 4 0 7 0))
         ( az (* c (uniform-rand 5)))
         ( abarx '(26 30 26 26))
         ( abary '(1.75 3.25 2.25 1.75))
         ( abarz (* c (uniform-rand 4)))
         )
    (send self :lines 
          (list Vx Vy Vz;1
                ix iy iz idotx idoty idotz;5
                stopx stopy stopz smidx smidy smidz sbotx sboty sbotz ;11
                tupx tupy tupz tbarx tbary tbarz;15
                ax ay az abarx abary abarz))
    (send self :lines)))

(defmeth logo-proto :draw-logo ()
  (cond
    ((send self :use-color)
     (send self :draw-color 'black)
     (let ((color 'magenta)
           (lines (send self :lines)))
       ;(break)
       (mapcar #'(lambda (i) 
                   (cond
                     ((= i 3) (setf color 'red))
                     ((= i 9) (setf color 'blue))
                     ((= i 18) (setf color 'green))
                     ((= i 24) (setf color 'cyan))
                     )
                   (send self :add-lines 
                         (list (select lines i) 
                               (select lines (1+ i))
                               (select lines (+ i 2))) 
                         :draw nil :width 3 :color color))
               (* 3 (iseq (floor (/ (length lines) 3)))))))
    (t
     (let ((lines (send self :lines)))
       ;(break)
       (mapcar #'(lambda (i) 
                   (send self :add-lines 
                         (list (select lines i) 
                               (select lines (1+ i))
                               (select lines (+ i 2))) 
                         :draw nil :width 3))
               (* 3 (iseq (floor (/ (length lines) 3)))))))))


(defmeth logo-proto :change-coordinates ()
  (let* ((loops (send self :line-data))
         (num-loops (/ (length loops) 2))
         (nums nil))
    (dotimes (i num-loops)
             (setf nums (combine nums 
                     (send self :rand (length (select loops (* 2 i)))))))
    (send self :linestart-coordinate 2 
          (iseq (send self :nlines)) (rest nums))))

(defmeth logo-proto :rand (n)
  (let ((nums (normal-rand n)))
    (setf (select nums 0) (select nums (- n 1)))
    nums))

(defmeth logo-proto :glide  
  (seconds-per-rotation nrotations fade-seconds direction 
                        &optional initialize-only)
;(format t "LOGO: ~d~%"(list seconds-per-rotation nrotations 
 ;                           fade-seconds direction 
  ;                          initialize-only))
  (let* (( frames-per-rotation 240)
         ( frames-per-second nil)
         (fade-frames nil)
         (c (cos (/ pi (/ frames-per-rotation 2))))
         (s (sin (/ pi (/ frames-per-rotation 2))))
         (u (* 1 (first (- (uniform-rand 1) .5))))
         (v (* 1 (first (- (uniform-rand 1) .5))))
         (w (* 1 (first (- (uniform-rand 1) .5))))
         (r (matrix '(3 3) (list 0        u  v 
                                 (- u)    0  w 
                                 (- v) (- w) 0) ))
         (z (identity-matrix 3))
         (m (+ (* c z) (* s r )))
         ( start (get-internal-real-time))
         ( finish nil)
         ( elapsed 0)
         ( previous-elapsed 0)
         ( k 0))
    (send self :dynamic t)
    (cond 
      ((send self :transf)
       (setf m (send self :transf))
       (setf frames-per-rotation (send self :frames-per-rotation)))
      (t
;wait for a clock tick
       (loop
        (setf finish (get-internal-real-time))
        (when (> finish start) (return)))
       (setf start finish)
       ;figure out how fast we are spinning with null rotation
       (dotimes (i frames-per-rotation)
                (setf k (1+ k))
                (send self :apply-transformation z :draw nil)
                (send self :scale (iseq 4) (send self :scale (iseq 4)))
                (setf finish (get-internal-real-time))
                (setf elapsed (/ (- finish start) 
                                 internal-time-units-per-second))
                (when (/= elapsed previous-elapsed) (return)))
       (setf previous-elapsed elapsed)
       (setf frames-per-second (round (/ k elapsed)))
       (setf frames-per-rotation 
             (round (* frames-per-second seconds-per-rotation)))
       (send self :frames-per-rotation frames-per-rotation)
       (setf c (cos (/ pi (/ frames-per-rotation 2))))
       (setf s (sin (/ pi (/ frames-per-rotation 2))))
       (setf m (+ (* c (identity-matrix 3)) (* s r )))
       (when initialize-only (send self :transf m))))
    (send self :ready t)
    (when (not initialize-only)
          (send self :showing t)
;do the desired rotations at the determined speed
          (when (> nrotations 0)
          (dotimes (i (*  nrotations frames-per-rotation))
                   ; (send self :center 0 (send self :center 0) :draw nil)
                   ; (send self :center 1 (send self :center 1) :draw nil)
                   (send self :apply-transformation m :draw nil)
                   (send self :scale (iseq 4) (send self :scale (iseq 4)))))
;fade near (direction +) or away (direction -)
          (setf fade-frames (* fade-seconds frames-per-rotation))
          (setf frames-per-rotation (floor (/ frames-per-rotation 1)))
          (setf c (cos (/ pi (/ frames-per-rotation 2))))
          (setf s (sin (/ pi (/ frames-per-rotation 2))))
          (setf m (+ (* c (identity-matrix 3)) (* s r )))
          (setf k 0)
          (when (> fade-seconds 0)
                (dotimes 
                 (j fade-seconds)
                 (dotimes 
                  (i frames-per-rotation)
                  (when (< k (- fade-frames 5)) (setf k (1+ k)))
                  (send self :apply-transformation m :draw nil)
                  (send self :scale (iseq 4)
                        (* (send self :scale (iseq 4))
                           (if (> direction 0)
                               (/ 1 (^ (/  fade-frames (- fade-frames k)) 
                                       .25))
                               (^ (/  fade-frames (- fade-frames k)) 
                                  .06))))      
                  )))
          (send self :dynamic nil)
          (send self :ready nil)
         ; (pause 30)
          #+msdos    (send self :close)
          #+X11    (send self :close)
          #+macintosh(send self :showing nil)
          #+macintosh(send self :hide-window)
          t)))

(defmeth logo-proto :write-text (text)
  (let* ((loc (send self :real-to-canvas 15 12))
         (prev-text (send self :prev-text))
         (back-color (send self :back-color))
         (draw-color (send self :draw-color))
         )
    (send self :draw-color back-color)
    (send self :draw-text prev-text (first loc) (second loc) 1 1)
    (send self :draw-color draw-color)
    (send self :draw-text text (first loc) (second loc) 1 1)
    (send self :prev-text text)))
    
(defmeth logo-proto :add-text (&optional (case 1))
  (let* ((text-size (+ 1 (send self :text-ascent) (send self :text-descent)))
         (next-line (list 0 text-size))
         (textlocxy0 (send self :real-to-canvas 15 12))
         (textlocxy  (- textlocxy0 next-line))
         (textlocxy1 (send self :real-to-canvas 15  -1))
         (textlocxy2 (+ textlocxy1 next-line))
         (textlocxy3 (+ textlocxy2 next-line)) 
         ) 
    (flet ((vistatext ()
             (send self :draw-text "ViSta: The Visual Statistics System" 
                   (first textlocxy1) (second textlocxy1) 1 1))
           (waittext ()
             (send self :draw-text "Initialization will take a moment." 
                   (first textlocxy) (second textlocxy) 1 1))
           (clicktext ()
             (send self :draw-text "Please click for more information." 
                   (first textlocxy0) (second textlocxy0) 1 1)))
      (case case
        (1 (vistatext) (waittext)
           (send self :draw-text *copyright-string* 
                 (first textlocxy2) (+ 0 (second textlocxy2)) 1 1)
           (send self :draw-text *version-string*
                 (first textlocxy3) (second textlocxy3) 1 1))
        (2 (vistatext) (clicktext)
           (send self :draw-text *copyright-string* 
               (first textlocxy2) (+ 0 (second textlocxy2)) 1 1)
           (send self :draw-text *version-string*
                 (first textlocxy3) (second textlocxy3) 1 1))
        (3 (clicktext)
           (send self :draw-text "Current documentation and code can be" 
                 (first textlocxy1) (+ 0 (second textlocxy1)) 1 1)
           (send self :draw-text "obtained from http://forrest.psych.unc.edu/" 
                 (first textlocxy2) (+ 0 (second textlocxy2)) 1 1)
           (send self :draw-text "Email: forrest@unc.edu"
                 (first textlocxy3) (second textlocxy3) 1 1))
        (4 (clicktext)
           (send self :draw-text "Designed by Forrest W. Young with thanks to:" 
                 (first textlocxy1) (second textlocxy1) 1 1)
           (send self :draw-text "David Lubinsky, John B. Smith," 
                 (first textlocxy2) (+ 0 (second textlocxy2)) 1 1)
           (send self :draw-text "Rich Faldowski and Carla Bann."
                 (first textlocxy3) (second textlocxy3) 1 1))
        (5 (clicktext)
           (send self :draw-text "Implemented by Forrest W. Young" 
                 (first textlocxy1) (second textlocxy1) 1 1)
           (send self :draw-text "French translation by Louis Le Guelte" 
                 (first textlocxy2) (+ 0 (second textlocxy2)) 1 1)
           (send self :draw-text "Spanish translation by Pedro Valero" 
                 (first textlocxy3) (+ 0 (second textlocxy3)) 1 1))
        (6 (clicktext)
           (send self :draw-text "Code contributed by Carla Bann, Lee Bee Leng"
                 (first textlocxy1) (second textlocxy1) 1 1)
           (send self :draw-text "Rich Faldowski, Mary McFarland, Chris Weisen," 
                 (first textlocxy2) (+ 0 (second textlocxy2)) 1 1)
           (send self :draw-text "David Flora, Charles Kurak and Tony Rossini"
                 (first textlocxy3) (second textlocxy3) 1 1))
           ))
           
        ))
  
(defmeth logo-proto :random-rotate ()
  (let* ((c (cos (/ pi 200)))
         (s (sin (/ pi 200)))
         (m nil))
    (setf m (+ (* c (identity-matrix 3))
               (* s (matrix '(3 3) 
                 (list 0  (first (uniform-rand 1))  (first (uniform-rand 1))
                       0   0  (first (uniform-rand 1))
                       0   0   0)))))
    (setf (select m 1 0) (- (select m 0 1)))
    (setf (select m 2 0) (- (select m 0 2)))
    (setf (select m 2 1) (- (select m 1 2)))
    (dotimes (i 10) (send *logo* :apply-transformation m))))

(defun fade-splash-screen (*logo*)
  (send *logo* :nclicks 5)
  (send *logo* :message-number 7)
  (send *logo* :ready t)
  (send *logo* :do-idle)
  (send *logo* :glide 1 1 3 -1) )

(defun about-vista-with-logo ()
  (setf *logo* (make-logo));#+msdos 
  (send *logo* :showing nil);#+msdos
  (send *logo* :idle-on (not (send *logo* :idle-on)))
  (when (send *logo* :idle-on) (setf nclicks 0))
  #+msdos(send *logo* :do-key "a" nil nil)
  (send *logo* :message-number 2)
  (send *logo* :ready t)
  (if (send *logo* :idle-on)
      (send *logo* :do-idle)
      (send *logo* :do-key "a" nil nil)))

(defun screen-saver ()
  (setf *screen-saver* (make-logo :location '(0 0) :size screen-size)) 
  (send *screen-saver* :showing nil)
  (send *screen-saver* :location 1 -18)
  (apply #'send *screen-saver* :size (+ '(20 40) screen-size))
  #+macintosh(defmeth *screen-saver* :do-motion (x y)
               (send self :do-key "a" nil nil))
  (send *screen-saver* :idle-on t)
  (send *screen-saver* :nclicks 5)
  (send *screen-saver* :message-number 7)
  (send *screen-saver* :show-window)
  (send *screen-saver* :glide 15 1 3 -1 t)
  (send *screen-saver* :showable t)
  (send *screen-saver* :idle-on t)
  (send *screen-saver* :do-idle))

(defun exit-logo ()
  (setf *screen-saver* (make-logo :location '(0 0) :size screen-size)) 
  (send *screen-saver* :showing nil)
  (send *screen-saver* :location 1 -18)
  (apply #'send *screen-saver* :size (+ '(20 40) screen-size))
  #+macintosh(defmeth *screen-saver* :do-motion (x y)
               (send self :do-key "a" nil nil))
  (send *screen-saver* :nclicks 5)
  (send *screen-saver* :message-number 7)
  (send *screen-saver* :show-window)
  (pause 90)
  (send *screen-saver* :close))

(defmeth logo-proto :do-idle ()
  (when (not (send self :showable))
        (send self :showable t)
        (send self :remake))
  (when (not (send self :showing))
        (send self :dynamic nil)
        (send self :show-window)
        (send self :showing t)
        (send self :redraw))
  (when (send self :showing)
        (when (send self :transf)
              (send self :apply-transformation (send self :transf)))))

(defmeth logo-proto :do-key (c m1 m2)
  (when (send self :ready)
        (send self :dynamic t)
        (send self :redraw)
        (let ((nclicks (send self :nclicks)))
          (setf nclicks (1+ nclicks))
          (send self :nclicks nclicks)
          (case nclicks
            #+msdos(0 (send self :add-text 2))
            (1 (send self :add-text 3))
            (2 (send self :add-text 4))
            (3 (send self :add-text 5))
            (4 (send self :add-text 6))
            (5 (send self :nclicks 0) 
               (send self :glide 1 1 3 -1)
               (send self :showing nil)
               (send self :idle-on nil)
               (send self :showable nil))
            (6 (send self :nclicks 0)
               (send self :frames-per-rotation 
                     (floor (/ (send self :frames-per-rotation) 3)))
               (send self :glide 0 0 1 -1)
               (send self :showing nil)
               (send self :idle-on nil)
               (send self :showable nil))
            ))))

(defmeth logo-proto :do-click (x y m1 m2)
  (send self :do-key "a" m1 m2))
