- added gui wrapper and merged its documentation with top-level frtime doc.txt

svn: r1793

collects/frtime/demos/gui/demo/bindec.ss

@@ -0,0 +1,46 @@
+(require "../simple.ss")
+(require (rename (lib "mred.ss" "mred") horizontal-panel% horizontal-panel%))
+
+; just change this to change the range of the binary/decimal converter
+(define SIZE 10) 
+
+(define (bool-lst->num bool-lst)
+  (let loop ([lst bool-lst] [sum 0] [pow 0])
+    (if (empty? lst)
+        sum
+        (loop (cdr lst) 
+              (+ sum
+                 (if (car lst)
+                     (expt 2 pow)
+                     0))
+              (add1 pow)))))
+
+(define (place-num->bool loc num)
+  (if (= 0 loc)
+      (odd? num)
+      (place-num->bool (sub1 loc) (quotient num 2))))
+
+
+(current-widget-parent (new ft-frame% 
+                            (its-width 0)
+                            (its-height 0)
+                            (label-text "Binary<-->Decimal")))
+
+(define-values-rec
+  [sld (mode value-b ft-slider%
+             (min-value 0)
+             (max-value (sub1 (expt 2 SIZE)))
+             (value-set (changes 
+                           (bool-lst->num
+                            boxes))))]
+  
+  [boxes (parameterize ([current-widget-parent
+                         (mode widget horizontal-panel%)])
+           (build-list SIZE ; build-list is right associative.
+                       (lambda (i)
+                         (mode value-b ft-check-box%
+                               (label (number->string (expt 2 i)))
+                               (value-set 
+                                (changes (place-num->bool i sld)))))))])
+
+(send (current-widget-parent) show #t)

collects/frtime/demos/gui/demo/instr.ss

@@ -0,0 +1,104 @@
+(require (lib "mixin-macros.ss" "frtime" "demos" "gui")) ;require the macros
+(require (lib "class.ss")) ; require class utilities
+(require (lib "mred.ss" "mred")) ; require base mred library
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+;; behavior->callbacks ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; create a mixin using the macro
+(define label-lifter
+  (behavior->callbacks label ; name of the init field
+                       set-label ; callback to invoke
+                       ))
+
+; apply the mixin to a class (and a default value).
+; whenever the "label" argument of a fr-label-frame changes,
+; set-label will be invoked with the current value of the
+; supplied label behavior
+(define fr-label-frame% (label-lifter "" frame%))
+
+; each second, the label will be changed to the current value of
+; seconds
+(define my-frame
+  (new fr-label-frame% (label (number->string seconds))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;
+;; events->callbacks ;;
+;;;;;;;;;;;;;;;;;;;;;;;
+
+; create a mixin using the macro
+(define set-value-lifter
+  (events->callbacks value-set-e ; name of the init field
+                     set-value ; callback to invoke
+                     ))
+
+; apply the mixin
+; fr-value-text-field%s will set their value to the value of 
+; the event occurances supplied in the initialization argument
+; value-set-e
+(define fr-value-text-field% (set-value-lifter text-field%))
+
+; every 10 seconds, the my-text will set its value to be that
+; of seconds
+(define my-text
+  (new fr-value-text-field% 
+       (label "")
+       (value-set-e 
+        (map-e number->string
+               (filter-e (lambda (evt) (zero? (modulo evt 10)))
+                         (changes seconds))))
+       (parent my-frame)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; callbacks->args-evts ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; create a mixin using the macro
+(define focus-lifter
+  (callbacks->args-evts focus-events ; name of event stream
+                        on-focus ; callback being watched
+                        (is-focused?) ; argument list of callback being watched
+                        ))
+
+; apply the mixin
+; whenever on-focus is called in a fr-focus-check-box%,
+; a list of the argument (is-focused?) is sent to an
+; event stream
+(define fr-focus-check-box% (focus-lifter check-box%))
+
+; the focus-events-event-processor is applied to the
+; event stream that carries events from on-focus.
+(define my-cb1 (new fr-focus-check-box%
+                          (parent my-frame)
+                          (label "Check1")))
+
+; Because these events are lists of one element (the only
+; argument to on-focus), car effectively extracts the
+; value indicated by the callback (is-focused?).
+(define my-cb2 (new fr-focus-check-box%
+                          (parent my-frame)
+                          (focus-events-event-processor
+                           (lambda (es) (map-e car es)))
+                          (label "Check2")))
+
+; focus-events-event-processor is a function of one
+; argument, an event stream, and can return anything
+; that is convenient
+(define my-cb3 (new fr-focus-check-box%
+                          (parent my-frame)
+                          (focus-events-event-processor
+                           (lambda (es) (hold (map-e car es) #f)))
+                          (label "Check3")))
+
+; get the streams from the check boxes
+(send my-cb1 get-focus-events)
+(send my-cb2 get-focus-events)
+(send my-cb3 get-focus-events)
+                          
+
+;; SHOW THE FRAME
+(send my-frame show #t)

collects/frtime/demos/gui/demo/timer.ss

@@ -0,0 +1,28 @@
+(require "../simple.ss")
+
+(current-widget-parent (new ft-frame% (its-width 400) (its-height 0)))
+
+(define tenths (quotient milliseconds 100))
+
+(define-values-rec
+  [range (* 10 (mode value-b ft-slider%
+                     (label "Range")
+                     (min-value 10)
+                     (max-value 30)
+                     (init-value 10)))]
+  [gauge-value (min range (- tenths
+                             (hold 
+                              (map-e (lambda (_) (value-now tenths))
+                                     reset)
+                              (value-now tenths))))]
+  [gauge (mode widget ft-gauge% 
+               (label "Timer") 
+               (value gauge-value)
+               (range range))]
+  [msg (mode widget ft-message%
+             (label (number->string (quotient gauge-value 10)))
+             (stretchable-width #t))]
+  [reset (mode value-e ft-button% (label "Reset"))])
+
+
+(send (current-widget-parent) show #t)

collects/frtime/demos/gui/doc.txt

@@ -0,0 +1,111 @@
+> FtA (Forte GUI library)
+  
+MACROS
+-------
+To get the macros: 
+(require (lib "mixin-macros.ss" "frtime" "demos" "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.
+
+> (events->callbacks field-name update-call)
+Generates a mixin for allowing an event stream to drive
+callbacks. The one argument to the resulting mixin is the
+class to be extended
+
+> (callbacks->args-evts stream-name callback (args-to-callback ...))
+Generates a mixin that sends an event on stream-name when
+callback is called. The class has an init field called
+[stream-name]-event-processor, which is a function. The
+function is applied to an event stream that has an
+occurence every time callback is called, and the value
+of the events is a list of the arguments to the callback.
+The public method (get-[stream-name]) is a public method
+of the resulting class that gets the result of applying
+[stream-name]-event-processor to the stream of args-evts.
+
+FtA provides event-is-val, split-mouse-events/type, and
+split-key-events/type for use as initialization arguments.
+event-is-val can be used for [stream-name]-event-processor
+when the event should just be the value of the first 
+argument of the callback. split-*-events/type sets up an
+appropriate split (see FrTime docs for split information,
+MrEd docs for key-event codes and mouse-event types).
+                                                    
+
+MIXINS
+------
+Some common mixins have already been defined and applied.
+To get these: 
+(require "fred.ss" "frtime" "demos" "gui")
+
+> (add-mouse-access super-class)
+Derived from callbacks->args-evts.
+ stream-name: mouse-events
+ 
+> (add-focus-access super-class)
+Derived from callbacks->args-evts
+ stream-name: focus-events
+
+> (add-keypress-split super-class)
+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.
+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
+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.
+
+> (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.
+Widgets that have been standard-lift'ed:
+ft-button%
+ft-radio-box%
+ft-choice%
+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.
+Widgets that have been standard-lift/loop'ed:
+ft-check-box%
+ft-slider%
+ft-text-field%
+
+
+simple.ss
+---------
+
+Many useful utilities have been put in
+(require "simple.ss" "frtime" "demos" "gui")
+feel free to look around and use the ones you think are
+useful.
+  

collects/frtime/demos/gui/fred.ss

@@ -0,0 +1,306 @@
+(module fred (lib "frtime.ss" "frtime")
+  (require "mixin-macros.ss"
+           ;"r-label.ss"
+           (lib "class.ss")
+           (lib "string.ss")
+           (all-except (lib "mred.ss" "mred") send-event)
+           (lib "framework.ss" "framework"))
+  
+  (define-syntax add-signal-controls
+    (syntax-rules ()
+      [(_ src (field-name0 update-call0 default-val0) clause ...)
+       ((behavior->callbacks field-name0 update-call0)
+        default-val0
+        (add-signal-controls src clause ...))]
+      [(_ src)
+       src]))
+  
+
+  
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Helpers
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  
+  ;; adding assumed methods
+  (define (add-void-set-value super-class)
+    (class super-class
+      (define/public (set-value v) (void))
+      (super-new)))
+  
+  (define (add-focus-now super-class)
+    (class super-class
+      (super-new)
+      (inherit focus)
+      (define/public (focus-now _) (focus))))
+  
+  (define (callback->pub-meth super-class)
+    (class super-class
+      (define/public (callback-method w e) (void))
+      (super-new (callback (lambda (w e) (callback-method w e))))))
+  
+  
+  ;; *-event-processor init-argument values
+  (define event-is-val
+    (lambda (es)
+      (map-e car es)))
+  
+  ; (send x get-mouse-events) returns a split procedure over the event-type
+  (define split-mouse-events/type
+    (lambda (evt-src)
+      (split (map-e cadr evt-src) (lambda (evt) (send evt get-event-type)))))
+  
+  ; (send x get-key-events) returns a split procedure over the key code
+  (define split-key-events/type
+    (lambda (evt-src)
+      (split (map-e cadr evt-src) (lambda (evt) (send evt get-key-code)))))
+  
+  
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; make state available as eventstreams
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  
+  (define (add-mouse-access super-class)
+    ((callbacks->args-evts mouse-events ; Name of event stream
+                           on-subwindow-event ; proc overriding
+                           (window evt) ; arguments for on-subwindow-event. Caused by super being a macro
+                           )
+     super-class))
+  
+  
+  (define (add-focus-access super-class)
+    ((callbacks->args-evts focus-events on-focus (is-focused?))
+     super-class))
+  
+  (define (add-keypress-split super-class)
+    ((callbacks->args-evts key-events on-subwindow-char (w e))
+     super-class))
+  
+  
+  
+  #|
+  (define (add-value-b super-class default)
+    (class super-class
+      (super-new)
+      (inherit get-value-e)
+      (define/public (get-value-b) (hold (get-value-e) default))))
+  |#
+  
+  (define (add-callback-access val-ext default-val super-class)
+    (class ((callbacks->args-evts set-value-events
+                                  set-value
+                                  (v))
+            ((callbacks->args-evts callback-events
+                                   callback-method
+                                   (w e))
+             (callback->pub-meth super-class)))
+      (super-new (set-value-events-event-processor event-is-val)
+                 (callback-events-event-processor (lambda (es)
+                                                    (map-e (lambda (e) (apply val-ext e)) es))))
+      (inherit get-set-value-events get-callback-events)
+      (define value-e (merge-e (get-set-value-events)
+                               (get-callback-events)))
+      (define value-b (hold value-e (val-ext this #f)))
+      (define/public (get-value-e) value-e)
+      (define/public (get-value-b) value-b)
+      ))
+  
+  
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; using events to drive object interaction
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  
+  (define (add-callback-access/loop val-ext default-val super-class)
+    ((events->callbacks value-set set-value)
+     (add-callback-access val-ext default-val super-class)))
+  
+  
+  (define (add-focus-on-event super-class)
+    ((events->callbacks focus-when focus-now)
+     (add-focus-now super-class)))
+  
+  
+  
+    ;; Special case widgets
+  (define (in-string itm)
+    (if (undefined? itm)
+        ""
+        (if (string? itm)
+            itm
+            (expr->string itm))))
+  
+  
+  
+  (define ft-frame%
+    (class (add-mouse-access (add-keypress-split (add-signal-controls frame% (label set-label ""))))
+      ; Members, initialized
+      (init-field (its-width 800) (its-height 600) (label-text "") (x-loc 0) (y-loc 0))
+      #|
+      ;(make-prog-control label-text set-label)
+      
+      ; Private members, internal
+      (define width-e (event-receiver))
+      (define width-b (hold width-e its-width))
+      (define height-e (event-receiver))
+      (define height-b (hold height-e its-height))
+      
+      (define mouse-x-e (event-receiver))
+      (define mouse-x-b (hold mouse-x-e 0))
+      (define mouse-y-e (event-receiver))
+      (define mouse-y-b (hold mouse-y-e 0))
+      
+      ; Overridden methods
+      (override on-size on-subwindow-event)
+      
+      ; Overrides on-size from frame% to update width-e and height-e
+      (define (on-size new-width new-height)
+        (begin
+          (send-event width-e new-width)
+          (send-event height-e new-height)
+          
+          (super on-size new-width new-height)))
+      
+      (define (on-subwindow-event a-window event)
+        (begin
+          (case (send event get-event-type)
+            [(enter motion)
+             (send-event mouse-x-e (+ (send a-window get-x) (send event get-x)))
+             (send-event mouse-y-e (+ (send a-window get-y) (send event get-y)))])
+          (super on-subwindow-event a-window event)))
+      
+      ; Public Members    
+      (public get-width-b get-height-b get-mouse-x get-mouse-y)
+      
+      ; Returns a behavior of the width of the frame
+      (define (get-width-b) width-b)
+      
+      ; Returns a behavior of the height of the frame
+      (define (get-height-b) height-b)
+      
+      (define (get-mouse-x) mouse-x-b)
+      (define (get-mouse-y) mouse-y-b)
+      |#
+      (super-new (label (in-string (value-now label-text))) 
+                 (width its-width) 
+                 (height its-height)
+                 (x x-loc)
+                 (y y-loc)
+                 #;(style '(float metal)))))
+  
+  
+
+  
+  (define ft-message% 
+    (add-mouse-access
+     (add-focus-access
+      (add-signal-controls message% (label set-label "") (enabled enable #t)))))
+  
+  #;(define ft-autoresize-label% 
+    (add-mouse-access
+     (add-focus-access
+      (add-signal-controls autoresize-label% (text set-label-text "") (enabled enable #t)))))
+  
+  
+  (define specialized-gauge%
+    (class gauge%
+      (init value)
+      
+      (super-new)
+      
+      (inherit set-value)
+      #;(set-value value)))
+  
+  (define ft-gauge%
+    (add-mouse-access
+     (add-focus-access
+      (add-signal-controls specialized-gauge% 
+                           (label set-label "") 
+                           (enabled enable #t)
+                           (value set-value 0)
+                           (range set-range 1)))))
+  
+  (define ft-menu-item%
+    (add-callback-access
+     list
+     '()
+     (add-void-set-value
+      menu-item%)))
+  
+  
+  
+  (define (send-for-value w e)
+    (send w get-value))
+  
+  (define (send-for-selection w e)
+    (send w get-selection))
+  
+  
+  ;; Standard mixin combinations
+  (define (standard-lift widget value-method value-default)
+    (add-mouse-access
+     (add-focus-access
+      (add-callback-access
+       value-method
+       value-default
+       (add-signal-controls (add-void-set-value widget) (label set-label "") (enabled enable #t))))))
+  
+  (define (standard-lift/loop widget value-method value-default)
+    (add-mouse-access
+     (add-focus-access
+      (add-callback-access/loop
+       value-method
+       value-default
+       (add-signal-controls widget (label set-label "") (enabled enable #t))))))
+  
+  
+  
+  (define ft-button%
+    (standard-lift button% (lambda (w e) e) undefined))  
+  
+  (define ft-check-box%
+    (standard-lift/loop check-box% send-for-value #f))
+  
+  (define ft-radio-box%
+    (standard-lift radio-box% send-for-selection 0))
+  
+  (define ft-choice%
+    (standard-lift choice% send-for-selection 0))
+  
+  (define ft-slider%
+    (standard-lift/loop slider% send-for-value 0))
+  
+  (define ft-list-box% 
+    (standard-lift list-box% send-for-selection 0))
+  
+  (define ft-text-field%
+    (add-keypress-split
+     (add-focus-on-event
+      (standard-lift/loop text-field% send-for-value ""))))
+  
+ 
+  
+  
+  
+  
+  (provide ft-frame%
+           ft-message%
+           ;ft-autoresize-label%
+           ft-gauge%
+           ft-button%
+           ft-check-box%
+           ft-radio-box%
+           ft-choice%
+           ft-slider%
+           ft-list-box%
+           ft-text-field%
+           ft-menu-item%
+           menu%
+           menu-bar%
+           finder:get-file
+           finder:put-file
+           split-mouse-events/type
+           split-key-events/type
+           (all-from (lib "class.ss"))
+           (all-from "mixin-macros.ss"))) 
+
+
+

collects/frtime/demos/gui/mixin-macros.ss

@@ -0,0 +1,80 @@
+(module mixin-macros (lib "frtime.ss" "frtime")
+  (require (lib "class.ss"))
+  
+  ;; consider taking out setter
+  (define-syntax behavior->callbacks
+    (lambda (stx)
+      (syntax-case stx ()
+        [(_ field-name update-call)
+         (let ([s-field-name (syntax field-name)])
+           (with-syntax ([the-cell-name (string->symbol
+                                         (format "~a-cell" (syntax-e s-field-name)))]
+                         [getting-name (string->symbol
+                                        (format "get-~a-b" (syntax-e s-field-name)))])
+             (syntax
+              (lambda (default super)
+                (class super
+                  (init (field-name default))
+                  
+                  (super-new (field-name (value-now field-name)))
+                  
+                  (inherit update-call)
+                  (define the-cell-name field-name)
+                  
+                  (for-each-e! (changes the-cell-name)
+                               (lambda (evt) (update-call evt))
+                               this)
+                  
+                  (define/public (getting-name) the-cell-name))))))])))
+  
+  (define-syntax events->callbacks
+    (lambda (stx)
+      (syntax-case stx ()
+        [(_ field-name update-call)
+         (let ([s-field-name (syntax field-name)])
+           (with-syntax ([the-cell-name (string->symbol
+                                         (format "~a-cell" (syntax-e s-field-name)))]
+                         [getting-name (string->symbol
+                                        (format "get-~a-e" (syntax-e s-field-name)))])
+             (syntax
+              (lambda (super)
+                (class super
+                  (init (field-name (event-receiver)))
+                  (super-new)
+                  (inherit update-call)
+                  (define the-cell-name field-name)
+                  
+                  (for-each-e! the-cell-name
+                               (lambda (evt) (update-call evt))
+                               this)
+                  
+                  (define/public (getting-name) the-cell-name))))))])))
+ 
+  ;; overridden method can have >1 form
+  (define-syntax callbacks->args-evts
+    (lambda (stx)
+      (syntax-case stx ()
+        [(_ ev-name method-name (arg ...))
+         (with-syntax ([name-e (string->symbol (format "~a-e" (syntax-e #'ev-name)))]
+                       [g-name (string->symbol (format "get-~a" (syntax-e #'ev-name)))]
+                       [processor (string->symbol (format "~a-event-processor" (syntax-e #'ev-name)))])
+           #'(lambda (super-class)
+               (class super-class
+                 (init (processor (lambda (x) x)))
+                 (super-new)
+                 (define name-e (event-receiver))
+                 (define processed-events (processor name-e))
+                 ;what about when the super call returns an error?
+                 (define/override method-name
+                   (lambda (arg ...)
+                     (send-event name-e (list arg ...))
+                     (super method-name arg ...)))
+                 
+                 (define/public (g-name) processed-events))))])))
+  
+  
+
+  
+  (provide behavior->callbacks
+           events->callbacks
+           callbacks->args-evts))

collects/frtime/demos/gui/simple.ss

@@ -0,0 +1,57 @@
+(module simple (lib "frtime.ss" "frtime")
+  
+  (require "fred.ss"
+           (lib "class.ss")
+           (rename (lib "mred.ss" "mred") frame% frame%))
+  
+  (define widget (lambda (x) x))
+  (define value-b (lambda (x) (send x get-value-b)))
+  (define value-e (lambda (x) (send x get-value-e)))
+  
+  (define default-parent
+    (let ([fr #f])
+      (lambda ()
+        (unless fr
+          (set! fr (new ft-frame%)))
+        fr)))
+  
+  (define creation-filter (make-parameter value-b
+                                          (lambda (f) (if (and (procedure? f) (procedure-arity-includes? f 1))
+                                                          f
+                                                          (error 'creation-filter
+                                                                 "expected a procedure of arity 1")))))
+  
+  (define current-widget-parent (make-parameter #f))
+  
+  (define-syntax add-widget
+    (syntax-rules ()
+      [(_ type arg ...)
+       ((creation-filter) (new type (parent (current-widget-parent)) arg ...))]))
+  
+  
+  (define (filter-widget w)
+    ((creation-filter) w))
+  
+  (define-syntax mode
+    (syntax-rules ()
+      [(_ proc type arg ...) (parameterize ([creation-filter proc])
+                               (add-widget type arg ...))]))
+  
+  (define-syntax define-values-rec
+    (syntax-rules ()
+      [(_ [id0 exp0] [id exp] ...)
+       (define-values (id0 id ...)
+         (letrec ([id0 exp0]
+                  [id exp] ...)
+           (values id0 id ...)))]))
+  
+
+
+  
+  (provide (all-defined)
+           (all-from "fred.ss")
+           (all-from (lib "class.ss")))) 
+            
+            
+            
+          

collects/frtime/demos/spreadsheet/spread.ss

@@ -630,7 +630,7 @@
       (send offscreen-dc set-brush highlight-brush)))
   
   (define canvas
-    (instantiate ss-canvas% (frame) (style (list 'hscroll 'vscroll 'no-autoclear))))
+    (instantiate ss-canvas% (frame) (style (list 'hscroll 'vscroll))))
   
   (send frame show #t)
   (send canvas focus))

collects/frtime/doc.txt

@@ -253,3 +253,117 @@ of the face.  Click and drag to move the face around.
 growing-points.ss : A field of points that grow as the mouse approaches.
 
 needles.ss : A field of needles that point at the mouse.
+
+_FtA (Forte GUI library)_
+  
+MACROS
+------
+
+To get the macros: 
+(require (lib "mixin-macros.ss" "frtime" "demos" "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.
+
+> (events->callbacks field-name update-call)
+Generates a mixin for allowing an event stream to drive
+callbacks. The one argument to the resulting mixin is the
+class to be extended
+
+> (callbacks->args-evts stream-name callback (args-to-callback ...))
+Generates a mixin that sends an event on stream-name when
+callback is called. The class has an init field called
+[stream-name]-event-processor, which is a function. The
+function is applied to an event stream that has an
+occurence every time callback is called, and the value
+of the events is a list of the arguments to the callback.
+The public method (get-[stream-name]) is a public method
+of the resulting class that gets the result of applying
+[stream-name]-event-processor to the stream of args-evts.
+
+FtA provides event-is-val, split-mouse-events/type, and
+split-key-events/type for use as initialization arguments.
+event-is-val can be used for [stream-name]-event-processor
+when the event should just be the value of the first 
+argument of the callback. split-*-events/type sets up an
+appropriate split (see FrTime docs for split information,
+MrEd docs for key-event codes and mouse-event types).
+                                                    
+
+MIXINS
+------
+
+Some common mixins have already been defined and applied.
+To get these: 
+(require "fred.ss" "frtime" "demos" "gui")
+
+> (add-mouse-access super-class)
+Derived from callbacks->args-evts.
+ stream-name: mouse-events
+ 
+> (add-focus-access super-class)
+Derived from callbacks->args-evts
+ stream-name: focus-events
+
+> (add-keypress-split super-class)
+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.
+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
+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.
+
+> (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.
+Widgets that have been standard-lift'ed:
+ft-button%
+ft-radio-box%
+ft-choice%
+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.
+Widgets that have been standard-lift/loop'ed:
+ft-check-box%
+ft-slider%
+ft-text-field%
+
+
+simple.ss
+---------
+
+Many useful utilities have been put in
+(require "simple.ss" "frtime" "demos" "gui")
+feel free to look around and use the ones you think are
+useful.
+