Compare commits

...

2 Commits

Author SHA1 Message Date
Nico f2c33f880f make unlocking functions clearer 2021-04-01 14:24:19 +01:00
Nico d7ccec8595 prepare more for addition of garden 2021-04-01 13:13:53 +01:00
1 changed files with 16 additions and 6 deletions

22
main.fs
View File

@ -79,14 +79,17 @@ S" you feel like throwing some stuff into the pool." set-message
\ the word f!0= tests if a floating thing is non-zero
: f!0= ( r -- flag ) f0= 0= ;
\ the word can-afford? tests if you could afford n of a currency.
: can-afford? ( n currency -- flag ) f@ s>f f>= ;
\ the world unlock-members tests to see if hiring chat members can be unlocked. if so, they are unlocked.
: unlock-members
devices f@ ftrunc 5e f= membercost @ 0= and if
5 devices can-afford? membercost @ 0= and if
10 membercost !
S" A friendly townie wants to help out." set-message then ;
: unlock-constructs
devices f@ ftrunc 30e f= constructcost @ 0= and if
30 devices can-afford? constructcost @ 0= and if
40 constructcost !
S" You figure out that you can probably hack these devices." set-message then ;
@ -126,9 +129,6 @@ S" you feel like throwing some stuff into the pool." set-message
\ the word exit-game exits the game.
: exit-game page show-cursor bye ;
\ the word can-afford? tests if you could afford n of a currency.
: can-afford? ( n currency -- flag ) f@ s>f f>= ;
\ the word pay pays an amount of a currency.
: pay ( n currency -- ) dup f@ swap s>f ( fswap ) f- f! ;
@ -293,8 +293,18 @@ S" you feel like throwing some stuff into the pool." set-message
: draw-devices-screen any-change? if draw-message draw-devices draw-blank draw-actions clear-xy clear-all else clear-xy then ;
\ : draw-screen clear-all ;
\ TODO draw the garden, this is a stub
: draw-garden 2dup at-xy ." hello world! " ;
\ TODO apparently the forth-y way to do this is with a function table
: draw-screen
screen @ case
0 of draw-devices-screen endof
1 of draw-garden endof
endcase ;
\ main game loop
: game-loop begin wait-tick game-tick handle-input 1 1 draw-tab-bar draw-blank draw-devices-screen 0 until ;
: game-loop begin wait-tick game-tick handle-input 1 1 draw-tab-bar draw-blank draw-screen 0 until ;
\ for use in the debugging shell
: restart page game-loop ;