#===============================================
# MyCanvas
#===============================================
package Tk::MyCanvas;
require Tk::Canvas;
@ISA = qw(Tk::Canvas);
Construct Tk::Widget 'MyCanvas';

#公開したいサブルーチン
#@EXPORT = qw();

use strict;
use Rect;
#use base  qw(Tk::Widget);

#============================================================
#　変数等取得関数
#============================================================
sub SetSmoothLine { my ($this,$f)=@_; return $this->{'SmoothLine'} = $f; }
sub SmoothLine    { my ($this)=@_; return $this->{'SmoothLine'}; }
sub LastDrawnObject { return shift->{'LastDrawnObject'}; }
sub ClipRect 
{ 
	my ($this) = @_; 
	return undef unless($this->{'DoClip'}); 
	return $this->{'ClipRect'}; 
}

sub SetClipRect
{
	my ($this, $rt) = @_;
	if(!defined $rt or $rt == 0) {
		$this->{'DoClip'} = 0;
		undef $this->{'CliptRect'};
	}
	$this->{'DoClip'} = 1;
	return $this->{'ClipRect'} = $rt;
}

#============================================================
#　コンストラクタ、デストラクタ
#============================================================
sub Populate 
{
	my($cw, $args) = @_;

	$cw->SUPER::Populate($args);
return;
#	my $b = $cw->Canvas();
#	$b->pack(-expand => 1, -fill => 'both');
#	$cw->Advertise('MyCanvas', => $b);
#	$cw->ConfigSpecs(DEFAULT => [$b]);
#	$cw->Delegates(DEFAULT => $b);
}

sub ClassInit
{
	my ($class, $mw) = @_;
	return $class;
}

sub new
{
	my ($class, @args) = @_;
	my $self = Tk::Canvas->new(@args);
	return bless $self, ref($class) || $class;
}

sub DESTROY
{
	my $this = shift;
#	$this->delete("all");
#	$this->dtag("all");
	$this->SUPER::DESTROY(@_);
}

#============================================================
#　一般関数
#============================================================
sub ClearAll
{
	my ($this) = @_;
	$this->delete("all");
	$this->dtag("all");
	my @a = $this->children();
	foreach my $w (@a) {
		$w->destroy() if($w);
	}
	$this->delete('all');
}

sub SavePostScript
{
	my ($this, $OpenApp, $StartApp, $DefPath) = @_;
	$DefPath = '' if(!$DefPath);

	my $dir = '';
	my $fmask = '*.ps';
	my $defstr = $DefPath;
	my $message = 'Choose PostScript file name';
	chdir($dir) if($dir);
	my $filepath = Dialog::OpenFileDialog($this, 
				'save', $fmask, $defstr, $message, $dir);
	return undef unless($filepath);
	$filepath = "$filepath.ps" unless($filepath =~ /\.ps$/i);
#	if(-e $filepath) {
#		my $ret = Dialog::MessageBox($this,
#			"Confirm for overwrite",
#			"File [$filepath] exists.\n"
#			. "Overwrite?",
#			"YesNo", "question");
#		return undef if($ret ne 'Yes');
#	}
#print "f: $filepath\n";
	unlink($filepath);
	$this->postscript(-file => $filepath, -pageanchor => 's');
	unless(-e $filepath) {
		Dialog::MessageBox($this, "Error", 
			"Can not save to [$filepath]");
		return undef;
	}
	if($OpenApp) {
		$OpenApp = "\"$OpenApp\"" if($OpenApp =~ /\s/);
		my $path = $filepath;
		$path = "\"$path\"" if($path =~ /\s/);
		my $command = "$OpenApp $path";
print "Open [$filepath] by [$command]\n";
		Deps::ExecBackground($command, $StartApp);
	}
	return $filepath;
}

sub MoveTo
{
	my ($this, $x, $y) = @_;
	$this->{'PrevPositionX'} = $x;
	$this->{'PrevPositionY'} = $y;
	return $this->{'LinesRect'} = new Rect($x, $y, $x, $y);
}

