Just for fun I put a BMP image of the start screen of the +2 in my Tom Tom for one more retro computer fix at work!
Wednesday, 27 June 2012
Saturday, 9 June 2012
Drone Bomber and Surround for the Fignition.
Hi I have just discovered that I did not publish this when I had completed this programme back in February.
I have been playing Julz's mini race game and have made some alterations, the game has sound and is only three blocks!
use left and right to guide the bomb to the bottom of the cavern without touching the sides.
9 run for a slow game.
5 seems a good challenge.
FIGsurround
I have made a surround game based on the Forth Surround Game on the Ace Resource site.
this simple game allows you to move in an area, after you move, a block will randomly appear thus limiting your next move, the more times you move the better your score.
( FIGsurround Carl Attrill 2012)
0 var man
0 var nm
0 var seed
0 var sc
0 var ca
: char 27 vram man @ + ic! 32 vram nm @ + ic! ;
: seedon seed @ 75 u* 75 0 d+ over over u< - - 1 - dup seed ! ;
: blob 160 vram ca @ + ic! ;
: rnd seedon @ 75 u* swap drop ;
: set cls 22 1 do 1 i at 160 emit 23 i at 160 emit loop
24 1 do i 1 at 160 emit i 22 at 160 emit loop ;
: fin cls 5 10 at ." Score:" sc @ . quit ;
: dman vram man @ + ic@ 160 = if fin then ;
: dokey begin inkey dup 0 = if drop 0 else 1
then until
dup 8 = if man @ 1- man ! then
dup 11 = if man @ 25 - man ! then
dup 10 = if man @ 25 + man ! then
9 = if man @ 1 + man ! then
dman char man @ nm ! ;
: score sc @ 1 + sc ! 0 0 at sc @ . ;
: obs 4 rnd dup dup dup
0 = if vram man @ 1 + ca ! blob then
1 = if vram man @ 25 - ca ! blob then
2 = if vram man @ 24 + ca ! blob then
3 = if vram man @ 1 - ca ! blob then ;
: go 285 man ! 0 sc ! set char begin dokey obs dman score
99 = until ;
I have been playing Julz's mini race game and have made some alterations, the game has sound and is only three blocks!
use left and right to guide the bomb to the bottom of the cavern without touching the sides.
9 run for a slow game.
5 seems a good challenge.
I can complete it in setting 2!
listing here
: aud 64 191 42 >port> drop ;
: beep 0 69 ic! 71 ic! 7 and 69 ic! ;
27 var $s 32 var $r 9 var $z 5 var seed
0 var sc
: end 35 $r ! 24 $s ! ;
: df sc @ 100 = if 7 $z ! then
sc @ 150 = if 5 $z ! then
sc @ 175 = if 3 $z ! then
sc @ 200 = if 1 $z ! then
sc @ 206 = if 59 $r ! 00 $s ! then ;
: rnd seed @ 1= 75 * dup seed ! u* swap drop ;
: pause clock i@ + begin dup clock i@ - 0< until drop ;
: score 1 sc +! 0 0 at sc @ . ;
: fill 525 0 do 27 emit 21 255 beep loop ;
: flash 20 0 do fill cls 0 0 beep loop
8 12 at ." Hit!" 9 $z ! 27 $s ! 32 $r ! ;
: fail 21 100 beep 20 pause 21 200 beep
20 pause 0 0 beep 8 12 at ." Failed"
9 $z ! 27 $s ! 32 $r ! ;
: nupath 3 rnd 1- + o max 20 min 20 sc @ beep ;
0 var hit
: hit? 2dup 25 * + vram + ic@ hit ! ;
: path 24 23 at cr 25 0 do i over < over $z @
+ i < or $s @ and $r @ + emit loop 0 0 beep ;
: mv swap dup inkey dup 8 = swap 9 = 1 and + +
0 max 24 min dup 12 hit? at 29 emit swap 11 at
32 emit swap ;
: win hit @ 35 = if flash then
hit @ 59 = if fail then ;
: run cls 12 10 0 sc ! begin nupath path
mv df score >r over pause r> hit @ 32 = 0 = until
win ;
: aud 64 191 42 >port> drop ;
: beep 0 69 ic! 71 ic! 7 and 69 ic! ;
27 var $s 32 var $r 9 var $z 5 var seed
0 var sc
: end 35 $r ! 24 $s ! ;
: df sc @ 100 = if 7 $z ! then
sc @ 150 = if 5 $z ! then
sc @ 175 = if 3 $z ! then
sc @ 200 = if 1 $z ! then
sc @ 206 = if 59 $r ! 00 $s ! then ;
: rnd seed @ 1= 75 * dup seed ! u* swap drop ;
: pause clock i@ + begin dup clock i@ - 0< until drop ;
: score 1 sc +! 0 0 at sc @ . ;
: fill 525 0 do 27 emit 21 255 beep loop ;
: flash 20 0 do fill cls 0 0 beep loop
8 12 at ." Hit!" 9 $z ! 27 $s ! 32 $r ! ;
: fail 21 100 beep 20 pause 21 200 beep
20 pause 0 0 beep 8 12 at ." Failed"
9 $z ! 27 $s ! 32 $r ! ;
: nupath 3 rnd 1- + o max 20 min 20 sc @ beep ;
0 var hit
: hit? 2dup 25 * + vram + ic@ hit ! ;
: path 24 23 at cr 25 0 do i over < over $z @
+ i < or $s @ and $r @ + emit loop 0 0 beep ;
: mv swap dup inkey dup 8 = swap 9 = 1 and + +
0 max 24 min dup 12 hit? at 29 emit swap 11 at
32 emit swap ;
: win hit @ 35 = if flash then
hit @ 59 = if fail then ;
: run cls 12 10 0 sc ! begin nupath path
mv df score >r over pause r> hit @ 32 = 0 = until
win ;
0 var man
0 var nm
0 var seed
0 var sc
0 var ca
: char 27 vram man @ + ic! 32 vram nm @ + ic! ;
: seedon seed @ 75 u* 75 0 d+ over over u< - - 1 - dup seed ! ;
: blob 160 vram ca @ + ic! ;
: rnd seedon @ 75 u* swap drop ;
: set cls 22 1 do 1 i at 160 emit 23 i at 160 emit loop
24 1 do i 1 at 160 emit i 22 at 160 emit loop ;
: fin cls 5 10 at ." Score:" sc @ . quit ;
: dman vram man @ + ic@ 160 = if fin then ;
: dokey begin inkey dup 0 = if drop 0 else 1
then until
dup 8 = if man @ 1- man ! then
dup 11 = if man @ 25 - man ! then
dup 10 = if man @ 25 + man ! then
9 = if man @ 1 + man ! then
dman char man @ nm ! ;
: score sc @ 1 + sc ! 0 0 at sc @ . ;
: obs 4 rnd dup dup dup
0 = if vram man @ 1 + ca ! blob then
1 = if vram man @ 25 - ca ! blob then
2 = if vram man @ 24 + ca ! blob then
3 = if vram man @ 1 - ca ! blob then ;
: go 285 man ! 0 sc ! set char begin dokey obs dman score
99 = until ;
Subscribe to:
Posts (Atom)
