\ "THE BEER-WARE LICENSE" (Revision 42):
\ Stefan Ehmann and Martin Uzak wrote this file. As long as you retain this
\ notice you can do whatever you want with this stuff. If we meet some day, and
\ you think this stuff is worth it, you can buy me a beer in return.
\ 
\ Original beerware license is due to Poul-Henning Kamp.

needs random.fs
needs ansi.fs

time&date + + + + + seed !

create snake rows 1- cols 1- 2 * * cells allot

variable index 0 index !

: push ( x y -- )
	\ snake[index] = x; 
	\ snake[index+1] = y;
	snake index @ 1+ cells + !
	snake index @ cells + !
	;

: grow ( -- )
	\ index += 2
	index @ 2 + index !
	;

: tail ( -- snake[0] snake[1] )
	\ return snake[0] and snake[1]
	\ shift every element in snake 2 steps nearer to the beginning
	snake 1 cells + @ >r
	snake 0 cells + @ >r
	index @ 0 u+do
		snake i 2 + cells + @ snake i cells + !
		snake i 3 + cells + @ snake i 1+ cells + !
	loop
	r> r>
	;

: xy= ( x y x0 y0 -- b )
	rot = -rot = and ;

: check-collision ( x y -- b )
	false
	index @ 2 / 0 u+do
	 	-rot 2dup 
	 	snake i 2 * cells + @
	 	snake i 2 * 1 + cells + @
		xy=
	 	-rot 2swap
	 	or
	loop

	-rot
	rows 1- over <= swap 0 <= or swap
	cols 1- over <= swap 0 <= or
	or or
	;

: create$ ( x y -- x2 y2 x y )
	begin
		cols 2 - random 1+
		rows 2 - random 1+
	 	2dup check-collision
		if
			2drop false
		else
			2over 2over xy= if 2drop false else true endif
		endif
	until

	<a yellow >fg a> attr!
	2dup at-xy 36 emit \ $
	<a red >fg a> attr!
	2swap
	;


: endgame ( -- )
	<a white >fg a> attr!
	s" clear" system
	s" Your score: " type index @ 10 * . cr
	bye ;

: init ( -- )
	<a cyan >fg a> attr!
	0 0 at-xy
	cols 0 u+do 35 emit loop
	rows 1- 1 u+do 35 emit cols 2 - spaces 35 emit loop
	cols 0 u+do 35 emit loop
	<a blink >fg a> attr!
	;

: worm ( x y -- )
	create$
	k-right >r
	begin
		2dup at-xy 42 emit \ paint snake
		2dup push
		0 0 at-xy s" Your score: " type index @ 10 * .
		2dup at-xy

		ekey? if
			ekey
			dup >r
		else
			r> dup >r
		endif
		100 ms

		dup
		case
		k-up of
			swap 1- swap
		endof
		k-left of
			rot 1- -rot
		endof
		k-down of
			swap 1+ swap
		endof 
		k-right of
			rot 1+ -rot
		endof
		113 of
			endgame
		endof
		drop 0 swap
		endcase
		
		if \ valid key-pressed?
			2dup check-collision
			if endgame endif

			2over 2over xy= if \ $ eaten
				grow 2drop create$
			else
				tail at-xy bl emit \ cleanup snake's tail
			endif
		endif
	again
	;

init
1 1 worm \ x y