(in-package :cube-modeller)

;; play animation code

(defvar *print-running-averager-info-p* nil
  "boolean variable that says whether debug information of the running averager
   should be printed, or not")
(defvar *print-frame-duration-statistics-p* nil
  "boolean variable that says whether statistics on the frame display duration
   should be calculated and printed, or not")

(let (old-current-cube-number
      loop-animation
      animation-running

      frame-start-time
      frame-time-accumulator

      (average 0))
  
  (defun initialize-frame-time-counter ()
    (setf frame-start-time (get-internal-real-time)
          frame-time-accumulator 0))

  (let (average-window
        (average-window-length 15)) ;; I haven't spent much thought on the value (mgr, 20061010)
    (defun running-averager (new-value)
      ;; initialize average-window
      (unless average-window
        (setf average-window
              (loop for i from 1 to average-window-length
                 collect new-value)
              average new-value))
      
      ;; formula taken from http://www.kfs.oeaw.ac.at/oeal/corr/Averaging.htm
      (setf average (float (+ average
                              (/ (- new-value
                                    (car (last average-window)))
                                 average-window-length))))
      
      (when *print-running-averager-info-p*
        (let ((*PRINT-RIGHT-MARGIN* 400))
          (format t "new average: ~5,1f, new value: ~s, old list: ~s~%" average new-value average-window)))

      ;; pop last value and push the new one
      (setf average-window (butlast average-window))
      (push new-value average-window)))

  (let (remaining-time-average
        remaining-time-count
        frame-duration-average
        frame-duration-count)
    (defun print-frame-duration-statistics (frame-duration remaining-time)
      "Calculates frame duration and remaining time averages and
       prints them together with the current values."
      (when (< 1 frame-duration 250) ;; try to use only reasonable values
        (macrolet ((calculate-average (new-value average count)
                     `(if ,average
                          (setf ,average (+ (* (/ ,count
                                                 (1+ ,count))
                                              ,average)
                                           (/ ,new-value
                                              (1+ ,count)))
                                ,count (1+ ,count))
                          (setf ,average ,new-value
                                ,count 1))))
          (calculate-average remaining-time remaining-time-average remaining-time-count)
          (calculate-average frame-duration frame-duration-average frame-duration-count))
        
        (format t "go to next frame, frame duration: ~5,1f (~5,1f), remaining time: ~5,1f (~5,1f)~%"
                frame-time-accumulator frame-duration-average
                remaining-time remaining-time-average))))
                                    
  (defun enough-time-elapsed-for-next-frame-p ()
    "It returns t only if enough time (*frame-duration*) has elapsed
     since the last invocation.
     The idea is explained in
       http://www.gaffer.org/game-physics/fix-your-timestep/
     This is a modified version, though, for example it does not
     drop frames."
    (let* ((now (get-internal-real-time))
           (time-delta (- now frame-start-time)))
      (setf frame-start-time now)
      (incf frame-time-accumulator time-delta)

      (when (< 1 time-delta 250) ;; try to use only reasonable deltas
        (running-averager time-delta)))

    ;; (format t "next frame called, accumulator: ~a~%" frame-time-accumulator)
    
    (if (>= frame-time-accumulator
            (- (* *frame-duration* internal-time-units-per-second)
               (/ average 2)))
        (progn
          (when *print-frame-duration-statistics-p*
            (let ((remaining-time (- frame-time-accumulator
                                     (* *frame-duration* internal-time-units-per-second))))
              (print-frame-duration-statistics frame-time-accumulator remaining-time)))
          
          (setf frame-time-accumulator 0)
          t)
        nil))


  (defun start-animation (&key (endless-loop nil))
    "function to start the animation *mode*; to actually play you have to call ANIMATION-STEP"
    (setf loop-animation endless-loop)
    (setf old-current-cube-number *current-cube-number*)
    (initialize-frame-time-counter)
    (goto-cube :first)
    (write-cube-to-device)
    (setf animation-running t))

  (defun stop-animation ()
    "function to stop the animation *mode*"
    (when animation-running
      (setf animation-running nil)
      (goto-cube old-current-cube-number)
      (write-cube-to-device))) ;; not really necessary as it is alwys done at the end of next-frame

  (defun toggle-animation-running-state (&key (endless-loop t))
      (if animation-running
	  (stop-animation)
	  (start-animation :endless-loop endless-loop)))

;;;   (defun next-frame ()
;;;     (if (> (1- (length *animation*))
;;; 	   *current-cube-number*)
;;; 	(progn
;;; 	  (print 'foo *trace-output*)
;;; 
;;; 	  (goto-cube :next)
;;; 	  (write-cube-to-device))
;;; 	(progn
;;; 	  (print 'bar *trace-output*)
;;; 	  (setf animation-running nil)
;;; 	  (stop-animation))))

  (defun next-frame ()
    (if (= (1- (length *animation*)) ;; on last cube
           *current-cube-number*)
        (if loop-animation
            (goto-cube :first)
            (stop-animation))
          (goto-cube :next))
    (write-cube-to-device))

  (defun animation-step ()
    (when (and animation-running
               (enough-time-elapsed-for-next-frame-p))
      (next-frame)))

  
  (defun start-animation-process (&optional (process-name "animation loop"))
    "starts a new process which plays the animation independent from the OpenGL viewer"
    (clim-sys:make-process (lambda ()
                             (start-animation :endless-loop t)
                             (loop do (animation-step))
                             (stop-animation)
                             (destroy-process-with-name process-name))
                           :name process-name))

  (defun stop-animation-process (&optional (process-name "animation loop"))
    "destroys the animation playing process"
    (destroy-process-with-name process-name)
    (stop-animation))
  
  ) ;; of let