(in-package :LED-cube)

(defparameter *transformations* nil)

(defmacro define-cube-transformation (name lambda-list &rest body)
  `(progn
     (pushnew ',name *transformations*)
     (defun ,name ,lambda-list
       (clim-sys:with-recursive-lock-held (*animation-lock*)
         (save-undo)
         (with-disabled-save-undo
             ,@body)))))

(define-cube-transformation matrix-effect ()
  (delete-animation)
  
  (dotimes (i 149)
    
    ;; switch off LEDs of plane z=0
    (dotimes (x 5)
      (dotimes (y 5)
        (setf (aref (current-cube) x y 0) #\0)))
    
    ;; move cube one step in direction (x y z)=(1 1 -1)
    (move-cube :y -1)
    
    ;; switch on some LEDs of plane z=4
    (flet ((set-random-upper-led (&optional (intensity #\5))
             (setf (aref (current-cube) (random 5) (random 5) 4) intensity)))
      (dotimes (i (random 3))
        (set-random-upper-led)))
    
    ;; insert cube copy and move to it
    (insert-cube-copy :position :after
                      :move-to-new-cube t))
  
  ;; apply LED-shadow effect
  (LED-shadow)
  
  (goto-cube :first))
  
(defun LED-shadow-unlooped (&optional (animation *animation*))
  (let ((new-animation (loop for i from 1 to (length animation)
                          collect (make-cube))))
    (dotimes (i (length new-animation))
      (do-cube-times (x y z)
        (let* ((new-cube (nth i new-animation)))
          (loop for j from (min i (- (length animation) 1))
                      downto (max 0 (- i 5))
             do (let* ((k (- i j))
                       (cube (nth j animation))
                       (intensity (max 0
                                       (- (ensure-intensity-to-be-of-number (aref cube x y z))
                                          k))))
                  (when (> intensity
                           (ensure-intensity-to-be-of-number (aref new-cube x y z)))
                    (setf (aref new-cube x y z) (ensure-intensity-to-be-of-character intensity)))
                  #+nil (format *trace-output* "~a ~a ~a (~a ~a ~a) ~a ~a ~a~%"
                                i j k
                                x y z
                                (aref cube x y z)
                                intensity
                                (aref new-cube x y z)))))))
    new-animation))
  

(define-cube-transformation LED-shadow ()
  (let* ((times 4)
         (number-of-last-cube (1- (length *animation*)))
         (*current-cube-number* 0))
    (dotimes (i times)
      (insert-cube-copy :position :before :cube-to-copy (nth number-of-last-cube *animation*))
      ;; wrong, as insert-cube-copy increses animation size by one: ;; (decf number-of-last-cube)
      )
    (setf *animation* (led-shadow-unlooped))
    (dotimes (i times)
      (delete-cube)))
  *animation*)

(define-cube-transformation LED-shadow-with-fade-out ()
  (setf *animation* (led-shadow-unlooped (append *animation*
                                                 (loop for i from 1 to 5 collect (make-cube))))))

(define-cube-transformation LED-shadow-with-fade-in ()
  ;; make fade-in animation
  (let (fade-in
        (times 5))
    (dotimes (i times)
      (push (copy-cube (nth i *animation*)) fade-in))
    (setf fade-in (nreverse (led-shadow-unlooped (append fade-in (loop for i from 1 to 5 collect (make-cube))))))
    
    ;; replace original beginning by fade-in animation
    (let ((*current-cube-number* 0))
      (dotimes (i times)
        (delete-cube)))
    (setf *animation* (append fade-in *animation*))))

(define-cube-transformation LED-shadow-with-fade-in+out ()
  (led-shadow-with-fade-out)
  (led-shadow-with-fade-in))


(define-cube-transformation mirrored-animation ()
  (setf *animation* (nreverse (mapcar #'copy-cube *animation*))))

(define-cube-transformation append-mirrored-animation ()
  (setf *animation* (append *animation* (nreverse (mapcar #'copy-cube *animation*)))))


(defun invert-LEDs (&optional (cube (current-cube)))
  (let ((new-cube (make-cube)))
    (do-cube-times (x y z)
      (setf (aref new-cube x y z)
            (ensure-intensity-to-be-of-character
             (- 5 (ensure-intensity-to-be-of-number (aref cube x y z))))))
    new-cube))

(define-cube-transformation invert-current-LEDs ()
  (setf (current-cube) (invert-LEDs)))

(define-cube-transformation invert-all-cubes ()
  (setf *animation* (mapcar (lambda (cube)
                              (invert-LEDs (copy-cube cube)))
                            *animation*)))

(define-cube-transformation append-inverted-animation ()
  (setf *animation* (append *animation*
                            (mapcar (lambda (cube)
                                      (invert-LEDs (copy-cube cube)))
                                       *animation*))))


(define-cube-transformation copy-x-0-0-to-all ()
  (dolist (cube *animation*)
    (dotimes (x *cube-dimension*)
      (let ((led (aref cube x 0 0)))
;;	(princ led)
	(dotimes (y *cube-dimension*)
	  (dotimes (z *cube-dimension*)
	    (setf (aref cube x y z) led))))
;;      (princ #\newline)
      )))


(defvar *character-map* (make-hash-table))

(defun get-character-definition (character)
  (gethash (char-upcase character) *character-map*))

(flet ((add-character (character led-map)
         (setf (gethash character *character-map*)
               (with-input-from-string (s led-map)
                 (loop for row = (read-line s nil nil)
                    while row
                    for translated-row = (loop for col across row
                               when (digit-char-p col 6)
                               collect col)
                      unless (zerop (length row)) collect translated-row)))))
  (add-character #\A "
05500
50050
55550
50050
50050")
  (add-character #\B "
55500
50050
55500
50050
55500")
  (add-character #\C "
05550
50000
50000
50000
05550")
  (add-character #\D "
55500
50050
50050
50050
55500")
  (add-character #\E "
55550
50000
55500
50000
55550")
  (add-character #\F "
55550
50000
55500
50000
50000")
  (add-character #\G "
05550
50000
50550
50050
05550")
  (add-character #\H "
50050
50050
55550
50050
50050")
  (add-character #\I "
05550
00500
00500
00500
05550")
  (add-character #\J "
00500
00500
00500
50500
05500")
  (add-character #\K "
50050
50500
55000
50500
50050")
  (add-character #\L "
50000
50000
50000
50000
55550")
  (add-character #\M "
50005
55055
50505
50005
50005")
  (add-character #\N "
50005
55005
50505
50055
50005")
  (add-character #\O "
05550
50005
50005
50005
05550")
  (add-character #\P "
55500
50050
55500
50000
50000")
  (add-character #\Q "
05550
50005
50505
50055
05550")
  (add-character #\R "
55550
50050
55500
50500
50050")
  (add-character #\S "
05550
50000
05500
00050
55500")
  (add-character #\T "
55555
00500
00500
00500
00500")
  (add-character #\U "
50050
50050
50050
50050
05500")
  (add-character #\V "
50005
50005
50005
05050
00500")
  (add-character #\W "
50005
50005
50005
50505
05050")
  (add-character #\X "
50005
05050
00500
05050
50005")
  (add-character #\Y "
50005
05050
00500
00500
00500")
  (add-character #\Z "
55555
00050
00500
05000
55555")
  (add-character #\Space ""))

(defun make-character-cube (character)
  (let ((cube (make-cube))
        (char-definition (get-character-definition character)))
    (loop for row-nr downfrom (1- (length char-definition))
       for row in char-definition
       do (loop for col-nr downfrom (1- (length row))
             for col in row
             do (setf (aref cube 0 col-nr row-nr) col)))
    cube))

(define-cube-transformation insert-text ()
  (let ((string "")
        (*current-cube-number* *current-cube-number*))
    (clim:accepting-values (stream :own-window t)
      (setf string (clim:accept 'string :default string :prompt "Text" :stream stream))
      (fresh-line stream))
    (loop for character across string
       do (insert-cube-copy :cube-to-copy (make-character-cube character)))))

;;; (defun make-character-cube-all-sides (character)
;;;   (let ((cube (make-cube))
;;;         (char-definition (get-character-definition character)))
;;;     (loop for row-nr downfrom (1- (length char-definition))
;;;        for row in char-definition
;;;        do (loop for col-nr downfrom (1- (length row))
;;;              for col in row
;;;              do (progn
;;;                   (setf (aref cube 0 col-nr row-nr) col)
;;;                   (setf (aref cube col-nr 0 row-nr) col)
;;;                   (setf (aref cube 4 (- 4 col-nr) row-nr) col)
;;;                   (setf (aref cube  col-nr 4 row-nr) col))))         
;;;     cube))
;;;
;;; (define-cube-transformation insert-text-all-sides ()
;;;   (let ((string "")
;;;         (*current-cube-number* *current-cube-number*))
;;;     (clim:accepting-values (stream :own-window t)
;;;       (setf string (clim:accept 'string :default string :prompt "Text" :stream stream))
;;;       (fresh-line stream))
;;;     (loop for character across string
;;;        do (insert-cube-copy :cube-to-copy (make-character-cube-all-sides character))))))

(define-cube-transformation fade-every-cube-to-back ()
  (let ((*current-cube-number* 0)
        (times 5)
        (length (length *animation*)))
    (dotimes (j length)
      (dotimes (i times)
        (insert-cube-copy)
        (move-cube :z -1)
        (do-cube-times (x y z)
          (setf (aref (current-cube) x y z)
                    (ensure-intensity-to-be-of-character
                     (max 0 (1- (ensure-intensity-to-be-of-number (aref (current-cube) x y z))))))))
      (when (< j length)
        (goto-cube :next)))))

;;; now a command button of the toolbox
;;;
;;; (define-cube-transformation load-user-transformations ()
;;;   (let* ((directory (pathname-directory (or cube-modeller::*animation-pathname*
;;;                                             cube-modeller::*default-pathname*)))
;;;          (file (file-selector:select-file :own-window t
;;;                                           :pathname (make-pathname :name "effects"
;;;                                                                    :type "lisp"
;;;                                                                    :directory directory))))
;;;     (when (probe-file file)
;;;       (let ((*package* (find-package 'LED-cube)))
;;;         (load file))
;;;       (cube-modeller::update-transformations-pane))))

(define-cube-transformation duplicate-every-frame ()
  (goto-cube :first)
  
  ;; duplicate every cube
  (dotimes (i (length *animation*))
    (insert-cube-copy :position :after
                      :move-to-new-cube t)
    (goto-cube :next))
  
  (goto-cube :first))