\ 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