home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / oodleutl.cpt / oodles-of-utils / brutal-utils / GWorld-u.lisp < prev    next >
Encoding:
Text File  |  1992-04-22  |  1.9 KB  |  62 lines
  1. (in-package  :oou)
  2. (oou-provide :GWorld-u)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; GWorld-svm.lisp
  5. ;;
  6. ;; Copyright ⌐ 1992 Northwestern University Institute for the Learning Sciences
  7. ;; All Rights Reserved
  8. ;;
  9. ;; author: Michael S. Engber
  10. ;;         Tamar Offer
  11. ;;
  12. ;; utilities for working with GWorlds
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14.  
  15. (oou-dependencies :simple-view-ce
  16.                   )
  17.  
  18. (export '(with-focused-GWorld with-locked-GWorld))
  19.  
  20. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21.  
  22. (eval-when (:compile-toplevel :load-toplevel :execute)
  23.  
  24.  
  25.   (defmacro with-locked-GWorld (gWorld &body body)
  26.     (let ((pixMapHandle (gensym))
  27.           (state        (gensym)))
  28.       `(with-macptrs ((,pixMapHandle (require-trap #_GetGWorldPixMap ,gWorld)))
  29.          (let ((,state (require-trap #_GetPixelsState ,pixMapHandle)))
  30.            (unwind-protect
  31.              (if (require-trap #_LockPixels ,pixMapHandle)
  32.                (progn ,@body)
  33.                (error "unable to lock pixels - they've been purged!"))
  34.              (require-trap #_SetPixelsState ,pixMapHandle ,state))))))
  35.  
  36. #|
  37.   (defmacro with-focused-GWorld ((gWorld &optional gDevice '(%null-ptr)) &body body)
  38.     (let ((old-port   (gensym))
  39.           (old-gdh    (gensym))
  40.           (old-port_p (gensym))
  41.           (old-gdh_p  (gensym)))
  42.       `(rlet ((,old-port_p :pointer)
  43.               (,old-gdh_p  :pointer))
  44.          (require-trap #_GetGWorld ,old-port_p ,old-gdh_p)
  45.          (with-macptrs ((,old-port (%get-ptr ,old-port_p))
  46.                         (,old-gdh  (%get-ptr ,old-gdh_p)))
  47.            
  48.            (unwind-protect
  49.              (with-locked-GWorld ,gWorld
  50.                (without-interrupts
  51.                 (require-trap #_SetGWorld ,gWorld ,gDevice)
  52.                 ,@body))
  53.              (require-trap #_SetGWorld ,old-port ,old-gdh))))))
  54.  
  55. |#
  56.  
  57.   )
  58.  
  59.  
  60. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  61.  
  62.