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     ! 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.