(in-package "CCL")

(declaim (optimize (speed 2) (safety 1) (space 0) (compilation-speed 0)))


(require "COCOA")



(eval-when (:compile-toplevel :execute)
  (use-interface-dir :gl))

(defpackage "TINY"
  (:export "ANIMATE"))
(defpackage "OPENGL"
  (:nicknames :opengl :gl)
  (:export ;; Cocoa helpers
   "NEW-PIXEL-FORMAT"
   ;; OpenGL helpers
   "WITH-MATRIX-MODE"))

(in-package :opengl)

(defun new-pixel-format (&rest attributes)
  ;; take a list of opengl pixel format attributes (enums and other
  ;; small ints) and make an array (character array?), and create and
  ;; return an NSOpenGLPixelFormat
  (let* ((attribute-size (ccl::foreign-size :<NSO>pen<GLP>ixel<F>ormat<A>ttribute :bytes)))
    (ccl:%stack-block ((objc-attributes (* attribute-size (1+ (length attributes)))))
		      (loop for i from 0 to (* (1- (length attributes)) attribute-size) by attribute-size
			    for attribute in attributes do
			    (setf (%get-long objc-attributes i) attribute) ; <- autocoerced
			    finally (let ((lastpos (* (length attributes) attribute-size)))
				      (setf (%get-long objc-attributes lastpos) 0))) ;<- objc nil = null ptr
				      (let* ((pixelformat (ccl::send (ccl::send (ccl::@class ns-opengl-pixel-format) 'alloc)
								     :init-with-attributes objc-attributes)))
					pixelformat))))

(defparameter *matrix-mode* #$GL_MODELVIEW)
(defmacro with-matrix-mode ((mode) &body body)
  `(unwind-protect
       (let ((*matrix-mode* ,mode))
	 (#_glMatrixMode *matrix-mode*)
	 ,@body)
     (#_glMatrixMode *matrix-mode*)))


;;; Define the AnimView class 


(in-package "TINY")
(defclass bounce-glview (ns:ns-opengl-view)
  ((x :foreign-type :single-float :accessor bounce-glview-x) 
   (y :foreign-type :single-float :accessor bounce-glview-y) 
   (rsize :foreign-type :single-float :accessor bounce-glview-rsize) 
   (xstep :foreign-type :single-float :accessor bounce-glview-xstep) 
   (ystep :foreign-type :single-float :accessor bounce-glview-ystep)
   (window-width :foreign-type :single-float :accessor bounce-glview-window-width)
   (window-height :foreign-type :single-float :accessor bounce-glview-window-height))
  (:metaclass ns:+ns-object))



;;; do some setup stuff
(ccl::define-objc-method ((:void prepare-opengl) bounce-glview)
   (#_glClearColor 0.0 0.0 1.0 1.0) ; blue background
  (#_glColor3f 1.0 0.0 0.0) ; red pen color
  (opengl:with-matrix-mode (#$GL_PROJECTION) ;; default is GL_MODELVIEW
    (#_glLoadIdentity)
    (#_gluOrtho2D 0.0D0 600.0D0 0.0D0 800.0D0))
  (#_glClear #$GL_COLOR_BUFFER_BIT) 
  (#_glEnd)
  (#_glFlush)
)


(defconstant short-pi (coerce pi 'short-float))



(defclass bounce-window (ns:ns-window)
    ((close-timer :foreign-type :id :accessor bounce-window-close-timer)
     (animation-timer :foreign-type :id :accessor bounce-window-animation-timer))
  (:metaclass ns:+ns-object))





;;; This does the animation, by adding the animation and close timers
;;; to the current thread's runloop and then running that runloop.
;;; The only input sources should be those timers; when the window
;;; closes, they'll be removed and the runloop will exit.



(defmethod animate-window ((self bounce-window))
  (let* ((runloop (ccl::send (ccl::@class "NSRunLoop") 'current-run-loop)))
    (ccl::with-autorelease-pool
        (ccl::send runloop
              :add-timer
              (bounce-window-close-timer self)
              :for-mode #@"NSDefaultRunLoopMode")

      (ccl::send runloop
            :add-timer
            (bounce-window-animation-timer self)
            :for-mode #@"NSDefaultRunLoopMode")
    (ccl::send runloop 'run))))





(defmethod start-animation ((self bounce-window) view)
  (setf (bounce-window-close-timer self)
        (ccl::make-objc-instance 'ns:ns-timer
                            :with-fire-date (ccl::send (ccl::@class "NSDate") 'distant-future)
                            :interval 0.0d0
                            :target self
                            :selector (ccl::@selector "stopAnimation:")
                            :user-info (%null-ptr)
                            :repeats nil))

  (setf (bounce-window-animation-timer self)
        (ccl::make-objc-instance 'ns:ns-timer
                            :with-fire-date (ccl::send (ccl::@class "NSDate") 'distant-past)
                            :interval 0.1d0
                            :target view
                            :selector (ccl::@selector "doAnimation:")
                            :user-info (%null-ptr)
                            :repeats t))                            

  (process-run-function (format nil "Animation thread for window ~d"
                                (ccl::send self 'window-number))
                        #'animate-window
                        self))







;;; Define the method that the animation thread uses to draw a bounce-glview.
;;; NOTE: The (THE NS-COLOR ...) forms are currently necessary for full
;;;       optimization because the SET message has a nonunique type signature 
;;; NOTE: This will be replaced by a DEFMETHOD once ObjC objects have been
;;;       integrated into CLOS
;;; NOTE: The (@class XXX) forms will probably be replaced by 
;;;       (find-class 'XXX) once ObjC objects have been integrated into CLOS


;;; Draw the demo view, constrained to the indicated rectangle.
(defmethod redraw-bounce-glview ((self bounce-glview) rect)
  (declare (ignore rect))
  (ccl::slet ((bounds (ccl::send self 'bounds)))
    
      ;(#_glClear #$GL_COLOR_BUFFER_BIT) 
      #|(#_glRectf (bounce-glview-x self)
                 (bounce-glview-y self)
                 (+ (bounce-glview-x self)
                    (bounce-glview-rsize self))
                 (- (bounce-glview-y self)
                    (bounce-glview-rsize self)))
      (#_glEnd)|#
      (#_glFlush)
))



;;; The :draw-rect method should only be called on the main thread;
;;; it's called when needed by the Cocoa display mechanism, and ensures
;;; that (a) the graphics state is set up properly (b) the view is locked
;;; by the main thread.  Since we want all drawing to occur on the animation
;;; thread, our :draw-rect method does nothing.

(ccl::define-objc-method ((:void :draw-rect (:<NSR>ect rect)) 
		     bounce-glview)
  (declare (ignore rect)))



;;; Other threads can draw to the view, but they need to use
;;; lockFocusIfCanDraw:  to atomically lock the view if it's
;;; currently visible.
;;; If we're able to draw to the view, we have to tell the
;;; window to flush the offscreen buffer to the screen.

(defmethod draw-from-other-thread ((view bounce-glview) &optional
                                   (rectptr (%null-ptr)))
  (when (ccl::send view 'lock-focus-if-can-draw)
    (unwind-protect
         (progn
           (redraw-bounce-glview view rectptr)
           (ccl::send (ccl::send view 'window) 'flush-window))
      (ccl::send view 'unlock-focus))))





(ccl::define-objc-method ((:void :do-animation timer) bounce-glview)
  (declare (ignore timer))
  (ccl::slet ((view-bounds (ccl::send self 'bounds)))
    (draw-from-other-thread self view-bounds)
  
    (when (or (> (bounce-glview-x self) 
                 (- (bounce-glview-window-width self)				 
                    (bounce-glview-rsize self)))
              (< (bounce-glview-x self) 
                 (- (bounce-glview-window-width self))))
    
    (setf (bounce-glview-xstep self) (- (bounce-glview-xstep self))))

    (when (or (> (bounce-glview-y self) 
                 (bounce-glview-window-height self))
              (< (bounce-glview-y self) 
                 (+ (- (bounce-glview-window-height self))
                    (bounce-glview-rsize self)))))

    (setf (bounce-glview-x self) (+ (bounce-glview-x self)
                                    (bounce-glview-xstep self)))

    (setf (bounce-glview-y self) (+ (bounce-glview-y self)
                                    (bounce-glview-ystep self)))

    (cond ((> (bounce-glview-x self) 
              (+ (- (bounce-glview-window-width self)
                    (bounce-glview-rsize self))
                 (bounce-glview-xstep self)))
           (setf (bounce-glview-x self) (1- (bounce-glview-window-width self))))
	
          ((< (bounce-glview-x self) 
              (- (+ (bounce-glview-window-width self)
                    (bounce-glview-xstep self))))
           (setf (bounce-glview-x self) 
                 (- (+ (bounce-glview-window-width self) 1)))))
  
    (cond ((> (bounce-glview-y self) 
              (+ (bounce-glview-window-height self)
                 (bounce-glview-ystep self)))
           (setf (bounce-glview-y self) (1- (bounce-glview-window-height self))))
	
          ((< (bounce-glview-y self) 
              (- (+ (- (bounce-glview-window-height self)
                       (bounce-glview-rsize self))
                    (bounce-glview-ystep self))))
           (setf (bounce-glview-y self) 
                 (1- (+ (- (bounce-glview-window-height self))
                        (bounce-glview-rsize self))))))))



(ccl::define-objc-method ((:void :stop-animation timer) bounce-window)
  (declare (ignore timer))
  (ccl::send (bounce-window-animation-timer self) 'invalidate)
  (let* ((cfrunloop
          (ccl::send (ccl::send (ccl::@class "NSRunLoop") 'current-run-loop) 'get-cf-run-loop)))
    (#_CFRunLoopStop cfrunloop)))

           

                          



(ccl::define-objc-method ((:void close) bounce-window)
  (ccl::send (bounce-window-close-timer self) 'fire)
  (ccl::send-super 'close))





;;; This performs the actions that would normally be performed by loading

;;; a nib file. 


(ccl::define-objc-method ((:id :init-with-frame (:<NSR>ect r)) bounce-glview)
  (let* ((v (ccl::send-super :init-with-frame r)))
    (unless (%null-ptr-p v)
      (setf (bounce-glview-x self) 100.0
            (bounce-glview-y self) 100.0
            (bounce-glview-rsize self) 25.0
            (bounce-glview-xstep self) 1.0
            (bounce-glview-ystep self) 1.0
            (bounce-glview-window-width self) 800.0
            (bounce-glview-window-height self) 600.0))
    v))




(defun tiny-setup ()
  (ccl::slet ((r (ccl::ns-make-rect 0.0 0.0
                                    800.0
                                    600.0)))
  (let* ((w (make-instance 
                     'bounce-window
		     :with-content-rect r
		     :style-mask (logior #$NSTitledWindowMask 
		                         #$NSClosableWindowMask 
				         #$NSMiniaturizableWindowMask)
		     :backing #$NSBackingStoreBuffered
		     :defer nil))
                                        ;(ccl::send w :set-title #@"Polygon Window")
         (w-content-view (ccl::send w 'content-view)))
    (ccl::send w :set-title #@"Polygon Window")
    ;; Q: why slet here?
    (ccl::slet ((w-frame (ccl::send w-content-view 'frame)))

	;; Q: why make-objc-instance here?
        (let ((my-view (make-instance 'bounce-glview 
                                      :init-with-frame r    
                                      :pixel-format #+ignore
                                      (ccl::send (ccl::@class ns-opengl-view)
                                                 'default-pixel-format)
                                      (opengl:new-pixel-format ;#$NSOpenGLPFADoubleBuffer
                                       #$NSOpenGLPFAAccelerated
                                       #$NSOpenGLPFAColorSize 32
                                       #$NSOpenGLPFADepthSize 32))))
                                        ;(ccl::send w-content-view :add-subview my-view)
          (ccl::send w :set-content-view my-view)
          (ccl::send w :set-delegate my-view)
          (ccl::send w
                     :perform-selector-on-main-thread (ccl::@selector "makeKeyAndOrderFront:")
                     :with-object nil
                     :wait-until-done t)
          (start-animation w my-view)
          w)))))	 



(defun animate ()
  (tiny::tiny-setup))



(animate)