#!/usr/bin/perl
#copyright: Zach Morgan
#license: GPL2

use Gtk2;
use Gtk2::SimpleMenu;
use Gtk2::SimpleList;
use warnings;
use strict;
use Cairo;
use POSIX;#floor()

init Gtk2;

#some important g-g-g-globals!
my %w; #widgets
my ($w, $h)= (650, 623);
my ($numTilesX, $numTilesY)= (16, 13); # +1
my @centertile= (8,6);
#grid starting locations:
my ($gridStartX, $gridStartY)= (37,28);
my $pgonside= 23; #side length
my %colors= (
    'w' => [0, .1, .63],
    'b' => [.64, .68, .3],
    'j' => [0, .4, ,.03],
    'm' => [.4, .36, .33],
    'h' => [1, .57, 0],
    'blackteam' => [0, 0, 0],
    'redteam' => [1, .07, .07],
    'cyanteam' => [0, 1, 1],
    'yellteam' => [1, .9, 0]
);
my @teams=('blackteam', 'redteam', 'cyanteam', 'yellteam');
my $pplperteam= 10;
my $numboats=4;
 #@hexgrid.. vertically aligned. 
 #consists of [row]->[col]->{color=>'w', ppl=>[%,%...], fish=>'boat'}
my @hexgrid;
my $cr; #cairo context thing

my $localgame=1;
my $pointsVisible= 'own';
my $pplMovesPerTurn= 5;

sub setColor{
    my ($cr,$col)= @_;
    $cr->set_source_rgb(
      $colors{$col}->[0],
      $colors{$col}->[1],
      $colors{$col}->[2]
    );
}

my $menu;
my $menu_tree = [
    _File => {
        item_type => '<Branch>',
        children => [
            '_New-game' => {
                callback => \&newGame,
                callback_action => 7,
                accelerator => '<ctrl>N',
            },
            _Quit => {
                callback => sub { Gtk2->main_quit; },
                callback_action => 3,
                accelerator => '<ctrl>Q',
            },
        ]
    }
];

$w{window} = new Gtk2::Window;
$w{window}->signal_connect('destroy', sub {Gtk2->main_quit});

$w{topV} = new Gtk2::VBox;
$w{window}->add($w{topV});

$menu = Gtk2::SimpleMenu->new (
    menu_tree => $menu_tree,
    default_callback => \&default_callback,
    user_data => 'user_data',
);
$w{menu} = $menu->{widget};
$w{topV}->pack_start($w{menu}, 0, 0, 0);
$w{bigH} = new Gtk2::HBox;
$w{topV}->pack_start($w{bigH}, 1, 1, 0); # should expand

$w{gameBoard}= Gtk2::DrawingArea->new;
$w{gameBoard}->size($w, $h);
$w{eventB} = Gtk2::EventBox->new;
$w{eventB}->add($w{gameBoard});
$w{teams}= new Gtk2::Label();

$w{boardV} = new Gtk2::VBox;
$w{boardV}->pack_start($w{teams}, 0, 0, 0); # should expand
$w{boardV}->pack_start($w{eventB}, 0, 0, 0);
$w{bigH}->pack_start($w{boardV}, 0, 0, 0);
$w{sidepanelVBox}= new Gtk2::VBox;
$w{bigH}->pack_start($w{sidepanelVBox}, 0, 0, 0);

$w{diceHbox}= new Gtk2::HBox;
$w{sidepanelVBox}->pack_start($w{diceHbox}, 0, 0, 5);
$w{playerStats}= Gtk2::SimpleList->new (
           'player'    => 'text',
           'pieces safe'=> 'int',
           'points safe'=> 'int');
$w{sidepanelVBox}->pack_start($w{playerStats}, 0, 0, 5);
$w{piecesStats}= Gtk2::SimpleList->new (
           'value'    => 'int',
           'amount'   => 'int');
$w{sidepanelVBox}->pack_start($w{piecesStats}, 1, 1, 5);

$w{mvType}= Gtk2::DrawingArea->new;
$w{mvType}->size(100, 100);
$w{diceHbox}->pack_start($w{mvType}, 0, 0, 0);
$w{mvRem}= new Gtk2::Label();
$w{diceHbox}->pack_start($w{mvRem}, 1, 1, 5);

