fixes to the gui widget adaptors

svn: r4465
This commit is contained in:
Greg Cooper 2006-10-02 21:02:09 +00:00
parent 50ca4e1cbf
commit 3d3f22b910
3 changed files with 113 additions and 74 deletions

View File

@ -52,18 +52,11 @@
; with the initial value being init-field-name
(define-syntax (mixin-hold stx)
(syntax-case stx ()
[(_ b-name init-name getter)
(with-syntax ([init-holder (string->symbol
(format "~a-holder" (syntax-e (syntax init-name))))]
[get-init (string->symbol
(format "get-~a" (syntax-e (syntax init-name))))])
#'(lambda (default-val super-class)
((embed-processor b-name (lambda (es) (hold es (send this get-init))) getter)
(class super-class
(init (init-name default-val))
(define init-holder init-name)
(define/public (get-init) init-holder)
(super-new)))))]))
[(_ b-name get-init get-event-stream)
#'(embed-processor
b-name
(lambda (es) (hold es (send this get-init)))
get-event-stream)]))

View File

@ -7,12 +7,11 @@ To get the basic macros:
> (events->callbacks field-name update-call)
Generates a mixin for allowing an event stream to drive
callbacks. When an event stream is given as the init
value for field-name, that event stream is stored,
and whenever an event occurs on that stream,
update-call is invoked on the value of the event. The
one argument to the resulting mixin is the class being
extended
callbacks. When an event stream is given as the init value
for field-name, that event stream is stored, and whenever an
event occurs on that stream, update-call is invoked on the
value of the event. The one argument to the resulting mixin
is the class being extended
> (callbacks->args-evts stream-name callback)
Generates a mixin that sends an event on stream-name when
@ -23,8 +22,8 @@ gets the result of applying [stream-name]-event-processor
to the stream of args-evts. The events on the stream are
lists of the arguments to the callback. The default value
for [stream-name]-event-processor is given as the first
argument to the mixin, and the class being extended is
the second argument to the mixin.
argument to the mixin, and the class being extended is the
second argument to the mixin.
FtA provides event-is-val, split-mouse-events/type, and
split-key-events/type for use as initialization arguments.
@ -37,32 +36,56 @@ the type of event occurence.
events->callbacks and callbacks->args-evts are the backbone
of the transition between an object-oriented library and
an event-stream based library. Some common utility macros
are provided from:
of the transition between an object-oriented library and an
event-stream based library.
AUXILIARY MACROS
------------------
Some common utility macros provided from:
(lib "aux-mixin-macros.ss" "frtime" "demo" "gui")
> (behavior->callbacks field-name update-call)
Generates a mixin for allowing a behavior to control a widget.
The mixin has two arguments. The mixin's first argument is the
default value for field-name, and the seconds argument is the
class being mixed. Whenever a behavior is supplied as the value
for field-name, the value-now of that behavior is used as the
super-new argument for filed-name, and whenever there is a
change in that behavior, update-call is invoked with the
current value of the behavior.
Generates a mixin for allowing a behavior to control a
widget. The mixin has two arguments. The mixin's first
argument is the default value for field-name, and the
seconds argument is the class being mixed. Whenever a
behavior is supplied as the value for field-name, the
value-now of that behavior is used as the super-new argument
for filed-name, and whenever there is a change in that
behavior, update-call is invoked with the current value of
the behavior.
> (mixin-merge-e new-stream-name stream-getter1 stream-getter2)
Generates a mixin that provides access to the merge-e
of two event streams. The first argument is the name
of the merged stream. The merged stream can be accessed
by the public method (get-[new-stream-name]). The
method stream-getter1 and stream-getter2 are assumed to
be inherited public methods that return event streams.
Generates a mixin that provides access to the merge-e of two
event streams. The first argument is the name of the merged
stream. The merged stream can be accessed by the public
method (get-[new-stream-name]). The method stream-getter1
and stream-getter2 are assumed to be inherited public
methods that return event streams.
> (embed-processor processed-member-name getter ...)
For examples of how to use these macros, look at the file
"instr.ss" in collects/frtime/demos/gui/demo.
embed-processor is a macro for creating a mixin that embeds
a signal processing step into the object. For example,
mixin-merge-e is written in terms of embed-processor as:
(embed-processor new-stream-name
(lambda (ev1 ev2)
(merge-e ev1 ev2))
stream-getter1
stream-getter2).
The mixin created has one argument, which is the class being
mixed. embed-processor is in aux-mixin-macros.ss
For examples of how to use behavior->callbacks,
mixin-merge-e, events->callbacks, and callbacks->args-evts,
consult the tutorial file "instr.ss" in
collects/frtime/demos/gui/demo.
@ -85,36 +108,38 @@ Derived from callbacks->args-evts.
stream-name: key-events
> (add-callback-access value-extractor default-value super-class)
value-extractor is a method of two arguments (a widget
and a control event) that gets a value for the widget.
value-extractor is a method of two arguments (a widget and a
control event) that gets a value for the widget.
default-value is the default value for the widget. Adds
(get-value-e) and (get-value-b) to super-class, where
get-value-e returns an event stream representing the
value of the widget, and get-value-b returns a behavior
get-value-e returns an event stream representing the value
of the widget, and get-value-b returns a behavior
representing the value of the widget.
> (add-callback-access/loop value-extractor default-value super-class)
does the work of add-callback-access, but also adds
an initialization argument value-set, which is an
event stream that sets the value of the widget at
each event.
does the work of add-callback-access, but also adds an
initialization argument value-set, which is an event stream
that sets the value of the widget at each event.
> (add-focus-on-event super-class)
Derived from events->callbacks.
field-name: focus-when
UTILITY
-------
> (standard-lift widget value-method value-default)
standard-lift applys a common set of mixins to the
widget. It applies add-mouse-access, add-focus-access,
and it applys the result of behavior->callback for
label and enable. It also applies add-callback-access
with value-method as the value-extractor, and
value-default as the default-value.
standard-lift applys a common set of mixins to the widget.
It applies add-mouse-access, add-focus-access, and it applys
the result of behavior->callback for label, enabled,
min-width, and min-height. It also applies
add-callback-access with value-method as the
value-extractor, and value-default as the default-value.
Widgets that have been standard-lift'ed:
ft-button%
ft-radio-box%
ft-choice%
@ -122,9 +147,9 @@ ft-list-box%
> (standard-lift/loop widget value-method value-default)
standard-lift/loop is the same as standard-lift,
except thatit applies add-callback-access/loop
instead of add-callback-access.
standard-lift/loop is the same as standard-lift, except
thatit applies add-callback-access/loop instead of
add-callback-access.
Widgets that have been standard-lift/loop'ed:
ft-check-box%
ft-slider%

