s" random.fs" required
: reload  s" forth/valleys.fs" included ;
: h  page CR
." VALLEYS v1.0 - (C) 2002 Erik Rossen <rossen@rossen.ch>" CR
." This program is placed in the PUBLIC DOMAIN." CR CR
." Goal: Go as far and as fast as you can without crashing into the valley walls." CR CR
."    Press 'j' to go LEFT" CR
."    Press 'k' to go RIGHT" CR
."    Press 'i' to go SLOWER" CR
."    Press 'm' to go FASTER" CR
."    Press 'q' to QUIT" CR CR
." Type 'h' [ENTER] to reprint this notice" CR
." Type 'v' [ENTER] to START" CR CR
." NOTE: This program was developed with Gforth 0.5 and, for the moment," CR
." only works with ANSI terminals." CR CR ;
27 Constant ESC
: scroll_region ( u1 u2 -- ) ESC[ pn ;pn [char] r emit ;
\ NOTE: u1 is the BOTTOM line of the scroll region, u2 is the TOP line of the scroll region, the very top line of the screen is number 0
: cursor_invisible  ESC[ ." ?25l" ;
: cursor_visible  ESC[ ." ?25h" ;
: fix_screen  cursor_visible rows 0 scroll_region ;

Variable clock Variable x Variable x_last Variable y Variable y_last Variable width Variable height Variable gap Variable n Variable s
: init_vars  0 clock !  1 y !  1 y_last !  cols width ! rows 3 - height !  5 gap !  40 n !  0 s ! ;
: height-1 ( -- u ) height @ 1 - ;
: s++  s @ 1+ s ! ;

Variable fifo Variable fifo_in_i Variable fifo_out_i Variable fifo_end Variable fifo_length
: fifo_next ( addr -- addr ) 1 cells + dup fifo_end @ > if drop fifo @ then  ;
: fifo_out_i++ fifo_out_i @ fifo_next fifo_out_i ! ;
: fifo_in_i++ fifo_in_i @ fifo_next fifo_in_i ! ;
: dx_rand+ ( u -- u ) 3 random 1- + width @ gap @ - 2 - min 0 max ;
: new_row  fifo_out_i @ @ dx_rand+ fifo_out_i++ fifo_out_i @ ! ;
: .addr,cell ( addr -- ) CR dup . ? ;
: fifo_dump  fifo @ begin dup .addr,cell fifo_next dup fifo_end @ = until ; 
: init_fifo 
height-1 fifo_length !
fifo_length @ cells allocate throw fifo !
fifo @ fifo_length @ 1- cells + fifo_end !
fifo @ fifo_in_i !
fifo_end @ fifo_out_i !
width @ random fifo_out_i @ ! ;

: draw_row  fifo_out_i @ @ height-1 1- 2dup at-xy CR at-xy ." *" gap @ spaces ." *" ;
: init_screen  page height-1 0 scroll_region cursor_invisible
fifo_length @ begin draw_row new_row 1- dup 0= until drop ;
: init_ship  fifo_in_i @ @ gap @ 2 / + 1+ dup x ! x_last ! ;
: init  init_vars init_fifo init_screen init_ship ;
: tick  1 clock +! ;
: nth_tick? ( -- flag ) clock @ n @ mod 0 = ;
: end_game ( char -- ) fix_screen 0 height @ at-xy quit ;
: act_left ( char -- ) [char] j = if -1 x @ + 0 max x ! then ;
: act_right ( char -- ) [char] k = if 1 x @ + width @ 1 - min x ! then ;
: act_slower ( char -- ) [char] i = if n @ 3 * 2 / n ! then ;
: act_faster ( char -- ) [char] m = if n @ 2 * 3 / 1 max n ! then ;
: act_quit ( char -- ) [char] q = if end_game then ;
: handle_input  key? if key dup act_left dup act_right dup act_slower dup act_faster act_quit then ;
: show_status  0 height @ at-xy ." DIST:" s ? ."   TIME:" clock @ 100 / . ;
: show_verbose  0 height @ at-xy x ? ."   " clock ? 10 spaces fifo_in_i @ fifo @ - 4 / . 2 spaces fifo_out_i @ fifo @ - 4 / . ;
: (draw_ship)  x @ y @ at-xy ." V" ;
: (erase_ship)  x_last @ y_last @ at-xy ."  " ;
: draw_ship  x @ x_last @ <> if (erase_ship) (draw_ship) x @ x_last ! then ;
: more_valley  nth_tick? if s++ fifo_in_i++ (erase_ship) draw_row (draw_ship) new_row show_status then ;
: crash? ( -- flag ) fifo_in_i @ @ x @ >= fifo_in_i @ @ gap @ + x @ < or ;
: crash  x @ y @ at-xy ." X" end_game ;
: v  init (draw_ship) begin tick handle_input draw_ship more_valley crash? if crash then 10 ms again ; 
h