! Copyright (C) 2009 Søren Enevoldsen.
! See http://factorcode.org/license.txt for BSD license.
! Simulates the IEEE 754 floating point number.
USING: kernel namespaces prettyprint math math.ranges sequences combinators arrays io.styles accessors math.parser colors ui ui.gadgets ui.gadgets.frames ui.gadgets.grids ui.gadgets.labels ui.backend ui.gadgets.buttons ui.gadgets.worlds ui.gadgets.packs ui.render project-euler.011.private ;
IN: 754

! TODO: Fix enormously ugly code!!!

! Related to the label that contains the value of the float.
: create-float ( -- ) 32 0 <array> "floatnumber" set-global ;
: float-label ( -- label ) "textlabel" get-global ;
: float-array ( -- seq ) "floatnumber" get-global ;
: update-label ( -- ) float-label float-array [ number>string ] map concat bin> bits>float number>string >>text drop ;

! 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 "floatnumber" get-global [ set-nth ] keep
                              "floatnumber" set-global update-label ;

: set-button-size ( button -- button ) { 10 10 } >>size ;

! Brushes
: <red-brush> ( -- rgba ) 255 0 0 255 <rgba> <solid> ;
: <blue-brush> ( -- rgba ) 0 0 255 255 <rgba> <solid> ;
: <green-brush> ( -- rgba ) 0 255 0 255 <rgba> <solid> ;

! Create buttons for gui
: choose-color ( n -- brush ) { { [ dup 1 < ] [ drop <blue-brush> ] } 
                                { [ dup 9 < ] [ drop <green-brush> ] } 
                                { [ drop t ] [ <red-brush> ] } } cond ;

! Center label
: <center> ( child -- parent ) vertical <pack> 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" plain 16 } >>font drop ;
: create-button ( parent n -- parent ) "0" over [ button-click ] curry <roll-button> set-button-size set-button-color set-button-font add-gadget ;
: create-buttons ( parent -- parent ) 0 31 [a,b] [ create-button ] each ;

: ui-show ( -- )
    [ 
            <pile>
            "Simulation of the IEEE 754 floating point number" <label> { "sans-serif" bold 22 } >>font add-gadget
                    <shelf>
                    create-buttons
                    add-gadget
            "Float value here!" <label> dup "textlabel" set-global { "sans-serif" bold 18 } >>font add-gadget
               
            "My test program" open-window
    ] with-ui ;

: program ( -- ) create-float ui-show ;

MAIN: program