Paste: Some code
Author: | Muzzleflash |
Mode: | factor |
Date: | Sun, 3 May 2009 19:44:07 |
Plain Text |
USING: kernel namespaces sequences arrays math math.ranges
math.parser combinators ui.pens.solid accessors
colors ui ui.render ui.gadgets ui.gadgets.buttons
ui.gadgets.labels ui.gadgets.packs io.styles fonts ;
QUALIFIED: models
IN: 754
: create-float 32 0 <array> "array" set-global ;
: get-array "array" get-global ;
: array-num get-array [ number>string ] map concat bin> bits>float ;
: update-label array-num number>string "model" get-global models:set-model ;
: label-get children>> first ;
: label-bit-get text>> string>number ;
: label-bit-set number>string >>text drop ;
: button-bit-get label-get label-bit-get ;
: visual-update label-get dup label-bit-get 0 = [ 1 ] [ 0 ] if label-bit-set ;
: button-click over visual-update
[ button-bit-get ] dip get-array [ set-nth ] keep
"array" set-global update-label ;
: set-button-size { 10 10 } >>size ;
: <red-brush> 1.0 0.7 0.7 1.0 <rgba> <solid> ;
: <green-brush> 0.7 1.0 0.7 1.0 <rgba> <solid> ;
: <blue-brush> 0.7 0.7 1.0 1.0 <rgba> <solid> ;
: choose-color { { [ dup 1 < ] [ drop <blue-brush> ] }
{ [ dup 9 < ] [ drop <green-brush> ] }
{ [ drop t ] [ <red-brush> ] } } cond ;
: <center> <pile> 1/2 >>align swap add-gadget ;
: set-button-color swap choose-color >>interior ;
: set-button-font dup label-get <font> "sans-serif" >>name 16 >>size >>font drop ;
: create-button-32 "0" over [ button-click ] curry <roll-button>
set-button-size set-button-color set-button-font add-gadget ;
: create-buttons-32 0 31 [a,b] [ create-button-32 ] each ;
: create-font <font> swap >>size t >>bold? "sans-serif" >>name ;
: ui-show
[
<pile> 1 >>fill
"Simulation of the IEEE 754 floating point number" <label>
22 create-font >>font <center> add-gadget
<shelf>
create-buttons-32
<center>
add-gadget
0.0 models:<model> dup [ number>string ] models:change-model dup "model" set-global
<label-control> 18 create-font >>font <center> add-gadget
"My test program" open-window
] with-ui ;
: program create-float ui-show ;
MAIN: program
New Annotation