\ Zapper - an interactive game for the N.I.G.E. \ (c)copyright by Gerald Wodni \ GPLv3 warm marker warm rows 1+ cols * 2* constant screen-size screen-size buffer: buffer1 screen-size buffer: buffer2 cols constant enemy-size enemy-size cells buffer: enemies 1 cells constant cell variable buffer buffer1 buffer ! \ set text cursor ' csr-x 7 + constant t-x ' csr-y 7 + constant t-y : t-xy! ( x y -- ) t-y ! t-x ! ; \ openGL-like double buffering ;) : swap-buffers ( -- ) buffer @ screenplace vwait ! buffer1 buffer2 + buffer @ - buffer ! ; \ restore graphics : exit-game ( -- ) screenbase screenplace ! ; \ define colorful chars : col-char ( col char -- ) create swap 256 * + , does> @ ; 4 250 col-char enemy 3 159 col-char player 7 char : col-char bullet \ keys \ system software: put thi in keyboard.f 4 constant up-key 6 constant left-key 7 constant right-key 27 constant esc-key rows 5 - constant player-y 260132 constant syscount \ game vars variable player-x cols 2 / player-x ! variable level-y 10 level-y ! variable level-counter 0 level-counter ! variable shot-x cols 2 / shot-x ! variable kills 0 kills ! variable alive -1 alive ! : bounds over swap + ; \ screen buffer access : xy ( x y -- addr ) cols * + 2* buffer @ + ; : xy! ( col-char x y -- ) xy w! ; : cls-buffer ( -- ) buffer @ screen-size 0 fill ; : flush-keys ( -- ) begin key? while key drop repeat ; \ update world : update ( -- ) \ move foes level-counter @ 0 = if level-y @ level-counter ! enemy-size 0 do enemies i cells + >r 1 r@ +! r@ @ rows > if 0 alive ! then r> drop loop else -1 level-counter +! then \ check if we hit something shot-x @ -1 <> if player-x @ player-y 0 do bullet over i xy! loop drop \ perform kill enemies shot-x @ cells + >r r@ @ 0 > if syscount @ 511 and negate r@ ! 1 kills +! then r> drop -1 shot-x ! then ; : draw ( -- ) enemy-size 0 do enemies i cells + @ 0 > if enemy i enemies i cells + @ xy! then loop player player-x @ player-y xy! 0 0 t-xy! ." Kills:" kills @ . ; : game ( -- ) \ init-game enemy-size 0 do syscount @ 511 and negate enemies i cells + ! loop begin cls-buffer update draw swap-buffers 50 ms \ handle keys key? if key case up-key of player-x @ shot-x ! endof left-key of player-x @ 1- 0 max player-x ! endof right-key of player-x @ 1+ cols 1- min player-x ! endof esc-key of 0 alive ! endof endcase then flush-keys alive @ 0= until exit-game cls ." You killed " kills @ . ." foes, congrats commander!" cr ; game