javapool/main.fs

\ 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
\ 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 ;

\ 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 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
		10 membercost ! 
		S" A friendly townie wants to help out." set-message then ;
		
: unlock-constructs
	devices f@ ftrunc 30e f= constructcost @ 0= and if
		40 constructcost ! 
		S" You figure out that you can probably hack these devices." set-message then ;
				
\ the word unlock tests to see if any unlock conditions are matched, and unlocks them if they are.
: unlock unlock-members unlock-constructs ;

\ the word wait-tick waits a tick. Ticks are 1ms currently.
: wait-tick   1 ms ; 

\ 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 ; 

\ 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 can-afford? tests if you could afford n devices.
: can-afford? ( n -- flag ) s>f devices f@ f<= ;

\ the word pay pays an amount of devices
: pay ( n -- ) s>f devices f@ fswap f- devices f! ;

\ the word hire-chat-member hires a chat member.
: hire-chat-member 
	membercost @ dup !0= swap \ checks if member cost is nonzero, leaving member cost on the stack
  	can-afford? \ tests if the member cost (converted to a float) is less than the amount of devices we have
	and if
		membercost @ pay
		1 membercount +! \ add a member to the count
		membercount @ 2 * 5 + membercost +! \ increase the cost of buying a new member
		membercost 1 changed
		S"  " set-message \ blank the message, because we did a thing.
		then ;
		
\ the word build-construct builds a construct.
: build-construct
	constructcost @ dup !0= swap \ checks if member cost is nonzero, leaving member cost on the stack
    can-afford? \ tests if the member cost (converted to a float) is less than the amount of devices we have
	and if
		constructcost @ pay \ remove devices that pay for the construct
		1 constructcount +! \ add a construct to the count
		constructcount @ 4 * 10 + constructcost +! \ increase the cost of buying a new construct
		constructcount 1 changed
		S"  " set-message \ blank the message, because we did a thing.
		then ;
		

\ the word handle-input handles input every time around the game loop.
: handle-input 
    key? if key case 
        [char] q of exit-game endof
        [char] h of hire-chat-member endof
        [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 
	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-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-actions draws a list of the actions you've unlocked.
: draw-actions
	2dup at-xy
	draw-members cr 1 move-right
	draw-constructs cr 1 move-right
	." (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.
\ 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
: game-loop  begin wait-tick game-tick handle-input draw-screen 0 until ;

\ 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 ;

\ for use in the debugging shell
: restart page game-loop ;

\ clear the screen and start the game
page hide-cursor game-loop