rendered paste body#!/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);