CLIM mail archive

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

mouse-cursors again.




Good-Guy of the week awards to Paul McNamee and Bill York for
supplying the answer to this question: how to change the mouse-glyph?

here's my final running version of what they sent:

the first function reads a ordinary xbm file from a pathname you
supply and makes it the cursor for a frame. the bitmaps can be created
using

unix-prompt> bitmap filename.xbm 32x32 &

the remaining functions and macros create and use a spinning cursor
for indicating busy/activity for some window.

(with-spinning-cursor (some-window) &body body)

is the usage. inside this macro, you would use

(cycle-spinner some-window)

everywhere you wanted to indicate that more had happened (like inside
loops, etc.).

there's one flaw in that if you changed a frame's cursor to some other
bitmap, and then do with-spinning-cursor, the bitmap cursor gets
punted. (becuz with-spin... resets the cursor to :none, which means
the X default).

anyway, this will go in the library shortly. note that there are few
CLIM functions being called. mostly they're XLIB fns for the
interesting stuff. I understand that CLIM 2 will allow some of this
kind of thing, but probably not what I've included here, in just this
way.

enjoy! I'm using it now, and it looks great.

 -- clint




;;; -*- mode: lisp; package: common -*-

;;;****************************************************************
;;;****************************************************************

;;;put a bitmap in for the frame's cursor.
(defun frame-bitmap-cursor (frame bm)
  "Read a bitmap-image from BM and change the cursor for FRAME to be that bitmap.
Current limit is 32x32 image."
  (let* ((xwin (slot-value (clim:frame-top-level-window frame) 'clim::window))
	 (pixmap (xlib:create-pixmap :width 32 :height 32 :depth 1
				     :drawable xwin))
	 (mask-pixmap (xlib:create-pixmap :width 32 :height 32 :depth 1
					  :drawable xwin))
	 (pgc (xlib:create-gcontext :drawable pixmap 
				    :arc-mode :pie-slice
				    :foreground 1
				    :background 0)))

    ;; Cursor foreground is all 1's
    (xlib:draw-rectangle pixmap pgc 0 0 32 32 t)

    ;; Don't know why I have to clear the pixmap first.
    ;;(CRH: it's because a pixmap doesn't have a 'background'
    ;;       and may inherit some garbage)
    (xlib:with-gcontext (pgc :foreground 0)
      (xlib:draw-rectangle mask-pixmap pgc 0 0 32 32 t))

    (xlib:put-image mask-pixmap pgc (xlib:read-bitmap-file bm)
		    :x 0 :y 0)
    
    ;;now make the cursor.
    (let ((cursor (xlib:create-cursor :source pixmap
				      :mask mask-pixmap
				      ;; set "hot spot" to center
				      :x 0 :y 0
				      :foreground (xlib:make-color
						    :red 0.0
						    :green 0.0
						    :blue 0.0)
				      :background (xlib:make-color
						    :red 1.0
						    :green 1.0
						    :blue 1.0))))
      ;; Install the cursor;
      (setf (xlib:window-cursor xwin) cursor))
    ;; Make the change take effect.
    (xlib:display-force-output (xlib:drawable-display xwin)))
  )

;;;****************************************************************
;;;****************************************************************
;;;****************************************************************

(defparameter *cursor-spinners* (list 0))

;;;****************************************************************
;;;****************************************************************

(defun create-circle-cursors (win)
  ;; Get the CLX window object from the CLIM window using an
  ;; undocumented internal interface.
  (setq  *cursor-spinners* (list 0))
  (let* ((xwin (clim::clx-stream-window win))
	 (pixmap (xlib:create-pixmap :width 30 :height 30 :depth 1
				     :drawable xwin))
	 (mask-pixmap (xlib:create-pixmap :width 30 :height 30 :depth 1
					  :drawable xwin))
	 (pgc (xlib:create-gcontext :drawable pixmap 
				    :arc-mode :pie-slice
				    :foreground 1
				    :background 0))
	 cursor)

    ;; Cursor foreground is all 1's
    (xlib:draw-rectangle pixmap pgc 0 0 30 30 t)

    ;; Don't know why I have to clear the pixmap first.
    ;;(CRH: it's because a pixmap doesn't have a 'background'
    ;;       and may inherit some garbage)
    (xlib:with-gcontext (pgc :foreground 0)
      (xlib:draw-rectangle mask-pixmap pgc 0 0 30 30 t))

    ;; Cursor mask is a circle, so the cursor is a "see-through" circle
    (xlib:draw-arc mask-pixmap pgc 2 2 26 26 0 (* pi 2) nil)
    (xlib:draw-arc mask-pixmap pgc 2 2 26 26 0  (* 0.25 pi) t)
    (xlib:draw-arc mask-pixmap pgc 2 2 26 26 pi (* 0.25 pi) t)
    
    ;;now make the cursor. octants 1 & 5
    (setq cursor (xlib:create-cursor :source pixmap
				      :mask mask-pixmap
				      ;; set "hot spot" to center
				      :x 15 :y 15
				      :foreground (xlib:make-color
						    :red 0.0
						    :green 0.0
						    :blue 0.0)
				      :background (xlib:make-color
						    :red 1.0
						    :green 1.0
						    :blue 1.0)))
    (push cursor (cdr *cursor-spinners*))

    (setq mask-pixmap (xlib:create-pixmap :width 30 :height 30 :depth 1
					  :drawable xwin))
    (xlib:with-gcontext (pgc :foreground 0)
      (xlib:draw-rectangle mask-pixmap pgc 0 0 30 30 t))

    (xlib:draw-arc mask-pixmap pgc 2 2 26 26 0 (* pi 2) nil)
    (xlib:draw-arc mask-pixmap pgc 2 2 26 26 (* 0.25 pi) (* 0.25 pi) t)
    (xlib:draw-arc mask-pixmap pgc 2 2 26 26 (* 1.25 pi) (* 0.25 pi) t)
    ;;now make the cursor. octants 2 & 6
    (setq cursor (xlib:create-cursor :source pixmap
				      :mask mask-pixmap
				      ;; set "hot spot" to center
				      :x 15 :y 15
				      :foreground (xlib:make-color
						    :red 0.0
						    :green 0.0
						    :blue 0.0)
				      :background (xlib:make-color
						    :red 1.0
						    :green 1.0
						    :blue 1.0)))
    (push cursor (cdr *cursor-spinners*))
    
    (setq mask-pixmap (xlib:create-pixmap :width 30 :height 30 :depth 1
					  :drawable xwin))
    (xlib:with-gcontext (pgc :foreground 0)
      (xlib:draw-rectangle mask-pixmap pgc 0 0 30 30 t))

    (xlib:draw-arc mask-pixmap pgc 2 2 26 26 0 (* pi 2) nil)
    (xlib:draw-arc mask-pixmap pgc 2 2 26 26 (* 0.5 pi) (* 0.25 pi) t)
    (xlib:draw-arc mask-pixmap pgc 2 2 26 26 (* 1.5 pi) (* 0.25 pi) t)
    ;;now make the cursor. octants 3 & 7
    (setq cursor (xlib:create-cursor :source pixmap
				      :mask mask-pixmap
				      ;; set "hot spot" to center
				      :x 15 :y 15
				      :foreground (xlib:make-color
						    :red 0.0
						    :green 0.0
						    :blue 0.0)
				      :background (xlib:make-color
						    :red 1.0
						    :green 1.0
						    :blue 1.0)))
    (push cursor (cdr *cursor-spinners*))

    (setq mask-pixmap (xlib:create-pixmap :width 30 :height 30 :depth 1
					  :drawable xwin))
    (xlib:with-gcontext (pgc :foreground 0)
      (xlib:draw-rectangle mask-pixmap pgc 0 0 30 30 t))
    (xlib:draw-arc mask-pixmap pgc 2 2 26 26 0 (* pi 2) nil)
    (xlib:draw-arc mask-pixmap pgc 2 2 26 26 (* 0.75 pi) (* 0.25 pi) t)
    (xlib:draw-arc mask-pixmap pgc 2 2 26 26 (* 1.75 pi) (* 0.25 pi) t)
    
    ;;now make the cursor. octants 4 & 8
    (setq cursor (xlib:create-cursor :source pixmap
				      :mask mask-pixmap
				      ;; set "hot spot" to center
				      :x 15 :y 15
				      :foreground (xlib:make-color
						    :red 0.0
						    :green 0.0
						    :blue 0.0)
				      :background (xlib:make-color
						    :red 1.0
						    :green 1.0
						    :blue 1.0)))
    (push cursor (cdr *cursor-spinners*))
    (setf (cdr *cursor-spinners*) (reverse (cdr *cursor-spinners*)))
    ))

;;;****************************************************************
;;;****************************************************************

(create-circle-cursors cl-user::clim-lisp-listener)

;;;****************************************************************
;;;****************************************************************

(defun cycle-spinner (win)
  (let ((xwin (clim::clx-stream-window win)))

    ;; Install the cursor;
    (setf (xlib:window-cursor xwin) (nth (car *cursor-spinners*) (cdr *cursor-spinners*)))
    
    ;; Make the change take effect.
    (xlib:display-force-output (xlib:drawable-display xwin))
    
    ;;rotate for next time.
    (setf (car *cursor-spinners*) (mod (incf (car *cursor-spinners*)) 4))
    ))

;;;****************************************************************
;;;****************************************************************

(defun reset-cursor (win)
  (setf (xlib:window-cursor (clim::clx-stream-window win))
    :none)
  )

;;;****************************************************************
;;;****************************************************************
;;;****************************************************************

(defmacro with-spinning-cursor ((window) &body body)
  `(progn (create-circle-cursors ,window)	;this seems wasteful.
	  ,@body
	  (reset-cursor ,window)))

;;;****************************************************************
;;;****************************************************************
;;;****************************************************************

;;;test case.
(defun foo ()
  (dotimes (i 25)
    (cycle-spinner cl-user::clim-lisp-listener)
    (sleep 0.25)
    )
  ;;;back to the default.
  (setf (xlib:window-cursor (clim::clx-stream-window cl-user::clim-lisp-listener)) :none)
  )

;;;****************************************************************
;;;****************************************************************
;;;****************************************************************
;;;
;;; end of file
;;;
;;;****************************************************************
;;;****************************************************************
;;;****************************************************************

0,,


Main Index | Thread Index