Return to fract.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / testsuite

Annotation of qemu/roms/openbios/forth/testsuite/fract.fs, revision 1.1.1.1

1.1       root        1: \ tag: forth fractal example
                      2: \ 
                      3: \ Copyright (C) 2002, 2003 Volker Poplawski <[email protected]>
                      4: \                          Stefan Reinauer
                      5: 
                      6: \ This example even fits in a signature ;-)
                      7: 
                      8: \ hex 4666 dup negate do i 4000 dup 2* negate do 2a 0 dup 2dup 1e 0 do
                      9: \ 2swap * d >>a 4 pick + -rot - j + dup dup * e >>a rot dup dup * e >>a 
                     10: \ rot swap 2dup + 10000 > if 3drop 2drop 20 0 dup 2dup leave then loop 
                     11: \ 2drop 2drop type 268 +loop cr drop 5de +loop
                     12: 
                     13: 
                     14: : fract
                     15: 4666 dup negate
                     16: do
                     17:     i 4000 dup 2* negate
                     18:     do
                     19:         2a 0 dup 2dup 1e 0
                     20:        do
                     21:            2swap * d >>a 4 pick +
                     22:            -rot - j +
                     23:            dup dup * e >>a rot
                     24:            dup dup * e >>a rot
                     25:            swap
                     26:            2dup + 10000 > if
                     27:                3drop 2drop 20 0 dup 2dup leave
                     28:            then
                     29:        loop
                     30:        2drop 2drop
                     31:        emit
                     32:     268 +loop
                     33:     cr drop
                     34: 5de +loop
                     35: ;

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.