[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)

;;; 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))

(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))
        (send runloop
              (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))
                        (%inc-ptr self 0)
    (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))
                for g from 0.0 below (* 2 short-pi) by (* 2 (/ short-pi numsides))
                (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)) 
  (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)
           (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)))
             (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)))
    (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 
                    :with-content-rect r
                    :style-mask (logior #$NSTitledWindowMask 
                    :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