Merge branch 'main' of /run/media/nico/C340-0D4F/javapool

This commit is contained in:
Nico 2021-03-22 15:18:37 +00:00
commit aca6660132
1 changed files with 33 additions and 12 deletions

45
main.fs
View File

@ -167,6 +167,9 @@ S" you feel like throwing some stuff into the pool." set-message
[char] b of build-construct endof
[char] D of debug-console endof
endcase then ;
\ inc-y increments the y coordinate being drawn at.
: inc-y 1 + ;
\ print-rate prints the current device output rate on the screen.
: print-rate
@ -175,21 +178,31 @@ S" you feel like throwing some stuff into the pool." set-message
." (" devices/tick 1000e f* f. ." devices/second)" ;
\ draw-message draws the stored message on the screen.
: draw-message
1 2 at-xy
clear-line get-message type ;
: draw-message ( x y -- x y )
2dup at-xy
clear-line get-message type
inc-y ;
\ draw-blank draws a blank line.
: draw-blank ( x y -- x y )
2dup at-xy
clear-line
inc-y ;
\ draw-devices draws the number of devices on the screen.
: draw-devices
: draw-devices ( x y -- x y )
2dup at-xy
devices f@ f>s dup
1 1 at-xy
clear-line
1 = if ." There is 1 device in the javapool." drop else
." There are " . ." devices in the javapool." then
space print-rate ;
space print-rate
\ increment y position
inc-y ;
\ draw-constructs draws the option for building a construct
: draw-constructs
: draw-constructs ( x y -- x y )
2dup at-xy
clear-line
constructcost @ dup !0= if
." (b)uild a device-throwing construct [" . ." Devices]"
@ -197,22 +210,30 @@ S" you feel like throwing some stuff into the pool." set-message
else drop then ;
\ draw-members draws the option for hiring a chat member
: draw-members
: draw-members ( x y -- x y )
2dup at-xy
clear-line
membercost @ dup !0= if \ if membercost is non-zero (members have been unlocked)
." (h)ire a chat member [" . ." Devices]"
space ." (" membercount @ 0 .R ." )"
else drop then ;
else drop then
inc-y ;
\ draw-actions draws a list of the actions you've unlocked.
: draw-actions
1 4 at-xy
2dup at-xy
draw-members cr 1 move-right
draw-constructs cr 1 move-right
." (q)uit (without saving)" ;
." (q)uit (without saving)"
\ add 1 to y
1 + ;
\ clear-xy clears the x and y positions from the stack
: clear-xy ( x y -- ) drop drop ;
\ draw-screen redraws the screen, but only if there's been a change.
: draw-screen any-change? if draw-devices draw-actions draw-message clear-all then ;
\ 1 1 is the starting position to draw from.
: draw-screen any-change? if 1 1 draw-message draw-devices draw-blank draw-actions clear-xy clear-all then ;
\ : draw-screen clear-all ;
\ main game loop