implement FractalM;

# This code started life as Reversi which is
# Copyright © 2000 Vita Nuova Limited. All rights reserved.
# I'm under the impressions that therefore this is GPL as per distribution, I'm sure no-one will mind

include "sys.m";
	sys: Sys;
include "draw.m";
	draw: Draw;
	Point, Rect, Image, Font, Context, Screen, Display: import draw;
include "tk.m";
	tk: Tk;
	Toplevel: import tk;
include "tkclient.m";
	tkclient: Tkclient;
include "daytime.m";
	daytime: Daytime;
include "rand.m";
	rand: Rand;
include "math.m";
	math : Math;

# adtize and modularize

stderr: ref Sys->FD;

FractalM: module 
{
	init: fn(ctxt: ref Draw->Context, argv: list of string);
};

display: ref Draw->Display;

init(ctxt: ref Draw->Context, argv: list of string)
{
	sys = load Sys Sys->PATH;
	draw = load Draw Draw->PATH;
	tk = load Tk Tk->PATH;
	tkclient = load Tkclient Tkclient->PATH;
	tkclient->init();
	daytime = load Daytime Daytime->PATH;
	rand = load Rand Rand->PATH;
	math = load Math Math->PATH;

	argv = tl argv;
	while(argv != nil){
		s := hd argv;
		if(s != nil && s[0] == '-'){
			for(i := 1; i < len s; i++){
				case s[i] {
				* => ;
				}
			}
		}
		argv = tl argv;
	}
	stderr = sys->fildes(2);
	rand->init(daytime->now());
	daytime = nil;

	if(ctxt == nil)
		ctxt = tkclient->makedrawcontext();
	display = ctxt.display;
	(win, wmctl) := tkclient->toplevel(ctxt, "", "No Frills Fractals", Tkclient->Resize | Tkclient->Hide);
	mainwin = win;
	sys->pctl(Sys->NEWPGRP, nil);
	cmdch := chan of string;
	tk->namechan(win, cmdch, "cmd");
	for(i := 0; i < len win_config; i++)
		cmd(win, win_config[i]);
	fittoscreen(win);
	pid := -1;
	reset_zoom();
	setimage();
	drawboard();
	tkclient->onscreen(win, nil);
	tkclient->startinput(win, "kbd"::"ptr"::nil);
	sweep : Rect;
	for(;;){
		alt {
			s := <-win.ctxt.kbd =>
				tk->keyboard(win, s);
			s := <-win.ctxt.ptr =>
				tk->pointer(win, *s);
			s := <-win.ctxt.ctl or
			s = <-win.wreq =>
				tkclient->wmctl(win, s);
			c := <- wmctl =>
				case c {
					"exit" =>
						if(pid != -1)
							kill(pid);
						exit;
					* =>
						e := tkclient->wmctl(win, c);
						if(e == nil && c[0] == '!'){
							setimage();
							drawboard();
						}
				}
			c := <- cmdch =>
				(nil, toks) := sys->tokenize(c, " ");
				case hd toks {
					"b1" =>
						printls(toks);
						sweep.min.x = int hd tl toks;
						sweep.min.y = int hd tl tl toks;
					"sweep1" =>
						sweep.max.x = int hd tl toks;
						sweep.max.y = int hd tl tl toks;
					"release1" =>
						printls(toks);
						set_zoom(brdimg.r, sweep);
						drawboard();
					"bh" or "bm" or "wh" or "wm" =>
						;
					"blev" or "wlev" =>
						;
					"resetzoom" =>
						reset_zoom();
						drawboard();
					* =>
						;
				}
		}
	}
}

SQUARE, REPLAY: con iota;

WIDTH: con 100;
HEIGHT: con 200;
MAXITERATIONS: con 64;
GREYSCALER : con 256 / MAXITERATIONS;

SKILLB : con 6;
SKILLW : con 0;

mainwin: ref Toplevel;
brdimg: ref Image;
brdr: Rect;
brdx, brdy: int;

Xmin, Ymin, Xmax, Ymax : real;

