fignition‎ > ‎Examples‎ > ‎

Primes

This is a simple 1-block program to list all the prime numbers, it's really a kind of benchtest. You run it by typing, e.g. `1000 primes` to list all the primes up to 1000.

`: eloop 10 i@ 1- 12 i! ;`

```: primes   2 swap 2 . 3 . 5```
```  do     dup dup * i < if       1+ then```
```    1 over 1+ 3 do       r i mod 0= if         1- eloop then```
`    2 +loop`
```    if       i . then```
`  2 +loop`
`  drop ;`

It was originally written for Mark Willis's TI 99/4a Turbo Forth and converted by David Bambrough and Carl Attril.

Calendar

David Bambrough converted Ricardo Lopez's Calendar program for the Jupiter Ace to FIGnition:

 ```: weekday  swap dup 3 < if             12 + rot   1- rot rot  then              26 * 54 - 10 / +  swap 1900 -       dup 4 / + + 34 -  7 mod            ; : leapyear?  dup 100 mod 0= 0=  over 400 mod 0= or  swap 4 mod 0= and ; ``` ```: cal  cr  ." SU MO TU WE TH FR SA"  cr  over 3 * spaces decimal   1+ 1 do                   i 10 < if     1 spaces   then   i .                1+                 dup 6 > if    cr drop 0         then  loop  drop ; ``` ```: month       over leapyear?     over 1+ c@         swap over    2 = and -1 *    rot c@ +           rot rot 1          weekday           swap              cal ; ``` ```1  31 month january 2  28 month february 3  31 month march 4  30 month april 5  31 month may 6  30 month june 7  31 month july 8  31 month august 9  30 month september 10 31 month october 11 30 month november 12 31 month december ```

To use it, type (for example), `2013 april <exe>` . The following screenshot shows the result from typing `2012 february <exe> 2012 may <exe>`

Pong

A version of pong was originally developed for the Magnavox Odyssey home console by Ralph Baer, but first achieved mainstream acceptance with Atari's (improved) version of Pong in 1972. In that sense it's the video game that launched the industry. I've wanted to write a FIGnition version for quite a while, just to see how simple it can be. FIGnition's version requires firmware 0.9.8 or later, supports ball angles, and smooth bat movement, but currently lacks ball acceleration.

 ```( Pong) 0 var lsc 0 var rsc ( scores) 0 var ly 0 var ry  ( l/r coord) 0 var bh ( ball height) 0 var by  0 var bx ( ball x,y) 0 var dx 0 var dy ( ball dir) sysvars 11 + const joy 0 var audStop : aud 64 191 42 >port>   drop ; : beep ( presc freq --)  0 69 ic! ( sound off)  0 110 ic! ( no ints)  66 68 ic!  ( ctc mode)  71 ic! ( pitch)  7 and 69 ic! ( oct+on) ; : audEnd   audStop @ clock i@ -   0< if     0 0 beep   then ; : sfx   8 clock i@ +   audStop ! beep ; clock i@ var seed : rnd ( range -- rnd)   seed @ 75 * 1+ dup   seed ! u* swap drop ; ``` ```: initBall   3 198 sfx   24 by ! 25 bx !   2 rnd 2* 1- dy !   2 rnd 2* 1- dx ! ; : mvBally    ( y )   dy @ +   dup 2 < over 47 > or if     4 99 sfx     dy @ neg dup dy ! +   then ; : .batUp ( y' dy x --)   1 pen >r + r over plot   2 pen bh @ + r>   swap plot ; : .batDn ( y' dy x --)   1 pen >r drop   r over bh @ + plot   2 pen r> swap plot ; ( -- ) : mvBat ( j msk &y x )   >r >r and dup 16 <   over 0= 0= and swap   15 > neg +   r @ swap over + 2 max   48 bh @ - min dup r> !   over - r>   over 0< if     .batUp ;s   then   over neg 0< if       .batDn   else     drop drop drop   then ; ``` ```: .sc   6 0 at lsc @ 2 .r   18 0 at rsc @ 2 .r ; : init ( bh --)   0 lsc ! 0 rsc !   cls 1 pen .sc   dup bh ! dup   1 >> 24 swap   - dup ly ! dup ry !   swap over + swap do     0 i plot 49 i plot   loop   48 0 do     i 1 and 1+ pen     25 i plot   loop   aud initBall ; : bHit? ( x y limX &baty)   @ >r over dup r 1- >   swap r bh @ + < and   >r rot = r> and if     5 78 sfx     dx @ neg dx !     dup r bh @ 1 >> +     - dy !   then   drop r> drop ; ( --) : mvBallx ( x y)   swap dx @ + swap   2dup 1 ly bHit?   2dup 48 ry bHit? ; ``` ```: mvBall ( -- x)   3 pen   bx @ by @ 2dup >r >r   mvBally mvBallx   2dup plot by ! dup   bx ! r> r> plot 1 pen ; . : score? ( x --)   dup 0 < neg rsc +!   dup 49 > neg lsc +!   dup 0< over 49 > or if     3 pen dup by @ plot     .sc 50 pause     initBall 1 pen   then   drop ; : bats   joy ic@   dup \$21 ly 0 mvBat   \$48 ry 49 mvBat ; : pong ( speed bh --)   init 1- ( speed)   begin     dup 0 do       bats 0 pause     loop     bats mvBall score?     0 pause audEnd    lsc @ 15 = rsc @ 15 =    or inkey asc A = or   until   0 0 beep drop ; ```

