#!/usr/bin/perl -w
#  $Id: ShowSite.pm 349 2008-07-30 17:41:50Z overmars $

#/**  \file
# ShowSite - Displays and provides a GUI for updating a map location
#
#  Only supports a single instance of the ShowSite object
#
#  ShowSite - sets values of selected map cell and displays
# savOptions - stores the selections into the map cell
#
# */

# /** \class ShowSite Class creates the graphic information to select
# items in a map cell */

###
### AUTHORS
##   John D. Overmars overmars@rejiquar.com,
##   and Rob Duncan duncan@rejiquar.com
##
## COPYRIGHT
##   Copyright 2008 John D. Overmars and Rob Duncan, All rights reserved.
##
## LICENSE
##   This software is provided under the Perl Artistic License.  It may be
##   distributed, and revised according to the terms of that license.
##

## ShowSite - Displays and provides a GUI for updating a map location

package ShowSite;

use strict;
use Tk;

use base qw/OUtil/;
use ArchWall;

#-------------   Lexical Variable Declarations   -----------------------------

my $savTag;	       # holds which shape was selected from the Open map
my %rbVar;             # $rbVar{$savTag}{'1'}
                       # - holds which kind of thing is in that spot
                       #   except the pile which has no variations
my %widgetList;
my %colors;	       # Colors used in the Open graphic hashed by $facing.$tag
my %frame;             # Choices for each Open Graphic shape indexed by $savTag
my %pileVar;           # Hash of things in pile indexed by name
my %contains;          # Objects in the site
my @pileArray;         # The array of objects in the pile

my $side = 200;

my $debug = 0;
my $debugCalls = 0;	 # True to print call info

##
##  Create the properties selection Window
##
&init();

#-----------------------------------------------------------------
sub shape {
  my $p0 = 0;
  my $p1 = 1*$side/10;
  my $p2 = 2*$side/10;
  my $p3 = 3*$side/10;
  my $p4 = 4*$side/10;
  my $p5 = 5*$side/10;
  my $p6 = 6*$side/10;
  my $p7 = 7*$side/10;
  my $p8 = 8*$side/10;
  my $p9 = 9*$side/10;

  ([$p9,$p0,$side,$p9,  'E', 'edge',],
   [$p8,$p4,$p9,$p6,    'E', 'decor'],
#  [$p7,$p6,$p8,$p8,    'E', 'chest'],
   [$p0,$p1,$p1,$side,  'W', 'edge',],
   [$p1,$p4,$p2,$p6,    'W', 'decor'],
#  [$p2,$p2,$p3,$p4,    'W', 'chest'],
   [$p0,$p0,$p9,$p1,    'N', 'edge',],
   [$p4,$p1,$p6,$p2,    'N', 'decor'],
   [$p6,$p2,$p8,$p3,    'N', 'chest'],
   [$p1,$p9,$side,$side,'S', 'edge' ],
   [$p4,$p8,$p6,$p9,    'S', 'decor'],
#  [$p2,$p7,$p4,$p8,    'S', 'chest'],
   [$p4,$p4,$p6,$p6,    'C', 'pile' ],);
}

#-----------------------------------------------------------------
sub get_choices {
  my ($where) = @_;

  if    ($where eq 'edge') {
    return qw/None Wall ArchWall Door BarDoor StoneDoor/;
  }
  elsif ($where eq 'decor') {
    return qw/None Sign Character/;
  }
  elsif ($where eq 'chest') {
    return qw/None Chest Detector Switch Torch/;
  }
  elsif ($where eq 'pile') {
    return qw/Key Sword Helmet Treasure Robe Shoes Letter Lamp Knife MappingKit/;
  }
  else {
    warn "no such choice type $where";
    return undef;
  }
}

