PICT Scraps/Resources

[claris!Ashok_Khosla@apple.com]

Greg

I believe  this will do what you want. I use it primarily for exporting PICTs 
out. To get buttons in, you have to parse the PICT handle for PICT comments. 
Lot's of work to do correctly.
 
By the way, this works under 2.0 (when ported to CLOS)

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

(in-package :ccl)

(eval-when (eval compile)
  (require 'traps)
  (require 'records))

(defconstant $ApplScratch  #xA78)

(defparameter *pict-scrap-handler* (oneof *scrap-handler*))

(defobfun (set-internal-scrap *pict-scrap-handler*) (scrap)
  (let* ((old-pict (objvar internal-scrap)))
    (when (handlep old-pict)
      (_KillPicture :ptr 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
  (usual-set-internal-scrap scrap)
  (when scrap (pushnew :pict *scrap-state*)))

(defobfun (externalize-scrap *pict-scrap-handler*) ()
  (let* ((the-pict (objvar internal-scrap))
         (size (_GetHandleSize :a0 the-pict :d0)))
    (when the-pict
      (with-dereferenced-handles
        ((the-pict the-pict))
        (_PutScrap :long size :ostype :pict :ptr the-pict)))))

(defobfun (internalize-scrap *pict-scrap-handler*) ()
  (let* ((the-pict (_NewHandle :d0 0 :a0)))
    (_GetScrap :ptr the-pict
               :ostype :pict
               :long $ApplScratch)
    (setf (objvar internal-scrap) the-pict)))


(defobfun (get-internal-scrap *pict-scrap-handler*) ()
  (objvar internal-scrap))

(pushnew `(:pict . ,*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.

(eval-when (eval compile)
  (require 'traps)
  (require 'records))

(defobject *pict-window* *window*)

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

(defobfun (copy *pict-window*) ()
  (let* ((wptr (objvar wptr))
         (rect (rref wptr window.portrect)))
    (with-port wptr
      (_cliprect :ptr rect)
      (let* ((pict (_OpenPicture :ptr rect :ptr))
             (bits (rref wptr :window.portbits)))
        (_CopyBits :ptr bits
                   :ptr bits
                   :ptr rect
                   :ptr rect
                   :word 0        ;transfer mode
                   :ptr nil)
        (_ClosePicture)
        (put-scrap :pict pict)))))

(defobfun (clear *pict-window*) ()
  (with-port wptr
    (_EraseRect :ptr (rref wptr :window.portrect))))

(defobfun (cut *pict-window*) ()
  (copy)
  (clear))

(oneof *pict-window*)
      

|#