sub redraw_board{
    $w{gameBoard}->queue_draw;
}

package ppl;
    
sub new{
    my ($pplp, $val, $player, $tile)= @_;
    my ($x, $y)= @$tile;
    my $self= {
        val => $val,
        team => $player,
    };
    my $arr= $hexgrid [$y]->[$x]->{ppl};
    if ($#$arr==0){  #1 is too many ppl, max self.
        return 0;}
    push @$arr, $self;
    
    bless $self, 'ppl';
    return 1;# $self;
}

sub save{
    my $self= shift;
    my $data= $w{playerStats}->{data};
    
    for(0..3){
        if ($data->[$_]->[0] eq $self->{team}){
            $data->[$_]->[1]++;
            $data->[$_]->[2] += $self->{val};
        }
    }
    if (::noPplRemain($self->{team})){
        nextPhase();
        warn 'this should work.'
    }
}

package main;


##### begin team switching stuff #######
my $curteam;
my $curphase;
my $fishPhaseType;
my $mvRem;

sub resetPhase{
    $curteam='redteam';
    $curphase=0;
    $mvRem= $pplMovesPerTurn;
}
sub setTeam{
    $curteam= shift;
    my $lbl= join '   ', @teams;
    my $ulbl= uc($curteam);
    $lbl =~ s/$curteam/$ulbl/;
    $w{teams}->set_text($lbl);
    if($localgame==1 && $pointsVisible eq 'own'){
        redraw_board();
    }
}
sub nextTeam{
    my $i;
    for (0..3){
        $i=$_ if $curteam eq $teams[$_];
    }
    $i=($i+1)%4;
    setTeam ($teams[$i]);
    
}
my %moves=(
    whale => 3,
    shark => 2,
    serpent => 1);
my @monsters= ('serpent', 'shark', 'whale');
#phases: 0(ppl), 1(fishies), 2(tiles
sub nextPhase{
    if($curphase==2){
        nextTeam();
        $curphase=0;
        $mvRem= $pplMovesPerTurn;
    }else{
        $curphase++;
    }
    if($curphase==0){
        if (noPplRemain($curteam)){
            $curphase=1;
        }
    }
    if($curphase==1){
        $fishPhaseType= $monsters[floor(rand()*3)];
        $mvRem= $moves {$fishPhaseType};
    }
    if($curphase==2){
        #no more land?
        nextPhase() if $#{getAllTilesByColor('bjm')} == -1;
    }
    $w{mvRem}->set_text($mvRem);
    phase_expose($w{mvType});
}

sub phase_expose{
    my ($widget, $eventexpose) = @_;
    my $drawable= $widget->window;
    my $cr= Gtk2::Gdk::Cairo::Context->create ($drawable);
    $cr->rectangle (0, 0, 100, 100);
    $cr->set_source_rgb (1,1,1);
    $cr->fill;
    $cr->rectangle (0, 0, 100, 100);
    $cr->set_source_rgb (0, 0, 0);
    $cr->set_line_width (5);
    $cr->stroke;
    if($curphase==0){
        $cr->move_to(50,20);
        $cr->line_to(80,80);
        $cr->line_to(50,40);
        $cr->line_to(20,80);
        setColor($cr, $curteam);
        $cr->fill;
        $cr->move_to(19,90);
        $cr->set_source_rgb (0, 0, 0);
        $cr->show_text('move people');
    }
    elsif($curphase==1){ #fish
        $cr->move_to(15,40);
        $cr->line_to(22,33);
        $cr->line_to(50,31);
        $cr->line_to(68,49);
        $cr->line_to(68,31);
        $cr->line_to(50,49);
        $cr->line_to(22,47);
        $cr->close_path;
        $cr->stroke;
        
        $cr->move_to(22,90);
        $cr->set_source_rgb (0, 0, 0);
        $cr->show_text('move '. $fishPhaseType);
    }    
    else{
        $cr->move_to(30,20);
        $cr->line_to(70,20);
        $cr->line_to(85,50);
        $cr->line_to(70,80);
        $cr->line_to(30,80);
        $cr->line_to(15,50);
        $cr->close_path;
        $cr->stroke;
        
        $cr->move_to(22,90);
        $cr->set_source_rgb (0, 0, 0);
        $cr->show_text('flip tile');
    }
}
### end team switching stuff #####

