CLIM mail archive
[Prev][Next][Index][Thread]
Re: draw-icon
here's a complete working version.
-- clint
;;;****************************************************************
;;;****************************************************************
;;;****************************************************************
(defclass picture-button ()
((picture :initform () :initarg :picture :accessor picture)
(name :initform (INTERN (STRING (GENSYM "PICTURE-BUTTON-"))
*package*)
:initarg :name :accessor name)
(highlighted :initform () :initarg :highlighted :accessor highlighted)
(form :initform () :initarg :form :accessor form)
(x :initform () :initarg :x :accessor x)
(y :initform () :initarg :y :accessor y))
)
(clim:define-presentation-method clim:present
(myself (p-type picture-button) stream view
&key acceptably context-type)
(declare (ignore acceptably context-type))
(clim:with-output-as-presentation (:object myself :stream stream :single-box t)
(clim:draw-icon* stream (picture myself) (x myself) (y myself)))
)
(defparameter up-button (make-instance 'picture-button
:picture (clim:make-pattern #2a((0 0 0 0 0 0 1 0 0 0 0 0 0)
(0 0 0 0 0 1 0 1 0 0 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 1 0 0 0 0 0 1 0 0 0)
(0 0 1 0 0 0 0 0 0 0 1 0 0)
(0 1 0 0 0 0 0 0 0 0 0 1 0)
(1 0 0 0 0 0 0 0 0 0 0 0 1)
(1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 0 1 1 1 1 1 0 0 0 0)
)
(list clim:+background+ clim:+foreground+))
:x 15
:y 5)
)
(clim:define-presentation-to-command-translator pic-button (picture-button com-click-button
timeline-command-table
:gesture :select
:pointer-documentation "Click this button"
:menu nil)
(object) ;arglist ;(presentation context-type frame event window x y)
(list object)
)
(define-cdp-command (com-click-button :menu nil) ((myself 'picture-button))
(if (form myself)
(eval (form myself))
)
)
;;;****************************************************************
(clim:define-presentation-method clim:highlight-presentation ((type picture-button) record stream state)
(declare (ignore state)) ;we'll just use XOR
(multiple-value-bind (xoff yoff)
(clim:convert-from-relative-to-absolute-coordinates
stream (clim:output-record-parent record))
(clim:with-bounding-rectangle* (left top right bottom) record
(clim:draw-rectangle* stream
;;draw the box half-full. was (+ top yoff).
(+ left xoff) (+ top yoff)
(+ right xoff) (+ bottom yoff)
:ink clim:+flipping-ink+ :filled t)
)
))
(defparameter dn-button (make-instance 'picture-button
:picture (clim:make-pattern #2a((0 0 0 0 1 1 1 1 1 0 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(1 1 1 1 1 1 1 1 1 1 1 1 1)
(1 0 0 0 0 0 0 0 0 0 0 0 1)
(0 1 0 0 0 0 0 0 0 0 0 1 0)
(0 0 1 0 0 0 0 0 0 0 1 0 0)
(0 0 0 1 0 0 0 0 0 1 0 0 0)
(0 0 0 0 1 0 0 0 1 0 0 0 0)
(0 0 0 0 0 1 0 1 0 0 0 0 0)
(0 0 0 0 0 0 1 0 0 0 0 0 0)
)
(list clim:+background+ clim:+foreground+))
:x 15
:y 35)
)
(defun vert-scroll (frame pane)
(declare (ignore frame))
(clim:window-clear pane)
(clim:present up-button 'picture-button :stream pane)
(clim:present dn-button 'picture-button :stream pane)
)
;;;(vert-scroll () (clim:get-frame-pane (slot-value *cdp-frame* 'timeline-window) 'up-scroll))
;;;****************************************************************
;;;****************************************************************
;;;****************************************************************
;;;
;;; end of file
;;;
;;;****************************************************************
;;;****************************************************************
;;;****************************************************************
0,,
References:
- draw-icon
- From: Erik Eilerts <eilerts@cs.utexas.edu>
Main Index |
Thread Index