(*
 * LANGUAGE    : ANS Forth 
 * PROJECT     : Forth Environments
 * DESCRIPTION : Plotting Barnsley's Fern
 * CATEGORY    : Example, Graphics
 * AUTHOR      : Marcel Hendrix, August 4, 1991
 * LAST CHANGE : Marcel Hendrix, October 18, 1991
 * LAST CHANGE : Monday, December 29, 2003 11:45 PM, Marcel Hendrix, added MAPLE1
 *)



	NEEDS -miscutil
	NEEDS -graphics
	NEEDS -arrays

	REVISION -fern "ÄÄÄ Fern Generator      Version 1.01 ÄÄÄ"

	PRIVATES


			-- The affine transformations.


4 =: #transformations		PRIVATE

#transformations 1+ FARRAY []a1	PRIVATE	-- "1+" : index 0 is never used
#transformations 1+ FARRAY []b1	PRIVATE
#transformations 1+ FARRAY []c1	PRIVATE
#transformations 1+ FARRAY []d1	PRIVATE
#transformations 1+ FARRAY []e1	PRIVATE
#transformations 1+ FARRAY []f1	PRIVATE

#transformations 1+  ARRAY []q1	PRIVATE	
		    0 TO 0 []q1

: >ROWS1	SWAP TO OVER []q1	\ <%> <ix> -- <> F: <r>..<r> -- <>
		TO DUP []f1	TO DUP []e1
		TO DUP []d1	TO DUP []c1
		TO DUP []b1	TO     []a1 ; PRIVATE

: CHOOSE1	#100 CHOOSE			\ <> --- <ix>
		#transformations >S
		S  1 ?DO
			   DUP I 1- []q1  I []q1 
			   WITHIN IF -S I >S LEAVE ENDIF
		    LOOP 
		DROP S> ; PRIVATE	

	-- The next coeffients COMPLETELY define the picture.

\ ----	   a 	   b 	   c 	   d 	   e 	   f	prob%	-------
	 0.00e	 0.00e	 0.00e	 0.16e	 0.00e	 0.00e	  1 	1 >ROWS1
	 0.85e 	 0.04e	-0.04e 	 0.85e   0.00e	 1.60e	 86	2 >ROWS1
	 0.20e	-0.26e	 0.23e	 0.22e	 0.00e	 1.60e	 93 	3 >ROWS1
	-0.15e	 0.28e	 0.26e	 0.24e	 0.00e	 0.44e  100 	4 >ROWS1

#transformations 1+ FARRAY []a2	PRIVATE	
#transformations 1+ FARRAY []b2	PRIVATE
#transformations 1+ FARRAY []c2	PRIVATE
#transformations 1+ FARRAY []d2	PRIVATE
#transformations 1+ FARRAY []e2	PRIVATE
#transformations 1+ FARRAY []f2	PRIVATE

#transformations 1+  ARRAY []q2	PRIVATE	
		    0 TO 0 []q2

: >ROWS2	SWAP TO OVER []q2	\ <%> <ix> -- <> F: <r>..<r> -- <>
		TO DUP []f2	TO DUP []e2
		TO DUP []d2	TO DUP []c2
		TO DUP []b2	TO     []a2 ; PRIVATE

: CHOOSE2	#100 CHOOSE			\ <> --- <ix>
		#transformations >S
		S  1 ?DO
			   DUP I 1- []q2  I []q2 
			   WITHIN IF -S I >S LEAVE ENDIF
		    LOOP 
		DROP S> ; PRIVATE	

\ ----	   a 	   b 	   c 	   d 	   e 	   f	prob%	-------
	 0.60e	 0.00e	 0.00e	 0.60e	 0.18e	 0.36e	 30 	1 >ROWS2
	 0.60e 	 0.00e	 0.00e 	 0.60e   0.18e	 0.12e	 60	2 >ROWS2
	 0.40e	 0.30e	-0.30e	 0.40e	 0.27e	 0.36e	 80 	3 >ROWS2
	 0.40e	-0.30e	 0.30e	 0.40e	 0.27e	 0.09e  100 	4 >ROWS2

DEFER CHOOSE-ONE	PRIVATE			\ <> --- <ix>
DEFER AFFINE-TRANSFORM	PRIVATE			\ <ix> --- <>

: CFERN		LOCAL ix
		ix []a1 PenX  F*  ix []b1 PenY F*  F+  ix []e1 F+
		ix []c1 PenX  F*  ix []d1 PenY F*  F+  ix []f1 F+
		TO PenY  TO PenX ; PRIVATE

: CMAPLE	LOCAL ix
		ix []a2 PenX  F*  ix []b2 PenY F*  F+  ix []e2 F+
		ix []c2 PenX  F*  ix []d2 PenY F*  F+  ix []f2 F+
		TO PenY  TO PenX ; PRIVATE

: IS-FERN	['] CFERN   IS AFFINE-TRANSFORM
		['] CHOOSE1 IS CHOOSE-ONE ;P

: IS-MAPLE	['] CMAPLE  IS AFFINE-TRANSFORM
		['] CHOOSE2 IS CHOOSE-ONE ;P

green VALUE Color

: MAIN-LOOP	#20000	\ <<< enlarge for more realism
		 0 ?DO 
			KEY? IF KEY DROP LEAVE ENDIF
			CHOOSE-ONE  AFFINE-TRANSFORM
			Color PLOT-POINT
		  LOOP ; PRIVATE	

: DO'M		TEXTMODE? IF GRAPHICS ENDIF  SET-GWINDOW MAIN-LOOP TEXT ; PRIVATE

: FERN1		IS-FERN 0 0 Xmax Ymax  -8.0e -1.0e   8.0e 11.0e  DO'M ;
: -FERN1	IS-FERN 0 0 Xmax Ymax   4.0e -1.0e  -4.0e 11.0e  DO'M ;
: THICK		IS-FERN 0 0 Xmax Ymax  -3.0e -1.0e   3.0e 11.0e  DO'M ;

: 4FERNS	IS-FERN
		0 	0 	 Xmax 2/ Ymax 2/  -8.0e -1.0e  8.0e 11.0e  DO'M
		0       Ymax 2/  Xmax 2/ Ymax     -8.0e 11.0e  8.0e -1.0e  DO'M
		Xmax 2/ 0        Xmax    Ymax 2/   8.0e -1.0e -8.0e 11.0e  DO'M
		Xmax 2/ Ymax 2/  Xmax    Ymax      8.0e 11.0e -8.0e -1.0e  DO'M	;

: MAPLE1	IS-MAPLE 0 0 Xmax Ymax   0.0e  0.2e  0.8e 1.0e  DO'M ;

:ABOUT		CR ."  Type FERN1 -FERN1 THICK MAPLE1 or 4FERNS to "
		CR ."  get a fractal picture of ferns or a maple leaf." 
		CR ;

		DEPRIVE
		.ABOUT -fern CR 

			      (* End of File *)