Re: Clipping and Printing pictures in MCL2

[bill@cambridge.apple.com (Bill St. Clair)]

>Does anyone happen to have any code that copies to the clipboard and/or
>prints quickdraw pictures from MCL2? 
>
>A general purpose mixin would be great, although anything I could use just
>as an example is fine.  There seems to be a lot of code on cambridge.apple.com
>for reading and writing PICT files, but I didn't see anything doing
>what I need (did I miss it?).  In case it matters, I only care about
>simple black and white pictures made out of lines, arcs, text, etc (no
>bitmaps or icons or dialog-items).
>
>Not being a real Mac programmer, I have had trouble getting this to
>work from the info in the MCL manual.
>
>Thanks!

Here's an example file that will ship with 2.0 final. It knows how
to copy & paste PICTs.

-----------------------------------------------------------------

;;-*- Mode: Lisp; Package: CCL -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;Pict-Scrap.Lisp
;;
;;Copyright 1989, Apple Computer, Inc
;;
;;
;;  This file a scrap-handler for scraps of type PICT
;;
;;  Once this is installed, windows which copy and paste PICTs will
;;  be able to share their work with other applications
;;
;; Modified for 2.0 by Henry Lieberman

;;;;;;;;;;;;
;;
;; Modification History
;;
;; 11/18/91 bill Don't need to require traps or records anymore.
;; 08/24/91 gb  Use new traps; don't use $applScratch

(in-package :ccl)

(defclass pict-scrap-handler (scrap-handler) ())

(defmethod set-internal-scrap ((self pict-scrap-handler) scrap)
  (let* ((old-pict (slot-value self 'internal-scrap)))
    (when (handlep old-pict)
      (#_KillPicture old-pict)))        ;dispose of the old pict before we
                                        ;put a new one in its place
                                        ;this will crash if your program has
                                        ;other pointers to the pict, so
                                        ;always make sure cut/copy really do
                                        ;-copy- the pict
  (call-next-method self scrap)
  (when scrap (pushnew :pict *scrap-state*)))

(defmethod externalize-scrap ((pict-scrap-handler pict-scrap-handler))
  (let* ((the-pict (slot-value pict-scrap-handler 'internal-scrap))
         (size (#_GetHandleSize the-pict)))
    (when the-pict
      (with-dereferenced-handles
        ((the-pict the-pict))
        (#_PutScrap size :pict the-pict)))))

(defmethod internalize-scrap ((pict-scrap-handler pict-scrap-handler))
  (let* ((the-pict (#_NewHandle 0)))
    (rlet ((junk :signed-long))
      (#_GetScrap the-pict :pict junk))
    (setf (slot-value pict-scrap-handler 'internal-scrap) the-pict)))


(defmethod get-internal-scrap ((pict-scrap-handler pict-scrap-handler))
  (slot-value pict-scrap-handler 'internal-scrap))

(pushnew `(:pict . ,(make-instance 'pict-scrap-handler))
         *scrap-handler-alist*
         :test #'equal)

#|
;;;;;;;;;;;;;;;;;;;;;
;;
;; a simple window, supporting cut and paste with picts
;;
;; because it doesn't remember the picts which it pastes,
;; it can only cut a pseudo-pict, that is, a pict which
;; contains the window's current contents as a bitmap.

(defclass pict-window (window) ()
  (:default-initargs 
    :color-p t
    :window-title "A Pict Window"))

(defmethod paste ((pict-window pict-window))
  (let* ((pict (get-scrap :pict)))
    (when pict
      (with-port (wptr pict-window)
        (rlet ((r :rect))
          (with-dereferenced-handles ((pict-point pict))
            (copy-record (rref pict-point :picture.picframe
                               :storage :pointer)
                         :rect
                         r))
        (#_DrawPicture pict r))))))

(defmethod copy ((pict-window pict-window))
  (let* ((wptr (wptr pict-window)))
    (rlet ((rect :rect 
                 :left (rref wptr windowrecord.portrect.left)
                 :top (rref wptr windowrecord.portrect.top)
                 :right (rref wptr windowrecord.portrect.right)
                 :bottom (rref wptr windowrecord.portrect.bottom)))
      (with-port wptr
        (#_cliprect rect)
        (let* ((pict (#_OpenPicture rect))
               (bits (rref wptr :windowrecord.portbits)))
          (#_CopyBits 
           bits 
           bits 
           rect 
           rect 0        ;transfer mode
           (%null-ptr))
          (#_ClosePicture)
          (put-scrap :pict pict))))))

(defmethod clear ((pict-window pict-window))
  (let ((wptr (wptr pict-window)))
    (with-port wptr
      (#_EraseRect (rref wptr :windowrecord.portrect)))))

(defmethod cut ((pict-window pict-window))
  (copy pict-window)
  (clear pict-window))

(setq pw (make-instance 'pict-window))


|#