CLIM mail archive
[Prev][Next][Index][Thread]
Buttons and Controls
Date: Tue, 20 Nov 90 8:18:01 GMT
From: Bernd Wild <bwild%fzi.uka.de@relay.cs.net>
We are about to build a graphical user interface based on CLIM (ACL)
containing elements like buttons, thermometers and speedometers.
The question is how to build up these macro elements? One way
would be to allocate a window stream, draw all decorations
and make the interactive area a presentation type. The other
would be similar to the way you have to code such stuff under
Flavors on a Symbolics: get the appropriate system flavors as
component flavors of your own flavor and add some specific
handling methods, i.e. use as much as possible things which are
already present in the system.
As I don't have detected any hint in the code examples and the
(preliminary) manual of CLIM how to use the CLIM classes as
basic substrates I would appreciate any advice.
Bernd.
I see that you are running CLIM 0.9 on Allegro Common Lisp.
The way to define a set of "Buttons or Controls" with their own
independent behavior is to specialize the SHEET (or PANE) class and
provide methods for the set of generic functions that will be
invoked by the substrate. For example, to define a pushbutton, you
could define a new class called pushbutton and provide methods for
HANDLE-REPAINT -- to draw graphics associated with the button
BUTTON-PRESS -- to actually do the work of the pushbutton.
This method can use EQL specialization to
specialize on which button was pressed.
BUTTON-RELEASE -- ditto
ENTER-REGION -- If behavior is desired when mouse enters
EXIT-REGION -- ditto
MOUSE-MOTION -- When mouse moves. Note that this is called
CI::MOUSE-MOTION in the developer pre-release
and will be renamed to POINTER-MOTION for the
Release 1.0.
There are several pre-defined classes which provide toolkit
behavior for you (i.e. pushbuttons, menus, etc.)
Here is some sample code (incomplete, but you'll get the idea)
which constructs a scroll bar "control". You will notice that this
implementation invokes generic functions with names like
"scroll-to-bottom-callback". This is so that a programmer can use
this scroll bar in his application and simply write methods on
SCROLL-TO-BOTTOM-CALLBACK, specializing on his application class.
(SCROLL-TO-BOTTOM-CALLBACK is invoked on the scroll bar and its
"client," which the programmer would set to be his application.)
The code below is part of the adaptive toolkit, provided with
Release 1.0. The code below is part of the portable implementation
of the Adaptive Scroll Bar. When using the adaptive toolkit, the
programmer requests a "Scroll Bar" and receives the most integrated
scroll bar available, which may be the Lisp implementation below.
If, however, the programmer is using the Motif toolkit (for
example) a Motif scroll bar will be used and the application will
receive SCROLL-TO-BOTTOM-CALLBACKs whenever the toolkit deems them
appropriate. This provides look-and-feel integration.
----------------
;;; Copyright (c) 1990 by International Lisp Associates. All rights reserved.
;;;
;;;
;;; This file defines a scroll bar as a pane with three children:
;;; 2 targets and a shaft. Each target provides specialized
;;; behavior when clicked on, and each target repaints itself
;;; differently (is it at the "scroll up" or "scroll down" end?)
;;; The shaft has its own behavior and is responsible for
;;; repainting the "thumb" (or "elevator").
;;; Elsewhere are defined the superclasses for this pane. The
;;; scroll-bar superclass provides ORIENTATION, MIN-VALUE,
;;; MAX-VALUE, UNIT-INCREMENT, and PAGE-INCREMENT.
(defclass scroll-bar-pane
(input-handler background-repainter-mixin composite-pane scroll-bar)
((shaft-thickness :initarg :shaft-thickness)
(min-target-pane :initform nil)
(max-target-pane :initform nil)
(shaft-pane :initform nil))
(:default-initargs :value 0
:shaft-thickness 10))
;;; This tells the layout language how large to make the pane. A
;;; space-req is composed of horizontal and vertical space, plus
;;; stretchability and shrinkability along each dimension.
(defmethod compose-space ((pane scroll-bar-pane))
(with-slots (shaft-thickness) pane
(ecase (scroll-bar-orientation pane)
;; a vertical scroll bar should only be as wide as its shaft
;; (plus margins?)
(:vertical (make-space-req :hs shaft-thickness :hs+ 0 :hs- 0
:vs 0 :vs+ +fill+ :vs- +fill+))
;; a vertical scroll bar should only be as tall as its shaft
;; (plus margins?)
(:horizontal (make-space-req :hs 0 :hs+ +fill+ :hs- +fill+
:vs shaft-thickness :vs+ 0 :vs- 0)))
))
;;; This is how the scroll-bar-pane lays out its children
;;; (allocates a width and height among them).
(defmethod allocate-space ((pane scroll-bar-pane) width height)
(let ((shaft-thickness (slot-value pane 'shaft-thickness))
(orientation (slot-value pane 'orientation))
(min-target-pane (slot-value pane 'min-target-pane))
(max-target-pane (slot-value pane 'max-target-pane))
(shaft-pane (slot-value pane 'shaft-pane)))
(with-bounding-rectangle* (minx miny maxx maxy) (sheet-region pane)
(ecase orientation
(:vertical
(move-and-resize-sheet*
min-target-pane
minx miny
shaft-thickness
shaft-thickness)
(move-and-resize-sheet*
shaft-pane
minx shaft-thickness
shaft-thickness (- height shaft-thickness shaft-thickness))
(move-and-resize-sheet*
max-target-pane
minx (- height shaft-thickness)
shaft-thickness shaft-thickness))))))
;;; Here's where the children get made.
(defmethod initialize-instance :after
((pane scroll-bar-pane) &key)
(with-slots (min-target-pane max-target-pane shaft-pane) pane
;; This macro has a bad name, and is being changed for Release 1.0
(with-style ()
(let ((inferiors
(vertically
(setq min-target-pane
(make-pane 'scroll-bar-target-pane
:scroll-bar pane
:end :greater-than))
(setq shaft-pane (make-pane 'scroll-bar-shaft-pane :scroll-bar pane))
(setq max-target-pane
(make-pane 'scroll-bar-target-pane
:scroll-bar pane
:end :less-than)))))
(adopt-child pane inferiors)))))
;;; Here's the class for the target.
;;; As above, the superclasses are defined elsewhere.
(defclass scroll-bar-target-pane
(background-repainter-mixin input-handler leaf-pane)
((end :initarg :end)
(scroll-bar :initarg :scroll-bar))
)
;;; Draw the target whenever repainting is necessary.
(defmethod handle-repaint :after ((pane scroll-bar-target-pane) repaint-region
&key medium &allow-other-keys)
(declare (ignore repaint-region))
(draw-rectangle-with-rectangle medium (sheet-region pane) :filled nil)
(draw-target pane medium))
;;; You can pass :filled T to this in order to highlight the target when clicked on...
;;; This draws a triangle, so that the target area looks like:
;;; ------------
;;; | /\ |
;;; | / \ |
;;; | / \ |
;;; |/ \|
;;; ------------
;;;
(defmethod draw-target ((pane scroll-bar-target-pane) medium &key filled (ink +foreground+))
(with-bounding-rectangle* (minx miny maxx maxy) (sheet-region pane)
(ecase (slot-value pane 'end)
(:less-than
(draw-polygon* medium (list minx miny
(+ minx (/ (- maxx minx) 2)) maxy
maxx miny)
:filled filled :ink ink))
(:greater-than
(draw-polygon* medium (list minx maxy
(+ minx (/ (- maxx minx) 2)) miny
maxx maxy)
:ink ink
:filled filled)))))
;;; The shaft.
(defclass scroll-bar-shaft-pane
(background-repainter-mixin input-handler leaf-pane)
((scroll-bar :initarg :scroll-bar))
)
(defmethod handle-repaint :after ((pane scroll-bar-shaft-pane) repaint-region
&key medium &allow-other-keys)
(declare (ignore repaint-region))
(draw-rectangle-with-rectangle medium (sheet-region pane) :filled nil)
(draw-thumb pane medium))
;;; Draw a gray rectangle indicating the current scroll position.
(defmethod draw-thumb ((pane scroll-bar-shaft-pane) medium &key (ink +foreground+))
(let* ((scroll-bar (slot-value pane 'scroll-bar))
(current-value (gadget-value scroll-bar))
(max-value (scroll-bar-max-value scroll-bar))
(min-value (scroll-bar-min-value scroll-bar))
(33%-gray (make-color-rgb 1/3 1/3 1/3)))
(flet ((draw-car (left top right bottom)
(draw-rectangle* medium left top right bottom
:filled t
:ink (if (eq ink +foreground+) 33%-gray ink))
(draw-rectangle* medium left top right bottom
:filled nil
:ink ink)))
(declare (dynamic-extent #'draw-car))
(with-bounding-rectangle* (x1 y1 x2 y2) (sheet-region pane)
(let ((height (- y2 y1))
(width (- x2 x1 2)))
(let* ((multiplier (/ (- height (* width 2)) max-value))
(elevator-top (* multiplier current-value))
(elevator-bottom (+ elevator-top 20)))
(draw-car (1+ x1) (- y2 elevator-top)
(+ x1 width 1) (- y2 elevator-bottom))))))))
;;; Whenever any button is pressed in a target pane, highlight the
;;; target triangle until the associated action is performed.
;;; I probably should have done this with a :BEFORE method on
;;; BUTTON-PRESS and an :AFTER method on BUTTON-RELEASE.
(defmethod button-press :around ((pane scroll-bar-target-pane) (button-name T) &key)
(using-clim-medium (medium pane)
(draw-target pane medium :filled T :ink +foreground+)
(call-next-method)
(draw-target pane medium :filled T :ink +background+)
(draw-target pane medium :filled nil)))
;;; The interface to our scroll bars is that if you click left in the targets
;;; you scroll up/down by a page. If you click right you scroll up/down by a line.
;;; If you click middle, you scroll to top/bottom.
;;; This needs more complexity in that as long as the button is held down
;;; we want to smoothly continue to scroll by lines or pages. Later.
(defmethod button-press ((pane scroll-bar-target-pane) (button-name (eql :left)) &key)
;; note that EQL dispatch is used to select the behavior
;; associated with each button.
(let* ((scroll-bar (slot-value pane 'scroll-bar))
(client (gadget-client scroll-bar))
(id (gadget-id scroll-bar)))
(ecase (slot-value pane 'end)
(:greater-than
(scroll-down-page-callback scroll-bar client id))
(:less-than
(scroll-up-page-callback scroll-bar client id)))))
(defmethod button-press ((pane scroll-bar-target-pane) (button-name (eql :middle)) &key)
(let* ((scroll-bar (slot-value pane 'scroll-bar))
(client (gadget-client scroll-bar))
(id (gadget-id scroll-bar)))
(ecase (slot-value pane 'end)
(:greater-than
(update-scroll-bar-value-1
(slot-value scroll-bar 'shaft-pane) scroll-bar (scroll-bar-max-value scroll-bar))
(scroll-to-bottom-callback scroll-bar client id))
(:less-than
(update-scroll-bar-value-1 (slot-value scroll-bar 'shaft-pane)
scroll-bar (scroll-bar-min-value scroll-bar))
(scroll-to-top-callback scroll-bar client id)))))
(defmethod button-press ((pane scroll-bar-target-pane) (button-name (eql :right)) &key)
(let* ((scroll-bar (slot-value pane 'scroll-bar))
(client (gadget-client scroll-bar))
(id (gadget-id scroll-bar)))
(ecase (slot-value pane 'end)
(:greater-than
(scroll-down-line-callback scroll-bar client id))
(:less-than
(scroll-up-line-callback scroll-bar client id)))))
(defmethod button-press ((pane scroll-bar-shaft-pane) (button-name (eql :left)) &key x y)
(let ((scroll-bar (slot-value pane 'scroll-bar)))
(with-bounding-rectangle* (minx miny maxx maxy) (sheet-region pane)
(ecase (scroll-bar-orientation scroll-bar)
(:vertical
(update-scroll-bar-value pane scroll-bar (- maxy y) miny maxy))
(:horizontal
(update-scroll-bar-value pane scroll-bar (- maxx x) minx maxx))))))
;;; And some support utilities which aren't overly
;;; interesting when reading the above.
(defmethod update-scroll-bar-value ((pane scroll-bar-shaft-pane) scroll-bar coord min max)
(let* ((min-value (slot-value scroll-bar 'min-value))
(max-value (slot-value scroll-bar 'max-value))
(value (compute-symmetric-value min max coord min-value max-value)))
(update-scroll-bar-value-1 pane scroll-bar value)))
(defun update-scroll-bar-value-1 (pane scroll-bar value)
(using-clim-medium (medium pane)
;; erase old indicator, draw new
(draw-thumb pane medium :ink +background+)
(setf (gadget-value scroll-bar) value)
(draw-thumb pane medium)))
0,,
Main Index |
Thread Index