Note: This is taken from the Chicken Wiki, where a more recent version could be available.
A very simple GUI toolkit based on FLTK. This extension library has been tested with FLTK versions 1.1.4 and 1.1.6.
Initializes the toolkit. The optional argument SCHEME may be a string naming a particular graphical scheme (possible values "none" or "plastic") or #f (meaning the default). Calling this procedure a subsequent time has no effect.
Returns #t if X is a widget, or #f otherwise.
<procedure>(bb:make-widget TYPE [W H])</procedure> <procedure>(bb:make-widget TYPE X Y W H)</procedure>
Creates and returns a widget of the type given by the symbol TYPE. Possible widget types are:
A top-level window created with bb:make-widget will not automatically be shown until bb:show has been called.
<procedure>(bb:property WIDGET PROPERTY)</procedure> <setter>(set! (bb:property WIDGET PROPERTY) VALUE)</setter>
Gets or sets the properties given in PROPERTY1 ... (which should be symbols). Values may also be lists, in that case the values are combined (this only applies to certain properties - see below).
Some properties may be set for individual items of the tree and table widgets.
They are specified in the form (list WIDGET ITEMID). ITEMID is either unique item id or one of the symbols:
In this case the VALUE will be applied either to root node, connector or all subsequent branches or leaves added to the tree.
width and align properties can be applied to the table widget's columns.
Allowed widget properties are:
(may be combined)
The color attribute of a live-image widget designates the number of color channels (1-4). Also is applicable to the connector subitem of the tree widget.
Can be specified for the tree branches and leaves.
The default behaviour is to invoke the callback whenever the value of a widget changes, when a window is closed, when glwindow needs to be redrawn, or a button or list item has been clicked.
first (and only) argument to the handler. A event is one of the symbols:
Additional information about event can be obtained with bb:event procedure. Returning #f from handler indicates that widget is not interested in handling this event. #t means that event was successfully handled. Any other value leads to invoking default handler of this widget.
The html-view widget's handler is invoked when user tries to follow the link (which URI is passed as an argument). Handler should return either the name of the temporary file or #f and set the text property.
<procedure>(bb:event PROPERTY)</procedure> <setter>(set! (bb:event PROPERTY) VALUE)</setter>
Gets or sets the event properties given in PROPERTY (which should be symbol). Only click? and clicks properties can be set.
Allowed event properties are:
Whether mouse or special keyboard button was pressed.
The number of clicks (N - 1 for N clicks)
The length and text.
Which key was pressed. Possible values are:
for ordinary keys
for keypad keys
for special keys.
<procedure>(bb:message MESSAGE)</procedure> <procedure>(bb:message TYPE MESSAGE [BUTTON1 [BUTTON2 [BUTTON3]]])</procedure>
Shows a message box of type TYPE with the string MESSAGE. The optional BUTTON arguments should be strings the specify the text of any extra buttons. Message types may be:
Processes events. If WAIT is true or not specified, bb:run does not return until the last window closes. If WAIT is a number, then bb:run returns after that many seconds, or earlier, if no events are queued.
<procedure>(bb:add! WIDGET ITEM [CALLBACK [SHORTCUT]])</procedure> <procedure>(bb:add! LISTWIDGET TEXT [POSITION])</procedure> <procedure>(bb:add! TREEWIDGET TEXT [PARENT [POSITION [SUBWIDGET]])</procedure> <procedure>(bb:add! TABLEWIDGET [CELLTEXT ...])</procedure> <procedure>(bb:add! TEXTEDITOR TEXT [REPLACE])</procedure>
If WIDGET is a menu-bar, choice-button or menu-button, bb:add! adds a new menu with the text ITEM (a string), the keyboard-shortcut SHORTCUT (another string) and the callback CALLBACK (a procedure of no arguments).
The string encoding the menu-item can include subitems, using the syntax foo/bar/baz. As many levels as necessary are created.
The shortcut can be #f or a string describing the shortcut in one of two ways: [#+^]ASCII or [#+^]CHAR where a decimal value represents an ascii character (eg. 97 is the ascii for 'a'), and the optional prefixes enhance the value that follows. Multiple prefixes must appear in the above order.
If WIDGET is an edit, entry or text-edit widget, ITEM should be a string, which will be added to the end of the existing text. In case of a text-editor, the optional boolean argument REPLACE indicates whether the text should be inserted, or the current selection be replaced.
If WIDGET is a list, the ITEM should be a string, which will added to the list of existing lines. The string may be prefixed by a @... sequence to enable special formatting:
If WIDGET is a widget of any other type, then ITEM should be a child widget, which will be added with WIDGET as its parent.
For tree widget TEXT can be either full path (items are separated with slash) or text label. If it is terminated with slash, the branch (rather than leaf) will be inserted. One can specify parent node id and position in it (default values are -1 for both). The SUBWIDGET is a widget that will be inserted as a node. The procedure returns either the unique id of the freshly inserted node or -1 if failed.
This procedure can be used to add either columns (if first CELLTEXT is symbol column) or cells to the table widget.
<procedure>(bb:image X)</procedure> <procedure>(bb:image PTR W H D)</procedure>
If X is a string, then bb:image will load an image file (if its format is supported by FLTK). If X is a pointer, then it is treated as a pointer to XPM data. The 4-argument form of bb:image creates an RGB image from the data pointed to by the foreign pointer PTR, with width W, height H and depth D, where D specifies the number of color channels (1-4).
Returns four values: list of pointers to IMAGE data (usually one element for all formats, except of pixmaps), width, height and depth of the IMAGE.
<procedure>(bb:remove! WIDGET [INDEX])</procedure>
Removes the entry at the position INDEX from the list WIDGET, or all items, if index is #t. If widget is an image pointer, the storage occupied by the image will be released. For tree WIDGET the node with id INDEX will be removed. Destroys the widget.
<procedure>(bb:set-menu-item-active! WIDGET INDEX FLAG)</procedure>
Activates or deactivates the menu item with the index INDEX in the menu-bar WIDGET, depending on the boolean FLAG. Counting menu-items starts with 0 and every sub-menu increases the count by one. Note that each sub-menu introduces an invisible extra menu-item that has to be counted in.
<procedure>(bb:show WINDOW [ARG ...])</procedure>
Shows WINDOW. If WINDOW is already visible, it will be raised to the top. ARGs are the options to be parsed by FLTK. By default the name of the executable is passed. #f doesn't pass any arguments.
<procedure>(bb:select-file MESSAGE PATTERN [FILENAME])</procedure>
Opens a file-dialog and returns the selected filename (or #f if the file-selection has been canceled). PATTERN is a file-pattern that is used to match filenames that can be selected. The following syntax is used by pattern:
FILENAME specifies the default filename, if given.
<procedure>(bb:select-color [STRING])</procedure> <procedure>(bb:select-color COLOR [STRING])</procedure>
Pops up a color-selection dialog. If COLOR is an exact integer, or a symbol naming one of the default colors, then the user can select a color index, which will then be returned. If COLOR is a three-element list or vector, then the user can select an RGB (or HSV) color. bb:select-color either returns a color value (an integer, encoding a color index or a packed RGB value), or #f if the selection dialog was closed or canceled.
<procedure>(bb:rgb R [G B])</procedure>
Transforms the red, green and blue components given in R, G and B into a color value. All components should be integers in the range 0 - 255. If G and B are not given, bb:rgb returns a list of the red, green and blue color components of the packed color value R.
<procedure>(bb:get-input LABEL [DEFAULT])</procedure>
Pops up a dialog the requests an input string. LABEL should be a string that will be shown in the dialog, DEFAULT is the default text.
<procedure>(bb:group WIDGET THUNK)</procedure>
Invokes the zero-argument procedure THUNK in a dynamic context in which all created widgets are added the group WIDGET (which should be a window, group, tabs, tile, pack or scroll).
The following is a list of keyboard and mouse shortcuts available in entry and edit widgets.
With compose-character sequences, the next one or two keys typed define the character to insert (see the table that follows.)
For instance, to type "á" type [compose][a]['] or [compose]['][a].
The character "nbsp" (non-breaking space) is typed by using [compose][space].
The single-character sequences may be followed by a space if necessary to remove ambiguity. For instance, if you really want to type "ª~" rather than "ã" you must type [compose][a][space][~].
The same key may be used to "quote" control characters into the text. If you need a ^Q character you can get one by typing [compose][Control+Q].
X may have a key on the keyboard defined as XK_Multi_key. If so this key may be used as well as the right-hand control key. You can set this up with the program xmodmap.
If your keyboard is set to support a foreign language you should also be able to type "dead key" prefix characters. On X you will actually be able to see what dead key you typed, and if you then move the cursor without completing the sequence the accent will remain inserted.
<procedure>(bb:make-widgets SPEC WIDTH HEIGHT [CHARMAP])</procedure>
Creates the widgets defined in the graphical representation string SPEC in a window of the dimensions WIDTH and HEIGHT. The graphical representation string is an ASCII picture of the widget layout, with uppercase characters designating widget types:
A widgets dimensions are computed by drawing a contguous line along the upper and left border, starting from the origin of the widget:
01234567890123456789 .................... .....BBBBBBBBB...... .....BBBBBBBBB...... .....BBBBBBBBB...... ....................
Here we would have a button at 5/1, with width 9 and height 3 (before adjusting the dimensions to the specified width and height of the complete layout).
bb:make-widgets returns an association list of the form (TAG . WIDGET) which maps widget-tags to created widgets. If the optional argument CHARMAP (an list of lists of the form (ALIASCHAR CHAR TAG)) is given, then any occurrence of ALIASCHAR in the picture is treated as CHAR. The TAG will be returned in the widget a-list. If CHARMAP is not given, then the tag defaults to the usual widget type character.
Specially delimited strings can be embedded in the widget pictures:
Sets the text property of the widget.
Sets the direction, box type, slider type or color of the widget. Valid values for STRING are:
box type :
Adds items to a list widget.
STRING should be the name of an image file (as understood by bb:image).
STRING should be the name of a global variable holding a callback, or an expression evaulating to a procedure or name.
Creates the widgets defined by the SXML representation in SXML. Each element represents a widget where the tag specifies a widget type (as in bb:make-widget). Element attributes represent widget properties. Attribute-value strings are transformed according to the following mapping:
x y width height spacing maximum minimum x-position y-position text-size
Numeric strings. x, y, width and height may also be specified as offsets given as strings prefixed with + or -, or percentages given as strings suffixed with %.
color text-color selection-color
A string of the form #RRGGBB or a color name
resizable visible focus modal read-only valid-context
Anything different from the string no means true.
an element id.
A comma-separated list of indicator-names
Anything else is either treated as a numeric string or (if not a valid number) as a symbolic property value. Note that attribute values may also be of other types than strings. The content of an SXML element will be used as the text property value of the created widget, if given.
Elements may have any number of additional attributes. The attribute id can be used to identify elements.
A child widget will have the dimensions of it's parent, if no width and/or height attributes are given.
Returns #t if X is an element, or #f otherwise.
<procedure>(bb:element-widget ELEMENT)</procedure> <procedure>(bb:element-parent ELEMENT)</procedure> <procedure>(bb:element-children ELEMENT)</procedure> <procedure>(bb:element-id ELEMENT)</procedure> <procedure>(bb:element-tag ELEMENT)</procedure> <procedure>(bb:element-content ELEMENT)</procedure> <procedure>(bb:element-attributes ELEMENT)</procedure>
Accessor procedures for element slots. Parent is an element or #f (if its the root element). Children is a list of child elements. Widget is the widget represented by this element. Id and tag are symbols. Attributes is a property list mapping attribute symbols to values. Content is a string.
<procedure>(bb:find-element ID [ROOT])</procedure>
Searches the element with the id ID, starting from parent element ROOT, or the value of (bb:root-element) if not given. If no element with this id can be found #f is returned.
<procedure>(bb:find-widget ID [ROOT])</procedure>
Equivalent to (bb:element-widget (bb:find-element ID ROOT))
Parameter holding the current root element.
<example> <init>(use bb)
(define w (bb:make-widget 'window 200 100))
w (lambda () (let ([lbl (bb:make-widget 'label 200 100)]) (set! (bb:property lbl 'box) 'engraved-box) (set! (bb:property lbl 'text-size) 32) (set! (bb:property lbl 'text-font) 'times-bold-italic) (set! (bb:property lbl 'text) "Hello, World") ) ) )
A very simple shell:
<example> <init>(require-extension extras posix srfi-17 bb)
(define width 300) (define height 150)
(define w (bb:make-widget 'window width height))
(define str #«EOF LLLLLLLLLLLLLJJJJJJJ LLLLLLLLLLLLLJJJJJJJ LLLLLLLLLLLLLJJJJJJJ EEEEEEEEEEEEEEEEEEEE EOF )
(bb:group w (lambda () (bb:make-widgets str width height) ) ) )
(define lst (cdr (assq #\L widgets))) (define entry (cdr (assq #\E widgets)))
(set! (bb:property entry 'callback)
(lambda () (let ([cmd (bb:property entry 'text)]) (bb:add! lst (string-append "@i@." cmd)) (set! (bb:property entry 'text) "") (with-input-from-pipe cmd (lambda ()
(let loop () (let ([ln (read-line)]) (unless (eof-object? ln) (bb:add! lst (string-append "@." ln)) (loop) ) ) ) ) ) ) ) )
(bb:show w) (bb:run) </example>
A simple "notes" application:
<example> <init>(use utils srfi-17 bb)
(let ([item (bb:property item-list 'value)]) (when (> item 0) (let ([note (list-ref all-notes (sub1 item))])
(note-hidden?-set! note #f) (bb:show (note-window note)) ) ) ) )
`(window (@ (width 200) (height 300) (resizable) (id w) (resizable-widget lst))
(menu-bar (@ (height 30) (id m))) (list (@ (y 30) (width 200) (height 270) (id lst) (callback switch-note))) ) )
(define item-list (bb:find-widget 'lst)) (define menu-bar (bb:find-widget 'm)) (define notes-window (bb:find-widget 'w)) (define default-color 'yellow) (define all-notes '())
(define-record note window edit title color hidden?)
(define (note-hider note)
(lambda () (note-hidden?-set! note #t) (set! (bb:property (note-window note) 'visible) #f) ) )
(define (add-note . title)
(let* ([name (:optional title (->string (gensym 'note)))]
[x (random 600)] [y (random 400)] [w (bb:make-widget 'window x y 200 150)] [e (bb:group w (lambda () (bb:make-widget 'edit 0 0 200 150)))] [note (make-note w e name default-color #f)] )
(set! (bb:property w 'resizable) #t) (set! (bb:property w 'resizable-widget) e) (set! (bb:property e 'color) default-color) (set! (bb:property w 'callback) (note-hider note)) (bb:show w) (bb:add! item-list (sprintf "@.~A" name)) (set! all-notes (append all-notes (list note))) ) )
(and-let* ([col (bb:select-color default-color)]) (set! default-color col) ) )
(define notesfile (make-pathname (getenv "HOME") ".bbnotes"))
(define (load-notes . file)
(with-input-from-file (:optional file notesfile) (lambda () (match (read)
[(x y w h) (set! (bb:property notes-window 'x) x) (set! (bb:property notes-window 'y) y) (set! (bb:property notes-window 'width) w) (set! (bb:property notes-window 'height) h) ] )
(let loop ()
(match (read) [(? eof-object?) #f] [(title color pos text hidden?) (let* ([w (apply bb:make-widget 'window pos)] [e (bb:group w (lambda () (apply bb:make-widget 'edit 0 0 (cddr pos))))] [note (make-note w e title color hidden?)] ) (set! (bb:property e 'color) color) (set! (bb:property w 'resizable) #t) (set! (bb:property w 'resizable-widget) e) (set! (bb:property w 'text) title) (set! (bb:property w 'callback) (note-hider note)) (bb:add! e text) (unless hidden? (bb:show w)) (set! all-notes (append all-notes (list note))) (bb:add! item-list (string-append "@." title)) (loop) ) ] ) ) ) ) )
(define (save-notes . file)
(with-output-to-file (:optional file notesfile) (lambda () (write (map (cut bb:property notes-window <>) '(x y width height))) (newline) (for-each (lambda (note)
(let ([w (note-window note)] [e (note-edit note)] ) (write (list (note-title note) (note-color note) (list (bb:property w 'x) (bb:property w 'y) (bb:property w 'width) (bb:property w 'height)) (bb:property e 'text) (note-hidden? note) ) ) (newline) ) )
all-notes) ) ) )
(let ([i (bb:property item-list 'value)]) (when (> i 0) (let* ([note (list-ref all-notes (sub1 i))]
[title (bb:get-input "Enter new title" (note-title note))] ) (set! (bb:property (note-window note) 'text) title) (note-title-set! note title) (update-list) ) ) ) )
(bb:remove! item-list #t) (for-each (lambda (note) (bb:add! item-list (string-append "@." (note-title note)))) all-notes) )
(let ([i (bb:property item-list 'value)]) (when (> i 0) (let* ([note (list-ref all-notes (sub1 i))]
[col (bb:select-color (note-color note))] ) (set! (bb:property (note-edit note) 'color) col) (bb:redraw (note-edit note)) (note-color-set! note col) ) ) ) )
(save-notes) (exit) )
(set! (bb:property notes-window 'callback) fini) ; when ESC is pressed
(bb:add! menu-bar "File/Quit" fini "^q") (bb:add! menu-bar "Notes/New" add-note "^n") (bb:add! menu-bar "Notes/Set default color..." choose-color) (bb:add! menu-bar "Change/Title..." change-title) (bb:add! menu-bar "Change/Color..." change-color)
(when (file-exists? notesfile) (load-notes))
Event handlers usage:
<example> <init>(use srfi-17 bb)
(define w (bb:make-widget 'window 200 100)) (define e (bb:make-widget 'edit 5 5 150 25)) (set! (bb:property e 'callback) (lambda () (display "edit was changed") (newline) ) ) (set! (bb:property e 'when) 'changed) (set! (bb:property e 'handler)
(lambda (e) (case e [(move) (printf "mouse was moved over edit at (~A, ~A)~%" (bb:event 'x) (bb:event 'y)) #t] [(push) (printf "mouse was clicked on edit, clicks = 1 + ~A~%" (bb:event 'clicks)) (set! (bb:event 'clicks) 0) (printf "clicks after setting: ~A~%" (bb:event 'clicks)) #t] [(keydown) (printf "key was pressed: ~A~%" (bb:event 'key)) -1] [else -1] ) ; pass other events to the base class ) )
(bb:show w) (bb:run) </example>