(in-package :lol)


(defun make-midi-send-button ()
  (make-dialog-item  'moving-button-view
                    #@(700 15)
                    #@(66 16)
                    "SEND"
                    #'(lambda (self)
                        (format t "~%date : ~S -> " (get-universal-time))
                        (copy (situation (view-container self))) ;nil ;(record-data view)
                        (reset-data (view-container self)))
                    :view-nick-name 'send-button
                    :default-button t))


(defclass RUN-SITUATION (situation)
   (
    )
   (:documentation "SITUATION (LOL class) : General class for situation and body classes.
Slots are :name :body :supports :directions :levels :rotations :amplitudes :flexions :contacts :qualities. ")
   )


(defmethod initialize-instance :after ((self run-situation) &key
                                         name
                                         danser
                                         creation-date
                                         verbose)
  (let ((name-of-situation (if name 
                             (make-new-symbol (read-from-string name))
                             (make-new-symbol 'situation)))
        )
    (when (danser self)
      (when (color (danser self))
        (setf (slot-value self  'color) (color (danser self)))))
    (setf (symbol-value name-of-situation) self)
    (when (not danser)
      (let ((danser (make-instance 'danser)))
        (setf (slot-value (symbol-value name-of-situation) 'danser) danser)))
    (setf (slot-value (symbol-value name-of-situation) 'name) (string name-of-situation))
    (when (not creation-date)
      (setf (slot-value (symbol-value name-of-situation) 'creation-date)  (get-universal-time)))
    (when verbose
      (format t "Situation ~S created.~%" (name (eval name-of-situation))))
    
    (values self)))


(defmethod instal-views-in-situation ((situation-window run-window))
  (if (not (body (situation situation-window)))
    (apply #'add-subviews (append (list situation-window)
                                  (make-situation-menubar situation-window)))
    
    (let* ((situation (update-dimension-list (situation situation-window)))
           (situation-data-views (when (data situation) (make-situation-data-name-views situation)))
           (dimensions-views (make-dimension-name-views situation))
           (bodypart-views (make-bodypart-name-views situation))
           (data-views (make-all-data-views situation-window))
           (dim-button (make-bodypart-dim-util-view situation))
           (danser-view (make-instance 'danser-view
                          :dialog-item-text (string (type-of (danser situation)))
                          :view-nick-name 'danser
                          :view-position #@(8 40)))
           
           )
      (apply #'add-subviews (append (list situation-window danser-view (make-midi-send-button))
                                    (make-situation-menubar situation-window)
                                    situation-data-views
                                    dimensions-views
                                    bodypart-views
                                    data-views
                                    dim-button
                                    ))
      ;(set-dialog-item-action-function (view-named 'send-button situation-window) #'(lambda () (print 'ok)))
      (update-dimension-situation-views situation-window)))
  (set-part-color situation-window :frame (color (situation situation-window)))
  (set-view-position situation-window 50 110)
  (window-select situation-window))


(defmethod reset-data ((self run-window))
  (let ((body (body (situation self))))
    (dolist (b body)
      (let ((dim (dimension-list b)))
        (dolist (d dim)
          (setf (datum d) 'w!))))
    
    (do-subviews (v self)
      (when (eq 'run-dimension-edit-view (type-of v))
        (when (bodypart v)
          (set-pop-up-menu-default-item (elt (view-subviews v) 0) 1)
          )))))


;;pas sur... ??
(defmethod update-dimension-situation-views ((view run-window))
  (let ((situation (situation view)))
    ;(update-dimension-list situation)
    (when (dimension-list situation)
      (loop for v in (coerce (view-subviews view) 'list)
            do
            
            (cond ((eq (find-class 'moving-situation-data-text-view) (class-of v))
                   (when (data situation)
                     (set-view-position v (+ 150 (* 140 (position (view-nick-name v)
                                                                  (mapcar #'name (data situation)))))
                                        30))
                   )
                  ((eq (find-class 'moving-dimension-text-view) (class-of v))
                   (set-view-position v (+ 115 (* 67 (position (view-nick-name v)
                                                               (dimension-list situation))))
                                      65))
                  ((eq (find-class 'moving-bodypart-text-view) (class-of v))
                   (set-view-position v
                                      10
                                      (+ 83 (* (+ 20 (font-line-height '("Monaco" 10 :bold)))
                                               (position (view-nick-name v)
                                                         (mapcar #'(lambda (x) (read-from-string (name x)))
                                                                 (body situation)))
                                               ))))
                  ((eq (find-class 'moving-menu-item-view) (class-of v))
                   (set-view-position v
                                      0
                                      (+ 95 (* (+ 20 (font-line-height '("Monaco" 10 :bold)))
                                               (position (view-nick-name v)
                                                         (mapcar #'(lambda (x) (read-from-string (name x)))
                                                                 (body situation)))
                                               ))))
                  (t (values))))
      (loop for v in (coerce (view-subviews view) 'list)
            do
            (if (eq (find-class 'run-dimension-edit-view) (class-of v))
              
              (let ((body (bodypart v)))
                ;(print 'hey!)
                (if body
                  (set-view-position v 
                                     (point-h (view-position (view-named (view-nick-name v) view)))
                                     (- (point-v (view-position (view-named (bodypart v) view))) 4))
                  (set-view-position v 
                                     (+ (point-h (view-position (view-named (view-nick-name v) view))) 
                                        (string-width (string (view-nick-name v)) '("Monaco" 10 :bold)) 15)
                                     19)))
              (values)))
      (set-view-size view
                     (+ 115 50 (* 67 (length (dimension-list situation)) ))
                     (+ 85 (* 35 (length (body situation))))))))

(defclass run-window (situation-window)
   ((situation :initarg :situation :initform nil :accessor situation)
    )
   (:default-initargs
     :window-type :document
     :view-size #@(240 100)
     :view-position #@(50 110)
     :color-p t
     :window-show nil
     )
   (:documentation "Class of data fiels"))


(defmethod initialize-instance :after ((self run-window)
                                         &key situation)
   (when (not situation) (setf situation (make-instance 'run-situation)))
   (setf (situation self) (eval situation))
   (set-view-nick-name self (name situation))
   (set-window-title self (name situation))
   (if (slot-value (situation self) 'color)
     (set-fore-color self (color (situation self)))
     (set-fore-color self *black-color*))
   ;(instal-views-in-situation self)  ;; not since initialize-instance for situation-window has already it.
   )

(defmethod view-draw-contents ((self run-window))
   (call-next-method))

(defclass run-dimension-edit-view (view)
   ((data :initarg :data :initform nil :accessor data)
    (bodypart :initarg :bodypart :initform nil :accessor bodypart)
    )
   (:default-initargs
     :view-size #@(50 40)
     ;:back-color *wind-sit-back-color*
     )
   (:documentation "Class of data fiels"))

(defmethod initialize-instance :after ((self run-dimension-edit-view)
                                         &key data)
   (when (not data) (setf (slot-value self 'data) (make-instance 'dimension)
                          data (data self)))
   (let (;(type (type data))
         ;(mode (mode data))
         ;(vset (values-set data))
         ;(free (free data))
         (data-view (make-data-view data 0 0))
         )
     (set-view-nick-name self (class-name (class-of data)))
     (apply #'add-subviews (append (list self 
                                         )
                                   data-view))
     
     ))


(defmethod make-all-data-views ((view run-window))
  (let* ((situation (situation view))
         (body (if situation (body situation) nil))
         (data (if situation (data situation) nil))
         bodyviews dataviews
         )
    
    (when body
      (setf bodyviews
            (apply #'append
                   (loop for b in body
                         collect (mapcar #'(lambda (dim)
                                             (make-instance 'run-dimension-edit-view
                                               :data dim
                                               :bodypart (if (stringp (name b))
                                                           (read-from-string (name b) nil)
                                                           (name b))))
                                         (dimension b))))))
    (when data
      (setf dataviews
            (loop for d in data
                  collect (when (not (view-named (type-of d) view))
                            
                            (make-instance 'run-dimension-edit-view
                            :data d
                            :bodypart nil)))))
                                       
    (append (remove 'nil dataviews) bodyviews)))

;;;; MENUS



(setf *RUN-menu* (make-instance 'menu
                   :menu-title "   RUN !   "
                   ))


;(setf *RUN-menu* nil)


(setf *run-carole* (make-instance 'menu-item
                     :menu-item-title "Carole"
                     :command-key #\1
                     :menu-item-action #'(lambda nil
                                           (let ((sit (make-instance 'run-situation
                                                        :name "Carole-run"
                                                        :danser (make-instance 'carole)
                                                        :data (list (make-instance 'plan)
                                                                    (make-instance 'orientation)
                                                                    (make-instance 'durŽe)
                                                                    (make-instance 'point))
                                                        :body (list (make-instance 'jambeg)
                                                                  (make-instance 'jambed)
                                                                  (make-instance 'brasg)
                                                                  (make-instance 'brasd)
                                                                  (make-instance 'maing)
                                                                  (make-instance 'maind)
                                                                  (make-instance 'tronc)
                                                                  (make-instance 'buste)
                                                                  (make-instance 'tete)
                                                                  (make-instance 'regard)
                                                                  )
                                                        :color 7084208)))
                                             (make-instance 'run-window
                                               :situation sit
                                               ;:color 7084208
                                               )))))


(setf *run-dana* (make-instance 'menu-item
                   :menu-item-title "Dana"
                   :command-key #\2
                   :menu-item-action #'(lambda nil
                                         (let ((sit (make-instance 'run-situation
                                                      :name "Dana-run"
                                                      :danser (make-instance 'dana)
                                                      :data (list (make-instance 'plan)
                                                                  (make-instance 'orientation)
                                                                  (make-instance 'durŽe)
                                                                  (make-instance 'point))
                                                      :body (list (make-instance 'jambeg)
                                                                  (make-instance 'jambed)
                                                                  (make-instance 'brasg)
                                                                  (make-instance 'brasd)
                                                                  (make-instance 'maing)
                                                                  (make-instance 'maind)
                                                                  (make-instance 'tronc)
                                                                  (make-instance 'buste)
                                                                  (make-instance 'tete)
                                                                  (make-instance 'regard)
                                                                  )
                                                      :color *red-color*)))
                                           (make-instance 'run-window
                                             :situation sit
                                             ;:color *red-color*
                                             )))))

(setf *run-dansers-menu* (make-instance 'menu
                         :menu-title "DANSER"
                         :menu-items (list *run-carole*
                                           *run-dana*)))


(setf *chrono-carole* (make-instance 'menu-item
                        :menu-item-title "CHRONO Carole"
                        ;:command-key #\1
                        :menu-item-action #'(lambda nil
                                              (make-instance 'chronometre
                                                :name 'carole
                                                :color 7084208))))


(setf *chrono-dana* (make-instance 'menu-item
                        :menu-item-title "CHRONO Dana"
                        ;:command-key #\1
                        :menu-item-action #'(lambda nil
                                              (make-instance 'chronometre
                                                :name 'dana
                                                :color *red-color*))))

(setf *chrono-gen* (make-instance 'menu-item
                        :menu-item-title "CHRONO"
                        ;:command-key #\1
                        :menu-item-action #'(lambda nil
                                              (make-instance 'chronometre
                                                :name 'general
                                                :color *black-color*))))

(setf *chrono-menu* (make-instance 'menu
                         :menu-title "Chronos"
                         :menu-items (list *chrono-carole*
                                           *chrono-dana*
                                           *chrono-gen*)))

(setf *separator* (make-instance 'menu-item
                         :menu-item-title "-"))


(add-menu-items *RUN-menu* *run-dansers-menu* *separator* *chrono-menu*)

(menu-install *RUN-menu*)
;(menu-deinstall *RUN-menu*)


#|


(setq a
(make-instance 'run-window
  :situation
  (make-instance 'run-situation
    :danser (make-instance 'carole)
    :data (list (make-instance 'plan)
                (make-instance 'orientation)
                (make-instance 'durŽe)
                (make-instance 'point))
    :body (list (make-instance 'bassin))))
)

|#