Here's a screenshot of FIGnition Pong in action:

The game itself is 162 lines long and occupies 2.9Kb of source or 862 bytes when compiled. It supports audio; different speeds and bat sizes (but no attract mode).

How to play (PONG needs Firmware 0.9.8):
2. Type: speed `batSize pong <exe>` Usually I type `3 8 pong` . The speed is the ratio of bat frames to ball frames, in this case 3 to 1.
3. The left player uses SW1 and SW6 to go up and down; the right player uses SW4 and SW7 to go up and down.
4. First person to 15 wins!

I2C Access

It's possible to connect I2C devices to FIGnition entirely using Forth. I2C devices require the addition of a 1K8 (minimum) resistor between U1 Pin 8 and 5V and another similar resistor between U1 Pin 28 and 5V.

Oleg Kobchenko developed an I2C library for this purpose (slightly modified here):

 ```( i2c/2-wire 0 [c]fig8r) \$B8 const twbr \$B9 const twsr \$BC const twcr \$BB const twdr \$BA const twar \$BD const twamr create badI2c " bad i2c" : ?twsr ( msk)   twsr ic@ and 0=   badI2c ?error ; ``` ```: twcr! ( c-)   \$84 or twcr ic! ; : ?twINT   begin     twcr ic@ \$80 and   until ; : ?twSTO   begin     twcr ic@ \$10 and   0= until ; ``` ```: i2ini   0 twsr ic!   \$C0 twbr ic! ; : {i2c ( addr)   \$20 twcr! ?twINT   \$18 ?twsr   ( a) twdr ic! 0 twcr!   ?twINT \$58 ?twsr ; : i2c}   \$10 twcr! ?twSTO ; ``` ```: >i2c ( c)   twdr ic! 0 twcr!   ?twINT \$28 ?twsr ; : i2c> ( -c)   \$30 twcr! ?twINT   twdr ic@ ; : i2c>- ( -c)   0 twcr! ?twINT   twdr ic@ ; ```

For example, a Maxim 517 DAC I2C device can be used with a FIGnition with the following code:

 ```( Maxim DAC bit 0=reg) \$4C const max517/8Base \$40 const max519Base : >dac ( val addr)   dup \$FE and i2c{     1 and >i2c >i2c   }i2c ; ``` ```( demo code saw tooth) max517/8Base const aDac : demoDac   begin     256 0 do       i aDac >dac     loop   inkey until ; ```

FIGgyBird