setimage()
{
	brdw := int tk->cmd(mainwin, ".p cget -actwidth");
	brdh := int tk->cmd(mainwin, ".p cget -actheight");

	brdr = Rect((0,0), (brdw, brdh));
	brdimg = display.newimage(brdr, display.image.chans, 0, Draw->White);
	if(brdimg == nil)
		fatal("not enough image memory");
	tk->putimage(mainwin, ".p", brdimg, nil);
}

printr(r : Rect)
{
	log(sys->sprint("(%d, %d), (%d, %d)\n", r.min.x, r.min.y, r.max.x, r.max.y));
}

printls(s : list of string)
{
	sys->fprint(stderr, "[");
	while(s != nil) {
		sys->fprint(stderr, "%s,", hd s);
		s = tl s;
	}
	sys->fprint(stderr, "]\n");
}

set_zoom(r, s : Rect) {
	ys := math->fabs((Ymax - Ymin) / real (r.max.y - r.min.y));
	xs := math->fabs((Xmax - Xmin) / real (r.max.x - r.min.x));
	log("r");
	printr(r);
	log("s");
	printr(s);


#	log("brdimg.r.max.y " + string brdimg.r.max.y + " brdimg.r.min.y " + string brdimg.r.min.y + " ys " + string ys);
			
	if(Xmin < 0.0)
		Xmin += xs * real s.min.x;
	else
		Xmin -= xs * real s.min.x;
				
	if(Xmax < 0.0)
		Xmax += xs * real (r.max.x - s.max.x);
	else
		Xmax -= xs * real (r.max.x - s.max.x);

	if(Ymin < 0.0)
		Ymin += ys * real (r.max.y - s.max.y); 
	else
		Ymin -= ys * real (r.max.y - s.max.y); 
	
	if(Ymax < 0.0)
		Ymax += ys * real (s.min.y);
	else
		Ymax -= ys * real (s.min.y);
}

reset_zoom() {
	Xmin = -2.5;
	Ymin = -1.5;
	Xmax = 1.5;
	Ymax = 1.5;
}


mandel(x, y : real) : int
{
	i : int;
	r := x + x * x - y * y;
	r2 := r * r;

	j := y + x * y + x  * y;
	j2 := j * j;
	
 	for(i = 2; i < MAXITERATIONS; i++) {
		{
			j = y + r * j + r * j;
			r = x - j2 + r2;
			j2 = j * j;
			if(j2 > 4.0) break;
			r2 = r * r;
			if(j2 + r2 > 4.0) break;
		} exception e {
			"*" =>
				log(e);
		}
	}	

	return i;
}	
puts(s: string)
{
	# while(sfont.width(s) > swidth)
	#	s = s[0: len s -1];
	cmd(mainwin, ".f1.txt configure -text {" + s + "}");
	cmd(mainwin, "update");
}

drawboard()
{
	data := array [(brdimg.r.max.x - brdimg.r.min.x) * (brdimg.r.max.y - brdimg.r.min.y) * 4] of byte;
	m : int;
	p := 0;
	xs, ys : real;
	ys = (Ymax - Ymin) / real (brdimg.r.max.y - brdimg.r.min.y);
	xs = (Xmax - Xmin) / real (brdimg.r.max.x - brdimg.r.min.x);
	log("(" + string Xmin + ", " + string Ymin + ")-(" + string Xmax + "," + string Ymax + ")");
	for(y := brdimg.r.max.y; y > 0; y--) 
	for(x := brdimg.r.min.x; x < brdimg.r.max.x; x++) {
		m = GREYSCALER * mandel(Xmin + real x * xs, Ymin + real y * ys);
		data[p++] = byte m;
		data[p++] = byte m;
		data[p++] = byte m;
		data[p++] = byte 255;
	}
	brdimg.writepixels(brdimg.r, data);
	panelupdate();
}

panelupdate()
{
	tk->cmd(mainwin, sys->sprint(".p dirty %d %d %d %d", brdr.min.x, brdr.min.y, brdr.max.x, brdr.max.y));
	tk->cmd(mainwin, "update");
}

log(s: string)
{
	sys->fprint(stderr, "%s\n", s);
}

fatal(s: string)
{
	log(s);
	exit;
}

