use strict;
use Tk;
use Tk::FileSelect;
use Tk::BrowseEntry;
use Math::Trig;
use IO::File;

my @Colors = ("dark green", "magenta", 
	      "red", "blue", "green", "gold", 
	      "brown", "purple", "light blue", 
	      "grey", "black"); 

# set up the display, with three frames: one for the drawing
# area, one for status bar and the third for the control bar.
my $main = MainWindow->new;
my $display = $main->Frame;
$display->pack(-side=>'left');
my $statusBar = $main->Frame;
$statusBar->pack(-side=>'left');
my $controlBar = $display->Frame;
$controlBar->pack(-side=>'bottom');

# initialize the drawing canvas
my $can = $display->Canvas(-height => 500, -width => 500,
			   -background => 'white')
    ->pack(-side=>'top');

# put controls for the x and y range in the control bar
# and add a button for redrawing
$controlBar->Label(-text=>'minX')->pack(-side=>'left');
my $minxEntry = $controlBar->Entry(-width=>5)
    ->pack(-side=>'left');
$controlBar->Label(-text=>'minY')->pack(-side=>'left');
my $minyEntry = $controlBar->Entry(-width=>5)
    ->pack(-side=>'left');
$controlBar->Label(-text=>'side')->pack(-side=>'left');
my $sideEntry = $controlBar->Entry(-width=>5)
    ->pack(-side=>'left');
$controlBar->Button(-text=>'Redraw',
		 -command=>sub{redrawCanvas()})
    ->pack(-side=>'left');

# add zoom buttons and right-left-up-down buttons
$controlBar->Button(-text=>'Zoom in',
		 -command=>sub{zoomIn()})
    ->pack(-side=>'left');
$controlBar->Button(-text=>'Zoom out',
		 -command=>sub{zoomOut()})
    ->pack(-side=>'left');
$controlBar->Button(-text=>'<',
		 -command=>sub{goLeft()})
    ->pack(-side=>'left');
$controlBar->Button(-text=>'>',
		 -command=>sub{goRight()})
    ->pack(-side=>'left');
$controlBar->Button(-text=>'^',
		 -command=>sub{goUp()})
    ->pack(-side=>'left');
$controlBar->Button(-text=>'v',
		 -command=>sub{goDown()})
    ->pack(-side=>'left');

# add buttons for reading a gap output file and for 
# quitting
$statusBar->Button(-text=>'Choose file',
		   -command=>sub{ChooseFile()})
    -> pack;
my $D;
my $discEntry = $statusBar->BrowseEntry(-label=>'Disc',
				       -width=>5,
					-variable=>\$D)
    ->pack;
$statusBar->Button(-text=>'Begin',
		   -command=>sub{initDraw()})
    ->pack;
$statusBar->Button(-text=>'Quit', 
		   -command=>[$main=>'destroy'])
    ->pack(-side=>'bottom');

# add information about algebra and current element
$statusBar->Label(-text=>'Algebra')->pack;
my $algLabel = $statusBar->Label(-text=>'undef',
				 -background=>'yellow')
    ->pack;
$statusBar->Label(-text=>'Group elem')->pack;
my $grpLabel = $statusBar->Label(-text=>'undef',
				 -background=>'yellow')
    ->pack;

# global variable for parameter file
my $paramFile = undef;

# set the global variables for the display
my ($minx, $miny, $side);
my @ArcList;

# set quaternion algebra constants
my $U;
my $V;

# set vertex list of the domain, has to be ordered
# so that the sides are between consecutive vertices
my @VertList;

# set group generators, inverse index and color map
my @Gen;
my @Inv;
my @ColorMap;

# set the centers of the neighbouring domains
my @GroupElem;
my @Centers;

resetAll();

# try to initialize the discriminant file from the
# command line
if (scalar(@ARGV) > 0) {

    $paramFile = $ARGV[0];
    updateDiscFromFile();
}
# otherwise, try the default file
else {

    if (-e "Grp100.txt") {

	$paramFile = "Grp100.txt";
	updateDiscFromFile();
    }
}

MainLoop;

