(defpackage :demo-app
(:use :cl :objc-runtime)
(:export ))
(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)))
#+null
(cffi:defcfun (set-uncaught-exception-handler "set_uncaught_exception_handler"
:library objc-runtime::expose-stuff)
:void
(cb :pointer))
(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 ns-rect))
(cffi:with-foreign-slots (((:pointer ns-rect-origin) (:pointer ns-rect-size))
rect (:struct 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 main ()
(with-selectors ((shared-application "sharedApplication")
(process-info "processInfo")
(process-name "processName")
(set-activation-policy "setActivationPolicy:")
(init-with-content-rect "initWithContentRect:styleMask:backing:defer:")
(set-title "setTitle:")
(run "run")
(activate-ignoring-other-apps "activateIgnoringOtherApps:")
alloc
(make-key-and-order-front "makeKeyAndOrderFront:")
(cascade-top-left-from-point "cascadeTopLeftFromPoint:")
;; (application-should-terminate "applicationShouldTerminate:")
;; (set-delegate "setDelegate:")
;; (finish-launching "finishLaunching")
)
[#@NSApplication shared-application]
[objc-runtime::ns-app set-activation-policy :int 0]
(break)
(let* ((application-name [[#@NSProcessInfo process-info] process-name]))
(with-point (p (20 20))
(let* ((the-window [#@NSWindow alloc]))
[the-window init-with-content-rect :pointer (make-rect 10 10 120 120)
:char 1 :char 2 :boolean nil]
[the-window cascade-top-left-from-point :pointer p]
[the-window set-title :pointer application-name]
[the-window make-key-and-order-front :pointer (cffi:null-pointer)]
[ objc-runtime::ns-app activate-ignoring-other-apps :boolean t]
[ objc-runtime::ns-app run])))))