! Copyright (C) 2009 Søren Enevoldsen. ! See http://factorcode.org/license.txt for BSD license. ! Simulates the IEEE 754 (32 bit) floating point number. 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 ! TODO: Fix somewhat ugly code! ! TODO: Make UI resize better (waiting for unresizable windows). ! TODO: Get rid of warnings (Gone in latest build). ! Related to the label that contains the value of the float. : create-float ( -- ) 32 0 "array" set-global ; : get-array ( -- seq ) "array" get-global ; : array-num ( -- m ) get-array [ number>string ] map concat bin> bits>float ; : update-label ( -- ) array-num number>string "model" get-global models:set-model ; ! Label related : label-get ( button -- label ) children>> first ; : label-bit-get ( label -- m ) text>> string>number ; : label-bit-set ( label m -- ) number>string >>text drop ; ! Button related : button-bit-get ( button -- m ) label-get label-bit-get ; : visual-update ( button -- ) label-get dup label-bit-get 0 = [ 1 ] [ 0 ] if label-bit-set ; : button-click ( button n -- ) over visual-update [ button-bit-get ] dip get-array [ set-nth ] keep "array" set-global update-label ; : set-button-size ( button -- button ) { 10 10 } >>size ; ! Brushes : ( -- rgba ) 1.0 0.7 0.7 1.0 ; : ( -- rgba ) 0.7 1.0 0.7 1.0 ; : ( -- rgba ) 0.7 0.7 1.0 1.0 ; ! Create buttons for gui : choose-color ( n -- brush ) { { [ dup 1 < ] [ drop ] } { [ dup 9 < ] [ drop ] } { [ drop t ] [ ] } } cond ; ! Center label :
( child -- parent ) 1/2 >>align swap add-gadget ; : set-button-color ( n button -- button ) swap choose-color >>interior ; : set-button-font ( button -- button ) dup label-get "sans-serif" >>name 16 >>size >>font drop ; : create-button-32 ( parent n -- parent ) "0" over [ button-click ] curry set-button-size set-button-color set-button-font add-gadget ; : create-buttons-32 ( parent -- parent ) 0 31 [a,b] [ create-button-32 ] each ; : create-font ( n -- font ) swap >>size t >>bold? "sans-serif" >>name ; : ui-show ( -- ) [ 1 >>fill "Simulation of the IEEE 754 floating point number"