sub LineTo
{
	my ($this, $x2, $y2, $width, $color, $tags) = @_;
	my @args = ();
	@args = (@args, -width => $width) if($width);
	@args = (@args, -fill => $color)  if($color);
	@args = (@args, -tags => $tags) if($tags);

	my $x1 = $this->{'PrevPositionX'};
	my $y1 = $this->{'PrevPositionY'};
	$this->{'LastDrawnObject'} = $this->createLine($x1, $y1, $x2, $y2, @args);
	$this->{'PrevPositionX'} = $x2;
	$this->{'PrevPositionY'} = $y2;
	return $this->{'LinesRect'}->Merge($x1, $y1, $x2, $y2);
}

sub PrepareDrawLines
{
	my ($this, $LineWidth, $LineColor, $Tag) = @_;
	$this->{'PushLineWidth'} = $LineWidth;
	$this->{'PushLineColor'} = $LineColor;
	$this->{'PushLineTag'}   = $Tag;
#print "Prepare1\n";
	if(defined $this->{'pPushLineXYArray'}) {
		undef $this->{'pPushLineXYArray'};
	}

	if(!defined $this->SmoothLine() or $this->SmoothLine() == 0) {
		return;
	}

	my @XY;
	$this->{'pPushLineXYArray'} = \@XY;
#print "Prepare2\n";
}

sub DrawPushedLines
{
	my ($this) = @_;

	return unless(defined $this->SmoothLine() and $this->SmoothLine() > 0);
	my $pPushLineXYArray = $this->{'pPushLineXYArray'};
	return if(!defined $pPushLineXYArray or @$pPushLineXYArray < 4);

#print "Lines: ", join(@$pPushLineXYArray, ','), "\n";

	$this->createLine(@$pPushLineXYArray,
		-width       => $this->{'PushLineWidth'},
		-fill        => $this->{'PushLineColor'},
		-capstyle    => 'round', #'round', 'butt', 'projecting'
		-joinstyle   => 'bevel', #'miter', 'round', 'bevel'
		-smooth      => 1,
		-splinesteps => $this->SmoothLine(),
		-tags        => $this->{'PushLineTag'}
		);
	undef $this->{'pPushLineXYArray'};
}

sub DrawClippedLine
{
	my ($this, $x1, $y1, $x2, $y2, $width, $color, $tags) = @_;
	my $Action = 'draw';
	if(defined $this->SmoothLine() and $this->SmoothLine() > 0) {
		$Action = 'push';
	}
#print "Action: $Action\n";
	return $this->DoDrawClippedLine($Action, $x1, $y1, $x2, $y2, $width, $color, $tags);
}

