(in-package "CL-USER")

;; This example demonstrates how to initialize Cocoa and use it without
;; having to create an application bundle or use a nib file.  This example
;; can be loaded from within Emacs and Slime, and it will work.

;; This loads the Cocoa shared libraries as a side-effect.
(eval-when (:compile-toplevel :load-toplevel :execute)
  (require "OBJC-SUPPORT"))

;; This is not strictly necessary, since you can use
;; (#/sharedApplication ns:ns-application) to retrieve the
;; shared NSApplication instance, but it's handy.
(defvar *nsapp*)

;; For easy access later.
(defvar *view*)

;; For convenience.  Note that NSWindow objects are released when
;; they are closed (by default, anyway).
(defun make-window (x y w h)
  (ns:with-ns-rect (r x y w h)
    (make-instance 'ns:ns-window :with-content-rect r
		   :style-mask (logior #$NSTitledWindowMask
				       #$NSClosableWindowMask
				       #$NSMiniaturizableWindowMask)
		   :backing #$NSBackingStoreBuffered
		   :defer #$NO)))

;; The way to do custom drawing in Cocoa is to create a subclass
;; of NSView.  We define one that simply paints itself solid red.
(defclass demo-view (ns:ns-view)
  ()
  (:metaclass ns:+ns-object))

;; As a general rule, all drawing in Cocoa should be done from the
;; drawRect: method.  However, it's actually safe to draw to a view
;; from a different thread, and we'll be doing that later.
(objc:defmethod (#/drawRect: :void) ((self demo-view) (r #>NSRect))
  (#_NSEraseRect (#/bounds self))
  (#/set (#/redColor ns:ns-color))
  (#_NSRectFill (#/bounds self)))

;; Many objects in Cocoa can have a delegate, which is a helper object
;; that the main object consults in certain circumstances.  The
;; application object can use a delegate, and we create one for it here.
(defclass app-delegate (ns:ns-object)
  ()
  (:metaclass ns:+ns-object))

(defun make-application-menu ()
  (let ((menu (make-instance 'ns:ns-menu :with-title #@"Apple"))
	(item nil))
    ;; about
    (setq item (#/addItemWithTitle:action:keyEquivalent:
		menu
		#@"About ccl..."
		(objc:@selector #/orderFrontStandardAboutPanel:)
		#@""))
    (#/setTarget: item *nsapp*)
    ;; separator
    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
    ;; preferences
    (setq item (#/addItemWithTitle:action:keyEquivalent:
		menu
		#@"Preferences..."
		+null-ptr+
		#@","))
    ;; separator
    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
    ;; services
    (setq item (#/addItemWithTitle:action:keyEquivalent:
		menu
		#@"Services"
		+null-ptr+
		#@""))
    (let ((services-menu (make-instance 'ns:ns-menu :with-title #@"Services")))
      (#/setSubmenu:forItem: menu services-menu item)
      (#/setServicesMenu: *nsapp* services-menu)
      (#/release services-menu))
    ;; separator
    (#/addItem: menu (#/separatorItem ns:ns-menu-item))
    ;; quit
    (setq item (#/addItemWithTitle:action:keyEquivalent:
		menu
		#@"Quit"
		(objc:@selector #/terminate:)
		#@"q"))
    menu))

;; This is one of the messages  that the application object will send
;; its delegate.  We use this to set up the menu bar and create our
;; window and custom view.
(objc:defmethod (#/applicationWillFinishLaunching: :void) ((self app-delegate)
							  notification)
  (declare (ignore notification))
  (let* ((main-menu (make-instance 'ns:ns-menu :with-title #@"MainMenu"))
	 (submenu nil)
	 (menu-item nil)
	 (w (make-window 100 100 300 300)))
    (setq menu-item (#/addItemWithTitle:action:keyEquivalent: main-menu
							      #@"Apple"
							      +null-ptr+
							      #@""))
    (setq submenu (make-application-menu))
    (#/setSubmenu:forItem: main-menu submenu menu-item)
    (#/performSelector:withObject: *nsapp* (objc:@selector #/setAppleMenu:)
				   submenu)
    (#/release submenu)
    (ns:with-ns-rect (r 100 100 300 300)
      (let ((v (make-instance 'demo-view :with-frame r)))
	(#/setContentView: w v)
	(setq *view* v)
	(#/release v)))
    (#/setMainMenu: *nsapp* main-menu)
    (#/release main-menu)
    (#/center w)
    (#/makeKeyAndOrderFront: w +null-ptr+)))

;; In order for a command-line style program to talk to the window server,
;; we have to do this.
(defun transmogrify-to-foreground-app ()
  (rlet ((psn #>ProcessSerialNumber))
    (#_GetCurrentProcess psn)
    (#_TransformProcessType psn #$kProcessTransformToForegroundApplication)))

(defun event-loop ()
  (loop
    (with-simple-restart (abort "Process the next event")
      (#/run *nsapp*))))

(defun run-event-loop ()
  (%set-toplevel nil)
  (event-loop))

;; Here's the voodoo part.
;;
;; After the lisp starts up, it creates a listener thread.  The
;; initial thead then goes to sleep, waking up about 3 times a second
;; to auto-flush certain streams and do some other stuff.  The problem
;; is that the Cocoa event loop (and most other Cocoa functions) need
;; to run in the initial (or main) thread.
;;
;; That's what we're arranging to do here.  We interrupt the initial
;; process, and use %set-toplevel and toplevel (which are basically
;; process-preset and process-reset for the initial process) to make
;; the initial thread start running the Cocoa event loop.  We also
;; create a new thread to do the housekeeping.
(defun start-cocoa-application ()
  (flet ((startup ()
	   (ccl::with-standard-initial-bindings
	     (process-run-function "housekeeping" #'ccl::housekeeping-loop)
	     (transmogrify-to-foreground-app)
	     (ccl::with-autorelease-pool
	       (setq *nsapp* (#/sharedApplication ns:ns-application))
	       (#/setDelegate: *nsapp* (make-instance 'app-delegate)))
	     (ccl::with-autorelease-pool
	       (run-event-loop)))))
    (process-interrupt ccl::*initial-process*
		       #'(lambda ()
			   (%set-toplevel #'startup)
			   (toplevel)))))

;; After loading this file, you can evaluate
;; (start-cocoa-application), and an icon will appear in the dock, and
;; a window filled with solid red will appear.

;; It's possible to safely draw in a view from other threads.  This
;; macro sets things up to make that safe.	   
(defmacro with-focused-view ((view) &body body)
  `(let ((locked nil))
     (unwind-protect
	  (when (#/lockFocusIfCanDraw ,view)
	    (setq locked t)
	    ,@body)
       (when locked
	 (#/unlockFocus ,view)))))

;; As an example, one might say something like this:
#|
(with-focused-view (*view*)
  (let ((ctx (#/currentContext ns:ns-graphics-context)))
    (ns:with-ns-rect (r 20 20 50 50)
      (#_NSFrameRect r))
    (#/flushGraphics ctx)))
|#

;; With ctx in hand, you should be able to use any of the numerous
;; #_CGContextWhatever functions to do any drawing you want.
;;
;; Gelphman and Laden (see http://www.amazon.com/dp/0123694736) is a
;; hardcopy reference that you might find useful.