(*
 * LANGUAGE    : ANS Forth with extensions
 * PROJECT     : Forth Environments
 * DESCRIPTION : Draw "Levy's line"
 * CATEGORY    : Iterative system with 2 contractors
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : December 10, 2003, Marcel Hendrix 
 *)



 	NEEDS -miscutil
	NEEDS -graphics

	REVISION -levy "ÄÄÄ Tree-like fractals  Version 1.00 ÄÄÄ"

	PRIVATES

DOC
(*
 Build Levy's fractal, point by point. A new generation is build from the previous one.
 Wasteful of memory, p=15 is about maximum for iForth 2.0's default memory size.
*)
ENDDOC

#15 =: p  PRIVATE
CREATE x  PRIVATE  p 1+ 2^x SFLOATS DUP ALLOT	x SWAP ERASE  
CREATE y  PRIVATE  p 1+ 2^x SFLOATS DUP ALLOT	y SWAP ERASE  

0.5e FSQRT   FCONSTANT rr  PRIVATE
0.5e FSQRT   FCONSTANT ss  PRIVATE
PI/4 	     FCONSTANT phi PRIVATE
PI/4 FNEGATE FCONSTANT psi PRIVATE

phi FCOS  rr F* FVALUE aa  PRIVATE	
phi FSIN  rr F* FVALUE bb  PRIVATE	
psi FCOS  ss F* FVALUE cc  PRIVATE	
psi FSIN  ss F* FVALUE dd  PRIVATE	

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]

-- FPLOT dominates, so extreme optimization has no use:
-- FORTH> cr timer-reset levy .elapsed ( DROP instead of PLOT-POINT )
-- 0.082 seconds elapsed. ok
-- FORTH> cr timer-reset levy .elapsed ( SET-DOT instead of DROP, window hidden )
-- 1.086 seconds elapsed. ok
-- FORTH> cr timer-reset levy .elapsed ( SET-DOT instead of DROP, small/large window )
-- 1.566 seconds elapsed. ok
: LR-contraction ( ix -- )
		LOCAL N
		N 2*    x []SFLOAT LOCAL 'x(2N)
		N 2* 1+ x []SFLOAT LOCAL 'x(2N+1)
		N 2*    y []SFLOAT LOCAL 'y(2N)
		N 2* 1+ y []SFLOAT LOCAL 'y(2N+1)

		N       x []SFLOAT SF@ FLOCAL x(N)
		N       y []SFLOAT SF@ FLOCAL y(N)

		aa x(N) F*  bb y(N) F* F-  aa F1- F+ ( x1)
		bb x(N) F*  aa y(N) F* F+  bb     F+ ( y1) 
		F2DUP 'y(2N)   SF!  'x(2N)   SF!  FPLOT 

		cc x(N) F*  dd y(N) F* F-  F1+ cc F- ( x2)
		dd x(N) F*  cc y(N) F* F+  dd     F- ( y2) 
		F2DUP 'y(2N+1) SF!  'x(2N+1) SF!  FPLOT ;P

: LEVY ( -- )   TEXTMODE? IF GRAPHICS ENDIF  GCLEAR
		 0 0 Xmax Ymax -2.4e -1.2e  2.4e 2.4e SET-GWINDOW
		 RESET-MDOTS
		  0e 1e  F2DUP y SFLOAT+ SF! x SFLOAT+ SF!  FPLOT
		  p 1+ 1 DO  I 2^x  I 1- 2^x DO  I LR-contraction  LOOP LOOP
		 FLUSH-MDOTS
		TEXT ;

:ABOUT	CR ." Try: LEVY " ;


		.ABOUT -levy CR
		DEPRIVE

				(* End of Source *)