(*
 * LANGUAGE    : ANS Forth with extensions
 * PROJECT     : Forth Environments
 * DESCRIPTION : Fractal in the form of a maple leaf; random method
 * CATEGORY    : Fractals
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : December 12, 2003, Marcel Hendrix 
 *)



 	NEEDS -miscutil
	NEEDS -graphics

	REVISION -maple "ÄÄÄ Maple leaf Fractal  Version 1.00 ÄÄÄ"

	PRIVATES

DOC
(*
 Maple leaf fractal; using random numbers. 
 Data taken from Barnsley's book, "Fractals everywhere".
*)
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]

 0.60e FCONSTANT a1  PRIVATE  0.60e FCONSTANT a2  PRIVATE  0.40e FCONSTANT a3  PRIVATE  0.40e FCONSTANT a4  PRIVATE
 0.00e FCONSTANT b1  PRIVATE  0.00e FCONSTANT b2  PRIVATE  0.30e FCONSTANT b3  PRIVATE -0.30e FCONSTANT b4  PRIVATE
 0.00e FCONSTANT c1  PRIVATE  0.00e FCONSTANT c2  PRIVATE -0.30e FCONSTANT c3  PRIVATE  0.30e FCONSTANT c4  PRIVATE
 0.60e FCONSTANT d1  PRIVATE  0.60e FCONSTANT d2  PRIVATE  0.40e FCONSTANT d3  PRIVATE  0.40e FCONSTANT d4  PRIVATE
 0.18e FCONSTANT e1  PRIVATE  0.18e FCONSTANT e2  PRIVATE  0.27e FCONSTANT e3  PRIVATE  0.27e FCONSTANT e4  PRIVATE
 0.36e FCONSTANT f1  PRIVATE  0.12e FCONSTANT f2  PRIVATE  0.36e FCONSTANT f3  PRIVATE  0.09e FCONSTANT f4  PRIVATE
 
 0.3e  FCONSTANT q1  PRIVATE
 0.6e  FCONSTANT q2  PRIVATE
 0.8e  FCONSTANT q3  PRIVATE

   0e  FVALUE x	     PRIVATE
   0e  FVALUE y	     PRIVATE

INLINE: contract1 ( -- ) a1 x F*  b1 y F* F+  e1 F+ ( x1)  c1 x F*  d1 y F* F+  f1 F+ TO y TO x ;P
INLINE: contract2 ( -- ) a2 x F*  b2 y F* F+  e2 F+ ( x1)  c2 x F*  d2 y F* F+  f2 F+ TO y TO x ;P
INLINE: contract3 ( -- ) a3 x F*  b3 y F* F+  e3 F+ ( x1)  c3 x F*  d3 y F* F+  f3 F+ TO y TO x ;P
INLINE: contract4 ( -- ) a4 x F*  b4 y F* F+  e4 F+ ( x1)  c4 x F*  d4 y F* F+  f4 F+ TO y TO x ;P

: MAPLE		0e FLOCAL rr
		TEXTMODE? IF GRAPHICS ENDIF  GCLEAR
		 0 0 Xmax Ymax -0.35e -0.1e  1.25e 1.1e SET-GWINDOW
		 RESET-MDOTS  
		 CLEAR x CLEAR y ( start )
		 #60000 0 DO    1 FCHOOSE TO rr
		 		rr q1 F<  		IF  contract1  ENDIF
		 		rr q1 F>= rr q2 F< AND  IF  contract2  ENDIF
				rr q2 F>= rr q3 F< AND  IF  contract3  ENDIF
				rr q3 F>=		IF  contract4  ENDIF
				I #32 > IF x y FPLOT ENDIF
		        LOOP
		 FLUSH-MDOTS
		TEXT ;

:ABOUT	CR ." Try: MAPLE " ;


		.ABOUT -maple CR
		DEPRIVE

				(* End of Source *)