source: trunk/source/examples/cocoa/qtvidcapture/qtvidcapture.lisp @ 12031

Last change on this file since 12031 was 12031, checked in by gb, 11 years ago

Video capture example, from openmcl-devel, 05/08.

File size: 14.3 KB
1(in-package "CL-USER")
4;;; This is supposed to be a (close) translation of Apple's "MyRecorder"
5;;; example, which shows a simple use of QTKit's QTCaptureView, which
6;;; was introduced in Leopard.  The example requires a companion nib
7;;; file - "QTVidCapture.nib" - which is basically identical to the
8;;; "MainMenu.nib" from Apple's example (with the "MainMenu" menu removed
9;;; and the window's title and position changed.)  There's a little
10;;; utility function at the bottom of this file that runs an "Open" panel
11;;; that lets you select this nib file and tries to open a video capture
12;;; window.
14;;; Apple's MyRecorder example is at:
15;;; <>
17;;; Related guides/tutorials are available at:
18;;; <>
21;;; I tried to point out some issues of syntax and bridge arcana that
22;;; people new to Cocoa programming in CCL might need help with (I'm
23;;; sure that I missed some of that.)  I know very little about QTKit
24;;; and QT video capture; the hope is that people looking to do
25;;; something more ambituous will find Apple's guides and tutorials
26;;; easier to understand after reading this.
28(eval-when (:compile-toplevel :load-toplevel :execute)
29  (require "COCOA"))
31(eval-when (:compile-toplevel :load-toplevel :execute)
32  ;; Some of this requires OSX 10.5, which is software-version 9
33  ;; as far as we're concerned.
34  (if (< (parse-integer (software-version) :junk-allowed t) 9)
35    (error "This code requires OSX 10.5 or later"))
36  ;;
37  ;; Many class names in QTKit are prefixed with "QT".  Persuade the
38  ;; bridge that it should treat "QT" specially when mapping from
39  ;; ObjC class names to lisp.
40  (ccl::define-special-objc-word "QT")
41  (objc:load-framework "QTKit" :qtkit))
44;;; The .nib file refers to this class via the name
45;;; "MyRecorderController"; in lisp, that's basically any symbol whose
46;;; pname is "MY-RECORDER-CONTROLLER".  Likewise, there are references
47;;; to the slot "m-capture-view" - or "mCaptureView" in ObjC - in
48;;; the nib file.
50;;; If you open the "QTVidCapture.nib" file in IB 3.0, select the
51;;; "My Recorder" object in the main view, then choose the "Connections
52;;; Inspector" item (cmd-5) from the "Tools" menu, you'll see that
53;;; there's an "outlet" from the mCaptureView slot to the window's
54;;; Capture View.  This basically means that this slot in the
55;;; MY-WINDOW-CONTROLLER instance will be initialized to refer to
56;;; the window's QTCaptureView when the .nib file is loaded (if and
57;;; only if there's a slot with that name.  Changing the name of the
58;;; outlet in the nib file - or the name of the slot in the class
59;;; definition below - could keep this initialization from working.
61(defclass my-recorder-controller (ns:ns-object)
62  ((m-capture-view :foreign-type :id)
63   (m-capture-session :foreign-type :id)
64   (m-capture-movie-file-output :foreign-type :id)
65   (m-capture-video-device-input :foreign-type :id)
66   (m-capture-audio-device-input :foreign-type :id))
67  (:metaclass ns:+ns-object))
70;;; This method will be called (if it's defined) on all objects
71;;; in the .nib file have been initialized in ways specified in
72;;; the init file (i.e., "outlet" instance variables are set up,
73;;; "action" messages are associated with the objects that implement
74;;; them, etc.)  The order in which #/awakeFromNib methods are
75;;; called isn't specified, but we can count on the m-capture-view
76;;; slot being initialized to the QTCaptureView in the window.
77;;; For a better explanation of what this code does, see the
78;;; Apple tutorial.
79;;; The Apple sample code from which this was derived was pretty
80;;; casual about reporting errors; this code is equally casual.
81;;; Most of the things that can cause errors (missing devices
82;;; or resources, etc.) will store an NSError object in the
83;;; location that the "perror" pointer points to; this NSError
84;;; object can be used to report error conditons and (in some
85;;; cases) try to recover from them.  Real code should certainly
86;;; try to address those issues.
88(objc:defmethod (#/awakeFromNib :void) ((self my-recorder-controller))
89  (rlet ((perror (:* :id) +null-ptr+))
90    ;; In ObjC, it's generally possible to refer to a class's slots
91    ;; as if they were simple variables in a method specialized on
92    ;; that class.  OBJC:DEFMETHOD doesn't do that for us, but if
93    ;; we want to do that we can use WITH-SLOTS to get a similar
94    ;; effect.  (I tend to use SETQ whenever its legal to do so;
95    ;; other people use SETF.)
96    (with-slots (m-capture-view
97                 m-capture-session 
98                 m-capture-movie-file-output
99                 m-capture-video-device-input
100                 m-capture-audio-device-input) self
101      ;; Using MAKE-INSTANCE (with no initargs) to create an instance
102      ;; of an ObjC class is entirely equivalent to calling #/init
103      ;; on the value returned by calling #/alloc on the class,
104      (setq m-capture-session (make-instance 'ns:qt-capture-session))
106      ;; Some of the values below are (non-constant) ObjC variables.
107      ;; The #& reader macro lets us access those ObjC variables
108      ;; more-or-less as if they were lisp global variables.
109      (let* ((video-device (#/defaultInputDeviceWithMediaType:
110                            ns:qt-capture-device
111                            #&QTMediaTypeVideo))
112             (success (#/open: video-device perror)))
113        (unless success
114          (setq video-device (#/defaultInputDeviceWithMediaType:
115                              ns:qt-capture-device
116                              #&QTMediaTypeMuxed)
117                success (#/open: video-device perror)))
118        (when success
119          ;; (MAKE-INSTANCE objc-class-or-class-name :with-WHATEVER ...)
120          ;; is basically the same as using #/initWithWhatever:
121          ;; to initialize a newly-allocated instance of that class.
122          ;; MAKE-INSTANCE can also deal with the case where a class
123          ;; has a mixture of ObjC and Lisp slots.)
124          (setq m-capture-video-device-input 
125                (make-instance 'ns:qt-capture-device-input
126                               :with-device video-device))
127          (setq success (#/addInput:error: m-capture-session m-capture-video-device-input
128                                           perror)))
129        (when success
130          (unless (or (#/hasMediaType: video-device #&QTMediaTypeSound)
131                      (#/hasMediaType: video-device #&QTMediaTypeMuxed))
132            (let* ((audio-device (#/defaultInputDeviceWithMediaType:
133                                  ns:qt-capture-device
134                                  #&QTMediaTypeSound)))
135              (setq success (#/open: audio-device perror))
136              (when success
137                (setq m-capture-audio-device-input
138                      (make-instance 'ns:qt-capture-device-input
139                                     :with-device audio-device)
140                      success (#/addInput:error: m-capture-session
141                                                 m-capture-audio-device-input
142                                                 perror))))))
143        (when success
144          (setq m-capture-movie-file-output 
145                (make-instance 'ns:qt-capture-movie-file-output)
146                success (#/addOutput:error: m-capture-session m-capture-movie-file-output perror)))
147        (when success
148          (#/setDelegate: m-capture-movie-file-output self)
149          (let* ((connection-enumerator 
150                  (#/objectEnumerator (#/connections m-capture-movie-file-output))))
151            (do* ((connection (#/nextObject connection-enumerator)
152                              (#/nextObject connection-enumerator)))
153                 ((%null-ptr-p connection))
154              (let* ((media-type (#/mediaType connection))
155                     (compression-options
156                      (cond ((#/isEqualToString: media-type #&QTMediaTypeVideo)
157                             (#/compressionOptionsWithIdentifier:
158                              ns:qt-compression-options
159                              #@"QTCompressionOptions240SizeH264Video"))
160                            ((#/isEqualToString: media-type #&QTMediaTypeSound)
161                             (#/compressionOptionsWithIdentifier:
162                              ns:qt-compression-options
163                              #@"QTCompressionOptionsHighQualityAACAudio"))
164                            (t +null-ptr+))))
165                (#/setCompressionOptions:forConnection: m-capture-movie-file-output
166                                                       compression-options
167                                                       connection))))
168          (#/setCaptureSession: m-capture-view m-capture-session)
169          (#/startRunning m-capture-session)
170          )))))
172;;; Similarly, we use WITH-SLOTS here so that we can access slots
173;;; as if they were simple variables.  We're basically just trying
174;;; to close/free resources that have been associated with this
175;;; MY-WINDOW-CONTROLLER instance.
176;;; This method is called because the MY-RECORDER-CONTROLLER was
177;;; specified as the "delegate" of the window in the nib file.
178(objc:defmethod (#/windowWillClose: :void) ((self my-recorder-controller)
179                                           notification)
180  (declare (ignorable notification))
181  (with-slots (m-capture-session
182               m-capture-video-device-input
183               m-capture-audio-device-input) self
184    (unless (%null-ptr-p m-capture-session)
185      (#/stopRunning m-capture-session))
186    (unless (%null-ptr-p m-capture-video-device-input)
187      (if (#/isOpen (#/device m-capture-video-device-input))
188        (#/close (#/device m-capture-video-device-input))))
189    (unless (%null-ptr-p m-capture-audio-device-input)
190      (if (#/isOpen (#/device m-capture-audio-device-input))
191        (#/close (#/device m-capture-video-device-input))))))
193;;; This method is called when the MY-RECORDER-INSTANCE has had
194;;; its reference count go to 0   It basically decrements the
195;;; reference counts of the things it has allocated (possibly
196;;; causing #/dealloc to be invoked on them), then calls the
197;;; superclass method to deallocate itself.
198;;; A lisp pointer to the MY-WINDOW-CONTROLLER object might
199;;; continue to believe that the object its pointing to is
200;;; still a MY-WINDOW-CONTROLLER, even after the actual object
201;;; has been deallocated (basically, "deallocated" means "turned
202;;; into free memory.)  There isn't currently a good solution
203;;; to this problem (such a solution involves deeper integration
204;;; between the Lisp and its GC and the ObjC memory-management
205;;; system.)  It's a little hard to do this and the issue doesn't
206;;; come up that often, but it's worth remembering that there is
207;;; an issue here.
208(objc:defmethod (#/dealloc :void) ((self my-recorder-controller))
209  (with-slots (m-capture-session
210               m-capture-video-device-input
211               m-capture-audio-device-input
212               m-capture-movie-file-output) self
213    (#/release m-capture-session)
214    (#/release m-capture-video-device-input)
215    (#/release m-capture-audio-device-input)
216    (#/release m-capture-movie-file-output)
217    (call-next-method)))
219;;; This is an "action" method (specified in the nib file) that's
220;;; invoked whenever the "start" button is pressed.  "action" methods
221;;; recieve the object that invoked the method as a "sender" argument.
222;;; (In this case, the "sender" is the "start" button.)  We don't
223;;; care who sent the message and might ordinarily declare "sender"
224;;; to be ignored.  It's hard to know when the bridge might cause
225;;; objc:defmethod to expand into code that includes incidental
226;;; references to an argument, so it's generally best to say that
227;;; something that we don't use is "ignorable": we don't intend to
228;;; reference the variable, but don't really care if there are
229;;; incidental references to it in the macroexpansion of OBJC:DEFMETHOD.
231(objc:defmethod (#/startRecording: :void) ((self my-recorder-controller) sender)
232  (declare (ignorable sender))
233  (#/recordToOutputFileURL: (slot-value self 'm-capture-movie-file-output)
234                            (#/fileURLWithPath: ns:ns-url
235                                                #@"/Users/Shared/My Recorded")))
237;;; Likewise, another action method here.
238(objc:defmethod (#/stopRecording: :void) ((self my-recorder-controller) sender)
239  (declare (ignorable sender))
240  (#/recordToOutputFileURL: (slot-value self 'm-capture-movie-file-output)
241                            +null-ptr+))
243;;; This message is sent to us because we're the delegate object of
244;;; our output-capture object
246    (#/captureOutput:didFinishRecordingToOutputFileAtURL:forConnections:dueToError: :void)
247    ((self my-recorder-controller) captureoutput output-file-url connections error)
248  (declare (ignorable captureoutput connections error))
249  (#/openURL: (#/sharedWorkspace ns:ns-workspace) output-file-url))
252;;; That's the end of the transliterated code.  Here's a little function
253;;; that runs an "Open" panel to allow the selection of a nib file, then
254;;; tries to use a standard NSWindowController object to create and
255;;; show a window using that nib file.
258(defun open-window-using-selected-nib (&optional (prompt "Pick a nib file.  Any nib file"))
259  ;;; There are a bunch of issues that make it easier to do all of the
260  ;;; work on the main Cocoa event thread, which is the value of
262  (process-interrupt
263   gui::*cocoa-event-process*
264   (lambda ()
265     (let* ((panel (#/openPanel ns:ns-open-panel)))
266       ;; CCL::%MAKE-NSSTRING should probably be moved to some
267       ;; other package and exported from there.
268       (#/setTitle: panel (ccl::%make-nsstring prompt))
269       (#/setAllowsMultipleSelection: panel nil)
270       (let* ((types (#/arrayWithObject: ns:ns-array #@"nib"))
271              (button (#/runModalForTypes: panel types)))
272         (when (eql button #$NSOKButton)
273           (let* ((filenames (#/filenames panel)))
274             (when (eql 1 (#/count filenames))
275               (let* ((wc (make-instance 'ns:ns-window-controller
276                                         :with-window-nib-path
277                                         (#/objectAtIndex: filenames 0)
278                                         :owner (#/sharedApplication ns:ns-application))))
279                 (unless (%null-ptr-p wc)
280                   (#/showWindow: wc +null-ptr+)))))))))))
Note: See TracBrowser for help on using the repository browser.