#-----------------------------------------------------------------------------
##
## Build Initial Frames for each Picture element
##
sub buildFrames {
  my ($self) = @_;

  my $i = 0;			# position

  foreach my $ary (shape()) {
    my @ary = @$ary;
    #warn "shape $ary[4] $ary[5]";
    my $tag = $ary[4].$ary[5];
    my $tag1 = $ary[5];
    next if defined $frame{$tag1};
    $widgetList{$tag1} = [];
    $frame{$tag1} = $self->{base1}->Frame(-relief=>'sunken', -bd=>2);
    if ($ary[5] eq 'pile') {
      my $l1 = $frame{$tag1}->Label(-text=>'What ya want in the pile?')
	->grid();
      push(@{$widgetList{$tag1}},$l1);

      foreach my $z (get_choices('pile')) {
	my $b1 = $frame{$tag1}->Checkbutton(-text=>$z,
					    -variable=>\$pileVar{$z},
					    -command=> [\&clickPile,
							$self, $z,
							'C', 'pile'],
					   );
	push(@{$widgetList{$tag1}},$b1);
	$b1->grid();
      }
    } else {
      setOptions($self, $frame{$tag1}, $ary[4], $ary[5]);
    }
    $frame{$tag1}->grid(-row=>0, -column=>$i);
    $i++;
  }
}

#-----------------------------------------------------------------------------
# /** Purpose:	Create a ShowSite object
# Inputs:
#   \param $class Class name 'ShowSite' generated by Perl
#   \param $base widget to attach the ShowSite frame with graphic to
#
# \return New ShowSite Object refference
# */
sub new {
  my ($class,$base,$base1) = @_;
  $debugCalls  && warn "new($class,$base,$base1)";
  my $sq = $side;
  my $self =
    {
     t_icon => undef,
     base   => $base->Frame(),
     base1  => $base1->Frame(),
     currX  => 4,
     currZ  => 4,
    #callback => $callback,
    };
  bless($self,$class);
  $self->{canv} = $self->{base}->Canvas(-width =>$side,
					-height=>$side*1.15,
					-relief=>'sunken',
					-bd=>1);
  $self->{canv}->grid();
  $self->{base}->grid();
  $self->{base1}->grid();
  $self->create_accessors;

  # draw the graphic
  foreach my $ary (shape()) {
    my @ary = @$ary;
    if (0 && $debug) {
      foreach my $ww (@$ary[0]) {
	#	warn "ww $ww";
      }
    }
    my $tag = $ary[4].$ary[5];
    #$tag = $ary[5];
    my $w1;
    my $f;
    my $ffc = $colors{$tag};
    #warn "fill $ffctag $tag";
    if ($ary[4] eq 'C') {
      $self->canv->createOval($ary[0],  $ary[1], $ary[2], $ary[3],
			-fill=> $ffc, -outline=>'slategray',
			-tags=>[$tag,$ary[4],$ary[5]]);

      $self->canv->bind('Cpile','<1>', [\&pickShape,$self]);
    } else {
      $self->canv->createRectangle($ary[0],  $ary[1], $ary[2], $ary[3],
			     -fill=> $ffc, -outline=>'slategray',
			     -tags=>[$tag,'face_'.$ary[4]]);
      #$debug && warn 'binding ', $tag;
      $self->canv->bind($tag,'<1>', [\&pickShape,$self]);
    }
  }
  $self->init();
  $self->buildFrames();

  $debug && warn "ShowSite new returning $self";
  return $self;
}

#------------------------------------------------------------------
##
##  User Picked a shape -- Callback
##
sub pickShape {
  my ($e,$self) = @_;
  die 'pickShape(',join(',',@_),') ',join(':',caller) unless ref $self eq 'ShowSite';

  $debugCalls  && warn "pickShape($e)";
  my ($tag, $tag1, $tag2, $tag3) = $self->canv->gettags('current');
  $savTag = $tag;

# disable unused controls
  for my $key (keys %widgetList){
    my $listRef = $widgetList{$key};
    for my $w (@{$listRef}) {
      if ($key eq substr($savTag,1)) {
	$w->configure(-state=>'normal');
      } else {
	$w->configure(-state=>'disabled');
      }
    }
  }
  #set current information for selected shape
  if (defined($contains{$savTag})) {
    my $obj = $contains{$savTag};
    $rbVar{substr($savTag,1)}{'1'} = ref $obj; # Set to type of $obj

    ## set properties display from $obj ????????????????
    setChoices($obj);
  } else {
    $rbVar{substr($savTag,1)}{'1'} = 'None';
  }
}

