home *** CD-ROM | disk | FTP | other *** search
- ; book pp.259-260
-
- (require "functions/bitmapedit")
-
- (setf w (send bitmap-edit-proto :new 16 16))
- (send w :title "Cursor Editor")
-
- (defmeth bitmap-edit-proto :name-bitmap ()
- (let ((str (get-string-dialog "Symbol for the bitmap:")))
- (if str
- (let ((name (with-input-from-string (s str) (read s))))
- (setf (symbol-value name) (send self :bitmap))))))
- (defmeth bitmap-edit-proto :bitmap-as-cursor (yes)
- (if yes (make-cursor 'temp-cursor (send self :bitmap)))
- (send self :cursor (if yes 'temp-cursor 'arrow)))
-
- (setf bitmenu (send menu-proto :new "Bitmap"))
- (setf name-item
- (send menu-item-proto :new "Name Bitmap..."
- :action #'(lambda () (send w :name-bitmap))))
- (setf cursor-item
- (send menu-item-proto :new "Use as Cursor"
- :action #'(lambda ()
- (let ((mark (send cursor-item :mark)))
- (send w :bitmap-as-cursor (not mark))
- (send cursor-item :mark (not mark))))))
- (send bitmenu :append-items name-item cursor-item)
- (send w :menu bitmenu)
- (send bitmenu :install)
-