include graphs \ This is a comment.
include addANS ( And this is a comment.)
use random
16 constant size
320 size - constant xmax \ Max. x of ball's upper left corner.
200 size - constant ymax \ Max. y of ball's upper left corner.
0 0 2variable ball \ Location of ball.
0 0 2variable hole \ Location of hole.
\ Draw a square.
: square ( x y color -- ) \ Receive x,y, & color on the stack; leave nothing
\ on the stack.
color ! \ Set color.
dup size + swap do \ Loop from y to y+size-1.
dup i over size + 1- i line \ i is the index of this loop.
loop drop ( Discard x.) ;
\ Move the "ball".
: slide ( dx dy -- ) \ This word gets delta-x & delta-y on the stack.
ball 2@ \ Fetch ball's x and y.
( dx dy x y ) \ What stack now holds.
rot + \ Bring up dy and add to y.
( dx x newy)
0 max ymax min \ Force y within bounds.
-rot + \ Move y down and increment x.
0 max xmax min \ Force x within bounds.
swap ball 2! ; \ Store ball's location.
\ Show ball and hole.
: display ( oldx oldy -- )
gray square \ Erase ball at old location.
hole 2@ black square
ball 2@ red square ;
\ This word will create the words that respond when the directional
\ keys are pressed. If a created word sees that the character on the
\ stack matches its name, it springs into action.
: dir ( dx dy "name" -- )
\ This part defines a new word and stores its data.
>in @ \ Save position in parse buffer.
create \ Define a word whose name is the next word in the input stream.
>in ! \ Restore position in parse buffer.
char , \ Reparse the name (letter), get ASCII value, and store it.
2, \ Store dx and dy.
\ This part is what the created word does. When the word is executed,
\ the address of its storage area is put on the stack.
does> ( char adr -- char)
over over ( char adr char adr)
@ = \ Is character on stack the same as stored character?
if cell+ 2@ ( char dx dy) slide else drop then ( char) ;
0 -1 dir e
-1 0 dir s
0 1 dir x
1 0 dir d
-1 -1 dir w
-1 1 dir z
1 1 dir c
1 -1 dir r
: might
Set-VGA320 ?Graph
ifnot ." No VGA display found." bye then
SetGraphMode
Gray FillWindow
xmax random ymax random hole 2!
xmax random ymax random ball 2!
0 0 display
begin
ball 2@ \ Put current ball location on stack.
ekey $FF and \ Get keypress.
e s x d w z c r drop \ Handle keypress.
display
ball 2@ \ Fetch ball's coordinates.
hole 2@ \ Fetch hole's coordinates.
d= \ d= instead of = because we're comparing a pair of numbers to
\ another pair (d= is also used to compare double-numbers).
until
SetTextMode ;
NoTraps
NoErrors
Build .\red-ball