Paste: Help with centering text in labels

Author: Muzzleflash
Mode: factor
Date: Mon, 6 Apr 2009 20:30:06
Plain Text | 
! 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

Annotation: Update

Author: Muzzleflash
Mode: factor
Date: Mon, 6 Apr 2009 21:04:36
Plain Text | 
! 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 models models.filter 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 somewhat ugly code!
! TODO: Make UI resize better.
! TODO: Get rid of warnings.

! Related to the label that contains the value of the float.
: create-float ( -- ) 32 0 <array> "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 "model" get-global 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
: <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 ) <pile> 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> 1 >>fill
            "Simulation of the IEEE 754 floating point number" <label> { "sans-serif" bold 22 } >>font <center> add-gadget
                    <shelf>
                    create-buttons
                    <center>
                    add-gadget
            0.0 <model> dup "model" set-global [ number>string ] <filter> <label-control> <center> add-gadget
            "My test program" open-window
    ] with-ui ;

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

MAIN: program

New Annotation

Summary:
Author:
Mode:
Body: