examples/mandelbrot.4th

   1 ( --- Complex arithmetic --- )
   2
   3 ( Location of floating point. )
   4 : precision 10000 ;
   5
   6 : >scaled precision 10 / * swap precision * + ;
   7
   8 ( Redefine multiplication.  Yay forth! )
   9 : * precision */ ;
  10
  11 : c* ( x1 y1 x2 y2 -- x3 y3 )
  12         swap -rot               ( x1 x2 y1 y2 )
  13         2dup * negate           ( x1 x2 y1 y2 -y1y2 )
  14         4 pick 4 pick * +       ( x1 x2 y1 y2 (x1x2-y1y2))
  15         4 roll 2 roll *         ( x2 y1 (x1x2-y1y2) x1y2 )
  16         3 roll 3 roll * +       ( (x1x2-y1y2) (x1y2+x2y1) )
  17 ;
  18
  19 : c+ ( x1 y1 x2 y2 -- x3 y3 )
  20         rot +
  21         -rot +
  22         swap
  23 ;
  24
  25 : csq 2dup c* ;
  26
  27 : cmagsq ( x1 y1 -- mag )
  28         csq abs
  29 ;
  30
  31 ( --- Mandelbrot set calculations  --- )
  32
  33 : iterate ( cr ci zr zi -- cr ci z'r z'i )
  34         csq c+
  35 ;
  36
  37 : inSet? ( cr ci -- res )
  38
  39     100 0 do
  40
  41         2swap 2dup 5 roll 5 roll
  42         iterate
  43         2dup cmagsq
  44         100 > if
  45             leave
  46         then
  47
  48     loop
  49 ;
  50
  51 ( Draw the Mandelbrot Set!)
  52 : mandel ( x1 y1 x2 y2 -- )
  53
  54 ;
  55
  56 ( Clean up - hide non-standard multiplication def. )
  57 hide *