fignition‎ > ‎

Examples

Since FIGnition is a real (though simple) computer, it can run real software and there are a number of example programs that can be run!

Contents:

 Page 1
 Page 2
  1. Lunar Lander
  2. UDG Graphics Demo
  3. Timeout and EEPROM access
  4. Circles
  5. Noughts And Crosses (aka Tic-Tac-Toe).
  6. Line Drawing
  7. Conways Life
  8. Simple UDG Game Engine
  9. Forth Debugger.
  10. Mini Car Race
  11. Two Player Chess
  12. Brikky (A Breakout clone), With Audio.
  13. Maze Generator.
  1. Primes
  2. Calendar
  3. Pong
  4. i2c
  5. FIGgyBird
  6. Scientific Functions

Luna: A Lunar Lander

To begin with, here's a simple interactive version of Lunar Lander, called Luna. It's a bitmapped version of the game which was supposed to have been delivered to the BBC along with kit, but wasn't ready in time. It demonstrates that you can write a simple interactive bitmapped - i.e. sprite-based game and that the Forth system is capable of supporting 'real' development. Since this is the first available program for FIGnition I've supplied it as a listing too:

( ...*.*.. ******** )
( ....*... ..**..** )
( .******. .**..**. )
( **.**.** **..**.. )
( *..**..* *..**..* )
( ******** ..**..** )
( .*....*. .**..**. )
( ***..*** ******** )

( .**..**. ........ )
( .**..**. ........ )
( ..****.. ........ )
( ...**... ........ )
( ........ ........ )
( ........ ........ )
( ........ ........ )
( ........ ........ )
.
create sprites
$FF33 , $66CC , $9933 ,
$66FF , $1408 , $7EDB ,
$99FF , $42E7 , $6666 ,
$3C18 , $0000 , $0000 ,

: dvar
  <builds , ,
  does>
;

: d@ dup @ swap 2+ @ ;
: d! >r r 2+ ! r> ! ;
: hi@ 2+ @ ;

0 var fuel
0 var level
10 var x 5d dvar y
0 var ox 0d dvar oy
1 var drift 0d dvar vel
5000 const g
0 var gameover
17 var platform
64 const thrust

clock i@ var seed
: rnd ( range -- rnd )
  seed @ 1+ 75 * dup
  seed ! u* swap drop
;

160 bytes surface

 : regolith ( y end strt)
  do
    i over plot
    dup i surface c!
    2 rnd dup + 1- +
    151 min 120 max
  loop
