uf-toys

toys and experiments with uf forth
git clone git://git.alexwennerberg.com/uf-toys
Log | Files | Refs | README

commit 8131409538ca93b7df16833613c66666add7801f
parent bbb00e2068af9a040c20f00140429707c6405e32
Author: alex wennerberg <alex@alexwennerberg.com>
Date:   Sun, 20 Nov 2022 11:43:16 -0800

add snake

Diffstat:
Asnake.fs | 65+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 65 insertions(+), 0 deletions(-)

diff --git a/snake.fs b/snake.fs @@ -0,0 +1,65 @@ +\ pretty much a 1-1 rewrite of devine's snake program, somewhat simplified. +\ Only sort-of idiomatic forth for this reason + +variable arena-w variable arena-h variable timer +variable apple-x variable apple-y +\ snake vars +variable direction variable length variable dead +variable snake-x variable snake-y variable tail + +\ button values after shifting +1 constant up 2 constant down 4 constant left 8 constant right + +\ Lower == harder +4 constant difficulty + +hex +create sbody 7eff , ffff , ffff , ff7e , +create shead 7eff , ffff , ffff , ff7e , +create apple 0000 , 76ff , ffff , 7e3c , 1008 , 0000 , 0000 , 0000 , +decimal + +: 8/ ( u1 -- u2 ) 3 rshift ; +: 8* ( u1 -- u2 ) 3 lshift ; +: 0! ( a -- ) 0 swap ! ; +: 1+! ( a -- ) 1 swap +! ; +: 1-! ( a -- ) -1 swap +! ; + +/* create tail 32 32 * alloc */ + +: add-apple rnd arena-w @ umod apple-x ! rnd arena-h @ umod apple-y ! ; +: apple-collide? ( -- f ) snake-x @ apple-x @ = snake-y @ apple-y @ = and ; +: draw-apple ( color -- ) apple spritedata apple-x @ 8* apple-y @ 8* position sprite ; +: draw-snake ( color -- ) snake-x @ 8* snake-y @ 8* position sbody spritedata sprite ; +: move +direction @ +\ TODO simplify +dup up = if snake-y @ 1- arena-h @ umod snake-y ! then +dup down = if snake-y @ 1+ arena-h @ umod snake-y ! then +dup right = if snake-x @ 1+ arena-w @ umod snake-x ! then +\ Broken ATM +dup left = if snake-x @ 1- arena-w @ umod snake-x ! then +drop +apple-collide? if add-apple then ; +; +: on-frame +timer 1+! +timer @ difficulty = if +0 draw-snake move 2 draw-snake h# 83 draw-apple +0 timer ! then brk +; + +: on-button jbutton 4 rshift dup 0<> if dup direction ! then drop brk ; + +: g-reset +0 draw-apple 0 draw-snake +dead 0! length 0! direction 0! 3 draw-snake add-apple ; + +: init +h# 0f7e h# 0fe6 h# 0f62 colors +h# 00c8 h# 0100 2dup screensize! 8/ swap 8/ arena-w ! arena-h ! +g-reset ; + +: boot init ['] on-frame svector ['] on-button jvector brk bye ; + +save foo.rom bye