home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / oodleutl.cpt / oodles-of-utils / objects-of-desire / screen-3buf.lisp next >
Encoding:
Text File  |  1992-05-18  |  12.6 KB  |  307 lines
  1. (in-package  :oou)
  2. (oou-provide :screen-3buf)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; screen-3buf.Lisp
  5. ;;
  6. ;; Copyright ⌐ 1992 Northwestern University Institute for the Learning Sciences
  7. ;; All Rights Reserved
  8. ;;
  9. ;; author: Michael S. Engber
  10. ;;
  11. ;; Class of triple buffer screen buffers for doing smooth animation
  12. ;;
  13. ;; It's currently pretty nasty code, not for public consumption. Various things
  14. ;; which are easier to use will be built on top of it.
  15. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16.  
  17. (oou-dependencies :WMgr-view
  18.                   :simple-view-ce
  19.                   :GWorld-view
  20.                   :QuickDraw-u)
  21.  
  22. (export '())
  23.  
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25.  
  26. (defclass screen-3buf ()
  27.   
  28.   ((s3buf-position :initarg :s3buf-position
  29.                    :reader   s3buf-position)
  30.    (s3buf-size     :initarg :s3buf-size
  31.                    :reader   s3buf-size)
  32.    (saved-GW-view  :accessor saved-GW-view)
  33.    (image-GW-view  :accessor image-GW-view)
  34.    (scrap-GW-view  :accessor scrap-GW-view))
  35.    
  36.    (:default-initargs
  37.      
  38.      ))
  39.  
  40. (defmethod initialize-instance :after ((s3b screen-3buf) &rest initargs)
  41.   (declare (ignore initargs))
  42.   (setf (saved-GW-view s3b) (make-instance 'GWorld-view
  43.                               :view-position (s3buf-position s3b)
  44.                               :view-size (s3buf-size s3b)
  45.                               :GW-depth 0))
  46.   (setf (image-GW-view s3b) (make-instance 'GWorld-view
  47.                               :view-position (s3buf-position s3b)
  48.                               :view-size (s3buf-size s3b)
  49.                               :GW-depth 0))
  50.   (setf (scrap-GW-view s3b) (make-instance 'GWorld-view
  51.                               :view-position (s3buf-position s3b)
  52.                               :view-size (s3buf-size s3b)
  53.                               :GW-depth 0
  54.                               :GW-init-flags #.(+ (ash 1 #$useTempMem) (ash 1 #$pixPurge))
  55. )))
  56.  
  57.  
  58. (defmethod s3buf-alloc ((s3b screen-3buf))
  59.   (GWorld-alloc (saved-GW-view s3b))
  60.   (GWorld-alloc (image-GW-view s3b))
  61.   (GWorld-alloc (scrap-GW-view s3b))
  62.   (s3buf-screen-to-saved s3b)
  63.   (s3buf-saved-to-image s3b))
  64.  
  65. (defmethod s3buf-dispose ((s3b screen-3buf))
  66.   (GWorld-free (saved-GW-view s3b))
  67.   (GWorld-free (image-GW-view s3b))
  68.   (GWorld-free (scrap-GW-view s3b)))
  69.  
  70. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  71. ;;buffer drawing fns
  72.  
  73. (defmethod s3buf-draw-to-saved ((s3b screen-3buf) draw-fn)
  74.   (with-slots (saved-GW-view) s3b
  75.     (with-focused-view saved-GW-view
  76.       (funcall draw-fn s3b (pref (GWorld saved-GW-view) :CGrafPort.portRect)))))
  77.  
  78. (defmethod s3buf-draw-to-image ((s3b screen-3buf) draw-fn)
  79.   (with-slots (image-GW-view) s3b
  80.     (with-focused-view image-GW-view
  81.       (funcall draw-fn s3b (pref (GWorld image-GW-view) :CGrafPort.portRect)))))
  82.  
  83. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  84. ;;buffer <-> screen copy fns
  85.  
  86. (defmethod s3buf-screen-to-saved ((s3b screen-3buf) &key (copy-rgn (%null-ptr)))
  87.   (with-slots (saved-GW-view) s3b
  88.     (with-macptrs ((r (pref (GWorld saved-GW-view) :CGrafPort.portRect)))
  89.       (with-focused-view saved-GW-view
  90.         (#_CopyBits (view-portBits *WMGr-view*) (view-portBits saved-GW-view) r r #$srcCopy copy-rgn)))))
  91.  
  92. (defmethod s3buf-saved-to-image  ((s3b screen-3buf) &key (copy-rgn (%null-ptr)))
  93.   (with-slots (saved-GW-view image-GW-view) s3b
  94.     (with-macptrs ((r (pref (GWorld saved-GW-view) :CGrafPort.portRect)))
  95.       (with-locked-GWorld-view saved-GW-view
  96.         (with-focused-view image-GW-view
  97.           (#_CopyBits (view-portBits saved-GW-view) (view-portBits image-GW-view) r r #$srcCopy copy-rgn))))))
  98.  
  99. (defmethod s3buf-saved-to-screen ((s3b screen-3buf) &key (copy-rgn (%null-ptr)))
  100.   (with-slots (saved-GW-view) s3b
  101.     (with-macptrs ((r (pref (GWorld saved-GW-view) :CGrafPort.portRect)))
  102.       (with-locked-GWorld-view saved-GW-view
  103.         (with-focused-view *WMGr-view*
  104.           (#_CopyBits (view-portBits saved-GW-view) (view-portBits *WMGr-view*) r r #$srcCopy copy-rgn))))))
  105.  
  106. (defmethod s3buf-image-to-screen ((s3b screen-3buf) &key (copy-rgn (%null-ptr)))
  107.   (with-slots (image-GW-view) s3b
  108.     (with-macptrs ((r (pref (GWorld image-GW-view) :CGrafPort.portRect)))
  109.       (with-locked-GWorld-view image-GW-view
  110.         (with-focused-view *WMGr-view*
  111.           (#_CopyBits (view-portBits image-GW-view) (view-portBits *WMGr-view*) r r #$srcCopy copy-rgn))))))
  112.  
  113.  
  114. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  115. ;;buffer moving functions - very complicated - very ugly
  116. ;;
  117. ;; There are basically 2 concepts when repositioning a screen buffer:
  118. ;;
  119. ;;  - sliping: Buffered rect changes but the saved bits don't change position.
  120. ;;    Imagine, the frame of the buffer slipping over the screen to a new position.
  121. ;;
  122. ;;  - moving: Buffered rect changes and the bits move with it.
  123. ;;    Imagine, the frame of the buffer moving to a new position carrying the bits
  124. ;;    with it as it goes - like a window does when you move it.
  125. ;;
  126. ;; Slipping is useful if you're buffering the screen for the draging some region
  127. ;; around. You need to move your buffer to reflect the new position of the object,
  128. ;; but the background bits you're saving don't move.
  129. ;;
  130. ;; Moving is useful if you're buffering the contents of a window and the window
  131. ;; moves. Also, when draging an object around, the bits in the region corresponding
  132. ;; to the object being dragged should be moved (the rest of the bits should slip)
  133.  
  134. (defmethod s3buf-reposition ((s3b screen-3buf) topLeft botRight
  135.                              &key
  136.                              (restore-old-rgn-p  nil)
  137.                              (saved-xfer-mode   :slip)
  138.                              (image-xfer-mode   :move)
  139.                              (image-sub-rgn     (%null-ptr))
  140.                              (sub-rgn-new-pos    nil))
  141.   (declare (dynamic-extent s3b topLeft botRight restore-old-rgn-p saved-xfer-mode image-xfer-mode image-sub-rgn sub-rgn-new-pos))
  142.   (with-slots (saved-GW-view image-GW-view scrap-GW-view) s3b
  143.     (let ((old-pos (s3buf-position s3b)))
  144.       (declare (dynamic-extent old-pos))
  145.     (rlet ((old-r  :Rect
  146.                    :topLeft  old-pos
  147.                    :botRight (add-points old-pos (s3buf-size s3b)))
  148.            (new-r  :Rect
  149.                    :topLeft  topLeft
  150.                    :botRight botRight))
  151.  
  152.       (setf (slot-value s3b 's3buf-position) topLeft)
  153.       (setf (slot-value s3b 's3buf-size) (subtract-points botRight topLeft))
  154.  
  155.       ;;get the scrap GWorld ready to use
  156.       (#_NoPurgePixels (#_GetGWorldPixMap (GWorld scrap-GW-view)))
  157.       (GWorld-set-portRect scrap-GW-view old-r)
  158.       
  159.       ;;;;;;;;;;;
  160.       ;;saved bits
  161.       (ecase saved-xfer-mode
  162.         (:none )
  163.         (:slip (s3buf-slip-GW saved-GW-view scrap-GW-view old-r new-r))
  164.         (:move (s3buf-move-GW saved-GW-view scrap-GW-view old-r new-r)))
  165.       
  166.       (when restore-old-rgn-p
  167.         (with-macptrs ((old-rgn    (#_NewRgn))
  168.                        (quayle-rgn (#_NewRgn)))
  169.           (unwind-protect
  170.             (with-locked-GWorld-view scrap-GW-view
  171.               (with-focused-view *WMGr-view*
  172.                 (#_RectRgn quayle-rgn new-r)
  173.                 (#_RectRgn old-rgn old-r)
  174.                 (#_DiffRgn old-rgn quayle-rgn old-rgn)
  175.                 (#_CopyBits (view-portBits scrap-GW-view) (view-portBits *WMGr-view*) old-r old-r #$srcCopy old-rgn)))
  176.             (#_DisposeRgn old-rgn)
  177.             (#_DisposeRgn quayle-rgn))))
  178.       
  179.       
  180.       ;;;;;;;;;;;
  181.       ;;image bits
  182.       (ecase image-xfer-mode
  183.         (:none )
  184.         (:slip (s3buf-slip-GW image-GW-view scrap-GW-view old-r new-r))
  185.         (:move
  186.          (rlet ((old-image-r :Rect)
  187.                 (new-image-r :Rect))
  188.            
  189.            ;;prepare the copy rects and regions
  190.            (if (handlep image-sub-rgn)
  191.              (let ((delta (if sub-rgn-new-pos
  192.                             (subtract-points sub-rgn-new-pos (href image-sub-rgn :Region.rgnBBox.topLeft))
  193.                             (subtract-points topLeft old-pos))))
  194.                (declare (dynamic-extent delta))
  195.                (pset old-image-r :Rect.topLeft  (href image-sub-rgn :Region.rgnBBox.topLeft))
  196.                (pset old-image-r :Rect.botRight (href image-sub-rgn :Region.rgnBBox.botRight))
  197.                (#_OffsetRgn :pointer image-sub-rgn :long delta)
  198.                (pset new-image-r :Rect.topLeft  (href image-sub-rgn :Region.rgnBBox.topLeft))
  199.                (pset new-image-r :Rect.botRight (href image-sub-rgn :Region.rgnBBox.botRight)))
  200.              (let ((delta (subtract-points topLeft old-pos)))
  201.                (declare (dynamic-extent delta))
  202.                (pset old-image-r :Rect old-r)
  203.                (pset new-image-r :Rect old-r)
  204.                (#_OffsetRect :pointer new-image-r :long delta)))
  205.            
  206.            (s3buf-dup-and-resize image-GW-view scrap-GW-view old-r new-r)
  207.            (s3buf-saved-to-image s3b)
  208.            (with-locked-GWorld-view scrap-GW-view
  209.              (with-focused-view image-GW-view
  210.                (#_CopyBits (view-portBits scrap-GW-view) (view-portBits image-GW-view) old-image-r new-image-r #$srcCopy image-sub-rgn)))))))
  211.     
  212.     (#_AllowPurgePixels (#_GetGWorldPixMap (GWorld scrap-GW-view)))))
  213.  
  214.   t)
  215.  
  216.  
  217. (defun s3buf-dup-and-resize (gw-view gw-view-copy old-r new-r)
  218.   (with-locked-GWorld-view gw-view
  219.     (with-focused-view gw-view-copy
  220.       (#_CopyBits (view-portBits gw-view) (view-portBits gw-view-copy) old-r old-r #$srcCopy (%null-ptr))))
  221.   (GWorld-set-portRect gw-view new-r)
  222.   t)
  223.  
  224. (defun s3buf-slip-GW (gw-view temp-gw-view old-r new-r)
  225.   
  226.   (s3buf-dup-and-resize gw-view temp-gw-view old-r new-r)
  227.   
  228.   (rlet ((sect-r :Rect))
  229.     (#_SectRect old-r new-r sect-r)
  230.     
  231.     (with-locked-GWorld-view temp-gw-view
  232.       (with-focused-view gw-view
  233.         
  234.         ;;copy fresh bits in from the screen
  235.         (#_CopyBits (view-portBits *WMGr-view*) (view-portBits gw-view) new-r new-r #$srcCopy (%null-ptr))
  236.         
  237.         ;;copy overlapping/reusable bits
  238.         (#_CopyBits (view-portBits temp-gw-view) (view-portBits gw-view) sect-r sect-r #$srcCopy (%null-ptr)))))
  239.   t)
  240.  
  241.  
  242. (defun s3buf-move-GW (gw-view temp-gw-view old-r new-r)
  243.   
  244.   (s3buf-dup-and-resize gw-view temp-gw-view old-r new-r)
  245.   
  246.   (rlet ((r :Rect))
  247.     (pset r :Rect old-r)
  248.     (let ((delta (subtract-points (pref new-r :Rect.topLeft) (pref old-r :Rect.topLeft))))
  249.       (declare (dynamic-extent delta))
  250.       (#_OffsetRect :pointer r :long delta))
  251.     
  252.     (with-locked-GWorld-view temp-gw-view
  253.       (with-focused-view gw-view
  254.         
  255.         ;;copy fresh bits in from the screen
  256.         (#_CopyBits (view-portBits *WMGr-view*) (view-portBits gw-view) new-r new-r #$srcCopy (%null-ptr))
  257.         
  258.         ;;copy overlapping/reusable bits
  259.         (#_CopyBits (view-portBits temp-gw-view) (view-portBits gw-view) old-r r #$srcCopy (%null-ptr)))))
  260.   t)
  261.  
  262. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  263.  
  264. (defun erase-screen-buf-gWorld (gw-view &key (region nil) (rect nil))
  265.   ;;erases the specified region or rectangle of a GWorld view using the background
  266.   ;;pattern (including pattern alignment) and back/fore colors of the current port.
  267.   (with-macptrs ((cur-port (%getport))
  268.                  (rgn  (if (handlep region) region (#_NewRgn))))
  269.     (unwind-protect
  270.       (rlet ((rgb-fore :RGBColor)
  271.              (rgb-back :RGBColor))
  272.         (#_GetForeColor rgb-fore)
  273.         (#_GetBackColor rgb-back)
  274.         (unless (handlep region)
  275.           (#_RectRgn rgn (if (pointerp rect) rect (pref (GWorld gw-view) :CGrafPort.portRect))))
  276.         
  277.         ;;need to draw the rgn in local coord to ensure pattern alginment - yuck!
  278.         (let* ((old-rgn-tl (href rgn :Region.rgnBBox.topLeft))
  279.                (new-rgn-tl (rlet ((pt_p :Point old-rgn-tl))
  280.                              (#_GlobalToLocal pt_p)
  281.                              (subtract-points (%get-point pt_p) (pref cur-port :GrafPort.portRect.topLeft))))
  282.                (old-origin (view-origin gw-view))
  283.                (new-origin (add-points old-origin (subtract-points new-rgn-tl old-rgn-tl))))
  284.           
  285.           (with-focused-view gw-view
  286.             (with-fore-color (rgb-to-color rgb-fore)
  287.               (with-back-color (rgb-to-color rgb-back)
  288.                 (move-region-to rgn new-rgn-tl)
  289.                 (GWorld-set-origin gw-view new-origin)
  290.                 (if (wptr-color-p cur-port)
  291.                   (with-back-pix-pat (pref cur-port :CGrafPort.bkPixPat) (#_EraseRgn rgn))
  292.                   (with-back-pat     (pref cur-port :GrafPort.bkPat)     (#_EraseRgn rgn)))
  293.                 (GWorld-set-origin gw-view old-origin)
  294.                 (move-region-to rgn old-rgn-tl))))))
  295.       
  296.       (unless (handlep region) (#_DisposeRgn rgn))))
  297.   t)
  298.  
  299. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  300.  
  301. #|
  302.  
  303.  
  304. example code can be found in kinesis-u
  305.   
  306.  
  307. |#