(defpackage :demo-app
  (:use :cl :objc-runtime)
  (:export
   #:get-method-names))
(in-package :demo-app)
(named-readtables:in-readtable :objc-readtable)

(cffi:defcallback exception-handler :void ((exception :pointer))
  (with-selectors (reason)
    (format t "~&Exxception: ~a~%" [exception reason])
    (values)))

(defun init-window (window rect a b c)
  (format t "~&got rect: ~s" rect)
  (cffi:foreign-funcall "objc_msgSend"
                        :pointer window
                        :pointer @(initWithContentRect:)
                        :pointer window
                        (:struct objc-runtime::ns-rect) rect
                        :char a
                        :char b
                        :boolean c
                        :pointer))

(defmacro selector-lambda (selector &rest args)
  `(lambda (receiver)
     [receiver ,selector ,@args]))

(defun init-with-frame (thing rect)
  (format t "~&got rect: ~s" rect)
  (cffi:foreign-funcall "objc_msgSend"
                        :pointer thing
                        :pointer @(initWithFrame:)
                        (:struct objc-runtime::ns-rect) rect
                        :pointer))


(cffi:defcfun (print-rect "printRect")
    :void
  (rect (:struct objc-runtime:ns-rect)))

#+(or)
(cffi:defcfun (set-uncaught-exception-handler "set_uncaught_exception_handler"
                                              :library objc-runtime::expose-stuff)
    :void
  (cb :pointer))

(defun value-for-key (thing key)
  (with-selectors ((vfk "valueForKey:"))
    (let ((key (objc-runtime::make-nsstring key)))
      [thing vfk :string key])))

(defun call-with-rect (x y w h cb)
  (check-type x real)
  (check-type y real)
  (check-type w real)
  (check-type h real)
  (cffi:with-foreign-object (rect '(:struct objc-runtime::ns-rect))
    (cffi:with-foreign-slots (((:pointer ns-rect-origin) (:pointer ns-rect-size))
                              rect (:struct objc-runtime::ns-rect))
      (cffi:with-foreign-slots ((ns-point-x ns-point-y) ns-rect-origin (:struct ns-point))
        (setf ns-point-x (coerce x 'double-float)
              ns-point-y (coerce y 'double-float)))
      (cffi:with-foreign-slots ((ns-size-width ns-size-height)
                                ns-rect-size (:struct ns-size))
        (setf ns-size-width (coerce w 'double-float)
              ns-size-height (coerce h 'double-float))))
    (funcall cb rect)))

(defun call-with-point (x y cb)
  (check-type x real)
  (check-type y real)
  (cffi:with-foreign-object (point '(:struct ns-point))
    (cffi:with-foreign-slots ((ns-point-x ns-point-y) point (:struct ns-point))
      (setf ns-point-x (coerce x 'double-float)
            ns-point-y (coerce y 'double-float)))
    (funcall cb point)))

(defmacro with-rect ((rect (x y) (w h)) &body body)
  `(call-with-rect ,x ,y ,w ,h
                   (lambda (,rect)
                     ,@body)))

(defmacro with-point ((point (x y)) &body body)
  `(call-with-point ,x ,y
                   (lambda (,point)
                     ,@body)))

(defun make-rect (x y w h)
  (check-type x real)
  (check-type y real)
  (check-type w real)
  (check-type h real)
  (cffi:convert-to-foreign `(ns-rect-origin
                             (objc-runtime:ns-point-x
                              ,(coerce x 'double-float)
                              objc-runtime:ns-point-y
                              ,(coerce y 'double-float))
                             ns-rect-size
                             (objc-runtime:ns-size-width
                              ,(coerce w 'double-float)
                              objc-runtime:ns-size-height
                              ,(coerce h 'double-float)))
                           '(:struct objc-runtime:ns-rect)))

(defun show-alert (message &optional (informative-text "Informative Text!"))
  (let ((alert [[#@NSAlert @(alloc)] @(init)]))
    [alert @(setMessageText:) :pointer (objc-runtime::make-nsstring message)]
    [alert @(setInformativeText:) :pointer (objc-runtime::make-nsstring informative-text)]
    [alert @(addButtonWithTitle:) :pointer @"OK"]
    [alert @(addButtonWithTitle:) :pointer @"Cancel"]
    [alert @(runModal)]))

(cffi:defcallback do-things-action :void ((a :pointer) (b :pointer) (sender :pointer))
  (declare (ignore a b sender))
  (show-alert "Starting Swank"
              "Loading Quicklisp from ~/quicklisp/setup.lisp + starting swank")

  (load "~/quicklisp/setup.lisp")
  (funcall (intern "QUICKLOAD" (find-package :QL)) :swank)
  (funcall (intern "CREATE-SERVER" (find-package :swank)) :port 5060 :dont-close t)

  (show-alert "Started swank on 5060"))

(cffi:defcallback alert-action :void ((a :pointer) (b :pointer) (sender :pointer))
  (declare (ignore a b sender))
  (show-alert "Hello There!"))

(cffi:defcallback profit-action :void ((a :pointer) (b :pointer) (sender :pointer))
  (declare (ignore a b sender))
  (show-alert "That Was Profitable!"))

(defun alloc-init (cls)
  [[cls @(alloc)] @(init)])

(defun make-button-delegate (button cb)
  (objc-runtime.data-extractors:objc-typecase button
    (#@NSButton (let ((my-class (objc-runtime::objc-allocate-class-pair #@NSObject "ButtonDel" 0)))
                  (objc-runtime::class-add-method my-class @(doMagic) cb "v@:@")
                  (fw.lu:prog1-bind (result (alloc-init my-class))
                    [button @(setTarget:) :pointer result]
                    [button @(setAction:) :pointer @(doMagic)])))
    (t (format t "~&The button is not a button~%"))))

(defun make-app-delegate-class (outlets)
  (let ((app-delegate-class (objc-runtime::objc-allocate-class-pair
                             #@NSObject "AppDelegate" 0)))
    (objc-runtime:add-pointer-ivar app-delegate-class "window")
    (objc-runtime:add-pointer-ivar app-delegate-class "delegate")

    (loop for outlet in outlets do
         (objc-runtime:add-pointer-ivar app-delegate-class outlet))

    app-delegate-class))

(defun make-app-delegate-class-with-props (foo outlets)
  (let ((app-delegate-class (objc-runtime::objc-allocate-class-pair
                             #@NSObject foo 0)))
    (objc-runtime:add-pointer-ivar app-delegate-class "window")
    (objc-runtime:add-pointer-ivar app-delegate-class "delegate")

    (loop for outlet in outlets do
         (objc-runtime:add-pointer-ivar app-delegate-class outlet))

    app-delegate-class))


(defun load-nib (name)
  ;; find and activate the nib
  (let* ((bundle [#@NSBundle @(mainBundle)])
         (nib [[#@NSNib @(alloc)] @(initWithNibNamed:bundle:)
               :pointer (objc-runtime::make-nsstring name)
               :pointer bundle]))
    (cffi:with-foreign-object (p :pointer)
      ;; TODO: is dropping p a problem here? The docs say something relevant.
      ;;       must investigate.
      [nib @(instantiateWithOwner:topLevelObjects:)
           :pointer objc-runtime::ns-app
           :pointer p])))

;#+null
(defun main ()
  #+sbcl
  (sb-int:set-floating-point-modes :traps '())

  (load "~/quicklisp/setup.lisp")
  (funcall (intern "QUICKLOAD"
                   (find-package :QL))
           :swank)

  #+nil
  (funcall (intern "CREATE-SERVER"
                   (find-package :swank))
           :port 5060
           :dont-close t)

  (trivial-main-thread:with-body-in-main-thread (:blocking t)
    [#@NSAutoreleasePool @(new)]
    [#@NSApplication @(sharedApplication)]
    #+nil
    [objc-runtime::ns-app @(setActivationPolicy:) :int 0]

    ;; Setup the app delegate class. We register this one because it's useful
    ;; When debugging via something like lldb
    (objc-runtime::objc-register-class-pair
     (make-app-delegate-class '("actionButton"
                                "alertButton"
                                "profitButton")))

    (load-nib "MainMenu.nib")

    (let ((app-delegate [objc-runtime::ns-app @(delegate)]))
      (make-button-delegate (value-for-key app-delegate "actionButton")
                            (cffi:callback do-things-action))
      (make-button-delegate (value-for-key app-delegate "alertButton")
                            (cffi:callback alert-action))
      (make-button-delegate (value-for-key app-delegate "profitButton")
                            (cffi:callback profit-action)))

    [objc-runtime::ns-app @(activateIgnoringOtherApps:) :boolean t]
    [objc-runtime::ns-app @(run)]))

(defclass application-shim ()
  ((%main-view :initarg :main-view :accessor main-view)))

(cffi:defcfun (%set-string-value "objc_msgSend")
    :void
  (cls objc-runtime::o-class)
  (sel objc-runtime::o-selector)
  (value :pointer))

(defun set-string-value (control string)
  (prog1 control
    (%set-string-value control @(setStringValue:)
                       (objc-runtime:make-nsstring string))))

(defun label (text)
  (let ((view [[#@NSTextField @(alloc)] @(init)]))
    (prog1 view
      (set-string-value view text))))

(defun button (title)
  (trivial-main-thread:with-body-in-main-thread (:blocking t)
    [#@NSButton @(buttonWithTitle:target:action:)
                :pointer (objc-runtime:make-nsstring title)
                :pointer #@NSButton
                :pointer @(alloc)]))

(defun init-in-main-thread (instance)
  (prog1 instance
    [instance @(performSelectorOnMainThread:withObject:waitUntilDone:)
              :pointer @(init)
              :pointer (cffi:null-pointer)
              :bool t]))

(defvar *application-shim*
  (make-instance 'application-shim))
(defun wait-for-events ()
  (let ((event [objc-runtime::ns-app @(nextEventMatchingMask:untilDate:inMode:dequeue:)
                                     :unsigned-long 18446744073709551615
                                     :pointer [#@NSDate @(distantFuture)]
                                     :pointer @"kCFRunLoopDefaultMode"
                                     :int 1]))
    [objc-runtime::ns-app @(sendEvent:) :pointer event]
    event))

(defun tick ()
  (wait-for-events))

(defun task-thread ()
  (bt:make-thread (lambda ()
                    #+(or)
                    (trivial-main-thread:with-body-in-main-thread (:blocking t)
                      [#@NSEvent @(stopPeriodicEvents)]
                      [#@NSEvent @(startPeriodicEventsAfterDelay:withPeriod:) :double 0.0d0 :double 0.01d0])
                    (loop
                      (trivial-main-thread:with-body-in-main-thread (:blocking t)
                        (tick))))
                  :name "Cocoa Event Loop Feeder"))

;;#+nil
(defun old-main ()
  (trivial-main-thread:with-body-in-main-thread (:blocking nil)
    #+sbcl
    (sb-int:set-floating-point-modes :traps '())

    [#@NSAutoreleasePool @(new)]
    [#@NSApplication @(sharedApplication)]

    (format t "~&app: ~s~%" objc-runtime::ns-app)
    #+nil
    [objc-runtime::ns-app @(setActivationPolicy) :int 0]

    (let* ((application-name [[#@NSProcessInfo @(processInfo)] @(processName)]))
      (let* ((menubar [[#@NSMenu @(new)] @(autorelease)])
             (app-menu-item [[#@NSMenuItem @(new)] @(autorelease)])
             (app-menu [[#@NSMenu @(new)] @(autorelease)])
             (quit-name @"Quit")
             (key @"q")
             (quit-menu-item
               [[[#@NSMenuItem @(alloc)]
                 @(initWithTitle:action:keyEquivalent:) :pointer quit-name :pointer @(terminate?) :string key]
                @(autorelease)]))
        [menubar @(addItem:) :pointer app-menu-item]
        [app-menu @(addItem:) :pointer quit-menu-item]
        [app-menu-item @(setSubmenu:) :pointer app-menu]
        [objc-runtime::ns-app @(setMainMenu:) :pointer menubar] )

      (setf (main-view *application-shim*)
            [#@NSStackView @(stackViewWithViews:)
                           :pointer [[#@NSArray @(alloc)] @(init)]])
      (with-point (p (20 20))
        (let* ((foreign-rect (make-rect 10 10 120 120))
               (the-window (init-window [#@NSWindow @(alloc)] foreign-rect 15 2 nil)))

          [(value-for-key the-window "contentView") @(addSubview:) :pointer (main-view *application-shim*)]
          [the-window @(cascadeTopLeftFromPoint:) :pointer p]
          [the-window @(setTitle:) :pointer application-name]
          [the-window @(makeKeyAndOrderFront:) :pointer (cffi:null-pointer)]
          [ objc-runtime::ns-app @(activateIgnoringOtherApps:) :boolean t]
          (task-thread))))))

(cffi:defcfun (%get-view-frame "objc_msgSend_stret")
    :void
  (out (:pointer (:struct objc-runtime:ns-rect)))
  (class :pointer)
  (sel :pointer))

(cffi:defcfun (%init-with-frame "objc_msgSend")
    :pointer
  (class :pointer)
  (sel :pointer)
  (frame (:struct objc-runtime:ns-rect)))

(defmacro new-msg-send (selector ((&rest arg-types) return-type))
  (let ((arg-syms (mapcar (lambda (_) (gensym (symbol-name _)))
                          arg-types)))
    `(lambda ,(cons 'target arg-syms)
       (cffi:foreign-funcall "objc_msgSend"
                             :pointer target
                             :pointer ,selector
                             ,@(mapcan #'list arg-types arg-syms)
                             ,return-type))))

(defmacro make-view-dictionary (&rest objc-values)
  (alexandria:with-gensyms (selector)
    `(let ((,selector (new-msg-send @(dictionaryWithObjectsAndKeys:)
                          ((,@(mapcar (lambda (_) _ :pointer) objc-values) :pointer)
                           :pointer))))
       (funcall ,selector ,@objc-values (cffi:null-pointer)))))

#+(or)
(defun text-view (parent-view)
  (let ((text-view [#@NSTextView @(alloc)]))





    (trivial-main-thread:with-body-in-main-thread (:blocking nil)
      (cffi:with-foreign-pointer (v (cffi:foreign-type-size '(:struct objc-runtime::ns-rect)))
        (%get-view-frame v *window-view* @(frame))
        (init-with-frame *text-view* v))
      [*window-view* @(addSubview:) :pointer *text-view*]?)

    (defparameter *view-dictionary*
      )
    ))

#+(or)
(progn
  (defparameter *window-view*
    [(main-view *application-shim*) @(superview)])
  (trivial-main-thread:with-body-in-main-thread (:blocking nil)
    [(main-view *application-shim*) @(removeFromSuperview)]?
    ))