(********************************************************************)
(*                                                                  *)
(*  mandelbr.sd7  Display the Mandelbrot set                        *)
(*  Copyright (C) 2007  Thomas Mertes                               *)
(*                                                                  *)
(*  This program is free software; you can redistribute it and/or   *)
(*  modify it under the terms of the GNU General Public License as  *)
(*  published by the Free Software Foundation; either version 2 of  *)
(*  the License, or (at your option) any later version.             *)
(*                                                                  *)
(*  This program is distributed in the hope that it will be useful, *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
(*  GNU General Public License for more details.                    *)
(*                                                                  *)
(*  You should have received a copy of the GNU General Public       *)
(*  License along with this program; if not, write to the           *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


$ include "seed7_05.s7i";
  include "float.s7i";
  include "complex.s7i";
  include "draw.s7i";
  include "pixmap_file.s7i";
  include "stdfont8.s7i";
  include "keybd.s7i";

# Display the Mandelbrot set, that are points z[0] in the complex plane
# for which the sequence z[n+1] := z[n] ** 2 + z[0] (n >= 0) is bounded.
# Since this program is computing intensive it should be compiled with
# s7c -O2 mandelbr


const integer: pix is 200;
const integer: max_iter is 256;
var float: startZoom is 1.3 / flt(pix);
var complex: startCenter is complex(-0.75, 0.0);

var float: zoom is startZoom;
var complex: center is startCenter;
var array color: colorTable is max_iter times black;
var text: screen is STD_NULL;
var PRIMITIVE_WINDOW: startWindow is PRIMITIVE_WINDOW.value;


const func integer: iterate (in complex: z0) is func
  result
    var integer: iter is 1;
  local
    var complex: z is complex.value;
  begin
    z := z0;
    while sqrAbs(z) < 4.0 and  # not diverged
        iter < max_iter do     # not converged
      z *:= z;
      z +:= z0;
      incr(iter);
    end while;
  end func;


const proc: displayMandelbrotSet (in complex: center, in float: zoom) is func
  local
    var integer: x is 0;
    var integer: y is 0;
    var complex: z0 is complex.value;
  begin
    for x range -pix to pix do
      for y range -pix to pix do
        z0 := center + complex(flt(x) * zoom, flt(y) * zoom);
        point(x + pix, y + pix, colorTable[iterate(z0)]);
      end for;
    end for;
  end func;


const proc: showHelp is func
  begin
    put(0, 0, startWindow);
    setPosXY(screen, 282, 126);
    writeln(screen, "HELP");
    setPosXY(screen, 252, 142);
    color(screen, light_cyan, black);
    writeln(screen, "Left mouse key:");
    setPosXY(screen, 234, 158);
    color(screen, white, black);
    writeln(screen, "Select a new center");
    setPosXY(screen, 222, 174);
    writeln(screen, "and magnify by factor 2.");
    setPosXY(screen, 246, 190);
    color(screen, light_cyan, black);
    writeln(screen, "Middle mouse key:");
    setPosXY(screen, 234, 206);
    color(screen, white, black);
    writeln(screen, "Select a new center.");
    setPosXY(screen, 252, 222);
    color(screen, light_cyan, black);
    writeln(screen, "Right mouse key:");
    setPosXY(screen, 228, 238);
    color(screen, white, black);
    writeln(screen, "Scale down by factor 2.");
    setPosXY(screen, 276, 254);
    color(screen, light_cyan, black);
    writeln(screen, "H:");
    setPosXY(screen, 294, 254);
    color(screen, white, black);
    writeln(screen, "Help");
    setPosXY(screen, 276, 270);
    color(screen, light_cyan, black);
    writeln(screen, "R:");
    setPosXY(screen, 294, 270);
    color(screen, white, black);
    writeln(screen, "Restart");
    setPosXY(screen, 276, 286);
    color(screen, light_cyan, black);
    writeln(screen, "Q:");
    setPosXY(screen, 294, 286);
    color(screen, white, black);
    writeln(screen, "Quit");
    setPosXY(screen, 156, 174);
    writeln(screen, "to");
    setPosXY(screen, 133, 190);
    writeln(screen, "leave help");
    setPosXY(screen, 138, 206);
    writeln(screen, "press any");
    setPosXY(screen, 156, 222);
    writeln(screen, "key");
  end func;


const proc: doCommand (inout char: ch) is func
  local
    var PRIMITIVE_WINDOW: savedWindow is PRIMITIVE_WINDOW.value;
  begin
    case upper(ch) of
      when {KEY_MOUSE1}:
        center := complex(center.re + zoom * flt(clickedXPos(KEYBOARD) - pix),
                          center.im + zoom * flt(clickedYPos(KEYBOARD) - pix));
        zoom := zoom / 2.0;
      when {KEY_MOUSE2}:
        center := complex(center.re + zoom * flt(clickedXPos(KEYBOARD) - pix),
                          center.im + zoom * flt(clickedYPos(KEYBOARD) - pix));
      when {KEY_MOUSE3}:
        zoom := zoom * 2.0;
      when {'R'}:
        zoom := startZoom;
        center := startCenter;
        put(0, 0, startWindow);
        ch := getc(KEYBOARD);
        doCommand(ch);
      when {'H'}:
        savedWindow := getPixmap(curr_win);
        showHelp;
        ch := getc(KEYBOARD);
        if ch not in {'q', 'Q', KEY_ESC, KEY_CLOSE} then
          put(0, 0, savedWindow);
          ch := getc(KEYBOARD);
          doCommand(ch);
        end if;
    end case;
  end func;


const proc: main is func
  local
    const integer: num_pix is 2 * pix + 1;
    var char: ch is ' ';
    var integer: col is 0;
  begin
    screen(num_pix, num_pix);
    selectInput(curr_win, KEY_CLOSE, TRUE);
    clear(curr_win, black);
    screen := openPixmapFontFile(curr_win);
    setFont(screen, stdFont8);
    KEYBOARD := GRAPH_KEYBOARD;
    for col range 1 to pred(max_iter) do
      colorTable[col] := color(65535 - (col * 5003) mod 65535,
                                       (col * 257)  mod 65535,
                                       (col * 2609) mod 65535);
    end for;
    displayMandelbrotSet(center, zoom);
    startWindow := getPixmap(curr_win);
    setPosXY(screen, 252, 126);
    writeln(screen, "M A N D E L B R");
    setPosXY(screen, 240, 142);
    writeln(screen, "Copyright (C) 2007");
    setPosXY(screen, 258, 158);
    writeln(screen, "Thomas Mertes");
    setPosXY(screen, 210, 174);
    writeln(screen, "This program is free soft-");
    setPosXY(screen, 210, 190);
    writeln(screen, "ware under the terms of");
    setPosXY(screen, 210, 206);
    writeln(screen, "the GNU General Public");
    setPosXY(screen, 210, 222);
    writeln(screen, "License. Mandelbr is wri-");
    setPosXY(screen, 210, 238);
    writeln(screen, "tten in the Seed7 program-");
    setPosXY(screen, 222, 254);
    writeln(screen, "ming language. Homepage:");
    setPosXY(screen, 234, 270);
    writeln(screen, "seed7.sourceforge.net");
    setPosXY(screen, 150, 190);
    writeln(screen, "press");
    setPosXY(screen, 162, 206);
    writeln(screen, "H");
    setPosXY(screen, 138, 222);
    writeln(screen, "for help");
    flushGraphic;
    ch := getc(KEYBOARD);
    if upper(ch) = 'H' then
      showHelp;
      ch := getc(KEYBOARD);
    end if;
    if ch not in {'q', 'Q', KEY_ESC, KEY_CLOSE} then
      if ch not in {KEY_MOUSE1, KEY_MOUSE2, KEY_MOUSE3} then
        put(0, 0, startWindow);
        ch := getc(KEYBOARD);
      end if;
      doCommand(ch);
      while ch not in {'q', 'Q', KEY_ESC, KEY_CLOSE} do
        if ch in {'r', 'R', KEY_MOUSE1, KEY_MOUSE2, KEY_MOUSE3} then
          displayMandelbrotSet(center, zoom);
          flushGraphic;
        end if;
        ch := getc(KEYBOARD);
        doCommand(ch);
      end while;
    end if;
  end func;