Changeset 14242 for trunk/contrib/baylis/ca-demo.lisp
- Timestamp:
- Sep 9, 2010, 4:10:03 PM (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/contrib/baylis/ca-demo.lisp
r12568 r14242 7 7 ;; 8 8 ;; usage: 9 ;; 1. start a 64 bit version ofccl9 ;; 1. start ccl 10 10 ;; 2. (load "path to ca-demo.lisp on your system") 11 11 ;; 3. (run-demo "absolute path to small image file on your system") … … 23 23 (eval-when (:compile-toplevel :load-toplevel :execute) 24 24 (objc:load-framework "Quartz" :quartz)) 25 26 ;; 27 ;; Thanks to Raffael Cavallaro for this hack for determining OSX version 28 ;; 29 (defun snow-leopard-or-later-p () 30 (#/respondsToSelector: ns:ns-operation-queue (objc::@selector "mainQueue"))) 25 31 26 32 (defun nsstr (s) (make-instance 'gui::ns-lisp-string :string s)) … … 61 67 (defun set-layer-position (layer point) 62 68 (let* ((pos 63 64 69 (make-record 70 :<CGP>oint x (ns:ns-point-x point) y (ns:ns-point-y point)))) 65 71 (#/removeAllAnimations layer) 66 72 (#/setPosition: layer pos) … … 69 75 (ccl::define-objc-method ((:void :mouse-down (:id event)) ca-demo-view) 70 76 (let* ((event-location (#/locationInWindow event)) 71 77 (view-location (#/convertPoint:fromView: self event-location nil))) 72 78 (set-layer-position sprite view-location))) 73 79 74 80 (ccl::define-objc-method ((:void :mouse-dragged (:id event)) ca-demo-view) 75 81 (let* ((event-location (#/locationInWindow event)) 76 82 (view-location (#/convertPoint:fromView: self event-location nil))) 77 83 (set-layer-position sprite view-location))) 78 84 79 85 (ccl::define-objc-method ((:void :key-down (:id event)) ca-demo-view) 80 86 (declare (ignore event)) 81 82 83 87 (if (#/isInFullScreenMode self) 88 (#/exitFullScreenModeWithOptions: self #$nil) 89 (#/enterFullScreenMode:withOptions: self (#/mainScreen ns:ns-screen) #$nil))) 84 90 85 91 (ccl::define-objc-method ((:<BOOL> accepts-first-responder) ca-demo-view) #$YES) 86 92 87 93 (defun set-layer-bounds (layer rect) 88 (let* ((o (make-record :<CGP>oint 89 x (ns:ns-rect-x rect) 90 y (ns:ns-rect-y rect))) 91 (s (make-record :<CGS>ize 92 width (ns:ns-rect-width rect) 93 height (ns:ns-rect-height rect))) 94 (bounds (make-record :<CGR>ect origin o size s))) 94 (let* ((o (make-record :<CGP>oint x (ns:ns-rect-x rect) y (ns:ns-rect-y rect))) 95 (s (make-record :<CGS>ize width (ns:ns-rect-width rect) height (ns:ns-rect-height rect))) 96 (bounds (make-record :<CGR>ect origin o size s))) 95 97 (#/setBounds: layer bounds) 96 98 (free bounds) … … 98 100 (free o))) 99 101 100 (defun make-ca-layer (filename)102 (defun make-ca-layer-10.5 (filename) 101 103 (let* ((layer (#/init (make-instance 'ns:ca-layer))) 102 103 104 105 106 (ir (#_CGImageSourceCreateImageAtIndex sr 0 CCL:+NULL-PTR+))107 104 (ns-img (make-instance ns:ns-image :init-with-contents-of-file (nsstr filename))) 105 (s (#/size ns-img)) 106 (repr (#/TIFFRepresentation ns-img)) 107 (sr (#_CGImageSourceCreateWithData repr CCL:+NULL-PTR+)) 108 (ir (#_CGImageSourceCreateImageAtIndex sr 0 CCL:+NULL-PTR+))) 109 (format t "10.5 version~%") 108 110 (#/setName: layer (nsstr "sprite")) 109 111 (#/setContents: layer ir) … … 114 116 layer)) 115 117 118 ; 119 ; Making a layer from an image is simpler in OSX 10.6 because an NSImage can be 120 ; assigned directly to the layer contents. 121 ; 122 (defun make-ca-layer-10.6 (filename) 123 (let* ((layer (#/init (make-instance 'ns:ca-layer))) 124 (ns-img (make-instance ns:ns-image :init-with-contents-of-file (nsstr filename))) 125 (s (#/size ns-img))) 126 (#/setName: layer (nsstr "sprite")) 127 (#/setContents: layer ns-img) 128 (set-layer-bounds layer (ns:make-ns-rect 0 0 (pref s :ns-size.width) (pref s :ns-size.height))) 129 (#/release ns-img) 130 layer)) 131 116 132 (defun add-layer-to-view (view layer) 117 133 (#/setDelegate: layer view) 118 (#/addSublayer: (#/layer view) sprite))134 (#/addSublayer: (#/layer view) layer)) 119 135 120 136 ; … … 122 138 ; 123 139 ; Make a window. 124 ; Make a view 140 ; Make a view, add it to the window. 125 141 ; Tell the view that it needs a CA Backing layer 126 142 ; Make a CALayer using the content of the supplied image 127 143 ; Add the newly created layer to the view 128 ; Add the newly created view to the window129 144 ; 145 (defun run-demo-10.6 (filename) 146 (let ((window (make-ns-window 900 600 "CA Demo")) 147 (view (make-instance 'ca-demo-view))) 148 (#/setContentView: window view) 149 (#/setWantsLayer: view #$YES) 150 (setf sprite (make-ca-layer-10.6 filename)) 151 (add-layer-to-view view sprite))) 152 153 (defun run-demo-10.5 (filename) 154 (let ((window (make-ns-window 900 600 "CA Demo")) 155 (view (make-instance 'ca-demo-view))) 156 (#/setWantsLayer: view #$YES) 157 (setf sprite (make-ca-layer-10.5 filename)) 158 (add-layer-to-view view sprite) 159 (#/setContentView: window view))) 160 130 161 (defun run-demo (filename) 131 (let ((w (make-ns-window 900 600 "CA Demo")) 132 (v (make-instance 'ca-demo-view))) 133 (#/setWantsLayer: v #$YES) 134 (setf sprite (make-ca-layer filename)) 135 (add-layer-to-view v sprite) 136 (#/setContentView: w v))) 162 (if (snow-leopard-or-later-p) 163 (run-demo-10.6 filename) 164 (run-demo-10.5 filename)))
Note: See TracChangeset
for help on using the changeset viewer.