Here's a FIGnition version of the popular game in only 200 lines of code and 1026 bytes (when compiled).

 ```create birdUp \$0102 , \$040E , \$1111 , \$0906 , \$F028 , \$4C24 , \$1E21 , \$4F22 , \$0201 , \$0000 , \$0000 , \$0000 , \$1CE0 , \$0000 , \$0000 , \$0000 , create birdDn \$0102 , \$0408 , \$080E , \$1111 , \$F028 , \$4C24 , \$1E21 , \$4F22 , \$120D , \$0000 , \$0000 , \$0000 , \$1CE0 , \$0000 , \$0000 , \$0000 , create pipe \$4A55 , \$4A55 , \$4A55 , \$4A55 , \$AEA6 , \$AEA6 , \$AEA6 , \$AEA6 , create pipeEnd \$8095 , \$AA95 , \$AA95 , \$AAFF , \$0157 , \$AB57 , \$AB57 , \$ABFF , 0 var sc 0 var hi 16 const x 0 var y -16 var oy 0 var vel 18 const g 0 var gameover 64 const thrust 40 const gap 3 const pipes -1 var drift 3 arr pipeX 3 bytes pipeH clock i@ var seed : rnd ( range -- rnd )   seed @ 1+ 75 * dup   seed ! u* swap drop ; ``` ```: .stem ( x y h --)   >r over 0 max over at   over neg 160 + 17 min   r clip   r> 0 do ( x y)     2dup i + over 1+     over at at     8 \$0810 8 \$0810 2blt   8 +loop   drop drop   0 8 at 160 144 clip ; : .pipe ( x h --)   2dup 8 swap .stem   2dup 8 + over 1+ over   at at   10 \$810 10 \$810 2blt   2dup gap + over 1+   over at at   10 \$810 10 \$810 2blt   104 over - swap [ gap   8 + ] literal + swap   .stem ; : .status   0 0 at 160 8 clip   32 0 at sc @ .   ; : init   0 sc ! 0 vel !   \$5000 y ! \$F800 oy !   0 0 at   ." Sc: 0     Hi:"   hi @ .   birdUp \$1010 0 tile   birdDn \$1010 4 tile   pipe \$0810 8 tile   pipeEnd \$0810 10 tile   pipes 0 do     i 80 * 160 + i pipeX !     112 rnd i pipeH c!   loop ; : incSc ( pipeY)   dup -5 = neg ?dup if     sc +! .status   then ;`````` ``` ```: mvPipes   pipes 0 do     i pipeX dup @     dup 160 < if       dup i pipeH c@       .pipe     then     1- incSc     dup -16 < if       drop 224       112 rnd i pipeH c!     then     swap !   loop ; 0 var flap : wings ( thrust?)   flap dup @ dup if     1-   else     drop over 13 and   then   swap ! ; : .Bird   8 oy c@ at   8 y c@ at   flap @ >r   r 13 < r 5 > and   4 and \$1010   r> 6 > 4 and \$1010   2blt ; sysvars 11 + const joy : doKey ( joy --)   >r vel g   r> thrust and   0= 0= wings xor   over @ + swap   over swap !   y >r r @ dup oy !   + dup \$700 -   dup \$8700 u< 0= if     swap drop 0 vel !     \$BF80 u< \$86FF and     \$701 + 0   then   drop r> ! ;`````` ``` ```: hit?   0   3 0 do     i pipeX @ dup 23 <     swap -5 > and if       i pipeH c@ 15 +       y c@ 2dup > >r       gap - 25 + < r> or       or     then   loop ; : frame   0 8 at 160 144 clip   mvPipes .Bird   joy ic@ doKey hit? ; : hisc?   sc @ hi @ max hi ! ; . : bird   1 vmode   0 hi !   begin     cls init     begin       frame 0 pause     until     hisc?   inkey drop   key asc q = until   0 vmode ; ```

Here's a screenshot of FIGgyBirds in action:

Scientific Functions

FIGnition supports Floating-Point arithmetic from firmware 1.0.0 onwards. Here's a useful set of trigonometric and logarithmic scientific functions to support them:

So what's in the package?

