(*
 * LANGUAGE    : ANS Forth
 * PROJECT     : Forth Environments
 * DESCRIPTION : Exterior of Julia Fractal of z^2+c in binary coding
 * CATEGORY    : Graphic example
 * AUTHOR      : Marcel Hendrix 
 * LAST CHANGE : April 6, 1994, Marcel Hendrix 
 *)



        NEEDS -miscutil
	NEEDS -graphics

        REVISION -juliaf3 "ÄÄÄ Julia Fractal z^2+c Version 1.00 ÄÄÄ"

	PRIVATES


DOC
(*
 Exterior of Julia Fractal described by 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 j1  PRIVATE	

   0e FVALUE Xx	PRIVATE
   0e FVALUE Yy	PRIVATE	

-- Parameters 

 0.0e FVALUE Aa
 1.0e FVALUE Bb

  1.8e FCONSTANT p1 PRIVATE
  1.6e FCONSTANT p2 PRIVATE

: COLORIZE	i1 j1 ROT  SET-DOT ; PRIVATE	\ <col-index> --- <>

red    VALUE COLOR_TRUE   ( -- cr )
yellow VALUE COLOR_FALSE  ( -- cr )


1 [IF] ( Jos Ven's idea to add X,Y to colorize )

: INNERLOOP     0 LOCAL tmp			\ <> --- <>
		#10 
 		0 DO
		     Xx FSQR  Yy FSQR  F+ 
		     fdup Xx F* f>s I + TO tmp
		     1e2 F> IF Yy F0> IF color_true ELSE color_false ENDIF
			       tmp + COLORIZE UNLOOP EXIT
                         ENDIF
                      Xx FSQR  Yy FSQR F- Aa F+  ( x1)
                            Xx Yy F* F2*  Bb F+  ( y1)
                      F2DUP  Yy F- FSQR  FSWAP Xx F- FSQR  F+
                      1e-4  F< IF F2DROP UNLOOP EXIT ENDIF
                      TO Yy  TO Xx
		LOOP
		black COLORIZE ; PRIVATE

[ELSE]

: INNERLOOP	#250 0 				\ <> --- <>
		  DO 
		     Xx FSQR  Yy FSQR  F+ 
		     1e2 F> IF  Yy F0> IF color_true ELSE color_false ENDIF 
				COLORIZE UNLOOP EXIT
			 ENDIF
		     Xx FSQR  Yy FSQR F- Aa F+ ( x1)
		     	   Xx Yy F* F2*  Bb F+ ( y1)
		     F2DUP  Yy F- FSQR  FSWAP Xx F- FSQR  F+  
		     1e-4  F< IF F2DROP UNLOOP EXIT ENDIF
		     TO Yy  TO Xx
		LOOP 
		black COLORIZE ; PRIVATE

[THEN]

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

: COMPUTE	TEXTMODE? $FF AND >R R@ IF GRAPHICS ENDIF
		GCLEAR PUT!
		Xmax 2/ TO Xm
		Ymax 2/ TO Ym
		Xmax 2/ TO n1 
		n1 S>F p1 F* p2 F/ F>S TO n2
		OUTERLOOP 
		R> IF  TEXT  ENDIF ;

:ABOUT		CR ." Type COMPUTE for the exterior of a Julia fractal." 
		CR
		CR ." -1.754878e TO Aa  0e        TO Bb COMPUTE "
		CR ." -1.543689e TO Aa  0e        TO Bb COMPUTE " 
		CR ." 5e 4e F/   TO Aa  0e        TO Bb COMPUTE " 
		CR ." -1e        TO Aa  0e        TO Bb COMPUTE " 
		CR ." -0.75e     TO Aa  0e        TO Bb COMPUTE " 
		CR ."  0.25e     TO Aa  0e        TO Bb COMPUTE " 
		CR ."  0.3e      TO Aa  0e        TO Bb COMPUTE "
		CR ." -0.122561e TO Aa  0.744862e TO Bb COMPUTE "
		CR ." -0.101096e TO Aa  0.956287e TO Bb COMPUTE "
		CR ."  0.11e     TO Aa  0.67e     TO Bb COMPUTE " 
		CR ."  0.25e     TO Aa  0.25e     TO Bb COMPUTE "
		CR ." -0.318472e TO Aa  0.041257e TO Bb COMPUTE " ;


                .ABOUT -juliaf3 CR
		DEPRIVE

                              (* End of Source *)