#-----------------------------------------------------------------
##
##  Create choice options frame for facing, type pair
##
sub setOptions {
  my ($self, $frame, $facing, $key) = @_;

  $debugCalls && warn "setOptions($self, $frame, $facing, $key)";
  my $l1 = $frame->Label(-text=>"What's at $key?")->grid();
  push(@{$widgetList{$key}},$l1);

  foreach my $z (get_choices($key)) {
    $debug && warn "$key choice $z";
    my $b1 = $frame->Radiobutton(-text=>$z, # Decor
				 -variable=>\$rbVar{$key}{'1'},
				 -value=>$z,
				 -command=> [\&clickButton, $self, $z,
					     $facing, $key],
				);
    push(@{$widgetList{$key}},$b1);
    $b1->grid();
  }
  $debug &&warn "leaving SetOpt";
}

#-----------------------------------------------------------------
## /**
## Save properties & contents of this map loc & create selection graphic
##    ===>
## */
# Receive a list of the current map items that are/may be in the
# selected 8 x 8 area of the map and record them in $contains and
# display them with colors indicating what is at different parts of
# the cell.
#
sub showSite {
  my ($self, $x, $z, @contentAry) = @_;

  $debugCalls && warn "showSite($self, $x,$z,@contentAry)";

  # Start clean
  $self->init();
  $self->currX($x);
  $self->currZ($z);

  &disableLists();
  foreach my $containedItem (@contentAry) {
    &newLocalProps($x,$z,$containedItem);
  }
  # update the graphic
  foreach my $ary (shape()) {
    my @ary = @$ary;
    if (0 && $debug) {
      foreach my $ww (@$ary[0]) {
	#	warn "ww $ww";
      }
    }
    my $tag = $ary[4].$ary[5];
    #      warn $tag;
    #      warn $colors{$tag};
    $self->canv->itemconfigure($tag, -fill=> $colors{$tag})
      if defined  $colors{$tag};
  }
  $self->canv->update;
  $self->{base}->update;
  return $self->{base};
}

##------------------------------------------------------------------
sub newLocalProps {
  my ($x,$z,$thing) = @_;
  $debugCalls  && warn "newLocalProps($x,$z,$thing)";
  my $item = ref($thing);	# class name string
  my $result = picLoc($x,$z,$thing);
  return unless defined $result;
  my ($thingLoc, $facing) = @{$result};
#  warn $thingLoc;
#  warn '>>>> ',$facing;

  if ($thingLoc eq 'pile') {
    my $key = 'Cpile';
    # put it into an array for the pile
    $pileVar{$item} = 1;	# set the radio button on
    push(@pileArray,$thing);
    $colors{'Cpile'} =  picColor($item);
  } else {
    # handle non-pile items
    #    my $facing = $thing->facing();
    my $key =  $facing.$thingLoc;
    return if (ref($thing) =~ /Wall/ && ref($contains{$key}) =~ /Door/);
    $contains{$key} = $thing;
    $colors{$key} = picColor($item);
    setChoices($thing);
  }

}

#-------------------------------------------------------
## reset all properties to none
# Reset colors for each of the figure components to gray
# Reset the content of each of the figure components to None
# Empty the contains hash which seems to be redundant with rbVar{$key}{'1'}
# empty the pile array
sub init {
  my $self =shift;
  $debugCalls  && warn "init($self)";
  foreach my $ary (shape()) {
    my @ary = @$ary;
    my $key = $ary[4].$ary[5];
    $colors{$key} = 'gray';
    #    $values{$key} = '';
    $rbVar{$key}{'1'} = 'None';
  }
  $colors{'level'}   = 'gray';
  %contains = ();		# empty contains
  ### Need to set all choices from Shape table
  @pileArray = ();
}

