Re: Drawing Cursor or Cursor to PICT

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

I thought of how to avoid the possibility of #_CopyBits moving the
memory for an unlocked cursor while on the bus yesterday afternoon.
You just need to copy the bits into a stationary buffer. This code
also makes sure a cursor resource isn't purged:

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

; draw-cursor.lisp
;
; Drawing a cursor to a grafport.
; Does not handle the mask.

(in-package :ccl)

(export 'draw-cursor)

; If cursor is a fixnum, calls #_GetCursor on it.
; If cursor is a handle, dereferences it.
; Otherwise, cursor should be a pointer to a cursor record.
(defun draw-cursor (cursor h &optional v)
  (symbol-macrolet ((byte-count (* (/ 16 8) 16)))
    (%stack-block ((cursor-bits byte-count))
      (let ((p (make-point h v))
            (copy-from cursor-bits))
        (cond ((fixnump cursor)
               (with-macptrs ((handle (#_GetCursor cursor)))
                 (when (%null-ptr-p handle)
                   (error "~s does not specify a valid cursor" cursor))
                 (#_BlockMove (%get-ptr handle) cursor-bits byte-count)))
              ((or (when (eql 0 (#_HomeResFile cursor))
                     ; Make sure resource hasn't been purged
                     (#_LoadResource cursor)
                     t)
                   (handlep cursor))
                 (#_BlockMove (%get-ptr cursor) cursor-bits byte-count))
              (t (setq copy-from cursor)))
        (rlet ((srcrect :rect :topleft #@(0 0) :botRight #@(16 16))
               (dstrect :rect :topleft p :botright (add-points p #@(16 16)))
               (bitmap :bitmap
                       :bounds srcrect
                       :rowbytes 2
                       :baseaddr copy-from))
          (rlet ((port-var :pointer))
            (#_GetPort port-var)
            (#_CopyBits
             bitmap
             (rref (%get-ptr port-var) :grafport.portbits)
             srcrect
             dstrect
             #$srccopy
             (%null-ptr))))))))
         
#|
(defparameter *w* (make-instance 'window))

(defun draw-cursors (&optional (cursors
                                '#.(list #$iBeamCursor
                                         #$crossCursor
                                         #$plusCursor
                                         #$watchCursor
                                         *arrow-cursor*)))
  (with-focused-view *w*
    (let ((point #@(10 50)))
      (dolist (cursor cursors)
        (draw-cursor cursor point)
        (setq point (add-points point #@(24 0)))))))

(draw-cursors)
|#