$ include "seed7_05.s7i";
include "float.s7i";
include "complex.s7i";
include "draw.s7i";
include "pixmap_file.s7i";
include "stdfont8.s7i";
include "keybd.s7i";
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
iter < max_iter do
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;