#----------------------------------------
# PLACEABLE
#----------------------------------------
#
# Class for managing placeable objets
#

use strict;

package Tk::SlideShow::Placeable;

use vars qw(@ISA @classes);
@ISA = qw(Tk::SlideShow::Dict);


sub New {
  my ($class,$id) = @_;
  die "An mandatory id is needed !" unless defined $id;
  my $s = bless {'x'=>Tk::SlideShow->w/2,'y'=>Tk::SlideShow->h/2,'id'=>$id,
		'link' => []};
  $class->Set($id,$s);
  return $s;
}

sub x { return (shift)->{'x'};}
sub y { return (shift)->{'y'};}
sub xy { my $s = shift; return ($s->{'x'},$s->{'y'})};

sub no { 
  my $s = shift;
  my ($x1,$y1,$x2,$y2) = Tk::SlideShow->canvas->bbox($s->id);
#  print "bbox(".$s->id." = $x1,$y1,$x2,$y2\n";
  return ($x1,$y1);
}
sub n { 
  my $s = shift;
  my ($x1,$y1,$x2,$y2) = Tk::SlideShow->canvas->bbox($s->id);
  return (($x1+$x2)/2,$y1);
}
sub ne { 
  my $s = shift;
  my ($x1,$y1,$x2,$y2) = Tk::SlideShow->canvas->bbox($s->id);
  return ($x2,$y1);
}
sub e { 
  my $s = shift;
  my ($x1,$y1,$x2,$y2) = Tk::SlideShow->canvas->bbox($s->id);
  return ($x2,($y1+$y2)/2);
}
sub se { 
  my $s = shift;
  my ($x1,$y1,$x2,$y2) = Tk::SlideShow->canvas->bbox($s->id);
  return ($x2,$y2);
}
sub s { 
  my $s = shift;
  my ($x1,$y1,$x2,$y2) = Tk::SlideShow->canvas->bbox($s->id);
  return (($x1+$x2)/2,$y2);
}
sub so { 
  my $s = shift;
  my ($x1,$y1,$x2,$y2) = Tk::SlideShow->canvas->bbox($s->id);
  return ($x1,$y2);
}
sub o { 
  my $s = shift;
  my ($x1,$y1,$x2,$y2) = Tk::SlideShow->canvas->bbox($s->id);
  return ($x1,($y1+$y2)/2);
}

sub pos {
  my $s = shift;
  my $pos = shift;
  $pos = ( $pos + 8 ) % 8;
#  print "returning pos of ".$s->id." at $pos\n";
  return $s->no if $pos == 0;
  return $s->n  if $pos == 1;
  return $s->ne if $pos == 2;
  return $s->e  if $pos == 3;
  return $s->se if $pos == 4;
  return $s->s  if $pos == 5;
  return $s->so if $pos == 6;
  return $s->o  if $pos == 7;
  return (0,0);
}

sub addLink {
  my ($s,$l) = @_;
  push @{$s->{'link'}},$l;
}

sub links { return @{(shift)->{'link'}};}


sub id { return (shift)->{'id'};}

sub evalplace {
  my $s = shift;
  die "La méthode 'evalplace' doit être redéfinie pour la classe ".ref($s)." et ne l'est pas, apparament\n";
}
use Cwd;


sub save {
  shift;
  my $slides = shift;

  my $numero = $slides->currentName;
  my $dfltfname = "slide-$numero.pl";
  my %files = ();
  print "saving slide $numero\n";
  for my $id ( Tk::SlideShow::Dict->All) {
    my $s = Tk::SlideShow::Dict->Get($id);
#    print "Saving $id of class :".ref($s)."\n";
    next if $id eq '__null__';
    $id =~ s/['\\]/\\$&/g;
    my $fname = ($id =~ m|/|) ? $`: $dfltfname ;
    $files{$fname} .= "Tk::SlideShow::Dict->Get('$id')->".$s->evalplace.";\n";
  }
  while(my($k,$v) = each %files) {
    print "Generating file  $k\n";
    open(OUT,">$k") or die;
    print OUT $v;
    close OUT;
  }
};


sub Clean {
  Tk::SlideShow::Dict->Clean;
}


sub pan {
  my ($s,$button) = @_;
  my $c = Tk::SlideShow->canvas;
  Tk::SlideShow->addkeyhelp('Press Button 1 and move, on canvas items',
			    'to drag them');
  my $id = $s->id;
  Tk::SlideShow->addkeyhelp("Press Ctrl-Button 1 on canvas items",
			      'to lower them');

  $c->bind($id,"<Control-$button>", sub {$c->lower($id)});
  $c->bind($id,"<$button>", 
	   sub { 
	       my $e = (shift)->XEvent;
	       #	       my $id = $s->id;
#	       print "B1 pressed\n";
	       $c->raise($id);
	       ($s->{'sx'},$s->{'sy'}) = ($c->canvasx($e->x),$c->canvasy($e->y));
	     });
  $c->bind($id,"<B$button-Motion>", 
	   sub {
#	     print "B1 motion\n";
	     my $e = (shift)->XEvent;
#	     my $id = $s->id;
	     my ($nx,$ny) = ($c->canvasx($e->x),$c->canvasy($e->y));
	     my ($dx,$dy) = ($nx-$s->{'sx'},$ny-$s->{'sy'});
	     $c->move($id, $dx,$dy);
	     ($s->{'sx'}, $s->{'sy'}) = ($nx,$ny);
	     $s->{'x'} += $dx; $s->{'y'} += $dy; 
	     for my $l ($s->links) {$l->show;}

	   });
  return $s;
}

sub cursor {
  my ($s,$cursorname) = @_;
  my $c = Tk::SlideShow->canvas;
  my $id = $s->id;
  $c->bind($id, '<Enter>',sub { $c->configure(-cursor,$cursorname)});
  $c->bind($id, '<Leave>',sub { $c->configure(-cursor,'top_left_arrow')});
}


1;