Category : Forth Source Code
Archive   : FIFTH.ZIP
Filename : FRAC.FIV

 
Output of file : FRAC.FIV contained in archive : FIFTH.ZIP
CREATE FRAC
CREATE MACHINE
EDIT
( TI=0 / IBM=1 Machine flag)
0 constant machine
~UP
CREATE XMAX
CREATE X
EDIT
( Maximum X for this machine)
: x machine if 320 else 720 endif ;
~UP
EDIT
( Maximum X value)
x constant xmax
~UP
CREATE YMAX
CREATE Y
EDIT
: y machine if 200 else 300 endif ;
~UP
EDIT
y constant ymax
~UP
CREATE GO
CREATE GCLS
EDIT
: GCLS 4 vmode
0 0 0 xmax 1- ymax 1- FILLBOX
;
~UP
CREATE ARRAY
CREATE DEFINE
EDIT
: DEFINE CREATE
16 1024 * ALLOT
DOES>
SWAP DUP 16384 U< IF ELSE ." Out of range, array" QUIT ENDIF
+

;
~UP
EDIT
DEFINE ARRAY
~UP
CREATE GENERATE
CREATE TOP
EDIT
VARIABLE TOP
~UP
EDIT
: GENERATE
2 0 ARRAY C!
0 1 ARRAY C! \ Changing the ARRAY initial values or
1 2 ARRAY C! \
3 TOP ! \ uncommenting this line and removing the
\ trailing +1 changes the pattern.
11 0 DO \ |
1 TOP @ 1- DO \ |
I ARRAY C@ \ V
( J 3 AND IF 1+ ELSE 1- THEN 3 AND ) 1+
TOP @ ARRAY C! 1 TOP +!
-1 +LOOP
LOOP
;
~UP
CREATE PLOT
CREATE X
EDIT
VARIABLE X
~UP
CREATE Y
EDIT
VARIABLE Y
~UP
CREATE RR
EDIT
variable rr
~UP
CREATE PREV
EDIT
: prev

dup 0 = if 2 y +! drop exit endif
dup 1 = if -3 x +! drop exit endif
2 = if -2 y +! exit endif
3 x +!
;
~UP
CREATE CURR
CREATE L
EDIT
: L
2DUP ymax U< SWAP xmax U< AND IF ELSE 2DROP X @ Y @ EXIT ENDIF
X @ Y @ 2DUP ymax U< SWAP xmax U< AND IF ELSE 2SWAP 2DROP EXIT ENDIF

LINE
;
~UP
EDIT
: CURR
dup 0 = if drop 2 y +! L
2 y +! L exit endif
dup 1 = if drop -3 x +! L
-3 x +! L exit endif
2 = if -2 y +! L
-2 y +! L exit endif
3 x +! L
3 x +! L
;
~UP
EDIT
( Color Rotation -> )
: PLOT
RR ! ( Save rotation)
xmax 2/ X ! ymax 2/ Y !
x @ y @ ( Initial point, color on stack)
1 array c@ rr @ + 3 and CURR
512 1 * 2 DO
I 1- ARRAY C@ RR @ + 3 AND PREV
I ARRAY C@ RR @ + 3 AND CURR
LOOP 2drop drop
;
~UP
EDIT
: GO
cls gcls generate
99 0 do
?term if abort endif
i [ 7 machine 4 * - ] literal mod 1+ i 3 and plot
loop
;
~UP
EDIT
: frac go ;
~UP
ABORT


  3 Responses to “Category : Forth Source Code
Archive   : FIFTH.ZIP
Filename : FRAC.FIV

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/