sub getAdjacent{ #single tile
    my $t=shift;
    my ($x,$y)= @$t;
    my @adj;
    push @adj, [$x, $y-1];
    push @adj, [$x, $y+1];
    push @adj, [$x+1, $y];
    push @adj, [$x-1, $y];
    if($x&1){ #odd
        push @adj, [$x+1, $y-1];
        push @adj, [$x-1, $y-1];
    }
    else{
        push @adj, [$x+1, $y+1];
        push @adj, [$x-1, $y+1];
    }
    return \@adj;
}

sub getSurroundingWater{ 
    my $tiles=shift;
    my @sur;
    for (@$tiles){
        push @sur, @{getAdjacent($_)};
    }
    @sur= grep ($hexgrid[$_->[1]][$_->[0]]->{color} eq 'w', @sur);
    return \@sur; #has dupes.
}
sub tileExists{
    my ($x, $y)= @_;
    return 0 if $x<0;
    return 0 if $y<0;
    return 0 if $x>$numTilesX;
    if ($x&1) {return 0 if $y> $numTilesY}
    else {return 0 if $y> $numTilesY-1}
    return 1;
}
sub changetile{
    my ($t, $c)= @_;
    my ($x, $y)= @$t;
    unless (tileExists($x,$y)){ warn "x $x y $y"}
    $hexgrid [$y][$x]->{color}= $c;
}
sub changefish{
    my ($t, $f)= @_;
    my ($x, $y)= @$t;
    unless (tileExists($x,$y)){ warn "x $x y $y"}
    $hexgrid [$y][$x]->{fish}= $f;
}
sub getfish{
    my ($x, $y)= @_;
    unless (tileExists($x,$y)){ warn "tile x $x y $y outta range"}
    return $hexgrid [$y][$x]->{fish};
}
sub setfish{
    my ($x, $y, $f)= @_;
    unless (tileExists($x,$y)){ warn "tile x $x y $y outta range"}
    $hexgrid [$y][$x]->{fish}= $f;
}
sub getTileType{
    my ($x, $y)= @_;
    return $hexgrid[$y][$x]->{color}
}
sub putPpl{
    my ($t, $p)= @_;
    my ($x, $y)= @$t;
    unless (tileExists($x,$y)){ die "x $x y $y"}
    my $arr= $hexgrid [$y][$x]->{ppl};
    if ($arr->[-1]==2){  #too many ppl, max 3.
        return 0;}
    push @$arr, $p;
    return 1;
}

sub clearBoard{
    #waterize
    for my $y(0..$numTilesY){
        $hexgrid[$y]= []; #might be counterintuitive dimensions
        for my $x(0..$numTilesX){
            unless (tileExists($x, $y)) {next}#even columns are smaller.
            $hexgrid[$y][$x]= {color=> 'w', ppl=> []};
        }
    }
}

sub getAllTilesByColor{ #return all with if color in arg1.
    my $colors= shift;
    my @tiles;
    for my $y(0..$numTilesY){
        for my $x(0..$numTilesX){
            unless (tileExists($x, $y)) {next}
            my $tco= $hexgrid[$y][$x]->{color};
            if ($colors =~ m/$tco/){
                push @tiles, [$x, $y];
            }
        }
    }
    return \@tiles;
}
sub getLand{
    return getAllTilesByColor('mjb')
}
sub getWater{
    return getAllTilesByColor('w')
}
sub numTiles{
    my $type= shift;
    my $tiles= getAllTilesByColor($type);
    return $#$tiles + 1;
}

sub noPplRemain{
    my $team= shift;
    my $tiles= getAllTilesByColor('mjbw');
    my @allPpl;
    for my $t(@$tiles){
        push @allPpl, @{getppl($t->[0], $t->[1])};
    }
    if ($team){
        #grep {$_->{team} eq $team} @allPpl;
        for (@allPpl){
            if($_->{team} eq $team){
                return 0;
            }
        }
        return 1;
    }
    return 1 if $#allPpl == -1;
    return 0;
}
sub getppl{ #returns refs..
    my ($x, $y)= @_;
    return $hexgrid[$y][$x]->{ppl};
}
sub getTile{ #returns refs..
    my ($x, $y)= @_;
    return $hexgrid[$y][$x];
}