#----------------------------------------------------------------
sub clickPile {
  my ($self, $item, $facing, $figure) = @_;

  my $newThing;
  my $tag = $facing.$figure;
my $flag = $pileVar{$item};
warn '<> ',$item,' flag: ',$flag;
  if ($flag) {
    # add to the pile
    my $newItem = $item->new(x=>$self->currX,z=>$self->currZ);
    &main::add($newItem);
    push( @pileArray, $newItem);
  } else {
    #remove from the pile
    my @newPile = ();
    for my $pileItem (@pileArray){
      push (@newPile, $pileItem) unless $pileItem eq $item;
    }
    @pileArray = @newPile;
    #remove from the map
    &main::remove($item);
  }
  if (scalar(@pileArray)) {
    $colors{$tag} = picColor($item);
  } else {
    $colors{$tag} = picColor('None');
  }
  ## Update the Area display
  updateArea($self);
}

#----------------------------------------------------------------
sub clickButton {
  my ($self, $item, $facing, $figure) = @_;
warn 'clickButton(',join(',',@_),')';

  my $newThing;
  my $x = $self->currX - 4;
  my $z = $self->currZ - 4;
  $facing = substr($savTag,0,1);
  $figure = substr($savTag,1);
#warn 'clickButton facing: ',$facing,' figure: ',$figure;
  # Remove previous contents
  my $tag = $facing.$figure;
  if (defined $contains{$tag}) {
    &main::remove( $contains{$tag});
  }

#warn $item;
  # add new contents
  if ($item =~ /Wall/) {
    if      ($facing eq 'N') {
      $newThing = $item->new(x=>$x+0, z=>$z+0, yaw=>'0');
    } elsif ($facing eq 'S') {
      $newThing = $item->new(x=>$x+0, z=>$z+8, yaw=>'0');
    } elsif ($facing eq 'W') {
      $newThing = $item->new(x=>$x+0, z=>$z+0, yaw=>'270');
    } else { #facing    'E'
      $newThing = $item->new(x=>$x+8, z=>$z+0, yaw=>'270');
    }

  } elsif ($item =~ /Door/) {
    if ($facing eq 'N') {
      &main::add(ArchWall->new(x=>$x+0, z=>$z+0, yaw=>0));
      $newThing = $item->new(x=>$x+2, z=>$z+0, yaw=>0);
    } elsif ($facing eq 'S') {
      $newThing = $item->new(x=>$x+2, z=>$z+8, yaw=>0);
      &main::add(ArchWall->new(x=>$x+0, z=>$z+8, yaw=>0));
    } elsif ($facing eq 'W') {
      &main::add(ArchWall->new(x=>$x+0, z=>$z+0, yaw=>270));
      $newThing = $item->new(x=>$x+0, z=>$z+2, yaw=>270);
    } else {
      &main::add(ArchWall->new(x=>$x+8, z=>$z+0, yaw=>270));
      $newThing = $item->new(x=>$x+8, z=>$z+2, yaw=>270);
    }
  } elsif ($item eq 'Sign') {
    if ($facing eq 'N') {
      &main::add(Sign->new(x=>$x+4, z=>$z+0, yaw=>0));
    } elsif ($facing eq 'S') {
      &main::add(Sign->new(x=>$x+4, z=>$z+8, yaw=>0));
    } elsif ($facing eq 'W') {
      &main::add(Sign->new(x=>$x+0, z=>$z+4, yaw=>270));
    } else {
      &main::add(Sign->new(x=>$x+8, z=>$z+4, yaw=>270));
    }
  } elsif ($item eq 'Character') {
    if ($facing eq 'N') {
      &main::add(Character->new(x=>$x+4, z=>$z+0, yaw=>0));
    } elsif ($facing eq 'S') {
      &main::add(Character->new(x=>$x+4, z=>$z+8, yaw=>0));
    } elsif ($facing eq 'W') {
      &main::add(Character->new(x=>$x+0, z=>$z+4, yaw=>270));
    } else {
      &main::add(Character->new(x=>$x+8, z=>$z+4, yaw=>270));
    }
  } elsif (($item eq 'Chest') || ($item eq 'Detector') ||
	   ($item eq 'Switch') || ($item eq 'Torch') )  {
    &main::add($item->new(x=>$x+4, z=>$z+4, yaw=>0));
  } elsif ($item eq 'None'){
    $newThing = undef;
  } else {
    print "$item not implemented yet\n";
  }
  $contains{$tag} = $newThing;
  $colors{$tag} = picColor($item);
  if (defined ($newThing)){
    &main::add($contains{$tag});
  }
  ## Update the Area display
  updateArea($self);
}

