;;; LUI: Lisp User Interface - a code outline
;;; Andri Ioannidou and Alexander Repenning
;;; A quick exploration on how to deal with events in the context of simple gui windows
;;; V2 : ...-event-handler methods with paramters such as x,y to simplify dealing with relative coordinate systems 
;;;      of nested views. Other event attributes can be accessed through *Current-Event* 

(in-package :LUI)

;;*********************************
;; NS -> LUI name converters      *
;;*********************************

(defun NS-TO-LUI-EVENT-TYPE (NS-Type)
  (case NS-Type
    (#.#$NSLeftMouseDown :left-mouse-down)
    (#.#$NSLeftMouseUp :left-mouse-up)
    (#.#$NSRightMouseDown :rignt-mouse-down)
    (#.#$NSRightMouseUp :right-mouse-up)
    (#.#$NSOtherMouseDown :other-mouse-down)
    (#.#$NSOtherMouseUp :other-mouse-up)
    (#.#$NSMouseMoved :mouse-moved)
    (#.#$NSLeftMouseDragged :left-mouse-dragged)
    (#.#$NSRightMouseDragged :right-mouse-dragged)
    (#.#$NSOtherMouseDragged :other-mouse-dragged)
    (#.#$NSMouseEntered :mouse-entered)
    (#.#$NSMouseExited :mouse-exited)
    (#.#$NSKeyDown :key-down)
    (#.#$NSKeyUp :key-up)
    (#.#$NSFlagsChanged :flags-changed)
    (#.#$NSAppKitDefined :app-kit-defined)
    (#.#$NSSystemDefined :system-defined)
    (#.#$NSApplicationDefined :application-defined)
    (#.#$NSPeriodic :periodic)
    (#.#$NSCursorUpdate :cursor-update)
    (#.#$NSScrollWheel :scroll-wheel)
    (t :undefined-event)))

;;************************
;; Macros                *
;;************************

(defmacro with-focused-view (view &body forms)
  `(when (#/lockFocusIfCanDraw ,view)
     (unwind-protect
	  (progn ,@forms)
       (#/unlockFocus ,view)
       (#/flushGraphics (#/currentContext ns:ns-graphics-context))
       (#/flushWindow (#/window ,view)))))

;;********************************
;; Event Classes                 *
;;********************************

(defvar *Current-Event* nil "event")


(defclass MOUSE-EVENT ()
  ((event-type :accessor event-type :initarg :event-type :initform :mouse-down)
   (x :accessor x :initarg :x)
   (y :accessor y :initarg :y)
   (dx :accessor dx :initarg :dx :documentation "delta x")
   (dy :accessor dy :initarg :dy :documentation "delta y"))
  (:documentation "Crossplatform event"))

;;********************************
;; NS -> LUI events dispatching  *
;;********************************

(defclass dispatch-view (ns:ns-view)
  ((lui-window :accessor lui-window :initarg :lui-window))
  (:metaclass ns:+ns-object
	      :documentation "dispatch NS events to LUI events"))


(objc:defmethod (#/mouseDown: :void) ((self dispatch-view) event)
  (let ((mouse-loc (#/locationInWindow event)))
    (view-event-handler (lui-window Self) (make-instance 'mouse-event
					    :x (truncate (pref mouse-loc :<NSP>oint.x))
					    :y (truncate (pref mouse-loc :<NSP>oint.y))
					    :event-type (ns-to-lui-event-type (#/type event))))))


(objc:defmethod (#/mouseUp: :void) ((self dispatch-view) event)
  (let ((mouse-loc (#/locationInWindow event)))
    (view-event-handler (lui-window Self) (make-instance 'mouse-event
					    :x (truncate (pref mouse-loc :<NSP>oint.x))
					    :y (truncate (pref mouse-loc :<NSP>oint.y))
					    :event-type (ns-to-lui-event-type (#/type event))))))


(objc:defmethod (#/mouseDragged: :void) ((self dispatch-view) event)
  (let ((mouse-loc (#/locationInWindow event)))
    (view-event-handler (lui-window Self) (make-instance 'mouse-event
					    :x (truncate (pref mouse-loc :<NSP>oint.x))
					    :y (truncate (pref mouse-loc :<NSP>oint.y))
					    :dx (#/deltaX Event)
					    :dy (#/deltaY Event)
					    :event-type (ns-to-lui-event-type (#/type event))))))


(objc:defmethod (#/drawRect: :void) ((self dispatch-view) (rect :<NSR>ect))
  (view-draw-contents (lui-window Self)))

;;*******************************************************
;; LUI Classes: Cross Platform Application Level        *
;;*******************************************************

(defclass WINDOW ()
  ((ns-view :accessor ns-view)
   (ns-window :accessor ns-window))
  (:documentation "This could be simple gui window"))


(defmethod INITIALIZE-INSTANCE ((Self Window) &rest Initargs)
  (declare (ignore Initargs))
  (call-next-method)
  (ccl::with-autorelease-pool
   (setf (ns-window Self) (make-instance 'ns:ns-window
			    :with-content-rect (ns:make-ns-rect 0 0 300 300)
			    :style-mask (logior #$NSTitledWindowMask
						#$NSClosableWindowMask
						#$NSResizableWindowMask
						#$NSMiniaturizableWindowMask)
			    :backing #$NSBackingStoreBuffered
			    :defer t))
   (setf (ns-view Self) (make-instance 'dispatch-view :lui-window Self))
   (#/setContentView: (ns-window Self) (#/autorelease (ns-view Self)))
   (#/center (ns-window Self))
   (#/orderFront: (ns-window Self) nil)
   (#/contentView (ns-window Self))))


(defgeneric VIEW-EVENT-HANDLER (Window Event)
  (:documentation "Generic event handler: dispatch event types to methods. 
Call with most important parameters. Make other paramters accessible through *Current-Event*"))


(defgeneric VIEW-LEFT-MOUSE-DOWN-HANDLER (Window X Y)
  (:documentation "Mouse Click Event handler"))


(defgeneric VIEW-LEFT-MOUSE-DRAGGED-EVENT-HANDLER (Window X Y DX DY)
  (:documentation "Mouse dragged event handler"))


;; more mouse events here...

(defgeneric VIEW-DRAW-CONTENTS (Window)
  (:documentation "View draws its contents: needs to do all the focusing, locking, etc, necesssary"))


;; default implementations

(defmethod VIEW-DRAW-CONTENTS ((Self Window)) 
  ;; nada
  )


(defmethod VIEW-EVENT-HANDLER ((Self Window) Event)
  (setq *Current-Event* Event)
  (case (event-type Event)
    (:left-mouse-down (view-left-mouse-down-event-handler Self (x Event) (y Event)))
    (:left-mouse-dragged (view-left-mouse-dragged-event-handler Self (x Event) (y Event) (dx Event) (dy Event)))
    (t (format t "not handling ~A event yet~%" (event-type Event)))))


;****************************************************
; LUI Controls                                      *
;****************************************************

(defclass BUTTON (ns:ns-button)
  ()
  (:metaclass ns:+ns-object
	      :documentation "Basic button"))

(defmethod initialize-instance :after ((Self button) &rest Args)
  (declare (ignore Args))
  (ns:with-ns-rect (Frame 10 10 72 32)
    (#/initWithFrame: Self Frame)
    (#/setButtonType: Self #$NSMomentaryPushInButton)
    (#/setImagePosition: Self #$NSNoImage)
    (#/setBezelStyle: Self #$NSRoundedBezelStyle)))

;;***************************************************
;; Test App
;;***************************************************

(defclass event-test-window (window)
  ((x :accessor x :initarg :x :initform 0)
   (y :accessor y :initarg :y :initform 0)))


(defmethod VIEW-DRAW-CONTENTS ((Self event-test-Window))
  ;; draw small red square @ x, y using NS functions (for now)
  (with-focused-view
   (ns-view Self) 
   (#_NSEraseRect (#/bounds (ns-view Self)))
   (#/set (#/redColor ns:ns-color))
   (#_NSRectFill (ns:make-ns-rect (x self) (y self) 10 10))))


(defmethod VIEW-LEFT-MOUSE-DOWN-EVENT-HANDLER ((Self event-test-Window) X Y)
  (format t "click: x=~A, y=~A~%"  x y)
  (setf (x self) x)
  (setf (y self) y)
  (view-draw-contents Self))


(defmethod VIEW-LEFT-MOUSE-DRAGGED-EVENT-HANDLER ((Self event-test-Window) X Y Dx Dy)
  (format t "drag: x=~A, y=~A, dx=~A, dy=~A~%" x y dx dy)
  (setf (x self) x)
  (setf (y self) y)
  (view-draw-contents Self))



#| Examples 

(defparameter w (make-instance 'window))
(defparameter w2 (make-instance 'event-test-window))

(defparameter b1 (make-instance 'button))

(#/addSubview: (ns-view w2) b1)

|#