; ( -- y')

: landscape
  126 rnd 1+
  dup platform !
  32 rnd 120 + 1 pen
  over 0 regolith
  over surface over 32
  swap fill
  2dup at
  0 $808 3 0 blts
  160 rot 32 +
  regolith drop
;

: velo
  vel d@ 100 u* drop
  swap 100 u* swap drop
  +
;

: status
  40 0 at fuel @ 3 .r
  120 0 at velo 4 .r
;

: init
  level @ 1+ dup level !
  dup 30 * rnd neg
  500 + 100 max fuel !
  dup 2 * rnd swap -
  dup 0= - drift !
  -8 dup ox ! 0d oy d!
  128 rnd 16 + x !
  0 20 y d! 0 gameover !
  sprites $1808 0 tile
;

 : wrapBlt ( t dim x y--)
  dup -7 < if
    and and and drop ;s
  then
  over 152 > if
    over 160 - over at
    >r >r 2dup blt
    r> r>
  then
  at blt
;

: mvship
  1 $808 2dup
  x @ y hi@ wrapBlt
  ox @ oy hi@ wrapBlt
;

: flame
  x @ y hi@ 8 + at
  2 $808 blt ( erase)
;

: decFuel
  g dup + neg -1
  vel d@ d+ vel d!
  -1 fuel +!
;

: wrapX ( x -- wrappedX)
  dup 0< if
    160 +
  else
    dup 159 > if
      160 -
    then
  then
;

sysvars 11 + const joy

: doKey
  joy ic@ thrust and
  0= 0= fuel @ 0 >
  and dup if
   decFuel
  then
  drift @ x @ +
  wrapX x !
;

: within ( n min max--f)
  >r 1- over < swap
  r> < and
;

 : landing?
  y hi@ 8 +
  x @ dup platform @
  dup 24 + within if
    surface c@ 2dup 1-
    > if
      9 + < velo 200 <
      and 2+ gameover !
    else
      drop drop
    then
  else
    surface c@ > if
      2 gameover !
    then
  then
;

: doVel
   vel d@ y d@ d+ y d!
   vel d@ g 0 d+ vel d!
   landing?
;

: frame ( thrust)
  if flame then
  doKey doVel mvship
  status
  clock i@ 2 and and
  dup if flame then
; ( -- thrust')

: luna
  1 vmode cls
  init
  ." Fuel      Vel"
  landscape 0
  begin
    frame
    x @ ox ! y d@ oy d!
    0 pause
  gameover @ until
  drop 40 80 at
  gameover @ 1 = if
    ." WELL DONE!"
  else
    ." CRASH!!!!"
  then
  inkey drop
  key drop 0 vmode
;


Your Lunar lander is heading for the moon as it drifts along; guide it down gently to the landing pad using space (SW7) to provide thrust if necessary. Your Lunar lander will crash if you hit the regolith or hit the landing pad at a velocity over 200! Be careful not to send the craft out of orbit!!!!!!!!!!

     

Luna!


Graphics Demo

FIGnition is fast enough to handle a large number of moving graphic characters entirely in Forth. This simple demonstration moves a number of UDGs randomly around the screen while displaying the frame rate. 20 UDGs can be animated at 36 frames per second and up to 81 at least 10 frames per second. You run the demonstration with e.g. 20 gdem and then you can interactively increase or decrease the number of UDGs by pressing cursor right or left, and finally quit by pressing space.

 ( Block 1)
5 var seed
: rnd ( range -- random )
  seed @ 1+ 75 * dup seed
  ! u* swap drop
;

( graphic demo
  UDGs: Invader, mini
  pacman, mini-ghost,
  man, dog, quaver,
  Invader2, 8. )

: cdata <builds does> ;

: var[] <builds dup +
  allot does> over + + ;

2 base !
cdata udgs
00101000 c,
01111110 c,
11011011 c,
11111111 c,
10011001 c,
10100101 c,
00000000 c,
00000000 c, ( invader)

00111100 c,
01111110 c,
11111110 c,
11111000 c,
11110000 c,
11111110 c,
01111110 c,
00111100 c, ( pacman)

00111100 c,
11111111 c,
10010011 c,
10110111 c,
11111111 c,
11111111 c,
11011011 c,
01001001 c, ( ghost)

00111000 c,
00111000 c,
00010010 c,
11111110 c,
10010000 c,
00101000 c,
00101000 c,
00101000 c,

00000000 c,
00000000 c,
00000111 c,
10000111 c,
01111100 c,
01111000 c,
10000100 c,
01000100 c,

00000011 c,
00011111 c,
01111101 c,
01100001 c,
01000011 c,
01000011 c,
11000000 c,
11000000 c,

00011000 c,
00111100 c,
00011000 c,
00111100 c,
01111110 c,
11011011 c,
11111111 c,
00011000 c,


10000000 c,
11100000 c,
11110000 c,
11111100 c,
10110000 c,
00011000 c,
00001100 c,
00000110 c,

decimal

: udg
  8 * vram + 600 +
;

: initudg ( src dst num )
    8 * 0 do
       over c@ over ic!
       swap 1+ swap 1+
    loop
    drop drop
;

: tudgs ( addr -- )
   8 0 do
      i over ic!
      2 +
   loop
;
: scraddr ( x y )
  25 * + vram +
; ( 6 w )

100 const maxAnim
maxAnim var[] poz

: initpos ( lim )
   0 do
    vram 600 rnd + i poz
    ! loop ;


: range ( vramaddr -- )
  dup vram < if
    600 +
  then
  dup vram 599 + > if
    600 -
  then ;

: vcalc ( vramaddr -- )
  3 rnd 1 - 25 * + 3 rnd
  1 - + range ;

: udgmove ( lim -- )
  0 do
     i poz @ dup
     vcalc ( old new )
     swap 32 swap ic!
     i 7 and over ic!
     i poz !
  loop ;

: fps ( frms timo lim)
  >r swap 1+ swap
  dup clock i@ - 0< if
    0 0 at ." fps " drop
    . 0 ." #" r .
    clock i@ 49 +
  then r> ;
: doKey
  dup 9 = if
    drop 1+ maxAnim min 0
  then dup 8 = if
      drop 1 - 1 max 0
  then 32 = ;

: gdem ( initialUdgs )
  udgs 0 udg 8 initudg
  maxAnim initpos
  0 clock i@ 49 + rot
  begin
     dup udgmove fps
     inkey doKey until
  drop drop drop ;

A simple timeout command (note, we do a timeout by calculating timeout-clock<0, not timeout<clock since the subtraction followed by the 0< will in fact take care of overflow and wrap-around. The  maximum timeout ticks are limited to 32767 (about 10 minutes).

: setTimeout ( ticks -- timeout)
  clock i@ +
;

: timeout ( timeout -- boolean)

  dup clock i@ - 0<
;

Accessing the eeprom:

The AVR Microcontroller inside a FIGnition contains 512b (or 1024b) of non-volatile EEPROM memory. You can download data to it via USB using avrdude and read it by accessing the AVR's EEPROM registers. From Firmware 0.9.8 onwards you can write to it, using the 10 Kern vector and then read it back to another computer via USB and avrdude, which for the first time gives users the ability to transfer data in and out of a FIGnition.

$42 const eearh
$41 const eearl
$40 const eedr
$3F const eecr
2 const eepe
1 const eere

: eePrep
  begin
    eecr ic@ eepe and
  0= until
  dup 8 >> eearh ic!
  eearl ic!
;

 
: ec! ( value addr --)
  eePrep eedr ic!
  [ 10 kern , ]
;

: ec@ ( addr -- value)
  eePrep
  eere -2 eecr >port>
  drop eedr ic@
;


Drawing Circles!

The following few blocks uses a simple Bresenham Circle drawing algorithm to draw circles. You only really need the last 2 columns. It's quite quick, using roughly 100µs per point (a radius 23 circle can be drawn in <20ms).

( FIGnition Circles
 Method: we know
 x^2+y^2 = const.
 So, we start at [0,r],
    which gives r^2
 We can go straight up,
   which gives:
   [x^2+[y+1]^2] -
   x^2-y^2 =>
 a difference of +2y+1.
 Or we can do [x-1]^2 =>
   a diff of 1-2x.
 So, the rule is that
 when the accumulation
 of 2y+1>1-2x, then we do
  1-2x. )

 : nextp ( x y diff )
 ( calc with inc y )
 over dup + 1+ + >r
 over dup + 1- r>
 over over > if
   swap drop
 else
   swap - >r swap 1-
   swap r>
 then swap 1+ swap
;

: dxyplot ( cx cy dx dy)
  over over >r >r
  >r >r over r> +
  over r> + plot r> r> ;

 : octplot ( cx cy dx dy)
  4 0 do
    dxyplot swap
    dxyplot neg
  loop
; ( -- cx cy )

: circ ( x y r )
  0 ( dx=r, y=0)
  0 >r ( diff=0)
  begin
   octplot
   r> nextp >r
  over over < until r>
  drop drop drop drop
  drop ;
 : gTest1 ( circles)
  0 do
    2dup i circ
  2 +loop drop drop ;

: clg -3200 3200 0 fill
;

: hiCirc
 clg 1 vmode 1 pen
 79 79 79 gTest1
 key drop 0 vmode
;


Here's both a low resolution and high resolution demonstration of circ, the hi-res one being generated by running hiCirc.

Noughts And Crosses!

Here's a simple 'unbeatable' noughts and crosses game in only 5 screens and 554 bytes!



 ( Simple oxo block 0)
: 2drop drop drop ;

: .brdLine
  cr ." -+-+-" cr ;
 
: .board
  ." 1|2|3" .brdLine
  ." 8|X|4" .brdLine
  ." 7|6|5" ;

4 const opp
64 15 + const (o)
64 24 + const (x)

: cdata <builds does> ;

0 var board

( block 1)
cdata posConv
  0 c, 0 c, 1 c, 2 c,
  5 c, 8 c, 7 c, 6 c,
  3 c,
 
: pos2xy posConv + c@
  3 /mod 1 << swap
  1 << swap ;

: place ( pos ch -- f )
  over 1 swap << board @
  swap over or
  2dup = if ( pc old nu )
      2drop 2drop 0
  else
    swap drop board !
    swap pos2xy at emit
    1
  then ;
              
 ( block 2 )
: range? (val lo hi --
                val | 0 )
  rot swap over <
  >r swap over > r> or
  if
      drop 0
  then
;

: humPlay
  0 begin drop
    begin
        key 49 57 range?
    dup until
    48 - dup (o) place
  until
;

 ( block 3)
: brdRange 1 - 7 and 1+ ;

cdata compMoves
 1 c, 2 c, 7 c, 0 c,
 1 c, 2 c, 3 c, 6 c,

: compPlay ( mv c h ..)
  2dup opp + brdRange =
  >r over = r> or if
    over compMoves +
    c@ dup >r + brdRange
    r> 7 =
  else
    opp + 1
  then
  over (x) place drop
;  ( .. -- mv c f )

 ( block 4)
: init 0 board ! cls
  .board ;
: win? 5 0 at
  ?dup if
      ." I WIN!" key drop 1
  else
  over compMoves + c@ 6 =
  ?dup if
    ." DRAW!" key drop 1
  else 0 then then ;

: oxo
  init humPlay dup 1 and
  4 * swap dup
  begin
    compPlay win?
  0= while
    swap 1+ swap humPlay
  repeat
  2drop ;


For the Computing History Museum's Hackers' Delight event I wrote a better version of Noughts and Crosses ( see below). It's 7.5Kb of source, and compiles into 2.9Kb of Forth (though 841b are just the definition headers, so the actual, compiled code is only 2.1Kb).

    

In this version of Noughts and Crosses I used 14 of the 16 UDGs to provide crisp, chunky 'X's (which took 2 UDGs) and decent 'O's.


The 'O' was the most tricky, I found that I could re-use the the inverse of the characters from the outer parts of the 'O's as the inner parts and thus do the work of 24 UDGs in only 12. The game gives you the option of going first or second and you place your move by using the cursor keys, then pressing enter. The game uses the conventional plot command to draw the winning lines. With large characters I could fill the screen Wargames-style :-) !

Line Drawing

Here's a simple block that provides line drawing!

: qLine ( DX DY X Y n)
  0 do d>r d>r ( DX DY : X Y)
    2over dr> d+ ( DX DY X' : Y)
    2over dr> d+ ( DX DY X' Y')
    swap >r 2dup plot ( .. Xl Xh Yh /Xh Yh/ : Yl)
    r> swap ( .. Xl Xh Yl Yh)
  loop
  2drop 2drop 2drop 2drop
;

: /line ( dx dy max)
  swap 0< 1 or d>r ( dx : max -1|1 )
  $8000 swap dup abs ( $8000 dx |dx| : max -1|1 )
  dup r = if
    drop r> drop >r drop ( : dx -1|1)
    0 r> 0< 1 or
  else
    swap r> swap >r ( $8000 |dx| max : dx -1|1)
    u/ swap drop 0 ( FX : dx -1|1)
    r> d+-
  then
  0 r> ( DX : -1|1) ; ( -- DX DY)
; ( -- DX DY)
 
: line ( x y dx dy)  
  2swap 2dup plot d>r ( dx dy : x y)  
  over abs over abs ( dx dy |dx| |dy| : x y)  
  over max >r r -
  if ( dx dy : max x y)    
    r /line ( DX DY : max x y)  
  else    
    swap r /line 2swap ( DX DY : max x y)
  then ( WH:nxy)  
  r> 0 swap r> swap ( WH 0 x n : y)  
  0 swap r> swap qline ( WH 0 x 0 y n )

Using the standard Bresenham line-drawing algorithm would be slower on FIGnition so instead line gradients are represented as 16:16 bit fixed point values which are added to coordinates also represented as 16:16 fixed-point values. This replaces the earlier algorithm which used 8:8 bit fixed point values and now requires Firmware 1.0.0 or later to run. This line drawing algorithm plots lines at up to 8000 pixels per second, faster than most 80s 8-bit computers!

Life

I wrote a version of Life for the Jupiter-Ace in 2006. I wanted to see how easy it was to convert to FIGnition. It's not so hard and the result is listed here



The FIGnition version is only 1497b of compiled code (+4600b of data); is about 10x faster than the Ace version and generates a new generation every 2.95s. But the motivation wasn't just to prove FIGnition would be faster, but to encourage is other conversions of Jupiter-Ace programs by doing one myself.

Simple Character Graphics Engine

FIGnition is fast enough to support simple tiled graphics directly in Forth. Here's an easy double-buffered tiled graphics engine to make simple games easier to write.

 ( overhead: 1200b data)
25 const scr.w
24 const scr.h

0 var scr.x
0 var scr.pos
0 var scr.upPos
: cdata <builds does> ;
0 var backTiles scr.w
  scr.h * allot
0 var foreTiles scr.w
  scr.h * allot

: onscr ( -- f )
  >r dup 0< over
  [ scr.w 1- ] literal
  > or r> dup 0< over
  [ scr.w scr.h * 1- ]
  literal > or rot or ;

: tile ( t -- )
  scr.x @ scr.pos @ 2dup
  onscr if
    + backTiles  + c!
    1 scr.x +! ;s
  then
  drop drop drop ;

: >xy ( x y -- )
  scr.w * scr.pos !
  scr.x ! ;

 : xy@
  scr.x @ scr.pos @ 2dup
  onscr if
    + vram + ic@ ;s
  then
  drop drop ;


: fTile ( t -- )
  scr.x @ scr.pos @ 2dup
  onscr if
    + foreTiles + c!
    1 scr.x +! ;s
  then
  drop drop drop ;

: fore ( s^ dx dy -- )
  >r swap r>
  0 do
    scr.x @ >r ( save x)
    dup 0 do
      dup i + c@ fTile
    loop
    >r scr.x ! ( restore)
    scr.w scr.pos +!
    over +
  loop ;


 : clg
  backTiles
  [ scr.w scr.h * ]
  literal 32 fill ;

: backTiles>
  backTiles foreTiles
  [ scr.w scr.h * ]
  literal cmove ;

: foreTiles>
  foreTiles vram
  [ scr.w scr.h * ]
  literal cmove ;

: tilesUp ( tileMap )
  dup dup scr.w + swap
  [ scr.w scr.h 1- * ]
  literal dup >r cmove
  r> + scr.w 32 fill ;

: tilesDown
  backTiles>
  foreTiles dup >r
  scr.w + backTiles
  [ scr.w scr.h * 1- ]
  literal cmove
  r> scr.w 32 fill ;

 : vfill ( dst -- )
  scr.w swap
  scr.h 0 do
    32 over c!
    over +
  loop drop ;

: tilesLeft ( tileMap )
  dup dup 1+
  [ scr.w scr.h * 1- ]
  literal cmove
  [ scr.w 1- ] literal +
  vfill ;

: tilesRight ( tileMap )
  dup dup 1+ swap
  [ scr.w scr.h * 1- ]
  literal cmove
  vfill ;


The code is currently untested, so you should expect to see changes before anything is written using it, so for the moment this is a description of how it works. The display engine consists of a background image and a foreground image. The basic technique is to first draw the background contents using tile then use backTiles> to copy it to the foreground image. You then start drawing the foreground graphics using fore. When you've finished you'd use foreTiles> to copy the entire screen to video and then call backTiles> to restore the background image before drawing your new foreground graphics Foreground graphics are simple cdata tile maps, so if you have, say a 2x2 graphic image to be displayed at 10, 12 you'd define it with:

cdata myBlob 2 c, 3 c, 4 c, 5 c,

Then you can copy it using 10 12 >xy myBlob 2 2 fore .

The basic game is loop is thus:

clg ( clears the background)
generate-background-using-tile
backTiles>
begin
  generate-foreground-using-fore
  foreTiles>
  update-background-if-needed
  backTiles>
  inkey handle-keypresses
gameOver @ until

Because the background is restored on every loop the engine automatically provides flicker-free updates for your moving foreground images without you having to keep track of where the graphics had been and this works even if your foreground objects overlap. The definition xy@ provides some basic support for object detection.

The engine provides some niceties for scrolling games which you'd use as: backTiles> tilesUp or tilesDown or backTiles> tilesLeft or backTiles> tilesRight .  Scrolling and copying uses cmove for the updates which currently operates at roughly 19Kb/s for SRAM to SRAM copies and 31Kb/s for SRAM to internal RAM copies. Therefore foreTiles> takes 19.5ms and backTiles> 31ms => 50ms or 1/20th of a second = a maximum of 20 frames per second which is certainly playable though not stunningly fast. Scrolling up takes 19ms, left and right 21ms and down takes 39ms. Thus a horizontal scrolling game would take at least 71ms, and run at no more than 14 fps. By comparison, a Jupiter ace could shift RAM at over 150Kb/s (in machine code).  Future firmware updates will improve cmove and fill by at least 5x.

Debugger


 ( relative loader.
  loader block =blk# )
  blk# @ 1 + load
  blk# @ 2 + load
  blk# @ 3 + load
  blk# @ 4 + load
  blk# @ 5 + load
  blk# @ 6 + load
  blk# @ 7 + load
  blk# @ 8 + load
  blk# @ 9 + load
  blk# @ 10 + load
( doesn't load test blk )

: var[]
  <builds dup + allot
  does> over + + ;

8 const traceDepth
traceDepth var[] trace[]
0 var traceSp

: >trace ( cfa -- f )
  traceSp @ traceDepth <
  dup if
    swap traceSp @
    trace[] ! ( push cfa)
  1 traceSp +! then ;

: trace> ( bp -- cfa f|f)
  traceSp @ 0 > dup if
    -1 traceSp +!
    traceSp @ trace[] @
  swap then ;
: u. 0 d. ;
: .trace dup
  16384 < if ." Native"
  else dup pfa>nfa id.
  then space ." @0x" u. ;

0 var oldBase

: >hex base @ oldBase !
  hex ;

: base> oldBase @ base !
  ;

: .trace[] ( index--valu)
  ." CFAs:" >hex
   traceSp @ 0 do
      i trace[] @ .trace
      cr 6 spaces
   loop .trace base> ;

 : p@ dup 0< if @ else
  i@ then ;
: .mem
  >hex do i p@ ." 0x" u.
  2 +loop base> ;

: .ds ." Data:"
  sp i@ sp0 .mem ;

: .rs ." Ret :"
  1280 rp i@ 1+ .mem ;
0 var gMemS 0 var gMemL
8192 32768 + 600 - const
  vback
: xchVram
  vram vback 600 0 do
    dup c@ >r over ic@
    over c! over r> swap
    ic! 1+ swap 1+ swap
  loop drop drop ;
64 const kFigByteCodes
1 const kFigLit
4 const kFigOBranch
5 const kFigBranch
6 const kFigLoop
7 const kFigPlusLoop
46 const kFigExit

: find
  -find drop drop pfa>cfa
  ;

find abort var @bp

: bpSet ( bp --)
  @bp @ swap ! ;

: >bp ( cfa -- )
  dup @ >trace if
    bpSet then ;
0 var condTrace
0 var condRef
0 var fallThru
find abort var @condBp

: dbCondStep ( bp -- bp)
  dup 1+ @ dup condRef !
  dup @  condTrace !
  @condBp @ swap !
  dup 3 + fallThru ! ;

: db(.")Step ( bp -- bp)
  2+ count
;

 : ovc@ over c@ ;
: dbOStep ( bp -- bp )
  dup c@ kFigExit = if
    ;s
  then
  2 ( default step)
  ovc@ kFigByteCodes < if
    drop 1 then
  ovc@ dup kFigOBranch <
  swap kFigPlusLoop >
  or 0= if
    drop dbCondStep 3
  then
  ovc@ kFigLit = if
    drop 3 then
  over @ [ find (.") ]
  literal = if
    drop db(.")Step then
  over + >bp ;

( block 6)
: dbIn
  dup 0< if ( ram only)
    dup >bp
  then ;

: dbIStep ( bp key --bp  )
  dbOStep @ dbIn ;

0 var oldSys1 allot
: bpUI ( bp -- bp key )
  key dup 8 = if
    xchVram key drop
    xchVram then
  dup 9 = if drop dbOStep
    13 then
  dup 10 = if drop
  dbIStep 13 then ;
: doBp ( bp exeCfa -- )
  xchVram
  sysvars oldSys1 3 cmove
  cls .trace[] cr .ds cr
  .rs cr ." Mem:" gMemL @
  gMemS @ .mem cr begin
      bpUI
  13 = until drop
  xchVram oldSys1
  sysvars 3 cmove ;

 ( block 8: 54)
: patchBp ( patch --p bp)
  r> r> 2 - dup >r swap
  >r 2dup ! ;
: patchRef ( p r--)
  dup @ if swap over @ !
    0 swap !
  else drop drop then ;
: condBp
  trace> if fallThru
     patchRef then
  condTrace @ patchBp
  0 condRef !
  swap doBp
;

find condBp @condBp !



( block 9: 46)
: bp ( breakpoint entry)
  condTrace @ condRef
  patchRef
  trace> if ( cfaToExe )
    patchBp swap doBp
  else
    abort ( underflow)
  then ;

find bp @bp !

: >mem over + gMemL !
  gMemS ! ;

: dbug ( cfa -- )
  dbIn r> drop >r ;

: debug find dbug ;

( Example definition to
  debug )

: u . ;
: t 5 0 do i 1 and
  if ." hi "
  else i u then loop
;

find t 32 >mem

Forth is powerful enough to support a debugger written in Forth itself! To use the debugger you'd type debug CommandToDebug and it must be a command you've written. The display shows the Debugging stack, followed by the Data stack, then the return stack and finally the memory stack. Pressing SW3 (Right) steps over each command; SW1 (Left) allows you to see the run screen; SW6 (Down) Steps into a definition and SW8 (Enter) Continues until the next breakpoint (which usually means it steps out of a definition).

















The debugger can be downloaded from this page and includes both the .fth file and the .hex files created by T2E2. It occupies about 1.5Kb.

Mini Car Race

How small can a FIGnition game be? This extremely crude game, minirace is only 338 bytes long.


5 var seed             
: rnd ( range -- random )
  seed @ 1+ 75 * dup seed ! u* swap drop       
;

( the graphic image for the car)
hex 0BAFE var udg 0BA38 ,  28AA , 0FE82 , decimal

( copy it to the UDG area)
udg vram 608 + 8 cmove

( pause for delay/50ths of a second)
: pause ( delay -- )
  clock i@ +
  begin
    dup clock i@ -
  0< until
  drop
;

( choose the start position for the next bit of road)
: nupath
  3 rnd 1- + 0 max 20 min
;

0 var hit

( has the car hit the side of the road?)
: hit?
  2dup 25 * + vram + ic@ hit !
;
  ( create the next strip of road)
: path
  24 23 at cr
  25 0 do
    i over < over
    4 + i < or 128 and 32
    + emit
  loop
;

( handle moving the car, left or right)
: mv
  swap dup inkey dup
  8 = swap 9 = 1 and + +
  0 max 24 min dup 12
  hit? at 1 emit swap 11
  at 32 emit swap
;

 0 var sc

( update the score)
: score 1 sc +!  0 0 at sc @ . ;

( put everything together)
: race
  cls 12 10 0 sc !
  begin
    nupath path mv score >r over pause r>
  hit @ 32 = 0= until
;

( run minirace with e.g
  10 minirace
  for a slow game,
  4 minirace
  for a pretty quick game,
  2 minirace
  for an impossibly fast game! )



Minirace is simple, but it has all the elements of a game you need. It supports different speeds down to -1; it correctly handles the movement of the road so that it stays within bounds; it supports a UDG; it handles user input via inkey; it manages collision detection and a running score. The minirace.zip (which includes the .fth and .hex files) is in the attachments.

Chess

Here's the beginning of a simple chess game, a 2 player version. It generates a set of chess pieces; draws a board and allows 2 players to move pieces around the board.


( chessica )
hex 0 var udgs
0018 , 1818 , 3C00 ,
0000 , 1824 , 2424 ,
427E , 0018 , 3024 ,
1818 , 3C00 , 1824 ,
4E5A , 2424 , 423C ,
0024 , 3C3C , 1818 ,
3C00 , 245A , 4242 ,
2424 , 423C , 0018 ,
143E , 3818 , 3C00 ,
1824 , 2A41 , 4624 ,
423C , 0018 , 3C18 ,
183C , 3C00 , 1824 ,
4224 , 2442 , 423C ,
005A , 7E3C , 1818 ,
3C00 , 5AA5 , 8142 ,
2424 , 423C , decimal
udgs vram 632 + 96 cmove
udgs vram 616 + 80 cmove





( board layout)
hex 8609 var initbr
840F , 8A05 , 8807 ,
0382 , 0382 , 0382 ,
0382 , decimal
: nugrid cls 1 0 at
  ." ABCDEFGH" cr 8 0 do
    i 49 + emit 8 0 do
      32 128 r i xor
      1 and 0= and + emit
    loop cr loop ;
: gemit 256 + emit ;
: nupcs initbr 3 1 do
  9 1 do i r at dup c@
    gemit 9 i - 9 r -
    at dup c@ 1 xor
    gemit 1+ loop
  loop drop ;
: nubrd nugrid nupcs ;
 ( gen piece movement)
: >mv ( dst pc -- dst pc)
  over ic@ over xor 128
  and dup 7 >> xor xor ;
 : mv> ( src -- pc)
  dup ic@ dup 128 and
  32 + rot ic! ;
: chessAt ( x y -- addr)
  25 * + [ vram 64 -
  48 25 * - ] literal + ;
 : mv ( sx sy dstx dsty)
  chessAt rot rot chessAt
  mv> >mv swap ic! ;
0 var coords 2 allot
: clrcrds coords 4 32
  fill ;
: .coords 0 12 at coords
  4 type ;
: >mv> coords dup 4 +
  swap do i c@ loop mv ;


 ( ui )
: uikey ( crd -- crd key)
  dup 48 > over 57 <
  and if
    over coords 1+ + c! 0
  then
  dup 96 > over 105 <
  and if 32 -
    over coords + c! 0
  then
  dup 32 = if drop 2 xor
    0 then
  dup 13 = if >mv>
    drop drop 0 0 clrcrds
    then ;
: chessica clrcrds
  nubrd 0 begin .coords
    key uikey 7 = until
  drop ;


To use it, load the program and then type chessica. Type a pair of coordinates e.g. if you want to move F1 to F5 (which is technically illegal as a first move) then type F, then 1, then <space>, then F then 5, then <enter> . Typing a letter or digit always changes the value in the correct column, <space> always switches between the from and to coordinates.

As you can see, it's pretty simple and only requires 614b, including graphics. It doesn't check for any illegal moves, nor can the computer play chess itself - that's for the future. 2Kb chess anyone ;-) ?


Brikky

Brikky is a simple breakout clone in only 8 pages of code, it uses the Audio Mod that's recently been developed to provide sound!

 hex 0FF80 var udgs
8080 , 8080 , 80FF ,
0FF01 , 101 , 101 , 1FF ,
 0FF88 , A288 , A288 ,
A2FF , 0FF91 , 2591 ,
2591 , 25FF , 0FF99 ,
0B3E6 , 0CC99 , 0B3FF ,
0FF99 , 03367 , 0CD99 ,
033FF , 0FF80 , FF80 ,
0FF80 , FFFF , FF01 ,
FF01 , 0FF01 , 0FFFF ,
decimal
udgs vram 608 + 64 cmove

0 var playstate
1 const loselife
2 const newround
3 const quitgame
22 const maxBall
0 var audStop
0 var sc 0 var hisc
0 var lives 0 var speed
0 var level 0 var bricks
2 const brickwidth
27 const wallCh
0 var batx 23 const baty
0 var dx 0 var dy
0 var x 0 var y
sysvars 11 + const joy
: .Bricks 44 bricks !
  4 0 do
    1 level @ 4 + i + at
    i 2 * 257 + 23 1 do
    dup emit dup 1+ emit
    brickwidth +loop
  drop loop ;
: quiet 0 0 beep ;
: audEnd audStop @ clock
  i@ - 0< if quiet then ;
 : emits 0 do dup emit
  loop drop ;
: .Walls 0 1 at
  wallCh 24 emits
  24 1 do
     0 i at wallCh emit
     23 i at wallCh emit
  loop ;
: bat ( -- joy) joy
  ic@ batx @ over 1 and
  over 1 > and if
    dup 3 + baty at space
    1 - then
  over 4 and over
  19 < and if
    dup baty at space
    1+ then
  dup baty at 19 4 emits
  batx ! ;

: bounce ( addr -- )
  dup @ neg swap ! ;

: vpos 25 * + vram + ;

: sfx 8 clock i@ +
  audStop ! pitch> beep ;

: score 1 >> 5 swap -
  dup 3 << sfx
  sc @ + dup sc !
  0 0 at ." SC:" . ;
 
: pause
  clock i@ + begin
    dup clock i@ - 0<
  until drop ;

: showhi 9 0 at
  ." Hi:" hisc @ . ;


 : 40sfx 40 sfx ;

( ox oy nx ny)
: hitSides?
  >r dup maxBall 1 - > if
     dup maxBall - -
     dx bounce 40sfx
  else
     dup 2 < if
       dup 1 - - 40sfx
       dx bounce then
  then
  r> dup 3 < if dup 2 - -
    dy bounce 40sfx
  then ;

: hitFloor? ( o:xy n:xy)
  dup baty > if 1-
    loselife playstate !
  then ;
( ox oy nx ny)
: hitBrick?
  2dup vpos ic@ ( .. c )
  dup 0 > over 9 < and
  if score over 1- 1 or
    over at space space
    bricks @ 1- dup 0= if
    newround playstate !
    then bricks !
    dy bounce
  else drop then ;

: hitBat? ( ox oy nx ny)
  over batx @ - 4 u< over
  baty 1- = and if over
    batx @ - 2 - dup 0< +
    1+ dx ! dy bounce
    45 sfx then ;

 : ball x @ y @ over dx @
  + over dy @ +
  hitSides? hitFloor?
  hitBrick? hitBat?
  over x ! dup y !
  >r >r at space
  r> r> at 28 emit ;

: play ( newround?-- )
  18 0 at ." L:" level @
  . ." I:" lives @ 1 .r
  if 1 level +! -1 speed
    +! cls .Bricks .Walls
  then 10 score
  showhi 5 x ! 12 y ! -1
  dx ! 1 dy ! 10 batx !
  begin bat drop ball
    speed @ pause audEnd
  playstate @ until ;

: endplay
  playstate @
  dup loselife = if
     -1 lives +!
     1 baty at 23 spaces
  then newround = ;
: init
  speed ! 0 level !
  3 lives ! 0 sc ! ;

: brikky
  aud init 1
  begin play endplay
    quiet 0 playstate !
  lives @ 0< until drop
  sc @ hisc @ max hisc !
  showhi ;

I also created a simple YouTube video for it (note: there's some strobing effects on it!).


FIGnition Brikky With Sound!

Mazes!

I took Compute Magazine's! Maze generator and converted it for FIGnition. It's just a little 3 screen program.

128 const wall
25 const w 23 const h
6706 var d 6144 ,
0 var maze w h * allot

: backtrack
    drop dup maze + c@
    dup >r d + c@ 25 - -
    r> ;
: findPass ( pos dir)
    dup >r begin
      over over d + c@ 25
      - + dup maze + c@
    wall = 0= while
        drop 1+ 3 and
        dup r = if r>
          drop backtrack
        dup >r then
    repeat r> drop
; ( -- pos dir pos' )





513 var dxy 258 ,
1 , 256 , 257 ,

: passPlot ( x y dxy+dir)
  dup >r 1+ c@ 1- + swap
  r c@ 1- + swap
  2dup plot r> ;
: passage ( pos dir)
  dup + dxy + swap 0 25
  u/ dup + swap dup +
  swap rot passPlot
  passPlot drop drop
  drop ; ( --pos)

0 var seed
: rnd seed @ 1+ 75 *
  dup seed ! u* swap
  drop ;
 : init
  maze w h * -1 fill
  maze w + 1+ h 2 do
    dup w 2 - wall fill
  w + loop drop
  vram w h * 160 fill
  0 maze w + 1+ c! 2 pen
  wall maze c! ;

: gen ( cpos ) init
  w 1+ 4 over begin
    rot rot passage
    4 rnd findPass
    2dup maze + c!
  dup 0= until drop drop
;

: mazes begin
    clock i@ seed !
  gen key 32 = until ;


 



FIGnition can generate 23x21 mazes in about 3s per maze which isn't  bad.

   
   
 Maze (by drawing pixels)
 Maze with thin walls.

With a little bit of 3d code we could generate a program for you to walk through a 3D maze, rather like the Jupiter Ace version.

How does it work? Well it's a pretty simple brute-force random maze generator. We have the maze array which stores 128's in empty locations and any other value represents a filled location in the maze. At each step it just picks a random direction to go in and if it's empty it calculates the new location and stores the direction in the new location in the maze. If it was filled it tries for the next direction in a clockwise sequence and if it gets back to the first direction it backtracks.

Backtracking is pretty simply too: by storing the direction in each new location we visit, it provides backtracking information, so to backtrack we simply retrieve the direction in the current maze location and move in the opposite direction (by subtracting rather than adding its displacement). Eventually we'll fill the entire screen with maze walls.

To set it up, we need to make sure the outer edges of the maze are no-go areas, which we do by filling them with 0s (not empty).

The clever part about FIGnition's algorithm is that we don't need special checks for when we backtrack to the start, instead we simply define the direction at our starting position (which is (1,1) ) as 1 (=right) and then set maze[0] to empty. Then when we backtrack from (1,1) we move left to (0,1) and do a search. The algorithm finds that to the right it's filled, as is the bottom, as is the left (which corresponds to the top, right corner of the maze). But then it finds that (0,0) is empty so it moves there and since the terminating
condition happens before the move is displayed, the maze generation stops.

The maze is plotted as though walls were the same width as the paths, but in fact since the walls aren't used in the maze calculation they can be replaced with any width walls, which is why a conversion to 3D is pretty trivial (you can convince yourself of this by considering the fact that all the walls are on even coordinates; which means you could change their thicknesses without changing the maze itself).


 ( Alternative commands for a thin walled maze )

: passage ( pos dir)
  swap over 2 and if
    over d + c@ 25 - +
  then vram + dup ic@ rot
  1 and dup + 1+ - dup
  12 < if drop 23 then
  swap ic! ;

( also )
: init
  maze w h * -1 fill
  vram w h * 160 fill
  maze w + 1+ vram 26 +
  h 2 do swap dup w
    2 - wall fill
    w + swap dup w 2 -
    15 fill 25 +
  loop drop
  0 maze w + 1+ c! 2 pen
  wall maze c! ;
 ( and finally)

: gen ( cpos ) init
  w 1+ begin
    4 rnd findPass
    2dup maze + c!
    rot rot passage
  dup 0= until drop drop
;








Maze generation is good for chase games, e.g. the classic ZX81 3D Monster Maze. The algorithm here only uses 1030b including 575b for the maze array itself. Here's the code itself: (wall would be better termed as 'empty').

As you can see, it's pretty simple and only requires 614b, including graphics. It doesn't check for any illegal moves, nor can the computer play chess itself - that's for the future, 2Kb chess anyone ;-) ?


Subpages (1): Examples 2
ċ
Julian Skidmore,
23 Feb 2012, 03:08
ċ
Julian Skidmore,
10 Jan 2012, 06:21
ċ
Julian Skidmore,
23 Feb 2013, 01:16
ċ
Julian Skidmore,
1 Oct 2011, 02:50
ċ
GDemo.fth
(2k)
Julian Skidmore,
16 Aug 2011, 04:53
ċ
Julian Skidmore,
16 Aug 2011, 07:44
ċ
Life.fth
(4k)
Julian Skidmore,
15 Aug 2011, 02:19
ċ
LineDraw.fth
(0k)
Julian Skidmore,
29 Jul 2011, 03:10
ċ
Julian Skidmore,
9 Nov 2011, 12:07
ċ
SimpleTileEngine.fth
(2k)
Julian Skidmore,
17 Aug 2011, 06:46
ċ
lander.fth
(2k)
Julian Skidmore,
8 Jun 2011, 06:32
ċ
mini_oxo.fth
(1k)
Julian Skidmore,
20 Jul 2011, 07:26
ċ
oxo.fth
(7k)
Julian Skidmore,
1 Sep 2011, 07:16
Comments