Paste: completed stacky

#!/usr/bin/env factor

USING: assocs classes.struct hashtables kernel math math.parser
memory namespaces raylib sequences ;
IN: stacky
SYMBOLS: loc numbers inc-at-write ;
H{ } numbers set
f inc-at-write set
CONSTANT: stacky_text "STACKY"

: init           ( -- )          0 loc set 1000 1000 "STACKY" init-window ;
: white          ( -- )          WHITE clear-background ;
: wloop          ( quot -- )     [ window-should-close not ] swap while ; inline
: check-inc-w    ( -- )          KEY_W is-key-pressed [ inc-at-write get not inc-at-write set ] [ ] if ;
: stacky-text    ( -- )          stacky_text 500 stacky_text 30 measure-text 2 / - 500 225 - 30 BLACK draw-text ;
: stacky-rect    ( -- )          500 300 2 / - 500 150 - 300 700 BLACK draw-rectangle ;
: down-clicked   ( -- bool )     KEY_TAB is-key-pressed KEY_LEFT_SHIFT is-key-down KEY_RIGHT_SHIFT is-key-down or not and  KEY_DOWN is-key-pressed or KEY_ENTER is-key-pressed or ;
: up-clicked     ( -- bool )     KEY_UP  is-key-pressed KEY_TAB is-key-pressed KEY_LEFT_SHIFT is-key-down KEY_RIGHT_SHIFT is-key-down or and or ;
: down-incr-loc  ( -- )          down-clicked [ loc inc ] [ ] if ;
: up-decr-loc    ( -- )          up-clicked   [ loc get 0 > [ loc dec ] [ ] if ] [ ] if ;
: number-pressed ( -- number/f ) KEY_ZERO is-key-pressed [ "0" ] [ KEY_ONE is-key-pressed [ "1" ] [ KEY_TWO is-key-pressed [ "2" ] [ KEY_THREE is-key-pressed [ "3" ] [ KEY_FOUR is-key-pressed [ "4" ] [ KEY_FIVE is-key-pressed [ "5" ] [ KEY_SIX is-key-pressed [ "6" ] [ KEY_SEVEN is-key-pressed [ "7" ] [ KEY_EIGHT is-key-pressed [ "8" ] [ KEY_NINE is-key-pressed [ "9" ] [ f ] if ] if ] if ] if  ] if ] if ] if ] if ] if ] if ;
: erase-on-bsp   ( -- )          KEY_BACKSPACE is-key-pressed [ 0 loc set 20 <hashtable> numbers set ] [ ] if ;
: erase-on-space ( -- )          KEY_SPACE is-key-pressed [ loc get numbers get delete-at loc get 0 > [ loc dec ] [ ] if ] [ ] if ;
: gray-box       ( -- )          350 loc get 30 * 350 + 300 100 S{ Color f 50 50 50 255 } draw-rectangle ;
: write-number   ( -- )          number-pressed dup [ loc get numbers get at dup [ swap append loc get numbers get set-at ] [ drop loc get numbers get set-at ] if inc-at-write get [ loc inc  ] [ ] if ] [ drop ] if ;
: draw-numbers   ( -- )          numbers get [ dup 500 swap 30 measure-text 2 / - rot 30 * 385 + 30 WHITE draw-text ] assoc-each ;

: main           ( -- )          init [ begin-drawing white check-inc-w stacky-text stacky-rect up-decr-loc down-incr-loc gray-box write-number draw-numbers erase-on-bsp erase-on-space end-drawing ] wloop ;

MAIN: main