############################
# ChooseFile chooses a file of gap output, reads the file
# and retrieves the set of discriminants to choose 
# from
sub ChooseFile {

    my $FS = $main->FileSelect(-directory=>'.');
    $paramFile = $FS->Show; 
    updateDiscFromFile() unless ($paramFile eq "");
}

############################
# updateDiscFromFile resets the discriminant entry
# and reads new discriminants from a file
sub updateDiscFromFile {

    $discEntry->delete(0, 'end');
    my $infile = new IO::File;
    $infile->open("<$paramFile");

    while (<$infile>) {

	if (/^D=\s+(\d+)/) {

	    $discEntry->insert('end', $1);
	}
    }
    $infile->close();
}

############################
# resetAll initializes all the viewer data
sub resetAll {

    @ArcList = ();
    @VertList = ();
    @Gen = ();
    @Centers = ();

    $minx = -1;
    $miny = -1;
    $side = 2;
    $minxEntry->delete(0,'end');
    $minyEntry->delete(0,'end');
    $sideEntry->delete(0,'end');
    $minxEntry->insert('end',$minx);
    $minyEntry->insert('end',$miny);
    $sideEntry->insert('end',$side);
    @GroupElem = (1, 0, 0, 0);

    $can->delete('all');
    # draw unit circle
    drawUnitCircle();
}

############################
# initDraw reads the parameters of the domain
# from the parameter file, using the discriminant
# choice. It then clears the canvas and draws one
# fundamental domain in the center.
sub initDraw {

    resetAll();
    my $infile = new IO::File;
    $infile->open("<$paramFile");

    while (<$infile>) {

	if (/^D=\s+$D/) {

	    my %VertData;
	    parseVert($infile, \%VertData);
	    parseAlg($infile);
	    parseGen($infile);
	    parseInv($infile);

	    convertVert(\%VertData);
	    createColorMap();
	    last;
	}
    }
    $infile->close();

    $algLabel->configure(-text=>"B(-$U,$V)");
    plotDomain();
}

############################
# parseVert parses the vertices in the gap output file
sub parseVert {

    my $infile = shift;
    my $pVert = shift;
    while (<$infile>) {

	# stop when reaching the algebra definition,
	# skip lines that have no "rel"
	last if (/algebra/);
	next unless (/rel/);

	# read the algebra element
	my ($i, $a, $b, $c, $d) = 
	    /^(\d+): rel\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/;

	$pVert->{"$i"} = [$a, $b, $c, $d];
    }
}

############################
# parseAlg parses the algebra information 
# in the gap output file
sub parseAlg {

    my $infile = shift;
    while (<$infile>) {

	if (/^B\(-(\d+),(\d+)\)/) {

	    $U = $1;
	    $V = $2;
	    last;
	}
    }
}

############################
# parseGen parses the group generators in 
# the gap output file
sub parseGen {

    my $infile = shift;
    my $last = 0;
    my $str = "";
    while (!$last) {

	$_ = <$infile>;
	$last = 1 if /\]/;
	s/^gen=//;
	s/[\[\]\s]//g;
	$str = $str.$_;
    }

    my @gens = split /,/,$str;

    my $s;
    for $s (@gens) {

	push (@Gen, getGen($s));
    }

    my ($g, $cx, $cy);
    for $g (@Gen) {

	@GroupElem = @$g;
	($cx, $cy) = moveVert(0, 0);
	push (@Centers, [$cx, $cy]);
    } 

    @GroupElem = (1, 0, 0, 0);
}

############################
# parseInv parses the inverse mapping of 
# the generators
sub parseInv {

    my $infile = shift;
    my $last = 0;
    my $str = "";
    while (!$last) {

	$_ = <$infile>;
	$last = 1 if /\]/;
	s/^imap=//;
	s/[\[\]\s]//g;
	$str = $str.$_;
    }

    @Inv = split /,/,$str;
}

############################
# getGen transforms a group generator in string format
# into a 4 element array
sub getGen {

    my $str = shift;
    my ($a, $b, $c, $d);

    $a = getCoef ($str, "e");
    $b = getCoef ($str, "i");
    $c = getCoef ($str, "j");
    $d = getCoef ($str, "k");

    return ([$a, $b, $c, $d]);
}

