(in-package :cl-user)

(require :cocoa)
(require :utilities)

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

(define-class window ns-window subviews
  (:cv x0 100) (:cv y0 40))

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

(define-objc-class window-delegate target)

(objc:defmethod (#/windowWillClose: :void) ((self window-delegate) n)
  (declare (ignore n))
  (setf (slot-value (slot-value self 'target) 'ns-window) nil))

(defun make-window (&key (title "Untitled") (width 640) (height 480)
                         (style-mask +standard-window-style-mask+))
  (bb
   nsw (make-instance 'ns:ns-window
         :with-content-rect (ns:make-ns-rect 0 0 width height)
         :style-mask style-mask
         :backing #$NSBackingStoreBuffered
         :defer t)
   (#/setTitle: nsw (nsstr title))
   w (make-instance 'window :ns-window nsw)
   (#/setDelegate: nsw (make-window-delegate :target w))
   (with-slots (x0 y0) w
     (#/cascadeTopLeftFromPoint: nsw (ns:make-ns-point (incf x0 10) (incf y0 10))))
   (show w)))

(define-method (show (w window ns-window))
  (#/orderFront: ns-window nil)
  w)

(define-method (hide (w window ns-window))
  (#/orderOut: ns-window nil)
  w)

;;; Views

(define-class view ns-view subviews parent)

(define-method ((initialize-instance :after) (v view ns-view) &rest args)
  (declare (ignore args))
  (setf ns-view (make-instance 'standard-view :wrapper v)))

(define-objc-class (standard-view ns:ns-view) wrapper)

;;; Drawing

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

(objc:defmethod (#/drawRect: :void) ((self standard-view) (rect ns:ns-rect))
  (with-slots (wrapper) self
    (with-focused-ns-view self (view-draw-contents wrapper rect))))

(define-method (view-draw-contents (v view) &optional rect)
  (declare (ignore rect))
  v)

;;; Events

(defmacro define-event-type (ns-event method-name)
  `(progn
     (ccl::define-objc-method ((:void ,ns-event (:id event)) standard-view)
       (with-slots (wrapper) self
         (,method-name wrapper (#/locationInWindow event))))
     (define-method (,method-name (v view) loc)
       (declare (ignore loc))
       (values))))

(define-event-type :mouse-down view-click-event-handler)
(define-event-type :mouse-up view-mouse-up-event-handler)
(define-event-type :mouse-dragged view-drag-event-handler)
(define-event-type :mouse-entered view-mouse-enter-event-handler)
(define-event-type :mouse-moved view-mouse-move-event-handler)
(define-event-type :mouse-exited view-mouse-exit-event-handler)

(ccl::define-objc-method ((:<BOOL> accepts-first-responder) standard-view) #$YES)

;;; Subviews

(define-method (remove-from-parent (v view ns-view parent))
  (when parent
    (#/removeFromSuperview (#/retain ns-view))
    (deletef v (slot-value parent 'subviews))
    (setf parent nil))
  (values))

(define-method (add-subview (v view ns-view subviews) sv)
  (remove-from-parent sv)
  (push sv subviews)
  (#/addSubView: ns-view sv)
  (values))

(define-method (add-subview (w window subviews) sv)
  (remove-from-parent sv)
  (push sv subviews)
  (#/addSubview: (#/contentView (window-ns-window w)) (view-ns-view sv))
  (values))

;;; Test

(define-class (testview view) flag loc0)

(setf ms (make-instance 'ns:ns-mutable-attributed-string))
(#/appendString: (#/mutableString ms) #@"Lisp rules!")
(#/addAttribute:value:range: ms #@"NSFont"
 (#/convertFont:toHaveTrait:
  (#/sharedFontManager (find-class 'ns:ns-font-manager))
  (#/fontWithName:size: (find-class 'ns:ns-font) #@"Times New Roman" 48.0)
  #$NSItalicFontMask)
 (ns:make-ns-range 0 11))

(define-method (view-draw-contents (v testview ns-view flag) &optional rect)
  (declare (ignore rect))
  (if flag (#/strokeRect: ns:ns-bezier-path (#/bounds ns-view)))
  (#/drawAtPoint: ms (ns:make-ns-point 5 5)))

(define-method (view-click-event-handler (v testview loc0) loc)
  (setf loc0 loc))

(define-method (view-drag-event-handler (v testview ns-view loc0) loc)
  (bb
   f (#/frame ns-view)
   x0 (ns:ns-rect-x f)
   y0 (ns:ns-rect-y f)
   dx (- (ns:ns-point-x loc) (ns:ns-point-x loc0) )
   dy (- (ns:ns-point-y loc) (ns:ns-point-y loc0) )
   (#/setFrameOrigin: ns-view (ns:make-ns-point (+ x0 dx) (+ y0 dy)))
   (setf loc0 loc)))

; Why doesn't this work?
(define-method (view-mouse-enter-event-handler (v testview ns-view flag) loc)
  (setf flag t)
  (#/setNeedsDisplay: ns-view #$YES))

(define-method (view-mouse-exit-event-handler (v testview ns-view flag) loc)
  (setf flag nil)
  (#/setNeedsDisplay: ns-view #$YES))



#|
(setf w (make-window))
(setf v (make-testview :flag t))
(add-subview w v)
(setf v1 (view-ns-view v))
(#/setFrameSize: v1 (ns:make-ns-size 220 60))
(#/setFrameOrigin: v1 (ns:make-ns-point 100 100))
; Just for fun
(#/setFrameRotation: v1 30.0)
|#