home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1991: Code Warrior / bincue / Code Warrior.bin / Development Platforms (Moof!) / LISP Related / Goal-Plan-Code Editor / library / QuickDraw.lisp < prev    next >
Encoding:
Text File  |  1990-07-06  |  18.4 KB  |  562 lines  |  [TEXT/CCL ]
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;Quickdraw.lisp
  3. ;;
  4. ;;version 1.1
  5. ;;
  6. ;;copyright 1987 Coral Software Corp.
  7. ;;
  8. ;;  This file implements a full error-checked interface to Quickdraw.
  9. ;;  It is meant to be useful both in programs and as an example of how to use
  10. ;;  the low-level interface to the Mac.
  11. ;;
  12. ;;  You can compile selected portions of this file, but if you do, make sure to
  13. ;;  include the macros and utility functions from the top.
  14. ;;
  15.  
  16.  
  17. (proclaim '(object-variable wptr))
  18.  
  19. (eval-when (eval compile)
  20.   (require 'records)
  21.   (require 'traps))
  22.  
  23. (defmacro with-rectangle-arg ((var left top right bottom) &body body)
  24.   "takes a rectangle, two points, or four coordinates and makes a rectangle.
  25. body is evaluated with VAR bound to that rectangle."
  26.   `(rlet ((,var :rect))
  27.      (cond (,bottom
  28.             (rset ,var rect.topleft (make-point ,left ,top))
  29.             (rset ,var rect.bottomright (make-point ,right ,bottom)))
  30.            (,right
  31.             (error "Illegal rectangle arguments: ~s ~s ~s ~s"
  32.                    ,left ,top ,right ,bottom))
  33.            (,top
  34.             (rset ,var rect.topleft (make-point ,left nil))
  35.             (rset ,var rect.bottomright (make-point ,top nil)))
  36.            (t (setq ,var (pointer-arg ,left))))
  37.      ,@body))
  38.  
  39. (defun pointer-arg (thing)
  40.   (if (pointerp thing)
  41.       thing
  42.       (error "Argument: ~a is not a Macintosh pointer" thing)))
  43.  
  44. (defun handle-arg (thing)
  45.   (if (handlep thing)
  46.       thing
  47.       (error "Argument: ~a is not a Macintosh handle" thing)))
  48.  
  49. (defun region-arg (thing)
  50.   (if (handlep thing)
  51.       thing
  52.       (error "Argument: ~a is not a Macintosh handle" thing)))
  53.  
  54. (defun polygon-arg (thing)
  55.   (if (handlep thing)
  56.       thing
  57.       (error "Argument: ~a is not a Macintosh handle" thing)))
  58.  
  59. (defun picture-arg (thing)
  60.   (if (handlep thing)
  61.       thing
  62.       (error "Argument: ~a is not a Macintosh handle" thing)))
  63.  
  64. (defun mode-arg (thing)
  65.   (or
  66.    (and (fixnump thing) (<= 0 thing 15) thing)
  67.    (position thing *pen-modes*)
  68.    (error "Unknown pen mode: ~a" thing)))
  69.  
  70. (defobfun (origin *window*) ()
  71.   (rref wptr window.portrect.topleft))
  72.  
  73. (defobfun (set-origin *window*) (h &optional v &aux (pt (make-point h v)))
  74.   (with-port wptr (_SetOrigin :long pt))
  75.   pt)
  76.  
  77. (defobfun (clip-region *window*) (&optional (save-region (_NewRgn :ptr)))
  78.  (with-port wptr 
  79.    (_GetClip :ptr (setq save-region (region-arg save-region))))
  80.  save-region)
  81.  
  82. (defobfun (set-clip-region *window*) (new-region)
  83.  (with-port wptr
  84.    (_SetClip :ptr (region-arg new-region)))
  85.  new-region)
  86.  
  87. (defobfun (clip-rect *window*) (left &optional top right bot)
  88.   (with-rectangle-arg (r left top right bot)
  89.     (with-port wptr
  90.       (_ClipRect :ptr r)))
  91.   nil)
  92.  
  93. (defobfun (pen-show *window*) ()
  94.   (rset wptr grafport.pnvis 0)
  95.   nil)
  96.  
  97. (defobfun (pen-hide *window*) ()
  98.   (rset wptr grafport.pnvis -1)
  99.   nil)
  100.  
  101. (defobfun (pen-shown-p *window*) ()
  102.   (> (rref wptr grafport.pnvis) -1))
  103.  
  104. (defobfun (pen-position *window*) ()
  105.  (rref wptr window.pnloc))
  106.  
  107. (defobfun (pen-size *window*) ()
  108.   (rref wptr window.pnsize))
  109.  
  110. (defobfun (set-pen-size *window*) (h &optional v &aux (pt (make-point h v)))
  111.   (with-port wptr (_PenSize :long pt))
  112.   pt)
  113.  
  114. (defobfun (pen-mode *window*) ()
  115.   (elt *pen-modes* (rref wptr window.pnmode)))
  116.  
  117. (defobfun (set-pen-mode *window*) (new-mode)
  118.   (with-port wptr (_PenMode :word (mode-arg new-mode))))
  119.  
  120. (defobfun (pen-pattern *window*) (&optional (save-pat (make-record :pattern)))
  121.   (copy-record
  122.    (rref wptr window.pnPat) :pattern (pointer-arg save-pat))
  123.   save-pat)
  124.  
  125. (defobfun (set-pen-pattern *window*) (new-pattern)
  126.   (rset wptr window.pnPat (pointer-arg new-pattern))
  127.   new-pattern)
  128.  
  129. (defobfun (pen-state *window*) (&optional (save-state (make-record :penstate)))
  130.  (with-port wptr
  131.    (_GetPenState :ptr (pointer-arg save-state)))
  132.  save-state)
  133.  
  134. (defobfun (set-pen-state *window*) (new-state)
  135.  (with-port wptr
  136.    (_SetPenState :ptr (pointer-arg new-state)))
  137.  new-state)
  138.  
  139. (defobfun (pen-normal *window*) ()
  140.   (with-port wptr (_PenNormal)))
  141.  
  142. (defobfun (move-to *window*) (h &optional v)
  143.   (with-port wptr (_MoveTo :long (setq h (make-point h v))))
  144.   h)
  145.  
  146. (defobfun (move *window*) (h &optional v)
  147.   (with-port wptr (_Move :long (setq h (make-point h v))))
  148.   h)
  149.  
  150. (defobfun (line-to *window*) (h &optional v)
  151.   (with-port wptr (_LineTo :long (setq h (make-point h v))))
  152.   h)
  153.  
  154. (defobfun (line *window*) (h &optional v)
  155.   (with-port wptr (_Line :long (setq h (make-point h v))))
  156.   h)
  157.  
  158. (defun offset-rect (rect h &optional v)
  159.   (_OffsetRect :ptr (pointer-arg rect) :long (make-point h v))
  160.   rect)
  161.  
  162. (defun inset-rect (rect h &optional v)
  163.   (_InsetRect :ptr (pointer-arg rect) :long (make-point h v))
  164.   rect)
  165.  
  166. (defun intersect-rect (rect1 rect2 dest-rect)
  167.   (_SectRect :ptr (pointer-arg rect1) :ptr (pointer-arg rect2)
  168.              :ptr (pointer-arg dest-rect))
  169.   dest-rect)
  170.  
  171. (defun union-rect (rect1 rect2 dest-rect)
  172.   (_UnionRect :ptr (pointer-arg rect1) :ptr (pointer-arg rect2)
  173.              :ptr (pointer-arg dest-rect))
  174.   dest-rect)
  175.  
  176. (defun point-in-rect-p (rect h &optional v)
  177.   (logbitp 8 
  178.      (_PtInRect :long (make-point h v) :ptr (pointer-arg rect) :word)))
  179.  
  180. (defun points-to-rect (point1 point2 dest-rect)
  181.   (_Pt2Rect :long (make-point point1 nil) :long (make-point point2 nil)
  182.             :ptr (pointer-arg dest-rect))
  183.   dest-rect)
  184.  
  185. (defun point-to-angle (rect h &optional v)
  186.   (%stack-block ((ip 4))
  187.     (_PtToAngle :ptr rect :long (make-point h v) :ptr ip)
  188.     (%get-word ip)))
  189.  
  190. (defun equal-rect (rect1 rect2)
  191.   (logbitp 8
  192.     (_EqualRect :ptr (pointer-arg rect1) :ptr (pointer-arg rect2) :word)))
  193.  
  194. (defun empty-rect-p (left &optional top right bot)
  195.   (with-rectangle-arg (r left top right bot)
  196.   (logbitp 8 (_EmptyRect :ptr r :word))))
  197.  
  198. (defobfun (frame-rect *window*) (left &optional top right bot)
  199.  (with-port wptr
  200.    (with-rectangle-arg (r left top right bot) (_FrameRect :ptr r))))
  201.  
  202. (defobfun (paint-rect *window*) (left &optional top right bot)
  203.   (with-port wptr
  204.     (with-rectangle-arg (r left top right bot) (_PaintRect :ptr r))))
  205.  
  206. (defobfun (erase-rect *window*) (left &optional top right bot)
  207.   (with-port wptr
  208.     (with-rectangle-arg (r left top right bot) (_EraseRect :ptr r))))
  209.  
  210. (defobfun (invert-rect *window*) (left &optional top right bot)
  211.   (with-port wptr
  212.     (with-rectangle-arg (r left top right bot) (_InverRect :ptr r))))
  213.  
  214. (defobfun (fill-rect *window*) (pattern left &optional top right bot)
  215.   (with-port wptr
  216.     (with-rectangle-arg (r left top right bot)
  217.        (_FillRect :ptr r :ptr (pointer-arg pattern)))))
  218.  
  219. (defobfun (frame-oval *window*) (left &optional top right bot)
  220.  (with-port wptr
  221.    (with-rectangle-arg (r left top right bot) (_FrameOval :ptr r))))
  222.  
  223. (defobfun (paint-oval *window*) (left &optional top right bot)
  224.   (with-port wptr
  225.     (with-rectangle-arg (r left top right bot) (_PaintOval :ptr r))))
  226.  
  227. (defobfun (erase-oval *window*) (left &optional top right bot)
  228.   (with-port wptr
  229.     (with-rectangle-arg (r left top right bot) (_EraseOval :ptr r))))
  230.  
  231. (defobfun (invert-oval *window*) (left &optional top right bot)
  232.   (with-port wptr
  233.     (with-rectangle-arg (r left top right bot) (_InvertOval :ptr r))))
  234.  
  235. (defobfun (fill-oval *window*) (pattern left &optional top right bot)
  236.   (with-port wptr
  237.     (with-rectangle-arg (r left top right bot)
  238.        (_FillOval :ptr r :ptr (pointer-arg pattern)))))
  239.  
  240. (defobfun (frame-round-rect *window*) (oval-width oval-height 
  241.                                                  left &optional top right bot)
  242.  (with-port wptr
  243.    (with-rectangle-arg (r left top right bot)
  244.       (_FrameRoundRect :ptr r :word oval-width :word oval-height))))
  245.  
  246. (defobfun (paint-round-rect *window*) (oval-width oval-height 
  247.                                                  left &optional top right bot)
  248.  (with-port wptr
  249.    (with-rectangle-arg (r left top right bot)
  250.       (_PaintRoundRect :ptr r :word oval-width :word oval-height))))
  251.  
  252. (defobfun (erase-round-rect *window*) (oval-width oval-height 
  253.                                                  left &optional top right bot)
  254.  (with-port wptr
  255.    (with-rectangle-arg (r left top right bot)
  256.       (_EraseRoundRect :ptr r :word oval-width :word oval-height))))
  257.  
  258. (defobfun (invert-round-rect *window*) (oval-width oval-height 
  259.                                                  left &optional top right bot)
  260.  (with-port wptr
  261.    (with-rectangle-arg (r left top right bot)
  262.       (_InverRoundRect :ptr r :word oval-width :word oval-height))))
  263.  
  264. (defobfun (fill-round-rect *window*) (pattern oval-width oval-height 
  265.                                        left &optional top right bot)
  266.   (with-port wptr
  267.     (with-rectangle-arg (r left top right bot)
  268.        (_FillRoundRect :ptr r :word oval-width :word oval-height
  269.                        :ptr (pointer-arg pattern)))))
  270.  
  271. (defobfun (frame-arc *window*) (start-angle arc-angle 
  272.                                                  left &optional top right bot)
  273.  (with-port wptr
  274.    (with-rectangle-arg (r left top right bot)
  275.       (_FrameArc :ptr r :word start-angle :word arc-angle))))
  276.  
  277. (defobfun (paint-arc *window*) (start-angle arc-angle 
  278.                                                  left &optional top right bot)
  279.  (with-port wptr
  280.    (with-rectangle-arg (r left top right bot)
  281.       (_PaintArc :ptr r :word start-angle :word arc-angle))))
  282.  
  283. (defobfun (erase-arc *window*) (start-angle arc-angle 
  284.                                                  left &optional top right bot)
  285.  (with-port wptr
  286.    (with-rectangle-arg (r left top right bot)
  287.       (_EraseArc :ptr r :word start-angle :word arc-angle))))
  288.  
  289. (defobfun (invert-arc *window*) (start-angle arc-angle 
  290.                                                  left &optional top right bot)
  291.  (with-port wptr
  292.    (with-rectangle-arg (r left top right bot)
  293.       (_InvertArc :ptr r :word start-angle :word arc-angle))))
  294.  
  295. (defobfun (fill-arc *window*) (pattern start-angle arc-angle
  296.                                        left &optional top right bot)
  297.   (with-port wptr
  298.     (with-rectangle-arg (r left top right bot)
  299.        (_FillArc :ptr r :word start-angle :word arc-angle
  300.                  :ptr (pointer-arg pattern)))))
  301.  
  302. ;;;Regions
  303.  
  304. (defun new-region ()
  305.   (_NewRgn :ptr))
  306.  
  307. (defun dispose-region (region)
  308.   (_DisposRgn :ptr (region-arg region)))
  309.  
  310. (defun copy-region (region &optional (dest-region (new-region)))
  311.   (_CopyRgn :ptr (region-arg region) :ptr (region-arg dest-region))
  312.   dest-region)
  313.  
  314. (defun set-empty-region (region)
  315.   (_SetEmptyRgn :ptr (region-arg region))
  316.   region)
  317.  
  318. (defun set-rect-region (region left &optional top right bot)
  319.   (with-rectangle-arg (r left top right bot)
  320.    (_RectRgn :ptr (region-arg region) :ptr r))
  321.   region)
  322.  
  323. (defobfun (open-region *window*) ()
  324.   (if (rref wptr window.rgnSave)
  325.       (error "Region already open for window: ~a" (self)))
  326.   (with-port wptr (_OpenRgn)))
  327.  
  328. (defobfun (close-region *window*) (&optional (dest-region (new-region) dp))
  329.   (if (not (rref wptr window.rgnSave))
  330.       (progn 
  331.        (if (not dp) (dispose-region dest-region))
  332.        (error "Region is not open for window: ~a" (self))))
  333.   (with-port wptr
  334.     (_CloseRgn :ptr (region-arg dest-region)))
  335.   dest-region)
  336.  
  337. (defun offset-region (region h &optional v)
  338.   (_OffsetRgn :ptr (region-arg region) :long (make-point h v))
  339.   region)
  340.  
  341. (defun inset-region (region h &optional v)
  342.   (_InsetRgn :ptr (region-arg region) :long (make-point h v))
  343.   region)
  344.  
  345. (defun intersect-region (region1 region2 &optional (dest-region (new-region)))
  346.   (_SectRgn :ptr (region-arg region1) :ptr (region-arg region2)
  347.             :ptr (region-arg dest-region))
  348.   dest-region)
  349.  
  350. (defun union-region (region1 region2 &optional (dest-region (new-region)))
  351.   (_UnionRgn :ptr (region-arg region1) :ptr (region-arg region2)
  352.             :ptr (region-arg dest-region))
  353.   dest-region)
  354.  
  355. (defun difference-region (region1 region2 &optional (dest-region (new-region)))
  356.   (_DiffRgn :ptr (region-arg region1) :ptr (region-arg region2)
  357.             :ptr (region-arg dest-region))
  358.   dest-region)
  359.  
  360. (defun xor-region (region1 region2 &optional (dest-region (new-region)))
  361.   (_XorRgn :ptr (region-arg region1) :ptr (region-arg region2)
  362.             :ptr (region-arg dest-region))
  363.   dest-region)
  364.  
  365. (defun point-in-region-p (region h &optional v)
  366.   (logbitp 8 
  367.     (_PtInRgn :long (make-point h v) :ptr (region-arg region) :word)))
  368.  
  369. (defun rect-in-region-p (region left &optional top right bot)
  370.  (with-rectangle-arg (r left top right bot)
  371.   (logbitp 8 (_RectInRgn :ptr r :ptr (region-arg region) :word))))
  372.  
  373. (defun equal-region-p (region1 region2)
  374.   (logbitp 8 
  375.      (_EqualRgn :ptr (region-arg region1) :ptr (region-arg region2) :word)))
  376.  
  377. (defun empty-region-p (region)
  378.    (logbitp 8 (_EmptyRgn :ptr (region-arg region) :word)))
  379.  
  380. (defobfun (frame-region *window*) (region)
  381.   (with-port wptr (_FrameRgn :ptr (region-arg region))))
  382.  
  383. (defobfun (paint-region *window*) (region)
  384.   (with-port wptr (_PaintRgn :ptr (region-arg region))))
  385.  
  386. (defobfun (erase-region *window*) (region)
  387.   (with-port wptr (_EraseRgn :ptr (region-arg region))))
  388.  
  389. (defobfun (invert-region *window*) (region)
  390.   (with-port wptr (_InverRgn :ptr (region-arg region))))
  391.  
  392. (defobfun (fill-region *window*) (pattern region)
  393.   (with-port wptr 
  394.     (_FillRgn :ptr (region-arg region) :ptr (pointer-arg pattern))))
  395.  
  396. ;;;Pictures
  397.  
  398. (defobfun (start-picture *window*) (&optional left top right bottom)
  399.   (if (rref wptr window.picsave)
  400.    (error "A picture may not be started for window: ~a.
  401.            since one is already started" (self)))
  402.  (unless left (setq left (rref wptr window.portrect)))
  403.  (with-rectangle-arg (r left top right bottom)
  404.   (with-port wptr (have 'my-hPic (_OpenPicture :ptr r :ptr))))
  405.  nil)
  406.  
  407. (defobfun (get-picture *window*) ()
  408.   (declare (object-variable my-hPic))
  409.  (if (and (boundp 'my-hPic) my-hPic (rref wptr window.picSave))
  410.   (prog1
  411.     my-hPic
  412.     (with-port wptr (_ClosePicture))
  413.     (setq my-hPic nil))
  414.   (error "Picture for window: ~a is not started" (self))))
  415.  
  416. (defobfun (draw-picture *window*) (picture &optional left top right bottom)
  417.  (setq picture (picture-arg picture))
  418.  (cond ((not left)
  419.         (setq left (rref picture picture.picFrame.topleft)
  420.               top (rref picture picture.picFrame.bottomright)))
  421.        ((pointerp left)
  422.         ())
  423.        ((and (not right)
  424.              (not top))
  425.         (print (point-string
  426.                 (setq top
  427.                       (add-points left
  428.                                   (subtract-points
  429.                                    (rref picture picture.picframe.bottomright)
  430.                                    (rref picture picture.picframe.topleft))))))))
  431.  (with-rectangle-arg (r left top right bottom)
  432.    (with-port wptr
  433.      (_DrawPicture :ptr picture :ptr r))))
  434.  
  435. (defun kill-picture (picture)
  436.   (_KillPicture :ptr (picture-arg picture)))
  437.  
  438. (defobfun (start-polygon *window*) ()
  439.  (if (rref wptr window.polysave)
  440.    (error "A new polygon may not be started for window: ~a.
  441.            since one is already started" (self)))
  442.  (with-port wptr (have 'my-poly (_OpenPoly :ptr)))
  443.  nil)
  444.  
  445. (defobfun (get-polygon *window*) ()
  446.   (declare (object-variable my-poly))
  447.  (if (and (boundp 'my-poly) my-poly (rref wptr window.polysave))
  448.      (prog1
  449.        my-poly
  450.        (with-port wptr (_ClosePgon))
  451.        (setq my-poly nil))
  452.      (error "Polygon for window: ~a has not been started" (self))))
  453.  
  454. (defun kill-polygon (polygon)
  455.   (_KillPoly :ptr (polygon-arg polygon)))
  456.  
  457. (defun offset-polygon (polygon h &optional v)
  458.   (_OffsetPoly :ptr (polygon-arg polygon) :long (make-point h v))
  459.   polygon)
  460.  
  461. (defobfun (frame-polygon *window*) (polygon)
  462.   (with-port wptr (_FramePoly :ptr (polygon-arg polygon))))
  463.  
  464. (defobfun (paint-polygon *window*) (polygon)
  465.   (with-port wptr (_PaintPoly :ptr (polygon-arg polygon))))
  466.  
  467. (defobfun (erase-polygon *window*) (polygon)
  468.   (with-port wptr (_ErasePoly :ptr (polygon-arg polygon))))
  469.  
  470. (defobfun (invert-polygon *window*) (polygon)
  471.   (with-port wptr (_InvertPoly :ptr (polygon-arg polygon))))
  472.  
  473. (defobfun (fill-polygon *window*) (pattern polygon)
  474.  (with-port wptr
  475.    (_FillPoly :ptr (polygon-arg polygon) :ptr (pointer-arg pattern))))
  476.  
  477. (defobfun (local-to-global *window*) (h &optional v)
  478.   (subtract-points (make-point h v)
  479.                    (rref wptr grafport.portbits.bounds.topleft)))
  480.  
  481. (defobfun (global-to-local *window*) (h &optional v)
  482.   (add-points (make-point h v)
  483.               (rref wptr grafport.portbits.bounds.topleft)))
  484.  
  485. (defobfun (get-pixel *window*) (h &optional v)
  486.   (setq h (make-point h v))
  487.   (if (logbitp 8 
  488.          (_PtInRgn :long h :ptr (rref wptr window.visrgn) :word))
  489.       (with-port wptr
  490.          (logbitp 8 (_GetPixel :long h :word)))))
  491.  
  492. (defun scale-point (source-rect dest-rect h &optional v)
  493.   (rlet ((pt :point))
  494.     (%put-long pt (make-point h v))
  495.     (_ScalePt :ptr pt :ptr (pointer-arg source-rect)
  496.                       :ptr (pointer-arg dest-rect))
  497.     (%get-long pt)))
  498.  
  499. (defun map-point (source-rect dest-rect h &optional v)
  500.   (rlet ((pt :point))
  501.     (%put-long pt (make-point h v))
  502.     (_MapPt :ptr pt :ptr (pointer-arg source-rect)
  503.                       :ptr (pointer-arg dest-rect))
  504.     (%get-long pt)))
  505.  
  506. (defun map-rect (source-rect dest-rect rect)
  507.    (_MapRect :ptr (pointer-arg rect)
  508.              :ptr (pointer-arg source-rect)
  509.              :ptr (pointer-arg dest-rect))
  510.    rect)
  511.  
  512. (defun map-region (source-rect dest-rect region)
  513.    (_MapRgn :ptr (region-arg region)
  514.              :ptr (pointer-arg source-rect)
  515.              :ptr (pointer-arg dest-rect))
  516.    region)
  517.  
  518. (defun map-polygon (source-rect dest-rect polygon)
  519.    (_MapPoly :ptr (polygon-arg polygon)
  520.              :ptr (pointer-arg source-rect)
  521.              :ptr (pointer-arg dest-rect))
  522.    polygon)
  523.  
  524. (defun make-bitmap (left &optional top right bottom &aux rowbytes bm)
  525.  (with-rectangle-arg (r left top right bottom)
  526.    (setq rowbytes 
  527.     (logand
  528.        #xfffe 
  529.        (+ 2  (ash (- (rref r rect.right) (rref r rect.left) 1) -3))))
  530.    (setq bm 
  531.     (_NewPtr :errchk 
  532.       :d0 (+ 14 (* rowbytes (- (rref r rect.bottom) (rref r rect.top))))
  533.       :a0))
  534.    (rset bm bitmap.bounds r)
  535.    (rset bm bitmap.rowbytes rowbytes)
  536.    (rset bm bitmap.baseaddr (%inc-ptr bm 14)))
  537.  bm)
  538.  
  539.  
  540. (defun copy-bits (source-bitmap dest-bitmap source-rect dest-rect
  541.                     &optional (mode 0) mask-region)
  542.  (setq mask-region (if mask-region (region-arg mask-region)))
  543.  (_CopyBits :ptr (pointer-arg source-bitmap)
  544.             :ptr (pointer-arg dest-bitmap)
  545.             :ptr (pointer-arg source-rect)
  546.             :ptr (pointer-arg dest-rect)
  547.             :word (mode-arg mode)
  548.             :ptr mask-region))
  549.  
  550. (defobfun (scroll-rect *window*) (rect dh &optional dv)
  551.    (with-port wptr
  552.      (let* ((reg (_newrgn :ptr)))
  553.        (_ScrollRect :ptr (pointer-arg rect)
  554.                     :long (make-point dh dv)
  555.                     :ptr reg)
  556.        (_invalrgn :ptr reg)
  557.        (_disposrgn :ptr reg))))
  558.  
  559.  
  560.  
  561. (provide 'quickdraw)
  562. (pushnew :quickdraw *features*)