sub generateTerrain{
    clearBoard();
    changetile(\@centertile, 'm');
    my $mt= getAdjacent(\@centertile);
    for(@$mt){
        changetile($_, 'm');
    }
    my $jt= getSurroundingWater($mt);
    for (@$jt){
        changetile($_, 'j');
    }
    my $bt= getSurroundingWater($jt);
    warn $#$bt;
    changetile($bt->[int rand()*$#$bt], 'j');
    my $nbt= getSurroundingWater(getLand());
    for (@$nbt){
        changetile($_, 'b');
    }
    my $morebt= getSurroundingWater(getLand());
    changetile($morebt->[int rand()*$#$morebt], 'b');
    #gen havens:
    changetile([0,0],'h');
    changetile([1,0],'h');
    changetile([$numTilesX-1,0],'h');
    changetile([$numTilesX, 0],'h');
    changetile([0,$numTilesY-1],'h');
    changetile([1,$numTilesY],'h');
    changetile([$numTilesX-1,$numTilesY],'h');
    changetile([$numTilesX, $numTilesY-1],'h');
}

sub generateBoats{
    my $bWaters= getSurroundingWater(getLand());
    #'potential boats..they could intersect, which adds another element of randomness.
    for(1..$numboats){
        changefish($bWaters->[rand()*$#$bWaters], 'boat');
    }
}

my %monsters= (
    serpent => 8,
    shark => 2,
    whale => 2
);
sub generateMonsters{
    my $water= getWater();
    for my $m(keys %monsters){
        for(1..$monsters{$m}) {
            while(){
                # random water tile:
                my $pw= $water->[floor(rand()* ($#$water+1))];
                if (getfish($pw->[0], $pw->[1])) {next}
                setfish($pw->[0], $pw->[1], $m);
                last;
            }
        }
    }
}

sub generatePpl{
    my $remPpl= $pplperteam* 4;
    my $land= getLand();
    while ($remPpl>0){
        my $zTeam= $teams[($remPpl-1)/10];
        my $r= int rand() * ($#$land+1);
        $remPpl -= ppl->new(1, $zTeam, $land->[$r]);
        warn $remPpl if rand()>.9999; #maybe not enough tiles(lazy)
    }
}

sub resetWidgets{
    @{$w{playerStats}->{data}}= (
        ['blackteam', 0,0],
        ['redteam'  ,0,0],
        ['cyanteam'  ,0,0],
        ['yellteam'  ,0,0]
    );
    $w{mvRem}->set_text($mvRem);
    
    $w{window}->show_all;
    redraw_board;
    my $drawable= $w{gameBoard}->window;
    $cr= Gtk2::Gdk::Cairo::Context->create ($drawable);
}

sub newGame{
    generateTerrain;
    generateBoats
    generateMonsters;
    generatePpl;
    resetPhase;
    resetWidgets();
}

#constants for hex grid:
my $pgonMid= $pgonside* sqrt(3)/2; #tile half-height
my $pgonHeight=  $pgonside* sqrt(3);
my $pgonHalfSide= $pgonside/2;
    
#confusing trig stuff, you shouldn't need to understand this
# (as long as you use above sidelength and gridstart constants.)
sub dist{
    my ($x1,$x2,$y1,$y2)= @_;
    return sqrt(abs(($x1-$x2)**2 + ($y1-$y2)**2));
}

sub getTileCo{ #returns pixel of upperleft vertex
    my ($x, $y)= @_;
    my $tx= $gridStartX+ $x* $pgonside*1.5;
    my $ty=  ($x & 1)
      ? $gridStartY+ $y*$pgonHeight
      : $gridStartY+ $y*$pgonHeight+ $pgonMid;
    return (floor($tx), floor($ty))
}

sub getTileFromXY{ 
    my ($x, $y)= @_;
    my $vstep; #vertical half-tile index;
    my ($px1, $py1); #possibles
    my ($px2, $py2);
    my ($ax, $ay); #actual tile values
    #grid starts at 1st tile point, top-left
    $x-= ($gridStartX - $pgonside); #verified
    $y-= $gridStartY; #verf
    $vstep= floor($y/$pgonMid); #v
    $px1= floor($x/($pgonside*1.5))-1; #v
    $px2= $px1+1; #v
    unless (($vstep+$px1)& 1){# + slope
        $py1= floor(($vstep-1)/2); #v!
        $py2= ($px1&1) ? $py1 : $py1+1; #v!
    }
    else{ # neg. slope
        $py2= floor(($vstep-1)/2); 
        $py1= ($px2&1) ? $py2 : $py2+1; 
    }
    my ($pxc1, $pyc1)= getTileCo($px1, $py1);
    my ($pxc2, $pyc2)= getTileCo($px2, $py2);
    $x+= ($gridStartX - $pgonside); 
    $y+= $gridStartY; 
    my $d1= dist($pxc1+$pgonHalfSide, $x, $pyc1+$pgonMid, $y);
    my $d2= dist($pxc2+$pgonHalfSide, $x, $pyc2+$pgonMid, $y);
    
    return ($d1<$d2) #return nearest
     ? ($px1, $py1)
     : ($px2, $py2);
     
}

my %selection=(
    type=> 'ppl', #or fish
    num=> 0, #which person on tile.
    x => 4,
    y => 5,
    active => 0
);
### drawing stuff follows ###
my $blinkNow=1;
sub drawppl{
    my ($cr, $x, $y, $team, $val, $pos)= @_;
    if($pos != 0){
        $y -= 16;
        $x += ($pos==1) ? -10 : 10;
    }
    $cr->move_to($x,$y);
    $cr->line_to($x+8, $y+18);
    $cr->line_to($x,   $y+8);
    $cr->line_to($x-8, $y+18);
    setColor($cr, $team);
    $cr->fill;
    if($val>0){
        $cr->move_to($x,$y+8);
        $cr->line_to($x-8, $y+18);
        $cr->line_to($x-6, $y+23);
        $cr->line_to($x+6, $y+23);        
        $cr->line_to($x+8, $y+18);
        $cr->set_source_rgb (1, 1, 1);
        $cr->fill;
        
        $cr->move_to($x-3,$y+19);
        $cr->set_source_rgb (.1, .1, .1);
        $cr->show_text ($val);
    }
}

sub drawboat{
    my ($cr, $x, $y)= @_;
    $cr->move_to($x-2,$y+6.5);
    $cr->line_to($x+18, $y+3);
    $cr->line_to($x+23, $y+30);
    $cr->line_to($x+2, $y+33);
    $cr->set_source_rgb (.1, .1, .17);
    $cr->fill;
}
sub drawMonster{
    my ($cr, $x, $y, $fishtype)= @_;
    if ($fishtype eq 'serpent'){
        $cr->move_to($x+1, $y+30);
        $cr->line_to($x+11, $y+27);
        $cr->line_to($x+21, $y+30);
        $cr->line_to($x+14, $y+20);
        $cr->line_to($x+18, $y+9);
        $cr->line_to($x+22, $y+9);
        $cr->line_to($x+16, $y+3);
        $cr->line_to($x+4, $y+8);
        $cr->set_source_rgb (.02, .4, .06);
        $cr->fill;
    }
    elsif ($fishtype eq 'shark'){
        $cr->move_to($x+4, $y+30);
        $cr->line_to($x+19, $y+30);
        $cr->line_to($x+16, $y+14);
        $cr->line_to($x+10, $y+10);
        $cr->line_to($x+12, $y+18);
        $cr->set_source_rgb (.5, .5, .5);
        $cr->fill;
    }
    elsif ($fishtype eq 'whale'){
        $cr->move_to($x+1, $y+30);
        $cr->line_to($x+21, $y+30);
        $cr->line_to($x+18, $y+14);
        $cr->line_to($x+22, $y+12);
        $cr->line_to($x+21, $y+11);
        $cr->line_to($x+16, $y+10);
        $cr->line_to($x+11, $y+14);
        $cr->line_to($x+11, $y+16);
        $cr->line_to($x+15, $y+15);
        $cr->set_source_rgb (.5, .5, .9);
        $cr->fill;
    }
    else {warn 'unknown fish';}
}

sub drawTile{
    my ($cr, $x, $y, $bg, $blink)= @_;
    unless (exists ($hexgrid[$y][$x])) {
        return 0
    }#todo:fix
    unless (tileExists($x, $y)){
        return 0;
    }
     #coords for 1st tile point, top-left:
    my $tx= $gridStartX+ $x* $pgonside*1.5;
    my $ty=  $x % 2
      ? $gridStartY+ $y*$pgonHeight
      : $gridStartY+ $y*$pgonHeight+ $pgonMid;
    $cr->move_to($tx, $ty);
    $cr->line_to($tx+ $pgonside,   $ty);
    $cr->line_to($tx+ $pgonside+$pgonHalfSide,  $ty+ $pgonMid);
    $cr->line_to($tx+ $pgonside,    $ty+ $pgonHeight);
    $cr->line_to($tx, $ty+ $pgonHeight);
    $cr->line_to($tx- $pgonHalfSide,   $ty+ $pgonMid);
    
    my $path= $cr->copy_path;
    setColor($cr, $bg ? $bg : $hexgrid[$y][$x]->{color});
    
    $cr->fill;
    $cr->append_path($path);
    $cr->close_path;
    $cr->set_source_rgb (0, .03, .07);
    $cr->set_line_width (1.3);
    $cr->stroke;
    
    my $fishHere= getfish($x, $y);
    if($fishHere){
        if($blink && $selection{type} ne 'ppl'){return}
        if ($fishHere eq 'boat'){
            drawboat($cr, $tx, $ty);
        }
        else{
            drawMonster($cr, $tx, $ty, $fishHere);
        }
    }
    
    my $pplhere= getppl($x, $y);
    #print $pplhere->[0]->{team}, "\n";
    for my $i (0..$#$pplhere){
        if($blink && $selection{type}eq 'ppl'
            && $selection{num}==$i){next}
        my $p= $pplhere->[$i];
        my $team= $p->{team};
        my $pval= $p->{team} eq $curteam ? $p->{val} : 0;
        drawppl($cr, $tx+11, $ty+17, $team, $pval, $i);
    }
}
### end drawing stufff##
sub whirlpool{ #kills ecerything in nearby waters.
    my ($x, $y)= @_;
    my $WhirlpoolArea= getSurroundingWater([[$x, $y]]);
    push @$WhirlpoolArea, [$x, $y];
    for (@$WhirlpoolArea){
        setfish($_->[0], $_->[1], '');
        @{getppl($_->[0], $_->[1])}= ();
    }
}
sub genBoat{
    setfish($_[0], $_[1], 'boat');
}
sub genMonster{
    my $fish= $monsters[floor(rand()*3)];
    setfish($_[0], $_[1], $fish);
}
sub doNothing{
}

my @tileEvent;
for (1..3){push @tileEvent, \&genMonster}
for (1..3){push @tileEvent, \&genBoat}
for (1..3){push @tileEvent, \&whirlpool}
for (1..3){push @tileEvent, \&doNothing}
sub flipTile{
    my ($x, $y)= @_;
    return 0 unless tileExists($x, $y);
    my $terrain= getTileType($x,$y);
    return 0 if $terrain eq 'w';
    return 0 if $terrain eq 'h';
    return 0 if $terrain eq 'j' && numTiles('b');
    return 0 if $terrain eq 'm' && (numTiles('j') || numTiles('b'));
    my $ppl= getppl($x, $y);
    if ($#$ppl >= 0){
        my $othertiles= getAllTilesByColor($terrain);
        for my $t(@$othertiles){
            my $ppl= getppl($t->[0], $t->[1]);
            if ($#$ppl<0) {return 0}
        }
    }
    my $rn= floor(rand()*($#tileEvent+1));
    $tileEvent[$rn]->($x, $y);
    changetile([$x, $y], 'w');
    nextPhase;
    activateFish($x, $y);
    redraw_board();
    return 1;
}
sub hasControl{#team...of boat
    my ($thisteam, $ppl)= @_;
    my %teamsPresent;
    for my $p(@$ppl){
        if ($teamsPresent{$p->{team}}){
            $teamsPresent{$p->{team}} += 1;
        }
        else {$teamsPresent{$p->{team}} = 1}
    }
    if ($#$ppl < 2){
        return $teamsPresent{$thisteam} or 0;
    }
    else{
        my @keys= keys %teamsPresent;
        return $teamsPresent{$thisteam} if $#keys==2;
        return ($teamsPresent{$thisteam}==2) if $#keys==1;
        return $teamsPresent{$thisteam}
    }
}
sub doSelection{
    my ($x, $y, $rx, $ry)= @_; #r=relative
    my $fish= getfish($x, $y);
    my $ppl= getppl($x, $y);
    if($fish){
        if ($curphase==0){#ppl moving phase (boat counts as fish)
            goto CHOOSE_PPL if ($fish ne 'boat');
            goto CHOOSE_PPL unless (hasControl($curteam, $ppl));
            #should alternate selecting boat and ppl:
            if($selection{x}==$x && $selection{y}==$y){
                if ($selection{type} eq $fish && $selection{active}){
                    goto CHOOSE_PPL;
                }
            }
        }
        else{ #monster phase
            return 0 if $fish eq 'boat';
            return 0 if $fish ne $fishPhaseType;
        }
        %selection=(
            type=> $fish,
            x => $x,
            y => $y,
            active => 1
        );
        return 1;
    }
    CHOOSE_PPL:
    return 0 if $curphase != 0;#0 is ppl
    if($#$ppl+1){ #atleast 1 ppl
        if($#$ppl==0){ #1 ppl
            return 0 if $curteam ne $ppl->[0]->{team};
            %selection=(
                type=> 'ppl',
                num=> 0, #which person on tile.
                x => $x,
                y => $y,
                active => 1
            );
            return 1;
        }
        my $pos;
        if($ry>$pgonMid+4) {$pos=0}
        elsif($rx<$pgonHalfSide) {$pos=1}
        else {
            $pos=2;
            return 0 if $#$ppl==1;
        } 
        return 0 if $curteam ne $ppl->[$pos]->{team};
        %selection=(
            type=> 'ppl',
            num=> $pos, #which person on tile.
            x => $x,
            y => $y,
            active => 1
        );
        return 1;
    }
    return 0;
}
sub numppl{
    my $n= getppl(@_);
    return $#$n+1;    
}
sub activateFish{
    my ($tileX, $tileY)= @_;
    my $fish= getfish($tileX, $tileY);
    unless ($fish and numppl($tileX, $tileY)){
        return;
    }    
    if ($fish eq 'serpent' or $fish eq 'shark'){
        my $dppl= getppl($tileX, $tileY);
        @$dppl= ();
    }
}
sub moveFishTo{ #confirmed adjacent.
    my ($tileX, $tileY)= @_;
    my $src=getTile($selection{x}, $selection{y});
    my $dest=getTile($tileX, $tileY);
    if ($dest->{fish}){
        if ($src->{fish} eq 'shark'){
            if ($dest->{fish} eq 'whale'){
                #shark can't displace whale, just eats the ppl
                return 0 if $#{$dest->{ppl}}==-1;
                $dest->{ppl} = [];
                $mvRem -= 1;
                $w{mvRem}->set_text($mvRem);
                $selection{active}=0;
                drawTile($cr,$tileX, $tileY,0);
                drawTile($cr,$selection{x}, $selection{y},0);
                return 1;
            }
        }
        unless ($src->{fish} eq 'serpent'){ #serp eats all
            return 0 if $src->{fish} eq 'boat';
            return 0 if $src->{fish} eq 'shark';
            return 0 if $dest->{fish} ne 'boat';
        }
    }#else overwrite boat
    return 0 if $dest->{color} ne 'w';
    if($src->{fish} eq 'boat'){
        if (numppl($selection{x},$selection{y})+ numppl($tileX, $tileY)>3){
            return 0; #too many ppl on boat
        }
        push @{$dest->{ppl}}, @{$src->{ppl}};
        $src->{ppl}= [];
    }
    $dest->{fish}= $src->{fish};
    $src->{fish}= 0;
    $selection{active}=0;
    activateFish($tileX, $tileY);
    drawTile($cr,$tileX, $tileY,0);
    drawTile($cr,$selection{x}, $selection{y},0);
    $mvRem -= 1;
    $w{mvRem}->set_text($mvRem);
    return 1;
}
my %tileCost=(
    m=>3,
    j=>2,
    b=>1,
    w=>3);#boat=1
sub endGame{
     Gtk2->main_quit;
}
sub movePieceTo{#ret 1or0
    my ($tileX, $tileY)= @_;
    unless (tileExists($tileX, $tileY)) {return 0;}
    my ($sx, $sy)= ($selection{x}, $selection{y});
    my $a= getAdjacent(\@_);
    my $pos= $selection{num};
    for(@$a){
        if($_->[0]==$selection{x} && $_->[1]==$selection{y}){ #yes
            my $sppl= getppl($sx, $sy);
            my $dppl= getppl($tileX, $tileY);
            my $sfish= getfish($sx, $sy);
            if($sfish && ($selection{type} ne 'ppl')){
                return moveFishTo($tileX, $tileY);
            }
            if($#$dppl==2) {return 0}
            if(getTileType($tileX, $tileY) eq 'h'){ #haven
                $sppl->[$pos]->save();
                if (noPplRemain()){
                    endGame();
                }
                elsif (noPplRemain($curteam)){
                    nextPhase();
                }
            }
            else{
                push @$dppl, $sppl->[$pos];
            }
            #to remove @$sppl[$pos]...
            splice @$sppl, $pos, 1;
            $selection{active}=0;
            activateFish($tileX, $tileY);
            drawTile($cr,$tileX, $tileY,0);
            drawTile($cr,$sx, $sy,0);
            $mvRem -= ($sfish && ($sfish eq 'boat'))
              ? 1
              : $tileCost {getTileType($sx, $sy)};
            $w{mvRem}->set_text($mvRem);
            return 1;
        }#else next
    }
    return 0;
}

sub blinkSelection{
    if($selection{active}){
        drawTile($cr, $selection{x}, $selection{y}, 0, $blinkNow);
        $blinkNow ^= 1;
    }
    return 1;
}

#update board
#board exposes on powerup.
sub expose_cb{
    # $event would contain area to update
    my ($widget, $eventexpose) = @_;
    
    my $drawable= $w{gameBoard}->window;
    my $cr= Gtk2::Gdk::Cairo::Context->create ($drawable);

    
    #hex grid:
    #$my ($x1,$x2,$y1,$y2)= (0, $numTilesX, 0, $numTilesY);
    my @e= $eventexpose #exposed area
      ? $eventexpose->area->values
      : (0,0,$w, $h); 
    my ($x1, $y1)= getTileFromXY($e[0], $e[1]);
    my ($x2, $y2)= getTileFromXY($e[0]+$e[2], $e[1]+$e[3]+30);
    $y1-=1;#may be optimized further;
    $x1-=1;
    ($x1<0) and $x1=0;
    ($y1<0) and $y1=0;
    $x2= ($x2>=$numTilesX) ? $numTilesX : $x2+1;
    ($y2>$numTilesY) and $y2=$numTilesY;
    
    for my $y($y1..$y2){
        for my $x($x1..$x2){
            drawTile($cr, $x, $y, 0);
        }
    }
}

sub button_press_cb{
    # $widget is an eventbox
    my ($widget, $event) = @_;
    my ($x, $y)= $event->coords;
    my $button= $event->button;
    my ($tileX, $tileY)= getTileFromXY ($x, $y);
    drawTile($cr, $selection{x}, $selection{y},0,0);
    if ($event->button==1){
        if($curphase==2){
            flipTile($tileX, $tileY);
            return;
        }
        my @tileco= getTileCo($tileX, $tileY);
        if ($selection{active}){
            if(movePieceTo($tileX, $tileY)){
                if($mvRem<=0){
                    nextPhase;
                }
            }
            else{    
                doSelection($tileX, $tileY, $x-$tileco[0], $y-$tileco[1]);
            }
        }
        else{
            doSelection($tileX, $tileY, $x-$tileco[0], $y-$tileco[1]);
        }
    }
    else{ #other button clears selection
        $selection{active}=0;
    }
}

setTeam('redteam');
$w{gameBoard}->signal_connect ("expose_event" => \&expose_cb);
$w{mvType}->signal_connect ("expose_event" => \&phase_expose);
$w{eventB}->signal_connect ("button_press_event" => \&button_press_cb);
Glib::Timeout->add (300, \&blinkSelection);

newGame();

Gtk2->main ();

exit(0);