diff options
author | Angelos Mouzakitis <a.mouzakitis@virtualopensystems.com> | 2023-10-10 14:33:42 +0000 |
---|---|---|
committer | Angelos Mouzakitis <a.mouzakitis@virtualopensystems.com> | 2023-10-10 14:33:42 +0000 |
commit | af1a266670d040d2f4083ff309d732d648afba2a (patch) | |
tree | 2fc46203448ddcc6f81546d379abfaeb323575e9 /roms/openbios/forth/testsuite/fract.fs | |
parent | e02cda008591317b1625707ff8e115a4841aa889 (diff) |
Change-Id: Iaf8d18082d3991dec7c0ebbea540f092188eb4ec
Diffstat (limited to 'roms/openbios/forth/testsuite/fract.fs')
-rw-r--r-- | roms/openbios/forth/testsuite/fract.fs | 35 |
1 files changed, 35 insertions, 0 deletions
diff --git a/roms/openbios/forth/testsuite/fract.fs b/roms/openbios/forth/testsuite/fract.fs new file mode 100644 index 000000000..39c984056 --- /dev/null +++ b/roms/openbios/forth/testsuite/fract.fs @@ -0,0 +1,35 @@ +\ tag: forth fractal example +\ +\ Copyright (C) 2002, 2003 Volker Poplawski <volker@poplawski.de> +\ Stefan Reinauer + +\ This example even fits in a signature ;-) + +\ hex 4666 dup negate do i 4000 dup 2* negate do 2a 0 dup 2dup 1e 0 do +\ 2swap * d >>a 4 pick + -rot - j + dup dup * e >>a rot dup dup * e >>a +\ rot swap 2dup + 10000 > if 3drop 2drop 20 0 dup 2dup leave then loop +\ 2drop 2drop type 268 +loop cr drop 5de +loop + + +: fract +4666 dup negate +do + i 4000 dup 2* negate + do + 2a 0 dup 2dup 1e 0 + do + 2swap * d >>a 4 pick + + -rot - j + + dup dup * e >>a rot + dup dup * e >>a rot + swap + 2dup + 10000 > if + 3drop 2drop 20 0 dup 2dup leave + then + loop + 2drop 2drop + emit + 268 +loop + cr drop +5de +loop +; |