#!/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 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