(*
 * LANGUAGE    : ANS Forth with extensions
 * PROJECT     : Forth Environments
 * DESCRIPTION : Fractal in the form of a letter "H"
 * CATEGORY    : Fractals
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : December 13, 2003, Marcel Hendrix 
 *)



 	NEEDS -miscutil
	NEEDS -graphics

	REVISION -letterH "ÄÄÄ Letter H Fractal    Version 1.00 ÄÄÄ"

	PRIVATES

DOC
(*
 Collage of Letter "H" fractal. 
*)
ENDDOC

Green VALUE color
  2   VALUE dotsize

0 [IF]  :INLINE FPLOT ( F: x y -- ) SCALE dotsize color CIRCLE ; ( nice with p=8 or so)
[ELSE]  :INLINE FPLOT ( F: x y -- ) SCALE color SET-MDOT ; ( MDOT is about twice faster than DOT )
[THEN]

:INLINE 4PLOT ( F: x y -- )
		F2DUP 			  FPLOT   (  x  y )
		FNEGATE F2DUP 		  FPLOT   (  x -y )
		FSWAP FNEGATE FSWAP F2DUP FPLOT   ( -x -y )
		FNEGATE			  FPLOT ; ( -x  y )

: LETTERH	TEXTMODE? IF GRAPHICS ENDIF  GCLEAR
		 0 0 Xmax Ymax -6e -4e  6e 4e SET-GWINDOW
		 RESET-MDOTS  
		 0e 0e ( start )
		 #16000 0 DO    CASE 7 CHOOSE ( x y -> y' x' )
				 0 OF  3e F/ 2e F+  FSWAP 3e F/ 2e F+   ENDOF
				 1 OF  3e F/ 2e F-  FSWAP 3e F/ 2e F+   ENDOF
				 2 OF  3e F/ 2e F-  FSWAP 3e F/ 2e F-   ENDOF
				 3 OF  3e F/ 2e F+  FSWAP 3e F/ 2e F-   ENDOF
				 4 OF  3e F/ 2e F+  FSWAP 3e F/         ENDOF
				 5 OF  3e F/ 2e F-  FSWAP 3e F/         ENDOF
				 6 OF  3e F/        FSWAP 3e F/         ENDOF
				ENDCASE
				F2DUP 4PLOT FSWAP ( y' x' -> x' y' )
		        LOOP
		 F2DROP
		 FLUSH-MDOTS
		TEXT ;

:ABOUT	CR ." Try: LETTERH " ;


		.ABOUT -letterH CR
		DEPRIVE

				(* End of Source *)