(in-package "CL-USER")

(require :cocoa)

(defun nsstr (s) (make-instance 'gui::ns-lisp-string :string s))

(defparameter +standard-window-style-mask+
  (logior #$NSTitledWindowMask
          #$NSClosableWindowMask
          #$NSMiniaturizableWindowMask
          #$NSResizableWindowMask))

(defun make-ns-window (x y &optional (title "Untitled"))
  (let ((nsw (make-instance 'ns:ns-window
               :with-content-rect (ns:make-ns-rect 0 0 x y)
               :style-mask +standard-window-style-mask+
               :backing #$NSBackingStoreBuffered
               :defer t)))
    (#/setTitle: nsw (nsstr title))
    (#/setReleasedWhenClosed: nsw nil)
    (#/center nsw)
    (#/orderFront: nsw nil)
    nsw))

(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)))))

(defgeneric view-draw-contents (v &optional rect))
(defgeneric view-redraw-contents (v &optional rect))

(defmethod view-redraw-contents ((v ns::ns-view) &optional rect)
  (with-focused-view v (view-draw-contents v rect)))

(let* ((path (make-instance ns:ns-bezier-path)))
  (#/moveToPoint: path (ns:make-ns-point 10 10))
  (#/lineToPoint: path (ns:make-ns-point 10 40))
  (#/lineToPoint: path (ns:make-ns-point 90 40))
  (#/lineToPoint: path (ns:make-ns-point 90 10))
  (#/lineToPoint: path (ns:make-ns-point 10 10))
  (defun label (v)
    (#/drawAtPoint:withAttributes: #@"Scribble" (ns:make-ns-point 15 15) +null-ptr+)
    (#/stroke path)))

(defun scribble (v)
  (#/stroke (slot-value v 'path)))

(defclass scribble-view (ns:ns-view)
  ((path :initform (make-instance ns:ns-bezier-path)))
  (:metaclass ns:+ns-object))

(defmethod view-draw-contents ((v scribble-view) &optional rect)
  (label v)
  (scribble v)
)

(ccl::define-objc-method ((:void :mouse-down (:id event)) scribble-view)
  (let* ((event-location (#/locationInWindow event))
         (view-location (#/convertPoint:fromView: self event-location nil)))
    (setf (slot-value self 'path) (make-instance ns::ns-bezier-path))
    (#/moveToPoint: (slot-value self 'path) view-location)))

(ccl::define-objc-method ((:void :mouse-dragged (:id event)) scribble-view)
  (let* ((event-location (#/locationInWindow event))
         (view-location (#/convertPoint:fromView: self event-location nil)))
    (#/lineToPoint: (slot-value self 'path) view-location)
    (#/setNeedsDisplay: self #$YES)))

(ccl::define-objc-method ((:boolean accepts-first-responder) scribble-view) #$YES)

(objc:defmethod (#/drawRect: :void) ((self scribble-view) (rect ns:ns-rect))
  (view-redraw-contents self rect))

(defun make-scribble-window ()
  (let ((w (make-ns-window 300 300 "Scribble"))
        (v (make-instance 'scribble-view)))
    (#/setAlphaValue: v 0.5)
    (#/setContentView: w v)
    w))

(setf w (make-scribble-window))