(*
 * LANGUAGE    : ANS Forth with extensions
 * PROJECT     : Forth Environments
 * DESCRIPTION : Iterative system with 2 contractions; random method
 * CATEGORY    : Fractals
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : December 12, 2003, Marcel Hendrix 
 *)



 	NEEDS -miscutil
	NEEDS -graphics

	REVISION -contrmc1 "ÄÄÄ Fractal Tennis      Version 1.00 ÄÄÄ"

	PRIVATES

DOC
(*
 Iterative system with 2 contractions; using random numbers.
*)
ENDDOC

White 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.64e FCONSTANT a1  PRIVATE	
 0.64e FCONSTANT b1  PRIVATE	
 0.10e FCONSTANT a2  PRIVATE	
-0.10e FCONSTANT b2  PRIVATE	

 a1 FSQR b1 FSQR F+ FSQRT FCONSTANT f1  PRIVATE
 a2 FSQR b2 FSQR F+ FSQRT FCONSTANT f2  PRIVATE
  	f1  f1 f2 F+  F/  FCONSTANT qq	PRIVATE

: contract1 ( ix -- ) ( F: x y -- x1 y1 )
		FLOCALS| y x |
		a1 x F*  b1 y F* F-  a1 F1- F+ ( x1)
		b1 x F*  a1 y F* F+  b1     F+ ( y1) 
		#32 > IF F2DUP FPLOT ENDIF ;P
		
: contract2 ( ix -- ) ( F: x y -- x1 y1 )
		FLOCALS| y x |
		a2 x F*  b2 y F* F-  a2 F- F1+ ( x2)
		b2 x F*  a2 y F* F+  b2     F- ( y2) 
		#32 > IF F2DUP FPLOT ENDIF ;P

: CONTRMC1	TEXTMODE? IF GRAPHICS ENDIF  GCLEAR
		 0 0 Xmax Ymax -3.2e -2.4e  3.2e 2.4e SET-GWINDOW
		 RESET-MDOTS  
		 0e 1e ( start )
		 #30000 0 DO	1 FCHOOSE qq F< IF  I contract1  ELSE  I contract2  ENDIF  LOOP
		 F2DROP
		 FLUSH-MDOTS
		TEXT ;

:ABOUT	CR ." Try: CONTRMC1 " ;


		.ABOUT -contrmc1 CR
		DEPRIVE

				(* End of Source *)