The code is attached and should compile to 878b or so. I's designed for compactness rather than performance or accuracy. The commands are based on ZX Basic commands rather than modern 'C' function terminology. There's no reason why you can't rename them.

 ```( Transcendental Functions): fabs \$7FFF and ; : sqrt ( x -- sqrt[x])  dup 0< if ( if <0)    2drop 1d ;s ( overflow)  then  dup 1 >> \$7F80 and  \$1F80 - >r ( x : E/2)    \$FF and \$3F00 + 2dup fneg  2swap ( -m m : E'/2)  0d ( -m m dx : E'/2)  begin   f- ( -m m'-dx=>m' : E'/2)   2over 2over ( -m m' -m m'..)   2dup f* f+ ( -m m' m'^2-m..)   ( .. [m'^2-m]/[2m']=>dx..)    2over \$80 + f/  dup fabs \$3400 < until  2drop 2swap 2drop ( m : E'/2)  r> + ; : cheb ( Z chebData )  >r \$80 + ( 2*Z : chebData )  0d 0d 0d ( 2*Z, 0.0 0.0 0.0 )  r> ( 2Z M2 T M1 cTable^ )  dup 1+ swap c@ 0 do   ( 2Z T -M2 /M1/ : cTable^)   >r 2drop 2swap fneg   ( 2Z T 2Z*T : -M2 cTable^)   d>r 2over 2over f*   ( 2Z T 2Z*T -M2 A : cT'^)    dr> r d@ r> 4 + >r   ( 2Z T 2Z*T-M2+A : -M2 cT'^)   2over d>r f+ f+ dr> r>  loop  drop f+ d>r 2drop  2drop dr> ( T ) ;``` ```create pi -1 allot 71 c, \$40C90FDBd d,create e -1 allot 71 c, \$40ADF854d d,: >rad ( deg -- rad) [ pi 180. f/ ] dliteral f*;create kSinTab 6 c,    \$B1E60000d d, \$359F0B00d d,  \$B90F38EEd d, \$3C1563BBd d,  \$BE920DCEd d, \$40235D1Cd d, : sin ( a -- sin[a])  [ 0.5 pi f/ ] dliteral f*  2dup 0.5 f+ fint float f-  \$0100 + ( in range -2 to 2)  2dup fabs \$-40000001d d+  d0< 0= if ( abs[w]>1?)   dup >r fabs fneg   2.0 f+ ( -abs[w]+2)   r> 0< if    fneg ( -[-abs[w]+2])   then  then  2dup 2dup f* \$80 + 1.0 f-  kSinTab cheb f* ; : cos ( a -- cos[a] )  [ pi 2.0 f/ ] dliteral f+  sin ; : tan ( a -- tan[a] )  2dup sin 2swap cos f/ ; create kAtnTab 12 c,  \$AFB20000d d, \$310E0000d d,  \$B2648D00d d, \$33B9BC00d d,  \$B518FD00d d, \$36803675d d,  \$B7DBE8B4d d, \$3942C400d d,  \$BAB50937d d, \$3C36731Bd d,  \$BDD8DE64d d, \$3FE1A1B3d d, ``` ```: atn ( tan[a] -- a)  dup fabs \$4000  < if ( abs[w]<1? y=x )   0.0 ( y 0)  else   -1.0 2swap f/ dup >r   [ pi -2.0 f/ ] dliteral   r> \$8000 and xor  then  2swap ( w y)  2dup 2dup f* \$80 + -1.0 f+  kAtnTab cheb f* f+ ; : asn ( sin[a] -- a )  2dup 2dup f* ( x x*x)  fneg 1.0 f+ ( x 1-x*x)  sqrt 1.0 f+ f/  atn 2dup f+ ; : acs ( cos[a] -- a )  asn fneg  [ pi \$80 - ] dliteral f+ ; create kExpTab 8 c,  \$31360000d d, \$33E56600d d,  \$36786540d d, \$38E032C9d d,  \$3B21F7AFd d, \$3D2FB0B0d d,  \$3EFEBB94d d, \$403A7EF9d d, : exp ( fx--e^fx)  2dup 88.7228391 f< 0= if   2drop 1d ;s  then  1.44269504 f* 2dup fint ( y n)  over >r float f- \$80 + -1.0 f+  kExpTab cheb r> 7 << + ; ``` ```create kLnTab 12 c,  \$B02C0000d d, \$31890000d d,  \$B2DAA500d d, \$3430C500d d,  \$B590AA00d d, \$36F06F61d d,  \$B84BDA96d d, \$39B19FB4d d,  \$BB20FE5Dd d, \$3C9B43CAd d,  \$BE279C7Ed d, \$3FEE2381d d, : ln ( fx -- ln[fx])  dup 0< if   2drop 1d ;s  then  -3. 2swap dup ( -3. x x )  7 >> \$7F - >r ( -3. x : E')  \$7F and \$3F80 + ( -3. x' : e' )    2dup \$3FCCCCCDd f< if    ( -3. [x'|2x'] : e'-1)   r> 1- >r \$80 +  then  ( -3.+[2.5|5]x' : )  (    [x'|2x'] e'-1) )  2dup d>r 2.5 f* f+  kLnTab cheb dr> -1.0 f+  f* ( Z'*[[x'|2x']-1] : e'-1)  r> s->d float  \$3FB17218d f* f+ ; : ** ( fx fy)  2swap 2dup or if   ln f* exp  else ( x=0)   2drop 2dup or if    2drop 1.0 ( 0**0=1)   else ( -ve => overflow else 0)    swap drop 15 >> 0   then  then ; ```

Most of FIGnition's tiny scientific package uses Chebyshev polynomials to approximate calculations to an accuracy adequate for single-precision floating-point arithmetic. The exception is sqrt, which uses a Newton-Raphson approximation.

ċ
FIGgyBird.zip
(15k)
Julian Skidmore,
23 Mar 2014, 02:16
ċ
MathTrans.fth
(3k)
Julian Skidmore,
16 Jul 2014, 10:36
ċ
Pong.zip
(8k)
Julian Skidmore,
25 Nov 2013, 03:22