366 lines
12 KiB
Forth
366 lines
12 KiB
Forth
\ JAVAPOOL - THE GAME (an incremental game based on the lore of #javapool on tilde.town)
|
|
\ this code likely sucks, because I'm bad at forth and figuring stuff out as I go.
|
|
\ written for 64-bit gforth, might be portable to other forths with some tweaking, idk.
|
|
|
|
include debug.fs
|
|
|
|
\ ANSI escape sequences. gforth already provides at-xy and page, but I also need a word for clearing the current line and displaying the cursor.
|
|
: hide-cursor esc[ ." ?25l" ;
|
|
: show-cursor esc[ ." ?25h" ;
|
|
: clear-line esc[ ." K" ;
|
|
: move-right ( x -- ) esc[ 0 .R ." C" ; \ 0 .R : print a number without trailing space
|
|
|
|
|
|
\ some of these values (member cost, device count) have two cells.
|
|
\ the second cell is used to store if the value has changed or not.
|
|
\ for flexibility, these all take an offset of the cell the flag is stored in, so multiple values can be before the flag.
|
|
\ this is useful as it means we only redraw the display if a relevant value has changed.
|
|
\ the word "changed" sets one of these values as being changed.
|
|
: changed ( addr offset -- ) cells + -1 swap ! ;
|
|
\ the word "cleared" sets one of these values as having been used, clearing the change flag.
|
|
: cleared ( addr offset -- ) cells + 0 swap ! ;
|
|
\ the word changed? leaves a -1 if the value has changed since last clear, 0 otherwise.
|
|
: changed? ( addr offset -- flag ) cells + @ ;
|
|
|
|
\ the variable "devices" holds the amount of devices currently in the pool. It has two values a change flag.
|
|
\ The first value contains the current number of devices, the second contains the number of devices in the previous tick.
|
|
\ (this is used to determine if the change flag needs to be set)
|
|
\ It begins with the change flag set, to draw the screen the first time.
|
|
\ this variable can contain decimal-point amounts of devices. Things that need a non-decimal amount can round it with ftrunc.
|
|
create devices 0e f, -1 ,
|
|
\ old devices is the old device count. For convenience.
|
|
: old-devices devices float + ;
|
|
|
|
\ d/s converts a devices per second value into devices per tick.
|
|
: d/s 1000e f/ ;
|
|
|
|
\ the variable "base-speed" is the base amount of devices added per tick.
|
|
variable base-speed
|
|
0.5e d/s base-speed f!
|
|
\ the variable "membercost" is the cost of hiring a new chat member. If it is zero, hiring chat members hasn't been unlocked yet. It has a change flag and is fixed-point.
|
|
create membercost 0 , 0 ,
|
|
\ the variable "membercount" is how many chat members you've hired. For each chat member, device gain delay decreases.
|
|
variable membercount
|
|
\ the variable "constructcost" is how expensive a construct is. Follows the same rules as membercost.
|
|
create constructcost 0 , 0
|
|
\ the variable "constructcount" follows the same rules as membercount, but for constructs.
|
|
variable constructcount
|
|
\ count-messages-shown contains the amount of device count milestone messages that have been shown.
|
|
variable count-messages-shown
|
|
\ the variable detector-unlocked stores if the metal detector has been unlocked.
|
|
variable detector-unlocked
|
|
\ the variable screen contains the current screen number.
|
|
\ 0 = devices
|
|
\ 1 = garden
|
|
\ the rest are TBA
|
|
variable screen
|
|
0 screen !
|
|
\ variable screens contains the highest unlocked screen number.
|
|
variable screens
|
|
0 screens !
|
|
\ message contains a string message which is printed on the screen.
|
|
\ because forth is weird, strings can be stored in variables but it's easier to just store them someplace else and then store that address and the string's length in the variable (this is what S" " does and what "type" expects)
|
|
create message 0 , 0 , 0 ,
|
|
\ set-message sets the message
|
|
: set-message ( addr len -- ) message ! message 1 cells + ! message 2 changed ;
|
|
\ get-message gets the message
|
|
: get-message ( -- addr len ) message @ message 1 cells + @ swap ;
|
|
|
|
\ the map! It's a character array. Every mapize entries is a new row.
|
|
16 constant mapsize
|
|
create map mapsize mapsize * allot
|
|
map mapsize mapsize * 46 fill
|
|
|
|
\ "location" takes an x and y and returns the address of that position in the map. 0-indexed.
|
|
: location ( x y -- a )
|
|
mapsize * + map + ;
|
|
|
|
\ set an initial message
|
|
S" you feel like throwing some stuff into the pool." set-message
|
|
|
|
\ f+! is +! for floats
|
|
: f+! ( addr -- ) ( F: r -- ) dup f@ f+ f! ;
|
|
|
|
\ any-change? leaves a -1 on the stack if any value has changed, 0 otherwise
|
|
: any-change? ( -- flag ) membercost 1 changed? devices 2 changed? message 2 changed? or or ;
|
|
\ clear-all clears the change flag on all values.
|
|
: clear-all membercost 1 cleared devices 2 cleared message 2 cleared ;
|
|
\ the word !0= tests if something is non-zero
|
|
: !0= ( n -- flag ) 0= 0= ;
|
|
\ 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
|
|
5 devices can-afford? membercost @ 0= and if
|
|
10 membercost !
|
|
S" A friendly townie wants to help out." set-message then ;
|
|
|
|
: unlock-constructs
|
|
30 devices can-afford? constructcost @ 0= and if
|
|
40 constructcost !
|
|
S" You figure out that you can probably hack these devices." set-message then ;
|
|
|
|
: unlock-detector
|
|
100 devices can-afford? detector-unlocked @ 0= and if
|
|
S" Somebody is tinkering with some devices. Says they can build a metal detector. " set-message
|
|
-1 detector-unlocked ! then ;
|
|
|
|
\ the word unlock tests to see if any unlock conditions are matched, and unlocks them if they are.
|
|
: unlock unlock-members unlock-constructs unlock-detector ;
|
|
|
|
\ the word wait-tick waits a tick. Ticks are 1ms currently.
|
|
: wait-tick 1 ms ;
|
|
|
|
\ devices/tick calculates the amount of devices that are to be added per tick.
|
|
: devices/tick ( f: -- r )
|
|
base-speed f@
|
|
membercount @ s>f 0.5e d/s f* \ each member adds 0.5 d/s
|
|
constructcount @ s>f 2e d/s f* \ each construct adds 2 d/s
|
|
f+ f+ ;
|
|
|
|
\ set-count-message sets the message to certain things based on the amount of devices in the pool. The count-messages-shown variable is used to track how many of these have already been shown.
|
|
: set-count-message
|
|
devices f@ ftrunc 50e f> count-messages-shown @ 1 < and if
|
|
S" The pool is starting to look a little cluttered. " set-message
|
|
1 count-messages-shown +!
|
|
then ;
|
|
|
|
\ update-devices updates the device count, setting the change flag as needed
|
|
: update-devices
|
|
devices f@ old-devices f! \ store old value of devices
|
|
devices/tick devices f+!
|
|
devices f@ ftrunc old-devices f@ ftrunc f= 0= if \ if devices has changed by an integer amount
|
|
devices 2 changed
|
|
then ;
|
|
|
|
|
|
\ the word game-tick runs a single tick of the game
|
|
: game-tick unlock update-devices set-count-message ;
|
|
|
|
\ TODO saving
|
|
\ the word exit-game exits the game.
|
|
: exit-game page show-cursor bye ;
|
|
|
|
\ the word pay pays an amount of a currency.
|
|
: pay ( n currency -- ) dup f@ swap s>f ( fswap ) f- f! ;
|
|
|
|
\ the word clear-message clears the onscreen message
|
|
: clear-message S" " set-message ;
|
|
|
|
\ the word hire-chat-member hires a chat member.
|
|
: hire-chat-member
|
|
membercost @ dup !0= swap \ checks if cost is nonzero, leaving member cost on the stack
|
|
devices can-afford?
|
|
and if
|
|
membercost @ devices pay
|
|
1 membercount +! \ add a member to the count
|
|
membercount @ 2 * 5 + membercost +! \ increase the cost of buying a new member
|
|
membercost 1 changed
|
|
clear-message
|
|
then ;
|
|
|
|
\ the word build-construct builds a construct.
|
|
: build-construct
|
|
constructcost @ dup !0= swap
|
|
devices can-afford?
|
|
and if
|
|
constructcost @ devices pay
|
|
1 constructcount +!
|
|
constructcount @ 4 * 10 + constructcost +!
|
|
constructcount 1 changed
|
|
clear-message
|
|
then ;
|
|
|
|
\ the word buy-detector buys the metal detector!
|
|
: buy-detector
|
|
400 devices can-afford? if
|
|
1 screens +! then
|
|
page ;
|
|
|
|
\ DEBUGGING STUFF
|
|
|
|
\ the word debug-console is used for entering debug mode.
|
|
: debug-console
|
|
page
|
|
." Entering debug/cheat shell. use `restart` to restart the game." cr
|
|
.s cr f.s
|
|
quit ;
|
|
|
|
|
|
\ the seconds, minutes and hours words are used with skip-time in debugging.
|
|
: seconds 1000 * ;
|
|
: second seconds ;
|
|
: minutes seconds 60 * ;
|
|
: minute minutes ;
|
|
: hours minutes 60 * ;
|
|
: hour hours ;
|
|
|
|
\ skip-time runs x game ticks without waiting. Used for debugging.
|
|
: skip-time ( t -- ) 0 do game-tick loop ;
|
|
|
|
\ END DEBUGGING STUFF
|
|
|
|
\ move screen moves forward/back x screens.
|
|
: move-screen ( x -- )
|
|
screen @ + dup dup
|
|
0 >= swap screens @ <= and if
|
|
page
|
|
screen !
|
|
else drop then ;
|
|
|
|
\ the word devices-input contains the input cases specifically for the device counter screen.
|
|
: devices-input
|
|
case
|
|
[char] h of hire-chat-member endof
|
|
[char] b of build-construct endof
|
|
[char] g of buy-detector endof
|
|
endcase ;
|
|
|
|
\ the word handle-input handles input every time around the game loop.
|
|
: handle-input
|
|
key? if key dup case
|
|
screen @ 0= if devices-input then
|
|
[char] q of exit-game endof
|
|
[char] D of debug-console endof
|
|
[char] > of 1 move-screen endof
|
|
[char] < of -1 move-screen endof
|
|
endcase then ;
|
|
|
|
\ inc-y increments the y coordinate being drawn at.
|
|
: inc-y 1 + ;
|
|
\ inc-x increments the x coordinate being drawn at.
|
|
: inc-x swap 1 + swap ;
|
|
|
|
\ print-rate prints the current device output rate on the screen.
|
|
: print-rate
|
|
2 set-precision
|
|
\ first convert to floating point, divide by 1000 to get seconds from milliseconds, then do 1/n to get the devices/second from seconds/device
|
|
." (" devices/tick 1000e f* f. ." devices/second)" ;
|
|
|
|
: draw-screen-name ( i -- )
|
|
case
|
|
0 of ." Devices " endof
|
|
1 of ." Garden " endof
|
|
endcase ;
|
|
|
|
\ draw-tab-keys draws the keyboard bindings for switching screens.
|
|
: draw-tab-keys
|
|
." (use < and > to switch tabs) " ;
|
|
|
|
\ draw-tab-bar draws the tab bar. TODO make this into smaller words
|
|
: draw-tab-bar ( x y -- )
|
|
2dup at-xy
|
|
screens @ if \ 0 is false in forth, so if the number of screens is zero, don't draw the bar.
|
|
screens @ 1+ 0 do
|
|
i dup
|
|
screen @ = if
|
|
." >" bl
|
|
drop
|
|
then
|
|
draw-screen-name
|
|
loop inc-y
|
|
draw-tab-keys
|
|
then ;
|
|
|
|
\ draw-message draws the stored message on the screen.
|
|
: 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 ( x y -- x y )
|
|
2dup at-xy
|
|
devices f@ f>s dup
|
|
clear-line
|
|
1 = if ." There is 1 device in the javapool." drop else
|
|
." There are " . ." devices in the javapool." then
|
|
space print-rate
|
|
\ increment y position
|
|
inc-y ;
|
|
|
|
\ draw-constructs draws the option for building a construct
|
|
: draw-constructs ( x y -- x y )
|
|
2dup at-xy
|
|
clear-line
|
|
constructcost @ dup !0= if
|
|
." (b)uild a device-throwing construct [" . ." Devices]"
|
|
space ." (" constructcount @ 0 .R ." )"
|
|
else drop then ;
|
|
|
|
\ draw-members draws the option for hiring a chat member
|
|
: 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
|
|
inc-y ;
|
|
|
|
: draw-detector ( x y -- x y )
|
|
detector-unlocked @ screens @ 0= and if
|
|
." (g)o metal detecting! [400 Devices]"
|
|
then inc-y ;
|
|
|
|
\ draw-map draws the map. TODO don't just ignore coords
|
|
: draw-map ( x y -- x y )
|
|
2dup at-xy
|
|
mapsize mapsize * 0 do
|
|
i map + c@ emit
|
|
i 1 + mapsize mod 0= if
|
|
cr over move-right then
|
|
loop ;
|
|
\ draw-actions draws a list of the actions you've unlocked.
|
|
: draw-actions ( x y -- x y )
|
|
2dup at-xy
|
|
draw-members cr over move-right
|
|
draw-constructs cr over move-right
|
|
draw-detector cr over move-right
|
|
." (q)uit (without saving)"
|
|
\ add 1 to y
|
|
inc-y ;
|
|
|
|
\ clear-xy clears the x and y positions from the stack
|
|
: clear-xy ( x y -- ) 2drop ;
|
|
|
|
\ draw-screen redraws the devices screen, but only if there's been a change.
|
|
\ ( x y -- )
|
|
: draw-devices-screen draw-message draw-devices draw-blank draw-actions ;
|
|
\ : draw-screen clear-all ;
|
|
|
|
\ TODO draw the garden, this is a stub
|
|
: draw-garden 2dup at-xy draw-map ;
|
|
|
|
\ 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
|
|
any-change? if
|
|
1 1 draw-tab-bar draw-blank draw-screen clear-xy clear-all
|
|
then
|
|
0 until ;
|
|
|
|
\ for use in the debugging shell
|
|
: restart page game-loop ;
|
|
|
|
\ clear the screen and start the game
|
|
page hide-cursor game-loop
|