kill(pid: int): int
{
	fd := sys->open("#p/"+string pid+"/ctl", Sys->OWRITE);
	if(fd == nil)
		return -1;
	if(sys->write(fd, array of byte "kill", 4) != 4)
		return -1;
	return 0;
}

cmd(top: ref Toplevel, s: string): string
{
	e := tk->cmd(top, s);
	if (e != nil && e[0] == '!')
		sys->fprint(stderr, "reversi: tk error on '%s': %s\n", s, e);
	return e;
}

fittoscreen(win: ref Tk->Toplevel)
{
	Point: import draw;
	if (display.image == nil)
		return;
	r :=  display.image.r;
	scrsize := Point(r.dx(), r.dy());
	bd := int cmd(win, ". cget -bd");
	winsize := Point(int cmd(win, ". cget -actwidth") + bd * 2, int cmd(win, ". cget -actheight") + bd * 2);
	if (winsize.x > scrsize.x)
		cmd(win, ". configure -width " + string (scrsize.x - bd * 2));
	if (winsize.y > scrsize.y)
		cmd(win, ". configure -height " + string (scrsize.y - bd * 2));
	actr: Rect;
	actr.min = Point(int cmd(win, ". cget -actx"), int cmd(win, ". cget -acty"));
	actr.max = actr.min.add((int cmd(win, ". cget -actwidth") + bd*2,
				int cmd(win, ". cget -actheight") + bd*2));
	(dx, dy) := (actr.dx(), actr.dy());
	if (actr.max.x > r.max.x)
		(actr.min.x, actr.max.x) = (r.max.x - dx, r.max.x);
	if (actr.max.y > r.max.y)
		(actr.min.y, actr.max.y) = (r.max.y - dy, r.max.y);
	if (actr.min.x < r.min.x)
		(actr.min.x, actr.max.x) = (r.min.x, r.min.x + dx);
	if (actr.min.y < r.min.y)
		(actr.min.y, actr.max.y) = (r.min.y, r.min.y + dy);
	cmd(win, ". configure -x " + string actr.min.x + " -y " + string actr.min.y);
	cmd(win, "update");
}
					
win_config := array[] of {
	"frame .f",
	"button .f.resetzoom -text {reset zoom} -command {send cmd resetzoom}",
	"menubutton .f.bk -text Black -menu .f.bk.bm",
	"menubutton .f.wk -text White -menu .f.wk.wm",
	"menu .f.bk.bm",
	".f.bk.bm add command -label Human -command { send cmd bh }",
	".f.bk.bm add command -label Machine -command { send cmd bm }",
	"menu .f.wk.wm",
	".f.wk.wm add command -label Human -command { send cmd wh }",
	".f.wk.wm add command -label Machine -command { send cmd wm }",
	"pack .f.bk -side left",
	"pack .f.wk -side right",
	"pack .f.resetzoom -side top",

	"frame .f0",
	"label .f0.bl -text {Black level}",
	"label .f0.wl -text {White level}",
	"entry .f0.be -width 32",
	"entry .f0.we -width 32",
	".f0.be insert 0 " + string SKILLB,
	".f0.we insert 0 " + string SKILLW,
	"pack .f0.bl -side left",
	"pack .f0.be -side left",
	"pack .f0.wl -side right",
	"pack .f0.we -side right",

	"frame .f1",
	"label .f1.txt -text { } -width " + string WIDTH,
	"pack .f1.txt -side top -fill x",

	"panel .p -width " + string WIDTH + " -height " + string HEIGHT,

	"pack .f -side top -fill x",
	"pack .f0 -side top -fill x",
	"pack .f1 -side top -fill x",
	"pack .p -side bottom -fill both -expand 1",
	"pack propagate . 0",

	"bind .p <Button-1> {send cmd b1 %x %y}",
	"bind .p <Motion-Button-1> {send cmd sweep1 %x %y}",
	"bind .p <ButtonRelease-1> {send cmd release1 %x %y}",
	"bind .f0.be <Key-\n> {send cmd blev}",
	"bind .f0.we <Key-\n> {send cmd wlev}",
	"update",
};