View File

@ -90,21 +90,34 @@
(define (add-size-access super-class)
((callbacks->args-evts size-events on-size)
(lambda (x) x)
super-class))
(class super-class
(super-new)
(define/public (get-size-as-list)
(list (send this get-width)
(send this get-height))))))
(define (add-size-b super-class)
((mixin-hold size-b init-size-b get-size-events)
'(0 0)
((mixin-hold size-b get-size-as-list get-size-events)
(add-size-access super-class)))
(define (add-position-access super-class)
((callbacks->args-evts position-events on-move)
(lambda (x) x)
super-class))
(class super-class
(super-new)
(define/public (get-position-as-list)
(list (send this get-x)
(send this get-y))))))
(define (add-position-b super-class)
((mixin-hold position-b init-position-b get-position-events)
'(0 0)
((mixin-hold position-b
get-position-as-list
get-position-events)
(add-position-access super-class)))
@ -132,7 +145,7 @@
(lambda (es) (map-e (lambda (e) (apply val-ext e)) es)))))))
(define add-value-b (mixin-hold value-b initial-value get-value-e))
(define add-value-b (mixin-hold value-b get-value get-value-e))
@ -157,6 +170,11 @@
(define (control-stretchability default widget)
(add-signal-controls
widget
(stretchable-width stretchable-width default)
(stretchable-height stretchable-width default)))
;; Standard mixin combinations
(define (standard-lift widget)
@ -172,14 +190,17 @@
(enabled enable #t)
(min-width min-width 0)
(min-height min-height 0)
(stretchable-width stretchable-width #f)
(stretchable-height stretchable-height #f)
))))))))
(define (standard-input-lift accessor default val-ext)
(define (standard-container-lift widget)
(control-stretchability
#t
(standard-lift widget)))
(define (standard-input-lift accessor val-ext)
(lambda (super-class)
(add-value-b
default
(accessor val-ext super-class))))
@ -188,7 +209,7 @@
((behavior->callbacks shown show)
#f
(add-shown
(standard-lift frame%))))
(standard-container-lift frame%))))
(define ft-message%
(standard-lift message%))
@ -197,27 +218,27 @@
(add-callback-access (lambda (w e) e) (add-void-set-value (standard-lift button%))))
(define ft-check-box%
((standard-input-lift add-callback-access/loop #f send-for-value)
((standard-input-lift add-callback-access/loop send-for-value)
(standard-lift check-box%)))
(define ft-slider%
((standard-input-lift add-callback-access/loop 0 send-for-value)
((standard-input-lift add-callback-access/loop send-for-value)
(standard-lift slider%))) ;ideally the default should be the minimum value
(define ft-text-field%
((standard-input-lift add-callback-access/loop "" send-for-value)
((standard-input-lift add-callback-access/loop send-for-value)
(standard-lift text-field%)))
(define ft-radio-box%
((standard-input-lift add-callback-access 0 send-for-selection)
((standard-input-lift add-callback-access send-for-selection)
(add-void-set-value (standard-lift radio-box%))))
(define ft-choice%
((standard-input-lift add-callback-access 0 send-for-selection)
((standard-input-lift add-callback-access send-for-selection)
(add-void-set-value (standard-lift choice%))))
(define ft-list-box%
((standard-input-lift add-callback-access 0 send-for-selection)
((standard-input-lift add-callback-access send-for-selection)
(add-void-set-value (standard-lift list-box%))))