CLIM mail archive
[Prev][Next][Index][Thread]
Fwd: Changing the cursor in CLIM1.1
Date: Tue, 19 Oct 1993 15:17:35 -0700
From: Daniel D Suthers <suthers+@pitt.edu>
Lucid hasn't responded to this one ... anyone got ideas?
---------- Forwarded message begins here ----------
Date: Wed, 13 Oct 1993 10:29:50 -0400 (EDT)
From: Daniel D Suthers <suthers+@pitt.edu>
There's nothing in the 1.1 manual on changing the mouse cursor (as a
function of what command is active). From this I infer that it isn't
supported in a general way.
Here are two unsupported hacks. They were both posted to CLIM before,
so I assume that the authors won't mind my reposting them. The first
one uses a cursor glyph from a cursor font. The second is more
complex, and allows getting a cursor from a bitmap file or by drawing
(using CLX drawing requests) it into the pixmap.
---------- Forwarded message begins here ----------
From: Fredric M White <fwhite@bbn.com>
To: clim@bbn.com
Subject: Re: changing the mouse-glyph
Date: Thu, 29 Oct 92 15:46:25 EST
;; Here's how I set the mouse cursor in clim 1.1 under xlib
(in-package 'clim-user)
(defun WATCH-CURSOR ()
;; Do "xfd -fn cursor -center" to see other chars in the cursor font.
(xlib:create-glyph-cursor :source-font clim::*cursor-font* :source-char #x96
:mask-font clim::*cursor-font* :mask-char #x97
:foreground (xlib:make-color :red 0 :green 0 :blue 0)
:background (xlib:make-color :red 1 :green 1 :blue 1)))
(defun SET-WINDOW-CURSOR (window cursor)
;; window is a clim window.
(setf (xlib:window-cursor (slot-value window 'clim::window)) cursor))
-Fred
---------- Forwarded message begins here ----------
Date: Thu, 29 Oct 92 18:25:50 EST
From: Clinton Hyde <chyde@chesapeake.ads.com>
To: clim@BBN.COM
Subject: 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
;;;
;;;****************************************************************
;;;****************************************************************
;;;****************************************************************
References:
Main Index |
Thread Index