Changeset 14242 for trunk/contrib/baylis/ca-demo.lisp

Timestamp:

Sep 9, 2010, 4:10:03 PM (10 years ago)

Author:

rme

Message:

Updated demos from Neil Baylis.

File:

• trunk/contrib/baylis/ca-demo.lisp (modified) (7 diffs)

trunk/contrib/baylis/ca-demo.lisp

@@ -7 +7 @@
 ;;
 ;; usage:
-;;   1. start a 64 bit version of ccl
+;;   1. start ccl
 ;;   2. (load "path to ca-demo.lisp on your system")
 ;;   3. (run-demo "absolute path to small image file on your system")
@@ -23 +23 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (objc:load-framework "Quartz" :quartz))
+
+;;
+;; Thanks to Raffael Cavallaro for this hack for determining OSX version
+;;
+(defun snow-leopard-or-later-p ()
+   (#/respondsToSelector: ns:ns-operation-queue (objc::@selector "mainQueue")))
 
 (defun nsstr (s) (make-instance 'gui::ns-lisp-string :string s))
@@ -61 +67 @@
 (defun set-layer-position (layer point)
   (let* ((pos
-          (make-record
-           :<CGP>oint x (ns:ns-point-x point) y (ns:ns-point-y point))))
+          (make-record
+           :<CGP>oint x (ns:ns-point-x point) y (ns:ns-point-y point))))
     (#/removeAllAnimations layer)
     (#/setPosition: layer pos)
@@ -69 +75 @@
 (ccl::define-objc-method ((:void :mouse-down (:id event)) ca-demo-view)
     (let* ((event-location (#/locationInWindow event))
-           (view-location (#/convertPoint:fromView: self event-location nil)))
+           (view-location (#/convertPoint:fromView: self event-location nil)))
       (set-layer-position sprite view-location)))
 
 (ccl::define-objc-method ((:void :mouse-dragged (:id event)) ca-demo-view)
     (let* ((event-location (#/locationInWindow event))
-           (view-location (#/convertPoint:fromView: self event-location nil)))
+           (view-location (#/convertPoint:fromView: self event-location nil)))
       (set-layer-position sprite view-location)))
 
 (ccl::define-objc-method ((:void :key-down (:id event)) ca-demo-view)
     (declare (ignore event))
-    (if (#/isInFullScreenMode self)
-        (#/exitFullScreenModeWithOptions: self #$nil)
-        (#/enterFullScreenMode:withOptions: self (#/mainScreen ns:ns-screen) #$nil)))
+  (if (#/isInFullScreenMode self)
+      (#/exitFullScreenModeWithOptions: self #$nil)
+      (#/enterFullScreenMode:withOptions: self (#/mainScreen ns:ns-screen) #$nil)))
 
 (ccl::define-objc-method ((:<BOOL> accepts-first-responder) ca-demo-view) #$YES)
 
 (defun set-layer-bounds (layer rect)
-  (let* ((o (make-record :<CGP>oint
-                         x (ns:ns-rect-x rect)
-                         y (ns:ns-rect-y rect)))
-         (s (make-record :<CGS>ize
-                         width (ns:ns-rect-width rect)
-                         height (ns:ns-rect-height rect)))
-         (bounds (make-record :<CGR>ect origin o size s)))
+  (let* ((o (make-record :<CGP>oint x (ns:ns-rect-x rect) y (ns:ns-rect-y rect)))
+         (s (make-record :<CGS>ize width (ns:ns-rect-width rect) height (ns:ns-rect-height rect)))
+         (bounds (make-record :<CGR>ect origin o size s)))
     (#/setBounds: layer bounds)
     (free bounds)
@@ -98 +100 @@
     (free o)))
 
-(defun make-ca-layer (filename)
+(defun make-ca-layer-10.5 (filename)
   (let* ((layer (#/init (make-instance 'ns:ca-layer)))
-         (ns-img (make-instance ns:ns-image :init-with-contents-of-file (nsstr filename)))
-         (s (#/size ns-img))
-         (repr (#/TIFFRepresentation ns-img))
-         (sr (#_CGImageSourceCreateWithData repr CCL:+NULL-PTR+))
-         (ir (#_CGImageSourceCreateImageAtIndex sr 0 CCL:+NULL-PTR+))
-         )
+         (ns-img (make-instance ns:ns-image :init-with-contents-of-file (nsstr filename)))
+         (s (#/size ns-img))
+         (repr (#/TIFFRepresentation ns-img))
+         (sr (#_CGImageSourceCreateWithData repr CCL:+NULL-PTR+))
+         (ir (#_CGImageSourceCreateImageAtIndex sr 0 CCL:+NULL-PTR+)))
+    (format t "10.5 version~%")
     (#/setName: layer (nsstr "sprite"))
     (#/setContents: layer ir)
@@ -114 +116 @@
     layer))
 
+;
+; Making a layer from an image is simpler in OSX 10.6 because an NSImage can be
+; assigned directly to the layer contents.
+;
+(defun make-ca-layer-10.6 (filename)
+  (let* ((layer (#/init (make-instance 'ns:ca-layer)))
+         (ns-img (make-instance ns:ns-image :init-with-contents-of-file (nsstr filename)))
+         (s (#/size ns-img)))
+    (#/setName: layer (nsstr "sprite"))
+    (#/setContents: layer ns-img)
+    (set-layer-bounds layer (ns:make-ns-rect 0 0 (pref s :ns-size.width) (pref s :ns-size.height)))
+    (#/release ns-img)
+    layer))
+
 (defun add-layer-to-view (view layer)
   (#/setDelegate: layer view)
-  (#/addSublayer: (#/layer view) sprite))
+  (#/addSublayer: (#/layer view) layer))
 
 ;
@@ -122 +138 @@
 ;
 ; Make a window.
-; Make a view
+; Make a view, add it to the window.
 ; Tell the view that it needs a CA Backing layer
 ; Make a CALayer using the content of the supplied image 
 ; Add the newly created layer to the view
-; Add the newly created view to the window
 ;
+(defun run-demo-10.6 (filename)
+  (let ((window (make-ns-window 900 600 "CA Demo"))
+        (view (make-instance 'ca-demo-view)))
+    (#/setContentView: window view)
+    (#/setWantsLayer: view #$YES)
+    (setf sprite (make-ca-layer-10.6 filename))
+    (add-layer-to-view view sprite)))
+
+(defun run-demo-10.5 (filename)
+  (let ((window (make-ns-window 900 600 "CA Demo"))
+        (view (make-instance 'ca-demo-view)))
+    (#/setWantsLayer: view #$YES)
+    (setf sprite (make-ca-layer-10.5 filename))
+    (add-layer-to-view view sprite)
+    (#/setContentView: window view)))
+
 (defun run-demo (filename)
-  (let ((w (make-ns-window 900 600 "CA Demo"))
-        (v (make-instance 'ca-demo-view)))
-    (#/setWantsLayer: v #$YES)
-    (setf sprite (make-ca-layer filename))
-    (add-layer-to-view v sprite)
-    (#/setContentView: w v)))
+  (if (snow-leopard-or-later-p)
+      (run-demo-10.6 filename)
+      (run-demo-10.5 filename)))