I recently tried to rewrite the MacHack PONG in the XO firmware. I'd just read Thinking Forth so I didn't like the code in PONG.FTH: I wanted there to be one screenful of code for each important section (showing the score, taking keyboard input, etc). Then I'd be comfortable with writing the two-line feature that Mitch Bradley had suggested adding.
What really happened is that I had a lot of fun, learned a lot of Forth, didn't finish the game, and made absolutely no useful contribution to the PONG on the XO. Not too bad as far as failures go. :-)
Anyway I'm an old Amiga guy so I wanted the game logic to execute in lock-step with the screen refresh, and since the vertical blanking period is very short I used double-buffering to avoid flicker:
\ PONGDBUF.FTH: Simple double-buffer support.
: db-fill-rectangle ( col x y w h -- )
rot screen-height + -rot ( col x y' w h -- )
fill-rectangle
;
: wait-vblank ( -- )
gp-wait-ready
0 0 wh! 0 0 dst! 0 0 src!
h# 6000.00cc ropmode!
h# 400 blt!
;
: db-blit ( -- )
wait-vblank
0 screen-height 0 0 screen-width screen-height 20 - gp-move
;
And with lots of effort I did eventually manage to draw the score
using only a screen of code, though I reckon it should have been
simpler and more direct:
\ PONGSCOR.FTH: Text drawing
decimal
h# ffff constant fg
h# 0000 constant bg
" ****. *.****.****.* *.****.* .****.****.****."
" * *. *. *. *.* *.* .* . *.* *.* *." $cat2
" * *. *. *. *.* *.* .* . *.* *.* *." $cat2
" * *. *.****.****.****.****.****. *.****.****." $cat2
" * *. *.* . *. *. *.* *. *.* *. *." $cat2
" * *. *.* . *. *. *.* *. *.* *. *." $cat2
" ****. *.****.****. *.****.****. *.****. *." $cat2
" --------------------------------------------------" $cat2 drop
constant drawing-instructions
variable ip variable xloc variable yloc
: fill-box ( color -- ) xloc @ yloc @ 10 10 db-fill-rectangle ;
: draw-digit ( x y digit )
10 mod 5 * drawing-instructions + ip !
yloc ! xloc !
begin ( Empty )
ip @ c@ dup case
ascii * of 1 ip +! fg fill-box 10 xloc +! endof
bl of 1 ip +! bg fill-box 10 xloc +! endof
ascii . of 46 ip +! -40 xloc +! 10 yloc +! endof
endcase
ascii - = until
;
: draw-score ( x y score )
>r 2dup swap 50 + swap ( x y x' y r: score )
r@ draw-digit ( x y r: score )
r> 10 / draw-digit
;
hex
Drawing the board, bats, and ball was no problem at all:
\ PONGDRAW.FTH: Drawing non-text graphics
decimal
: units ( n -- n ) 20 * ;
: unit ( n -- n ) units ;
: draw-ball ( x y -- ) fg -rot 1 unit 1 unit db-fill-rectangle ;
: draw-bat ( x y -- ) fg -rot 1 unit 6 units db-fill-rectangle ;
: draw-bat1 ( y -- ) 1 unit swap draw-bat ;
: draw-bat2 ( y -- ) screen-width 2 units - swap draw-bat ;
: draw-score1 ( score -- ) 100 40 rot draw-score ;
: draw-score2 ( score -- ) screen-width 200 - 40 rot draw-score ;
: draw-centerline ( -- )
fg screen-width 10 - 2 / 40 10 screen-height 80 - db-fill-rectangle
;
: draw-boundary ( y -- ) >r fg 0 r> screen-width 20 db-fill-rectangle ;
: draw-boundaries ( -- ) 0 draw-boundary screen-height 20 - draw-boundary ;
: fill-screen ( color -- ) 0 0 screen-width screen-height db-fill-rectangle ;
: draw-screen ( bat1-y bat2-y ball-x ball-y score1 score2 -- )
bg fill-screen draw-boundaries draw-centerline
draw-score2 draw-score1
draw-ball draw-bat2 draw-bat1
;
: test-draw-screen ( -- ) 200 500 800 500 72 48 draw-screen ;
hex
The keyboard code fits in one screen but it's the one part I mostly borrowed from the original:
\ PONGKDB.FTH: Keyboard input
decimal
0 value key_esc 0 value key_off
0 value key_left_down 0 value key_left_up
0 value key_right_down 0 value key_right_up
: initkeys ( -- ) " stdin @ iselect ' get-scan 0 alarm iunselect" eval ;
: restorekeys ( -- ) " stdin @ iselect ' get-scan 10 alarm iunselect" eval ;
: clear-key-states ( -- )
false to key_esc false to key_off
false to key_left_down false to key_left_up
false to key_right_down false to key_right_up
;
0 value e0-seen?
: set-key-states ( down? station )
dup . dup 1 = if abort" quit" then case
h# 65 of e0-seen? if to key_right_up else to key_left_up then endof
h# 66 of e0-seen? if to key_right_down else to key_left_down then endof
h# 69 of to key_esc endof \ lower left game button
h# 2a of to key_left_up endof \ shift-left
h# 5b of to key_left_down endof \ hand-left
h# 36 of to key_right_up endof \ shift-right
h# 5c of to key_right_down endof \ hand-right
h# 5d of to key_esc endof \ square
h# 1 of to key_off endof \ ESC scancode
endcase
;
: scan-keyboard ( -- )
clear-key-states
begin " get-data?" stdin @ $call-method while ( scancode )
dup h# e0 = if
drop true to e0-seen?
else
set-key-states 0 to e0-seen?
then
repeat
;
hex
And then the game logic itself -- well, that's where I stopped,
because I got stuck chasing a bug that somehow locked up the keyboard
soon after the game starts:
\ PONGGAME.FTH: Game state
decimal
variable bat1-y variable bat2-y variable ball-x variable ball-y
variable ball-dx variable ball-dy
42 value score1 0 value score2
: step-ball ( -- ) ball-dx @ ball-x +! ball-dy @ ball-y +! ;
: game-draw ( -- )
bat1-y @ bat2-y @ ball-x @ ball-y @ score1 score2 draw-screen
;
: game-loop ( -- )
begin
scan-keyboard
key_left_up if -10 bat1-y +! then
key_left_down if 10 bat1-y +! then
key_right_up if -10 bat2-y +! then
key_right_down if 10 bat2-y +! ascii x emit then
\ 3 ball-x +! 1 ball-y +!
game-draw db-blit
random d# 10000 mod 0= if 1 to key_off then
key_off until
;
: pong-display-test ( -- )
d# 100 0 do test-draw-screen db-blit loop
;
: pong-game ( -- )
initkeys game-loop restorekeys
;
hex
There it ends, and I'll never finish it now that I'm having more fun programming in Etoys. So it goes! | 
![[info]](http://l-stat.livejournal.com/img/userinfo.gif){kind=small}
lukego's journal
![[info]](http://l-stat.livejournal.com/img/openid-profile.gif){kind=small}