#-----------------------------------------------------------------------------
sub updateArea {
  my $self = shift @_;
  # update the graphic
  foreach my $ary (shape()) {
    my @ary = @$ary;
    my $tag = $ary[4].$ary[5];
    $self->canv->itemconfigure($tag, -fill=> $colors{$tag})
      if defined  $colors{$tag};
  }
  $self->canv->update;
#  $self->{base}->update;
}

#-----------------------------------------------------------------------------
# disable unused controls
sub disableLists {
#warn ' saveTag: ',$savTag;
  for my $key (keys %widgetList){
    my $listRef = $widgetList{$key};
    for my $w (@{$listRef}) {
#warn substr($key,1);
#warn substr($savTag,1);
#      if ($key eq substr($savTag,1)) {
#	$w->configure(-state=>'normal');
#      } else {
      $w->configure(-state=>'disabled');
      #      }
    }
  }
}

#-----------------------------------------------------------------------------
### set the displayed choices to their current values
sub setChoices {
  my ($obj) = @_;

  $debugCalls && warn "setChoices($obj)";
  return;

  my $type = $obj->type();
  my $hash = $obj->properties();
  foreach my $key (keys %$hash) {
    $rbVar{$type}{key} = $hash->{$key}
  }
}

#-----------------------------------------------------------------
# Return Thing if any, with the facing and placement of interest
sub locThings {
  my ($site,$key) = @_;

  my $facing = substr($key,0,1);
  my $placement = substr($key,1);
  my @kinds = get_choices($placement);

  my $contList = $site->contains();
  foreach my $item (@$contList){
    foreach my $k (@kinds){
      if ($k eq $item->type) {
	if ($item->facing() eq $facing) {
	  #warn "locThings $item";
	  return $item;
	}
      }
    }
  }
  return undef;
}

sub picColor {
  my ($item) = @_;

  my %colMap = ('None'      => 'gray',
		'Wall'      => 'slategray',
		'ArchWall'  => 'gray57',
		'Door'      => 'brown',
		'BarDoor'   => 'black',
		'StoneDoor' => 'slategray',
		'Switch'    => 'burlywood',
		'Sign'      => 'gold2',
		'Character' => 'green',
		'Chest'     => 'brown',
	       );
  return $colMap{$item} if defined $colMap{$item};
  return 'yellow';
}


sub picLoc {
  my ($x,$z,$thing) = @_;

  # Location map
  #              YAW     X       Z
  my %locMap = (   0=> { 0 => {  0 => 'N',
				 8 => 'S',
			      },
			 8 => {  0 => undef,
				 8 => undef,
			      },
		       },
		   90=> { 0 => {  0 => undef,
				  8 => 'W',
			       },
			  8 => {  0 => undef,
				  8 => 'E',
			       },
			},
		   180=> { 0 => {  0 => undef,
				   8 => 'N',
				},
			   8 => {  0 => undef,
				   8 => 'S',
				},
			 },
		   270=> { 0 => {  0 => 'W',
				   8 => undef,
				},
			   8 => {  0 => 'E',
				   8 => undef,
				},
			 },
	       );
  my %thingLoc = ('Door'      => 'edge',
		  'ArchWall'  => 'edge',
		  'BarDoor'   => 'edge',
		  'StoneDoor' => 'edge',
		  'Wall'      => 'edge',
		  'Switch'    => 'decor',
		  'Sign'      => 'decor',
		  'Character' => 'decor',
		  'Chest'     => 'chest',
		  'Bag'       => 'chest',
		  'Key'       => 'pile',
		  'Sword'     => 'pile',
		  'Helmet'    => 'pile',
		  'Robes'     => 'pile',
		  'Robe'      => 'pile',
		  'Shoes'     => 'pile',
		  'Letter'    => 'pile',
		  'Lamp'      => 'pile',
		  'Knife'     => 'pile',
		  'MappingKit'=> 'pile',
		  'Treasure'  => 'pile',
		 );
  my $type = ref($thing);
  my $relX = $thing->x-($x-4);
  my $relZ = $thing->z-($z-4);
  my $yaw  = $thing->yaw;
  my $place = $thingLoc{$type};
  if ($place eq 'pile') {
    return ['pile', 'C'];
  }
  if ($type eq 'Level') {
    return (undef, undef);
  } elsif ($type =~ /Wall/) {
    my $facing = $locMap{$yaw}{$relX}{$relZ};
    $thing->seen('y')if defined $facing;
    return ['edge', $facing] if defined $facing;
    return undef;
  } elsif ($type =~ /Door/ ) {
    my $facing; # = $locMap{$yaw}{$relX}{$relZ};
    if ($relZ == 8) {
      $facing = 'S';
    } elsif ($relZ == 0) {
      $facing = 'N';
    } elsif ($relX == 0) {
      $facing = 'W';
    } elsif ($relX == 8) {
      $facing = 'E';
    } else {
      print STDERR "Door with unknown facing\n";
    }

    $thing->seen('y')if defined $facing;
    return ['edge', $facing] if defined $facing;
    return undef;
  } elsif ($type eq 'Character' || $type eq 'Sign') {
    my $facing = 'W'; ###$locMap{$yaw}{$relX}{$relZ};
    $thing->seen('y')if defined $facing;
    return ['decor', $facing] if defined $facing;
    return undef;
  } elsif ($type eq 'Chest') {
    my $facing = 'E'; #$locMap{$yaw}{$relX}{$relZ};
    $thing->seen('y')if defined $facing;
    return ['chest', $facing] if defined $facing;
    return undef;
  } else {
    print STDERR "picLoc(): Unknown type $type $thing from ",join(':',caller),"\n";
  }
  return undef;
}