sub DoDrawClippedLine
{
	my ($this, $Action, $x1, $y1, $x2, $y2, $width, $color, $tags) = @_;
	my $rt = $this->ClipRect();
	return $this->DrawLine($x1, $y1, $x2, $y2, $width, $color, $tags)
			unless($rt);
	my $pPushLineXYArray = $this->{'pPushLineXYArray'};
	return if($Action !~ /draw/i and !defined $pPushLineXYArray);

	my $In1 = $rt->IsInside($x1, $y1);
	my $In2 = $rt->IsInside($x2, $y2);
#両方が内側にあったら線を書く
	my @args = ();
	@args = (@args, -width => $width) if($width);
	@args = (@args, -fill => $color)  if($color);
	@args = (@args, -tags => $tags) if($tags);
	@args = (@args, -capstyle => 'round');
#print "x: $x1,$y1,$x2,$y2: $In1, $In2\n";
	if($In1 and $In2) {
		if($Action =~ /push/i) {
#print "xy2: $x2, $y2\n";
			if(@$pPushLineXYArray == 0) {
				push(@$pPushLineXYArray, $x1);
				push(@$pPushLineXYArray, $y1);
			}
			push(@$pPushLineXYArray, $x2);
			push(@$pPushLineXYArray, $y2);
		}
		else {
			$this->{'LastDrawnObject'} = $this->createLine($x1, $y1, $x2, $y2, @args);
		}
		return new Rect($x1, $y1, $x2, $y2);
	}
#点1と点2の両方が外側にあったら何もしない
	return undef if(!$In1 and !$In2);

#点1は内側、点2は外側にする
	if(!$In1) {
		($x2, $x1) = ($x1, $x2);
		($y2, $y1) = ($y1, $y2);
	}
	my $rx0 = $rt->{'x0'};
	my $ry0 = $rt->{'y0'};
	my $rx1 = $rt->{'x1'};
	my $ry1 = $rt->{'y1'};
	my $dx = $x2 - $x1;
	my $dy = $y2 - $y1;
# y = $y1 + $dy / $dx * x
# x = $x1 + $dx / $dy * y
	my ($xcut, $ycut);
	if($dy != 0.0) {
# y= $rt->{'y0'}できる
		my $xc = $x1 + $dx / $dy * ($rt->{'y0'} - $y1);
		my $r = ($xc - $rx0) / ($rx1 - $rx0);
		if($x1 != $x2) {
			my $r2 = ($xc - $x1) / ($x2 - $x1);
			if(0.0 <= $r and $r <= 1.0 and 0.0 <= $r2 and $r2 <= 1.0) {
				$xcut = $xc;
				$ycut = $rt->{'y0'};
			}
		}
# y= $rt->{'y1'}できる
		if(!defined $ycut) {
			$xc = $x1 + $dx / $dy * ($rt->{'y1'} - $y1);
			$r = ($xc - $rx0) / ($rx1 - $rx0);
			if($x1 != $x2) {
				my $r2 = ($xc - $x1) / ($x2 - $x1);
				if(0.0 <= $r and $r <= 1.0 and 0.0 <= $r2 and $r2 <= 1.0) {
					$xcut = $xc;
					$ycut = $rt->{'y1'};
				}
			}
		}
	}
	if(!defined $xcut and $dx != 0.0) {
# x= $rt->{'x0'}できる
		my $yc = $y1 + $dy / $dx * ($rt->{'x0'} - $x1);
		my $r = ($yc - $ry0) / ($ry1 - $ry0);
		if($y1 != $y2) {
			my $r2 = ($yc - $y1) / ($y2 - $y1);
			if(0.0 <= $r and $r <= 1.0 and 0.0 <= $r2 and $r2 <= 1.0) {
				$xcut = $rt->{'x0'};
				$ycut = $yc;
			}
		}
# x= $rt->{'x1'}できる
		if(!defined $xcut) {
			$yc = $y1 + $dy / $dx * ($rt->{'x1'} - $x1);
			$r = ($yc - $ry0) / ($ry1 - $ry0);
			if($y1 != $y2) {
				my $r2 = ($yc - $y1) / ($y2 - $y1);
				if(0.0 <= $r and $r <= 1.0 and 0.0 <= $r2 and $r2 <= 1.0) {
					$xcut = $rt->{'x1'};
					$ycut = $yc;
				}
			}
		}
	}
	return undef if(!defined $xcut or !defined !$ycut);

	if($Action =~ /push/i) {
#print "xycut: $xcut, $ycut\n";
		if(@$pPushLineXYArray == 0) {
			push(@$pPushLineXYArray, $x1);
			push(@$pPushLineXYArray, $y1);
		}
		push(@$pPushLineXYArray, $xcut);
		push(@$pPushLineXYArray, $ycut);
	}
	else {
		$this->{'LastDrawnObject'} 
			= $this->createLine($x1, $y1, $xcut, $ycut, @args);
	}
	return new Rect($x1, $y1, $xcut, $ycut);
}

sub DrawLine
{
	my ($this, $x1, $y1, $x2, $y2, $width, $color, $tags) = @_;
	my @args = ();
	@args = (@args, -width => $width) if($width);
	@args = (@args, -fill => $color)  if($color);
	@args = (@args, -tags => $tags) if($tags);
	@args = (@args, -capstyle => 'round');
	$this->{'LastDrawnObject'} = $this->createLine($x1, $y1, $x2, $y2, @args);
	return new Rect($x1, $y1, $x2, $y2);
}

sub DrawBox
{
	my ($this, $x1, $y1, $x2, $y2, $width, $fillcolor, $outcolor, $tags) = @_;
	my @args = ();
	@args = (@args, -width => $width) if($width);
	@args = (@args, -fill  => $fillcolor) if($fillcolor);
	@args = (@args, -outline => $outcolor) if($outcolor);
	@args = (@args, -tags => $tags) if($tags);
	$this->{'LastDrawnObject'} = $this->createRectangle($x1, $y1, $x2, $y2, @args);
	return new Rect($x1, $y1, $x2, $y2);
}

