[Openmcl-devel] Bridge and NSTimer
Gary Byers
gb at clozure.com
Wed May 2 05:40:29 PDT 2007
It seems to still compile and run; I'm not 100% sure that all
drawing is as thread-safe as it should be, but that's another issue.
On Tue, 1 May 2007, Phil wrote:
> If you could dig up that code, I'd like to take a look at it as I'm still not
> entirely clear on how they interact.
>
> Thanks,
> Phil
>
> On May 1, 2007, at 7:56 PM, Gary Byers wrote:
>
>> If you're just allocating the NSTimer in the lisp listener thread, the
>> NSTimer will fire in the listener thread's runloop. The listener
>> thread is probably not running its runloop, and therefore the timer
>> is playing to an empty house.
>>
>> You -could- tell the listener to run its runloop, or you could
>> create the timer in the event thread. (The event thread is always
>> "running its runloop", which is how it gets event messages, hears
>> other timers fire, etc.)
>>
>> A couple of years ago, someone was trying to do Cocoa-based animation
>> and drawing from multiple threads, and we took the "tiny.lisp" example
>> and persuaded it to create lots of simple windows and draw simple
>> polygons in them, using NSTimers to animate the drawing. I think
>> that I still have that code somewhere; the animation itself isn't
>> very interesting and there were race conditions all over (e.g.,
>> what, if anything, happens if a timer fires while its window is
>> being closed ?) but it does show how threads/runloops/timers interact
>> and one approach to getting them to do so.
>>
>> On Tue, 1 May 2007, Phil wrote:
>>
>>> The wrong one? Seriously, I see your point... is creating the timer on the
>>> main thread (i.e. create a new method to create the timer and then call it
>>> via "performSelectorOnMainThread:withObject:waitUntilDone:") the right way
>>> to do this or is there a better/alternate way?
>>>
>>> Thanks,
>>> Phil
>>>
>>> On May 1, 2007, at 5:37 PM, Gary Byers wrote:
>>>
>>>> What thread does that code run in ? (I guess that the more relevant
>>>> question is "what NSRunloop is the NSTimer associated with ?")
>>>> On Tue, 1 May 2007, Phil wrote:
>>>>> Is there anything special to getting NSTimer to work via the bridge? I
>>>>> don't see anything wrong with this code but the timer doesn't seem to be
>>>>> firing.
>>>>> (defclass timer-test (ns:ns-object)
>>>>> ()
>>>>> (:metaclass ns:+ns-object))
>>>>> (ccl::define-objc-method ((:void :timer-fired the-timer) timer-test)
>>>>> (#_NSLog #@"timer fired"))
>>>>> (setf mytimer-objc (objc:make-objc-instance "TimerTest"))
>>>>> (objc:send (objc:@class "NSTimer")
>>>>> "scheduledTimerWithTimeInterval:target:selector:userInfo:repeats:"
>>>>> 1.0d0
>>>>> mytimer-objc
>>>>> (objc:@selector "timerFired:")
>>>>> nil
>>>>> nil)
>>>>> Thanks,
>>>>> Phil
>>>
>
-------------- next part --------------
;;;; -*- Mode: Lisp; Package: CCL -*-
;;;; tiny.lisp
;;;;
;;;; A fairly direct translation into Lisp of the Tiny application (Chapter 4)
;;;; from "Building Cocoa Applications" by Garfinkel and Mahoney
;;;;
;;;; The original Tiny example was meant to illustrate the programmatic use of
;;;; Cocoa without Interface Builder. Its purpose here is to illustrate the
;;;; programmatic use of the Cocoa bridge.
;;;;
;;;; Copyright (c) 2003 Randall D. Beer
;;;;
;;;; This software is licensed under the terms of the Lisp Lesser GNU Public
;;;; License , known as the LLGPL. The LLGPL consists of a preamble and
;;;; the LGPL. Where these conflict, the preamble takes precedence. The
;;;; LLGPL is available online at http://opensource.franz.com/preamble.html.
;;;;
;;;; Please send comments and bug reports to <beer at eecs.cwru.edu>
;;;; Modified to animate the drawing of polygons by Raf Cavallaro 5-13-2004
;;;; Modifications (such as they are) also licensed under the LLGPL.
;;;; Raf Cavallaro can be reached at <raffaelcavallaro at mac.com>
;;; Temporary package and module stuff
(in-package "CCL")
(declaim (optimize (speed 2) (safety 1) (space 0) (compilation-speed 0)))
(defparameter *draw-in-main-thread* nil)
(require "COCOA")
(eval-when (:compile-toplevel :execute)
(use-interface-dir :carbon)
(use-interface-dir :cocoa))
;;; Define the AnimView class
(defclass anim-view (ns:ns-view)
((max :foreign-type :int ::accessor anim-view-max)
(min :foreign-type :int :accessor anim-view-min)
(step :foreign-type :int :accessor anim-view-step)
(numsides :foreign-type :int :accessor anim-view-numsides)
(down :foreign-type :<BOOL> :accessor anim-view-down))
(:metaclass ns:+ns-object))
(define-objc-method ((:<BOOL> is-opaque) anim-view)
t)
;;; It'd be nice if we could just use :INITFORM options to initialize
;;; these slots, but that's hard to do: SHARED-INITIALIZED would generally
;;; use :INITFORMs to initialize slots that're otherwise unbound, but
;;; there isn't really a good way to tell whether a foreign slot's
;;; "unbound".
(define-objc-method ((:id :init-with-frame (:<NSR>ect r)) anim-view)
(let* ((v (send-super :init-with-frame r)))
(unless (%null-ptr-p v)
(setf (anim-view-max v) 9
(anim-view-min v) 3
(anim-view-step v) 2
(anim-view-numsides v) 3))
v))
(defconstant short-pi (coerce pi 'short-float))
(defclass animation-window (ns:ns-window)
((thread-run-loop :foreign-type :id :accessor animation-window-thread-run-loop)
(animation-timer :foreign-type :id :accessor animation-window-animation-timer)
(close-ack :initform nil :accessor animation-window-close-ack))
(:metaclass ns:+ns-object))
;;; X, Y coordinates for cascading windows
(defparameter *next-animation-top* 100.0f0)
(defparameter *next-animation-left* 100.0f0)
(defparameter *animation-timer-delay* 0.1d0)
;;; This does the animation, by adding the animation and close timers
;;; to the current thread's runloop and then running that runloop.
;;; The only input sources should be those timers; when the window
;;; closes, they'll be removed and the runloop will exit.
(defmethod animate-window ((self animation-window) view done)
(setf (animation-window-close-ack self) (make-semaphore))
(let* ((runloop (send (@class "NSRunLoop") 'current-run-loop)))
(setf (animation-window-thread-run-loop self) runloop)
(setf (animation-window-animation-timer self)
(make-objc-instance 'ns:ns-timer
:with-fire-date (send (@class "NSDate") 'distant-past)
:interval *animation-timer-delay*
:target view
:selector (@selector "doAnimation:")
:user-info (%null-ptr)
:repeats t))
(with-autorelease-pool
(send runloop
:add-timer
(animation-window-animation-timer self)
:for-mode #@"NSDefaultRunLoopMode")
(signal-semaphore done)
(send (the ns:ns-run-loop runloop) 'run))))
(defmethod start-animation ((self animation-window) view)
(let* ((created (make-semaphore)))
(process-run-function (format nil "Animation thread for window ~d"
(send self 'window-number))
#'animate-window
(%inc-ptr self 0)
view
created)
(wait-on-semaphore created)))
;;; Define the method that the animation thread uses to draw a anim-view.
;;; NOTE: The (THE NS-COLOR ...) forms are currently necessary for full
;;; optimization because the SET message has a nonunique type signature
;;; NOTE: The (@class XXX) forms will probably be replaced by
;;; (find-class 'XXX) once ObjC objects have been integrated into CLOS
;;; Draw the demo view, constrained to the indicated rectangle.
(defmethod redraw-anim-view ((self anim-view) rect)
(declare (ignore rect))
(slet ((bounds (send self 'bounds)))
(let ((width (ns-width bounds))
(height (ns-height bounds))
(numsides (anim-view-numsides self)))
(macrolet ((X (tt) `(* (1+ (sin ,tt)) width 0.5))
(Y (tt) `(* (1+ (cos ,tt)) height 0.5)))
;; Fill the view with orange
(send (the ns-color (send (@class ns-color) 'orange-color)) 'set)
(#_NSRectFill bounds)
;; Trace two polygons with N sides and connect all of the vertices
;; with cyan lines
(send (the ns-color (send (@class ns-color) 'cyan-color)) 'set)
(loop for f from 0.0 below (* 2 short-pi) by (* 2 (/ short-pi numsides))
do
(loop
for g from 0.0 below (* 2 short-pi) by (* 2 (/ short-pi numsides))
do
(send (@class ns-bezier-path)
:stroke-line-from-point (ns:make-ns-point (X f) (Y f))
:to-point (ns:make-ns-point (X g) (Y g)))))))))
;;; The :draw-rect method should only be called on the main thread;
;;; it's called when needed by the Cocoa display mechanism, and
;;; ensures that (a) the graphics state is set up properly (b) the
;;; view is locked by the main thread. If *DRAW-IN-MAIN-THREAD* is
;;; false, we want all drawing to occur on the animation thread, so our
;;; :draw-rect method does nothing in that case.
(define-objc-method ((:void :draw-rect (:<NSR>ect rect))
anim-view)
(if *draw-in-main-thread*
(redraw-anim-view self rect)))
;;; Other threads can draw to the view, but they need to use
;;; lockFocusIfCanDraw: to atomically lock the view if it's
;;; currently visible.
;;; If we're able to draw to the view, we have to tell the
;;; window to flush the offscreen buffer to the screen.
(defmethod draw-from-other-thread ((view anim-view) &optional
(rectptr (%null-ptr)))
(when (send view 'lock-focus-if-can-draw)
(unwind-protect
(progn
(redraw-anim-view view rectptr)
(send (send view 'window) 'flush-window))
(send view 'unlock-focus))))
(define-objc-method ((:void :do-animation timer) anim-view)
(declare (ignore timer))
(slet ((view-bounds (send self 'bounds)))
(if *draw-in-main-thread*
(send self :set-needs-display t) ; force the main thread to redraw the view
(draw-from-other-thread self view-bounds)) ; draw it ourselves
(let* ((down-p (anim-view-down self))
(step (anim-view-step self))
(numsides (anim-view-numsides self)))
(cond ((and (eql #$YES down-p) (<= numsides (anim-view-min self)))
(setf (anim-view-down self) #$NO))
((and (eql #$NO down-p) (>= numsides (anim-view-max self)))
(setf (anim-view-down self) #$YES))
((eql #$NO down-p)
(setf (anim-view-numsides self) (+ numsides step)))
(t
(setf (anim-view-numsides self) (- numsides step)))))))
(define-objc-method ((:void :stop-animation timer) animation-window)
(declare (ignore timer))
(send (animation-window-animation-timer self) 'invalidate)
(let* ((cfrunloop
(send (send (@class "NSRunLoop") 'current-run-loop) 'get-cf-run-loop)))
(#_CFRunLoopStop cfrunloop))
(signal-semaphore (animation-window-close-ack self)))
(define-objc-method ((:void close) animation-window)
(let* ((timer (make-objc-instance 'ns:ns-timer
:with-fire-date (send (@class "NSDate") 'distant-past)
:interval 0.0d0
:target self
:selector (@selector "stopAnimation:")
:user-info (%null-ptr)
:repeats nil)))
;; Add the timer to the animation thread's run loop
(send (animation-window-thread-run-loop self)
:add-timer timer
:for-mode #@"NSDefaultRunLoopMode"))
;; Wait for it to acknowledge the close request
(wait-on-semaphore (animation-window-close-ack self))
;; Actually close the window ...
(send-super 'close))
;;; This performs the actions that would normally be performed by loading
;;; a nib file. To avoid resource-contention errors, some of those actions
;;; need to be performed on the main Cocoa event thread.
(defun animate (&key (n 1) (delay *animation-timer-delay*))
(declare (optimize (speed 2) (safety 1) (space 0) (compilation-speed 0)))
(check-type n (integer 1))
(setq delay (coerce delay 'double-float))
(check-type delay (double-float (0.0d0)))
(with-autorelease-pool
(ns:with-ns-rect (r 100.0 100.0 400.0 400.0)
(let* ((*animation-timer-delay* delay))
(dotimes (i n)
(let ((w (make-instance
'animation-window
:with-content-rect r
:style-mask (logior #$NSTitledWindowMask
#$NSClosableWindowMask
#$NSMiniaturizableWindowMask)
:backing #$NSBackingStoreBuffered
:defer t)))
(send w :set-title #@"Animation window")
(ns:with-ns-point (origin *next-animation-left* *next-animation-top*)
(slet ((new-origin (send w :cascade-top-left-from-point origin)))
(setq *next-animation-left* (pref new-origin :<NSP>oint.x)
*next-animation-top* (pref new-origin :<NSP>oint.y)))
(let ((my-view (make-instance 'anim-view :with-frame r)))
(send w :set-content-view my-view)
(send w :set-delegate my-view)
(send w :make-key-and-order-front nil)
(start-animation w my-view)))))))))
More information about the Openmcl-devel
mailing list