(*
 * LANGUAGE    : ANS Forth with extensions
 * PROJECT     : Forth Environments
 * DESCRIPTION : Fractal profile (Van der Waerden curve)
 * CATEGORY    : Fractals
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : Friday, December 19, 2003 11:36 AM, Marcel Hendrix 
 *)



 	NEEDS -miscutil
	NEEDS -graphics

	REVISION -waerden "ÄÄÄ Fractal profile     Version 1.00 ÄÄÄ"

	PRIVATES

DOC
(*
 Draw the Van der Waerden curve.
*)
ENDDOC

green VALUE color PRIVATE

:INLINE FREMAINDER ( F: r1 -- r2 ) FDUP F>D D>F F- ;

: VAN-DER-WAERDEN ( index -- )
		LOCAL p
		p S>F FNEGATE F2^X  0e  FLOCALS| s h |
		TEXTMODE? IF GRAPHICS ENDIF  GCLEAR
		0 0 Xmax Ymax -0.3e -0.3e  1.3e 0.9e SET-GWINDOW
		0e TO PenX  0e TO PenY  1e 0e color DRAW-SCALED-LINE
		p 2^x 1+ 0 DO  	CLEAR s
				I S>F h F* ( F: x -- )
				8 0 DO  FDUP I 2^x S>F F* FREMAINDER ( F: x y -- )
					FDUP 0.5e F>= IF  1e FSWAP F-  ENDIF ( F: x z -- )
					I 2^x S>F F/ +TO s
				  LOOP  s ( F: x s -- )
				I 0= IF TO PenY TO PenX 
				   ELSE color DRAW-SCALED-LINE
				  ENDIF
			 LOOP
		TEXT ;

:ABOUT		CR ." Try: <+level> VAN-DER-WAERDEN -- e.g. level = 10" ;

		.ABOUT -waerden CR
		DEPRIVE

				(* End of Source *)