sub GetTextHeight
{
	my ($this, $pFont) = @_;
	$pFont = $this->{'pFont'} unless($pFont);
	my $h = $this->fontMetrics($pFont, -ascent) 
		   + $this->fontMetrics($pFont, -descent);
	return $h;
}

sub GetTextWidth
{
	my ($this, $text, $pFont) = @_;
	$pFont = $this->{'pFont'} unless($pFont);
	my $w = $this->fontMeasure($pFont, $text);
	return $w;
}

sub DrawText
{
	my ($this, $x, $y, $text, $pFont, $anchor, $color, $tags) = @_;
	$pFont = $this->{'pFont'} unless($pFont);
	my @args = ();
	@args = (@args, -font => $pFont) if($pFont);
	@args = (@args, -anchor => $anchor) if($anchor);
	@args = (@args, -fill => $color) if($color);
	@args = (@args, -tags => $tags) if($tags);
	$this->{'LastDrawnObject'} = $this->createText($x, $y, -text   => $text, @args);
	my $h = $this->fontMetrics($pFont, -ascent) 
		   + $this->fontMetrics($pFont, -descent);
	my $w = $this->fontMeasure($pFont, $text);
	if($anchor eq 'e') {
		return new Rect($x-$w, $y-$h/2.0, $x, $y+$h/2.0);
	}
	elsif($anchor eq 'w') {
		return new Rect($x, $y-$h/2.0, $x+$w, $y+$h/2.0);
	}
	elsif($anchor eq 'n') {
		return new Rect($x-$w/2.0, $y, $x+$w/2.0, $y+$h);
	}
	elsif($anchor eq 's') {
		return new Rect($x-$w/2.0, $y-$h, $x+$w/2.0, $y);
	}
	elsif($anchor eq 'ne') {
		return new Rect($x-$w, $y, $x, $y+$h);
	}
	elsif($anchor eq 'se') {
		return new Rect($x-$w, $y-$h, $x, $y);
	}
	elsif($anchor eq 'nw') {
		return new Rect($x, $y, $x+$w, $y+$h);
	}
	elsif($anchor eq 'sw') {
		return new Rect($x, $y-$h, $x+$w, $y);
	}
	return new Rect($x-$w/2.0, $y-$h/2.0, $x+$w/2.0, $y+$h/2.0);
}

sub DrawOval
{
	my ($this, $x1, $y1, $x2, $y2, $width, $fillcolor, $outcolor, $tags) = @_;
	my @arg = ();
	@arg = (@arg, -width => $width)      if($width);
	@arg = (@arg, -fill  => $fillcolor)  if($fillcolor);
	@arg = (@arg, -outline => $outcolor) if($outcolor);
	@arg = (@arg, -tags => $tags)        if($tags);
#print "t=$tags\n";
	$this->{'LastDrawnObject'} = $this->createOval($x1, $y1, $x2, $y2, @arg);
	return new Rect($x1, $y1, $x2, $y2);
}

sub DrawCircle
{
	my ($this, $x, $y, $r, $width, $fillcolor, $outcolor, $tags) = @_;
	$this->DrawOval($x-$r, $y-$r, $x+$r, $y+$r,
			$width, $fillcolor, $outcolor, $tags);
	return new Rect($x-$r, $y-$r, $x+$r, $y+$r);
}

sub CreateFont {
	my ($this, $FontName, $FontSize, $FontStyle) = @_;
	$FontName  = 'times'  unless($FontName);
	$FontSize  = 10.5     unless($FontSize);
	$FontStyle = 'normal' unless($FontStyle);
	return [$FontName, $FontSize, $FontStyle];
}

sub SetFontBypFont
{
	my ($this, $pFont) = @_;
	return $this->{'pFont'} = $pFont;
}

sub SetFont
{
	my ($this, $FontName, $FontSize, $FontStyle) = @_;
	return undef unless($FontName);
	unless($FontSize) {
		return $this->SetFontBypFont($FontName);
	}
	my $font = [$FontName, $FontSize, $FontStyle];
	return $this->SetFontBypFont($font);
}

sub UpdateFont
{
	my ($this, $FontName, $FontSize, $FontStyle) = @_;
	$this->SetFont($FontName,$FontSize,$FontStyle);
	$this->Update();
}

sub Update
{
	return 1;
}

1;