( Forth Mandelbrot Copyright Dr. David Alan Gilbert 21st May 2009 )
( Tested with gforth )
( Note I made the mistake of looping based on the value and since this is fixed point )
( it can do more items than asked for - and I can't be bothered reworking it yet )
( Version 0.0.1 )


8192 constant FIXEDSCALE

: "MANDSTRING" C" .,:loO*@ " ;

: plotval    ( iter -- )
  7 AND "MANDSTRING" 1 + +
  C@ EMIT
  ;

: mandpoint  ( yval xval -- )
  2dup         ( yval xval cury curx )
  1 >r         ( yval xval cury curx R:iter)
  begin
    2dup             ( yval xval cury curx cury curx R:iter)
    dup *            ( yval xval cury curx cury curx^2SCALE R:iter)
    FIXEDSCALE /     ( yval xval cury curx cury curx^2 R:iter)
    swap dup *       ( yval xval cury curx curx^2 cury^2SCALE R:iter)
    FIXEDSCALE /     ( yval xval cury curx curx^2 cury^2 R:iter)
    +                ( yval xval cury curx curx^2+cury^2 R:iter)
    4 FIXEDSCALE * < ( yval xval cury curx val R:iter) 
    i 4096 < AND     ( yval xval cury curx FLAG R:iter )
  while
    r> 1 + >r        ( yval xval cury curx R:iter )
    2dup >r >r       ( yval xval cury curx R: oldy oldx iter )
    * 2 *            ( yval xval 2xySCALE R: oldy oldx iter )
    FIXEDSCALE /     ( yval xval 2xy R: oldy oldx iter )
    rot dup -rot +   ( xval yval newy=2xy+yval R: oldy oldx iter )
    rot r> dup *     ( yval newy xval oldy^2SCALE R: oldx iter )
    r> dup *         ( yval newy xval oldy^2SCALE oldx^2SCALE R: iter)
    swap - FIXEDSCALE / ( yval newy xval oldx^2-oldy^2 R: iter)
    swap dup         ( yval newy oldx^2-oldy^2 xval xval R: iter )
    rot +            ( yval newy xval newx=oldx^2-oldy^2+xval R: iter )
    rot swap         ( yval xval newy newx R: iter )
  repeat
  drop drop drop drop ( R: iter)
  r> plotval         ( )
  ;

: count2step ( count end beg -- step end beg )
  2dup       ( count end beg end beg -- )
  -          ( count end beg diff -- )
  >r         ( count end beg --    R: diff )
  rot        ( end beg count -- R: diff)
  r> swap    ( end beg diff count -- )
  /          ( end beg step -- )
  -rot       ( step end beg )
  ;

: xloop      ( yval count end beg -- )
  count2step ( yval step end beg )
  do         ( yval step )
    swap dup   ( step yval yval )
    i          ( step yval yval xval )
    mandpoint  ( step yval )
    swap dup   ( yval step step )
  +loop      ( yval step )
  drop drop  ( )
  ;

: yloop     ( xcount xend xbeg ycount yend ybeg -- )
  count2step  ( xcount xend xbeg ystep yend ybeg )
  do          ( xcount xend xbeg ystep )
    cr
    i         ( xcount xend xbeg ystep yval )
    rot dup >r >r ( xcount xend ystep yval R: xbeg xbeg )
    rot dup r>    ( xcount ystep yval xend xend xbeg R: xbeg )
    swap >r       ( xcount ystep yval xend xbeg R: xend xbeg )
    >r >r rot dup ( ystep yval xcount xcount R: xend xbeg xend xbeg )
    rot swap      ( ystep xcount yval xcount R: xend xbeg xend xbeg )
    r> r>         ( ystep xcount yval xcount xend xbeg R: xend xbeg )
    xloop         ( ystep xcount R: xend xbeg )
    swap r> swap  ( xcount xend ystep R: xbeg )
    r> swap       ( xcount xend xbeg ystep )
    dup           ( xcount xend xbeg ystep ystep )
  +loop           ( xcount xend xbeg ystep )
  drop drop drop drop
  ;

( Note this takes integer inputs so you don't have that much choice!)
: mandelbrot ( widthchars left right heightchars top bottom -- )
  swap               ( widthchars left right heightchars bottom top )
  FIXEDSCALE * >r    ( widthchars left right heightchars bottom R: topscale )
  FIXEDSCALE * >r >r ( widthchars left right R: heightchars bottomscale topscale )
  swap               ( widthchars right left R: heightchars bottomscale topscale ) 
  FIXEDSCALE *       ( widthschars right leftscale R: heightchars bottomscale topscale )
  swap FIXEDSCALE *  ( widthschars leftscale rightscale R: heightchars bottomscale topscale )
  swap r> r> r>      ( widthschars rightscale leftscale heightchars bottomscale topscale )
  yloop
  ;

: dobrot
  78 -2 2 23 -2 2 mandelbrot ;