[Openmcl-devel] Re: [Bug-openmcl] NSViewHierarchyLock Assertion failure

[Gary Byers]

On Thu, 13 May 2004, Raffael Cavallaro wrote:
>
> Here's tiny-loop.lisp:
>

Here's another version; it's probably not a good example of how to do
animation, and it may use enough CPU cycles to cause the occasional
PowerBook meltdown ...

All of the drawing happens in a separate, per-window thread.  A timer
wakes up every now and then (every 0.1d0 seconds, by default) and
runs an animation step; another timer is set to fire in the infinitely
distant future, but is manually fired when the window's about to close.
When the latter timer fires, the first timer is inalidated (so there
won't be any attempts to draw after the window closes) and the animation
thread exits.  I -think- that this is a fairly reliably way to prevent
drawing from happening after the window closes.

It seems to take more than 0.1d0 seconds to draw a frame on my iBook G4,
so the animation timer may want to have a longer interval.

The good news is that since all drawing takes place in an independent
thread, you should be able to have multiple animation windows onscreen
and animating themselves at the same time (I think that I've had 3 going
at the same time.)  The bad news is that the drawRect: method - used
to automatically update invalid view rectangles from the main thread -
is a no-op, so portions of the view that're exposed don't get redrawn
until the next animation cycle.  Fixing this is left as an excersise
(hint: don't allow the view's NUMSIDES instance variable to change
unless the view is locked for drawing.)
-------------- 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)))





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



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

    ((close-timer :foreign-type :id :accessor animation-window-close-timer)

     (animation-timer :foreign-type :id :accessor animation-window-animation-timer))

  (:metaclass ns:+ns-object))





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

  (let* ((runloop (send (@class "NSRunLoop") 'current-run-loop)))

    (with-autorelease-pool

        (send runloop

              :add-timer

              (animation-window-close-timer self)

              :for-mode #@"NSDefaultRunLoopMode")

      (send runloop

            :add-timer

            (animation-window-animation-timer self)

            :for-mode #@"NSDefaultRunLoopMode")

    (send runloop 'run))))





(defmethod start-animation ((self animation-window) view)

  (setf (animation-window-close-timer self)

        (make-objc-instance 'ns:ns-timer

                            :with-fire-date (send (@class "NSDate") 'distant-future)

                            :interval 0.0d0

                            :target self

                            :selector (@selector "stopAnimation:")

                            :user-info (%null-ptr)

                            :repeats nil))

  (setf (animation-window-animation-timer self)

        (make-objc-instance 'ns:ns-timer

                            :with-fire-date (send (@class "NSDate") 'distant-past)

                            :interval 0.1d0

                            :target view

                            :selector (@selector "doAnimation:")

                            :user-info (%null-ptr)

                            :repeats t))                            

  (process-run-function (format nil "Animation thread for window ~d"

                                (send self 'window-number))

                        #'animate-window

                        self))







;;; 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: This will be replaced by a DEFMETHOD once ObjC objects have been

;;;       integrated into CLOS

;;; 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-point (X f) (Y f)) 

                      :to-point (ns-make-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.  Since we want all drawing to occur on the animation

;;; thread, our :draw-rect method does nothing.

(define-objc-method ((:void :draw-rect (:<NSR>ect rect)) 

		     anim-view)

  (declare (ignore 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)))

    (draw-from-other-thread self view-bounds)

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

           

                          



(define-objc-method ((:void close) animation-window)

  (send (animation-window-close-timer self) 'fire)

  (send-super 'close))





;;; This performs the actions that would normally be performed by loading

;;; a nib file. 



(defun tiny-setup ()

  (declare (optimize (speed 2) (safety 1) (space 0) (compilation-speed 0)))

  (with-autorelease-pool

    (slet ((r (ns-make-rect 100.0 350.0 1000.0 1000.0)))

          (let ((w (make-instance 

                     'animation-window

		     :with-content-rect r

		     :style-mask (logior #$NSTitledWindowMask 

		                         #$NSClosableWindowMask 

				         #$NSMiniaturizableWindowMask)

		     :backing #$NSBackingStoreBuffered

		     :defer nil)))

            (send w :set-title #@"Polygon Window")

	    (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

                    :perform-selector-on-main-thread (@selector "makeKeyAndOrderFront:")

                    :with-object nil

                    :wait-until-done t)

              (start-animation w my-view)

	      w)))))



    

						

(defun animate ()

  (ccl::tiny-setup))