Re: Drawing Cursor or Cursor to PICT

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

>Thanks for the hack and the advice.  I can't seem to find any documentation
>for with-macptrs.  Is that the same as with-pointers?  If so, I don't
>understand the usefulness of it here.  ccl::%getport is not likely to
>return a handle, is it?

WITH-MACPTRS is basically the same as LET and DYNAMIC-EXTENT, but
it's a little more likely to avoid consing a macptr. E.g. the
following conses a macptr:

(let ((foo (#_GetCursor #$IBeamCursor)))
  (declare (dynamic-extent foo))
  ...)

but this code does not.

(with-macptrs ((foo (#_GetCursor #$IBeamCursor)))
  ...)

WITH-POINTERS dereferences and locks any handles you pass it.
Hence, WITH-MACPTRS is a much lower-level macro.

That the former conses a mactpr may qualify as a compiler bug, but
since the latter does not, it's no killer.

>
>I'm all done with the tool-pallette code, and will put it in the drop-box
>(or post it if there is no drop-box) as soon as I figure this out.

By drop-box do you mean the anonymous FTP server at cambridge.apple.com?

>
>Oh yeah, is there any way to use #_GetPort rather than the undocumented
>%getport?  I tried it with a straightforward substitution, and it didn't
>work.  But I thought you might know a way to do it.
>
>BTW, is it a bug that *arrow-cursor* is a pointer rather than a handle?  I
>don't care much, of course, since it's not too hard to handle [pun
>intended] both cases.

*arrow-cursor* is intentionally a pointer. The following modification
of my initial hack solves the problems you mention. All the %setf-macptr's
are to avoid heap consing the cursor-pointer value.

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

; draw-cursor.lisp
;
; Drawing a cursor to a grafport.
; Does not handle the mask.
; May fail if the cursor resource is purgeable.

(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)
  (let ((p (make-point h v))
        (cursor-pointer (%null-ptr)))
    (declare (dynamic-extent cursor-pointer))
    (cond ((fixnump cursor)
           (with-macptrs ((handle (#_GetCursor cursor)))
             (when (%null-ptr-p handle)
               (error "~s does not specify a valid cursor" cursor))
             (%setf-macptr cursor-pointer (%get-ptr handle))))
          ((handlep cursor)
           (%setf-macptr cursor-pointer (%get-ptr cursor)))
          (t (%setf-macptr cursor-pointer 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 cursor-pointer))
      (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)
#|