(*
 * LANGUAGE    : ANS Forth with extensions
 * PROJECT     : Forth Environments
 * DESCRIPTION : Peano line after Lindenmayer
 * CATEGORY    : Fractals
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : December 16, 2003, Marcel Hendrix 
 *)



 	NEEDS -miscutil
	NEEDS -graphics

	REVISION -peano "ÄÄÄ Peano line          Version 1.00 ÄÄÄ"

	PRIVATES

DOC
(*
 Draw a peano-like line fractal as a Lindenmayer system. 
*)
ENDDOC

CREATE x  PRIVATE  #3412 CELLS DUP ALLOT	x SWAP ERASE  
CREATE y  PRIVATE  #3412 CELLS DUP ALLOT	y SWAP ERASE  

Green VALUE color

  5   VALUE GMAX  PRIVATE
  0   VALUE NR	  PRIVATE

: contract1 ( p -- )
		LOCAL ix
	   	4  y ix   1+  CELL[] !  
		2  y ix   2+  CELL[] !	
		0  y ix   3 + CELL[] !  
		3  y ix   4 + CELL[] !
		1  y ix   5 + CELL[] !  
		0  y ix   6 + CELL[] !	
		1  y ix   7 + CELL[] !  
		3  y ix   8 + CELL[] !
		0  y ix   9 + CELL[] !  
		2  y ix #10 + CELL[] !	
		4  y ix #11 + CELL[] ! ;P
      
: contract2 ( p -- )
		LOCAL ix
	   	3  y ix   1+  CELL[] !  
		1  y ix   2+  CELL[] !	
		0  y ix   3 + CELL[] !  
		4  y ix   4 + CELL[] !
		2  y ix   5 + CELL[] !  
		0  y ix   6 + CELL[] !	
		2  y ix   7 + CELL[] !  
		4  y ix   8 + CELL[] !
		0  y ix   9 + CELL[] !  
		1  y ix #10 + CELL[] !	
		3  y ix #11 + CELL[] ! ;P

: (INIT)	1 TO NR
		0 LOCAL p
		1 x CELL+ !
		GMAX 1+ 1 DO	CLEAR p
			 	NR 1+ 
				   1 DO  CASE  x I CELL[] @ 
					   0 OF  1 +TO p  0  y p CELL[] !  ENDOF
					   1 OF  p  contract1  #11 +TO p   ENDOF 
					   2 OF  p  contract2  #11 +TO p   ENDOF
					   3 OF  1 +TO p  3  y p CELL[] !  ENDOF
					   4 OF  1 +TO p  4  y p CELL[] !  ENDOF
					 ENDCASE	
				   LOOP 
				p TO nr   y x  nr 1+ CELLS MOVE
		        LOOP ;P

: PEANOLIND ( n -- ) 
		5 UMIN TO GMAX ( system order )
		0e 0e FLOCALS| hh ff |
		(INIT)
		TEXTMODE? IF GRAPHICS ENDIF  GCLEAR
		 0 0 Xmax Ymax -0.7e -0.5e  1.7e 1.3e SET-GWINDOW
		 2e  GMAX NEGATE S>F  F** TO hh
		 0e TO ff  
		 0e TO PenX 0e TO PenY
		 NR 1+ 
		    1  DO  CASE x I CELL[] @
			   0 OF  ff FCOS hh F*  PenX F+
			         ff FSIN hh F*  PenY F+ 
				 color DRAW-SCALED-LINE ENDOF
			   3 OF  PI/2 -TO ff	  	ENDOF
			   4 OF  PI/2 +TO ff	  	ENDOF
			  ENDCASE 	
		    LOOP
		TEXT ;

:ABOUT		CR ." Try: <+n> PEANOLIND -- n is the system order (n<6)" ;


		.ABOUT -peano CR
		DEPRIVE

				(* End of Source *)