\ "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 fg a> attr! 2dup at-xy 36 emit \ \$ fg a> attr! 2swap ; : endgame ( -- ) fg a> attr! s" clear" system s" Your score: " type index @ 10 * . cr bye ; : init ( -- ) 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 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