[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Drawing Cursor or Cursor to PICT

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)
                   (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)
             (rref (%get-ptr port-var) :grafport.portbits)
(defparameter *w* (make-instance 'window))

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