############################
# getCoef looks for the coefficient of a single base
# element inside the string format of a group element
sub getCoef {

    my ($str, $base) = @_;
    my $a;

    if ($str =~ /$base/) {

	if ($str =~ /\*$base/) {

	    $str =~ /\(([^\(]*)\)\*$base/;
	    my $val = $1;
	    if ($val =~ /\//) {

		$a = parseFrac($val);
	    }
	    else {

		$a = $val;
	    }
	}
	else {

	    $a = 1;
	}
    }
    else {

	$a = 0;
    }
    return ($a);
}

############################
# convertVert converts the vertices element data
# to actual vertices
sub convertVert {

    my $pVert = shift;
    my $len = scalar(keys (%$pVert));
    my $i;
    
    for ($i=1;$i <= $len;++$i) {

	my $pDat = $pVert->{"$i"};
	my $a = parseFrac($$pDat[0]);
	my $b = parseFrac($$pDat[1]);
	my $c = parseFrac($$pDat[2]);
	my $d = parseFrac($$pDat[3]);

	my $norm = $a*$a+$U*$b*$b-$V*($c*$c+$U*$d*$d);
	my $num = $b*sqrt($U);
	if ($b>0) {

	    $num -= sqrt($norm-$a*$a);
	}
	else {

	    $num += sqrt($norm-$a*$a);
	}
	my $den = sqrt($V)*($c*$c+$U*$d*$d);
	my $x = -$d*sqrt($U)*$num/$den;
	my $y = $c*$num/$den;

	push (@VertList, [$x, $y]);
    }
}

############################
# parseFrac converts a fraction string to a value
sub parseFrac {

    my $str = shift;
    return ($str) unless ($str=~/\//);

    my ($p, $q) = ($str =~ /(-?\d+)\/(\d+)/);
    return($p/$q);
}

############################
# createColorMap uses the inverse information to 
# creat the color map for drawing the domain
# sides
sub createColorMap {

    my $ind = 0;
    my $i;
    my $len = scalar(@Inv);
    my $lim = scalar(@Colors);
    for ($i = 0;$i < $len;++$i) {

	if ($Inv[$i] >= $i+1) {

	    if ($ind < $lim) {

		$ColorMap[$i] = $Colors[$ind];
	    }
	    else {

		# add a random color
		my ($r, $g, $b);
		$r = int(rand(200))+50;
		$g = int(rand(200))+50;
		$b = int(rand(200))+50;
		my $col = sprintf("#%02x%02x%02x", $r, $g, $b);
		$ColorMap[$i] = $col;
	    }
	    ++$ind;
	}
	else {

	    $ColorMap[$i] = $ColorMap[$Inv[$i]-1];
	}
    }
}

############################
# drawUnitCircle draws the unit circle
sub drawUnitCircle {

    my ($sx1, $sy1) = getScreenXY(-1, -1);
    my ($sx2, $sy2) = getScreenXY(1, 1);
    $can->createOval($sx1,$sy1,$sx2,$sy2, -outline=>'black');
}

############################
# plotArc takes two points and draws the hyperbolic segment
# connecting them, either a straight line or a circular
# arc.
sub plotArc {

    my ($x1, $y1, $x2, $y2, $col) = @_;

    # save arc in ArcList
    push(@ArcList, [$x1, $y1, $x2, $y2, $col]);

    my $den = $x1*$y2-$x2*$y1;
    if (abs($den) < 0.000001) {
	# draw a line
	my ($sx1, $sy1) = getScreenXY($x1, $y1);
	my ($sx2, $sy2) = getScreenXY($x2, $y2);
	$can->createLine($sx1, $sy1, $sx2, $sy2,
			 -fill=>$col);
    }
    else {
	# draw an arc
	# find the center and radius of the circle
	my $cx = (-$y1*(1+$x2*$x2+$y2*$y2)+
		  $y2*(1+$x1*$x1+$y1*$y1))/2/$den;
	my $cy = ($x1*(1+$x2*$x2+$y2*$y2)-
		  $x2*(1+$x1*$x1+$y1*$y1))/2/$den;
	my $r = sqrt(($cx-$x1)**2+($cy-$y1)**2);

	# find the needed angles in degrees, relative
	# to the circle
	my $ang1 = rad2deg(atan2($y1-$cy, $x1-$cx));
	my $ang2 = rad2deg(atan2($y2-$cy, $x2-$cx));
	my $diff = $ang2-$ang1;
	# it will always be the case that the arc is
	# less than half a circle, since the center
	# is outside the unit circle. This helps us in
	# determining the correct sign/direction.
	if ($diff > 180) {
	    $diff = $diff-360;
	}
	if ($diff < -180) {
	    $diff = $diff+360;
	}
	# print "$cx $cy $r $ang1 $ang2 $diff\n";

	my ($sx1, $sy1) = getScreenXY($cx-$r,$cy-$r);
	my ($sx2, $sy2) = getScreenXY($cx+$r,$cy+$r);
	
	$can->createArc($sx1, $sy1, $sx2, $sy2, 
			-start=>$ang1, -extent=>$diff, 
			-style=>"arc", -outline=>$col);
    }
}

############################
# getScreenXY transforms graph coordinates to screen 
# coordinates, reversing the y-axis direction too
sub getScreenXY {

    my ($x, $y) = @_;
    my $sx = 500*($x-$minx)/$side;
    my $sy = 500*($miny+$side-$y)/$side;
    return ($sx, $sy);
}
############################
# plotDomain draws the fundamental domain, connecting
# consecutive vertices from the vertex list, and closing
# by connecting the first and the last vertices.
# Then it plots the neighbouring centers.
sub plotDomain {

    my ($i, $v1, $v2, $m1x, $m1y, $m2x, $m2y);
    my $len = scalar(@VertList);
    for ($i = 0;$i<$len-1;++$i) {

	$v1 = $VertList[$i];
	$v2 = $VertList[$i+1];

	($m1x, $m1y) = moveVert($$v1[0], $$v1[1]);
	($m2x, $m2y) = moveVert($$v2[0], $$v2[1]);
	plotArc($m1x, $m1y, $m2x, $m2y, $ColorMap[$i+1]);
    }
    $v1 = $VertList[0];
    $v2 = $VertList[$len-1];

    ($m1x, $m1y) = moveVert($$v1[0], $$v1[1]);
    ($m2x, $m2y) = moveVert($$v2[0], $$v2[1]);
    plotArc($m1x, $m1y, $m2x, $m2y, $ColorMap[0]);

    drawCenters();

    # update the group element label
    my $lbl = sprintf("%.3fe%+.3fi%+.3fj%+.3fk", @GroupElem);
    $grpLabel->configure(-text=>$lbl);
}

############################
# drawCenters plots the center of domain and the centers
# of the neighboring domains, binding them to an update
# function.
sub drawCenters {

    # draw domain center
    my ($cx, $cy);
    my $len;
    $len = scalar(@Centers);
    my $ctr;
    my $idx;
    my $i;
    for ($i = 0;$i < $len;++$i) {

	$ctr = $Centers[$i];
	($cx, $cy) = getScreenXY(moveVert($$ctr[0], $$ctr[1]));
	$idx = $can->createOval($cx-10, $cy-10, $cx+10, $cy+10, 
				-tags=>'clear', -fill=>'green');
	my $j = $i;
	$can->bind($idx, '<1>', sub{moveByGen($j)});
    }
    ($cx, $cy) = getScreenXY(moveVert(0, 0));
    $can->createOval($cx-5, $cy-5, $cx+5, $cy+5, -tags=>'clear',
		     -fill=>'blue');
}

############################
# moveVert takes a point and moves it by the Mobius
# transformation defined by GroupElem. The formula
# is (Az+B)/(Cz+D), where A=a+b*sqrt(-U), 
# B=sqrt(V)*(c+d*sqrt(-U)), C and D are the conjugates of
# A and B. This is all computed using complex numbers
# in small stages, first the numerator and the denominator
# and then the quotient.
sub moveVert {

    my ($x, $y) = @_;
    my ($a, $b, $c, $d) = @GroupElem;
    my $Ax = $a;
    my $Ay = $b*sqrt($U);
    my $Bx = sqrt($V)*$c;
    my $By = sqrt($V)*$d*sqrt($U);

    my $numx = $Ax*$x-$Ay*$y + $Bx;
    my $numy = $Ax*$y+$Ay*$x + $By;
    my $denx = $Bx*$x+$By*$y + $Ax;
    my $deny = $Bx*$y-$By*$x - $Ay;
    
    my $norm = $denx*$denx+$deny*$deny;
    my $resx = ($numx*$denx+$numy*$deny) / $norm;
    my $resy = (-$numx*$deny+$numy*$denx) / $norm;

    return ($resx, $resy);
}
############################
# RightMult multiplies the main group translation by 
# another group element, should be a generator
sub RightMult {

    my ($pg) =@_;
    my @x = @GroupElem;
    my ($a, $b, $c, $d);
    
    $a = $x[0]*$$pg[0]-$U*$x[1]*$$pg[1]+
	$V*$x[2]*$$pg[2]+$U*$V*$x[3]*$$pg[3];
    $b = $x[0]*$$pg[1]+$x[1]*$$pg[0]-
	$V*$x[2]*$$pg[3]+$V*$x[3]*$$pg[2];
    $c = $x[0]*$$pg[2]-$U*$x[1]*$$pg[3]+
	$x[2]*$$pg[0]+$U*$x[3]*$$pg[1];
    $d = $x[0]*$$pg[3]+$x[1]*$$pg[2]-
	$x[2]*$$pg[1]+$x[3]*$$pg[0];

    @GroupElem = ($a, $b, $c, $d);
}

############################
# redrawCanvas clears the canvas and redraws all the arcs
# in ArcList. Then it adds the neighbouring centers.
sub redrawCanvas {

    # clear canvas;
    $can->delete('all');

    # read x and y ranges from entries
    $minx = $minxEntry->get;
    $miny = $minyEntry->get;
    $side = $sideEntry->get;

    # draw all arcs
    drawUnitCircle();

    # clear the arclist first, since every arc drawn gets
    # into this list
    my $i;
    my $len = scalar(@ArcList);
    my @tmpList = @ArcList;
    @ArcList = ();

    my $arc;
    for ($i = 0;$i < $len;++$i) {

	$arc = $tmpList[$i];
	plotArc($$arc[0], $$arc[1], $$arc[2], $$arc[3],
		$$arc[4]);
    }

    drawCenters();
}

############################
# zoomIn decreases side length by 50% while keeping 
# center
sub zoomIn {

    $minxEntry->delete(0,'end');
    $minyEntry->delete(0,'end');
    $sideEntry->delete(0,'end');

    $minxEntry->insert('end',$minx + $side*0.25);
    $minyEntry->insert('end',$miny + $side*0.25);
    $sideEntry->insert('end',0.5*$side);

    redrawCanvas();
}

############################
# zoomOut increases side length by 100% while keeping 
# center
sub zoomOut {

    $minxEntry->delete(0,'end');
    $minyEntry->delete(0,'end');
    $sideEntry->delete(0,'end');

    $minxEntry->insert('end',$minx - $side*0.5);
    $minyEntry->insert('end',$miny - $side*0.5);
    $sideEntry->insert('end',2*$side);

    redrawCanvas();
}

############################
# goUp moves 0.25 of the side up
sub goUp {

    $minyEntry->delete(0,'end');

    $minyEntry->insert('end',$miny + $side*0.25);

    redrawCanvas();
}

############################
# goDown moves 0.25 of the side down
sub goDown {

    $minyEntry->delete(0,'end');

    $minyEntry->insert('end',$miny - $side*0.25);

    redrawCanvas();
}

############################
# goLeft moves 0.25 of the side left
sub goLeft {

    $minxEntry->delete(0,'end');

    $minxEntry->insert('end',$minx - $side*0.25);

    redrawCanvas();
}

############################
# goRight moves 0.25 of the side right
sub goRight {

    $minxEntry->delete(0,'end');

    $minxEntry->insert('end',$minx + $side*0.25);

    redrawCanvas();
}

############################
# moveByGen is invoked when a the mouse button1 is
# pressed over a neighbour circle, and it moves the 
# focus to this neighbouring domain 
sub moveByGen {

    my $ind = shift;
    $can->delete('clear');
    RightMult($Gen[$ind]);
    plotDomain();
}