(*
 * LANGUAGE    : ANS Forth
 * PROJECT     : Forth Environments
 * DESCRIPTION : Julia Sets
 * CATEGORY    : Graphic example
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : April 6, 1994, Marcel Hendrix 
 *)



        NEEDS -miscutil
	NEEDS -graphics

        REVISION -julia2 "ÄÄÄ Julia Set           Version 1.00 ÄÄÄ"

	PRIVATES


DOC
(*
 Normal Julia Fractal of z:=z^2+c.
*)
ENDDOC

    0 VALUE Xm	PRIVATE
    0 VALUE Ym	PRIVATE

    0 VALUE n1	PRIVATE	
    0 VALUE n2	PRIVATE	

    0 VALUE i1  PRIVATE	
    0 VALUE i2  PRIVATE	
    0 VALUE j1  PRIVATE	
    0 VALUE j2  PRIVATE	

    0 VALUE Xx	PRIVATE
    0 VALUE Yy	PRIVATE	

-- Parameters are scaled up by 1000
 #1 VALUE Aa
 #5000 VALUE Bb
#15000 =: p1	PRIVATE
#15000 =: p2	PRIVATE

-- 256 colors is fine, but higher... Try a "paletting" function
: COLORIZE	STDCOLOR >S			\ <color> --- <>
		i1 j1 S  SET-DOT
		i2 j2 S> SET-DOT ; PRIVATE

: ISQR		EVAL" DUP #10000 */ " ; IMMEDIATE PRIVATE

: INNERLOOP	0 0 LOCALS| x1 y1 |		\ <> --- <>
		#250 0 
		  DO 
		     Xx ISQR  Yy ISQR - Aa + TO x1
		     Xx Yy   #5000 */   Bb + TO y1
		     Xx ISQR  Yy ISQR  + #1000000  
			  U> IF I COLORIZE UNLOOP EXIT ENDIF
		     Xx x1 - ISQR  Yy y1 - ISQR + 
			  0= IF I COLORIZE UNLOOP EXIT ENDIF
		     x1 TO Xx  y1 TO Yy
		LOOP 
		0 COLORIZE ; PRIVATE

: OUTERLOOP	n1 1+ 0 ?DO			\ <> --- <>
			   n2 NEGATE n2
			    ?DO
				Xm J + TO i1  Xm J - TO i2  J p1 n1 */ TO Xx
				Ym I - TO j1  Ym I + TO j2  I p2 n2 */ TO Yy
				INNERLOOP
			   -1 +LOOP
			   EKEY? ?LEAVE 
		       LOOP ; PRIVATE

: COMPUTE	TEXTMODE? $FF AND >R R@ IF GRAPHICS ENDIF
		GCLEAR
		Xmax 2/ TO Xm  
		Ymax 2/ TO Ym
		Xmax 2/ TO n1 
		n1 p1 p2 */ TO n2
		#100 0 DO OUTERLOOP #500 +TO Bb  #100 +TO Aa
			  WAIT? ?LEAVE 
		     LOOP 
		R> IF TEXT ENDIF ;

:ABOUT		CR ." Type COMPUTE for a normal Julia fractal (integers)." 
		CR ." XOR! gives a special effect, default is PUT!" ;


                .ABOUT -julia2 CR

		DEPRIVE  PUT!

                              (* End of Source *)