#==================================================================
###
### Test Driver
###
if (!defined(caller())) {
  package main;

  my $root = MainWindow->new();
  $root->title("ShowSite Test");
  #my $swsbase = $root->Frame()->grid;
  #my $site = &initPresetOpen();

  #xxx
  # Tk Frame sizes
  my $fullHeight     = 650;
  my $fullWidth      = 700;
  my $topWidth       = $fullWidth;
  my $topHeight      = 400;
  my $topLeftWidth   = 400;
  my $topLeftHeight  = 400;
  my $topRightWidth  = $topWidth - $topLeftWidth;
  my $topRightHeight = $topLeftHeight;
  my $bottomHeight   = $fullHeight - $topHeight;
  my $bottomWidth    = $topWidth;

  my $topFrame = $root->Frame(-height=>$topHeight,-width=>$topWidth
			     )->grid(-row=>0,-column=>0);
  my $leftFrame = $topFrame->Frame(-height=>$topLeftHeight,
				   -width=>$topLeftWidth
				  )->grid(-row=>0,-column=>0);
  my $rightFrame = $topFrame->Frame(-height=>$topRightHeight,
				    -width=> $topRightWidth
				   )->grid(-row=>0,-column=>1);
  my $bottomFrame = $root->Frame(-height=>$bottomHeight,-width=>$bottomWidth
				)->grid(-row=>1,-column=>0);
  my $base3 = $rightFrame->Frame(-height=>$topRightHeight,
				 -width=> $topRightWidth,
				 -relief=>'sunken', -bd=>2
				)->grid(-row=>0,-column=>0);
  my $base1 = $leftFrame->Frame(-height=>$topLeftHeight,
				-width=> $topLeftWidth,
				-relief=>'sunken', -bd=>2
			       )->grid(-row=>0,-column=>0);
  my $base2 = $bottomFrame->Frame(-height=>40, -width=> $bottomWidth,
				  -bd=>2)->grid(-row=>0,-column=>0);
  my $base4 = $bottomFrame->Frame(-height=>$bottomHeight-40,
				  -width=> $bottomWidth,
				  -relief=>'sunken', -bd=>2
				 )->grid(-row=>1,-column=>0);
  #xxx

  my $swsead = ShowSite->new($base3,$base4);
  $swsead->showSite(0,0);

  my $quitButton = $root->Button(-text=>"Quit", -command=>sub{exit()});
  $quitButton->grid();
  warn "is Main ";
  $root->update();
  $root->MainLoop();
}


1;

__END__
