#============================================================
# MyMainWindow
#============================================================
package MyMainWindow;
use Tk::MainWindow;
use MyTk::TkCommon;
@ISA = qw(Tk::MainWindow TkCommon);

use strict;
use Tk::Balloon;
use MyTk::MyFrame;
use MyTk::MyEntry;

#============================================================
#　変数等取得、再定義関数
#============================================================
sub MainWindow     { return shift;                  }
sub mw             { return shift;                  }
sub SetApplication
{
	my ($this, $app) = @_;
	$this->{'Application'} = $app;
	$this->SetProgram( $app->Program() );
	$this->SetTitle( $app->Title() );
	return $this->{'Application'};
}

sub StatusBar     { 
	my ($this, $pos) = @_;
	return shift->{'StatusBarL'} if(defined $pos and $pos =~ /^l/i);
	return shift->{'StatusBarR'};
}
sub WriteStatusBar { 
	my ($this,$s,$p)=@_;
	return undef unless($this->StatusBar($p));
	return $this->StatusBar($p)->SetText($s); 
}
sub SetBalloon($) { my ($this,$b)=@_; return $this->{'Balloon'} = $b; }
sub GetBalloon()  { return shift->{'Balloon'}; }
sub MainMenu()    { return shift->{'MainMenu'}; }

#============================================================
#　コンストラクタ、デストラクタ
#============================================================
sub new
{
	my $class = shift;
	my $self = Tk::MainWindow->new(@_);
	my $this = bless $self, $class;

#Windowが削除されるときにCloseを呼び出す
	$this->protocol('WM_DELETE_WINDOW' => sub { $this->Close(0); });
#Windowが初めて表示されたときに、InitWindowを実行する
#	$this->bind('<Map>', [ \&InitWindow, $this ] );

	return $this;
}

#呼び出されない？
sub DESTROY
{
	my $this = shift;
#print "DD**\n";
	my $geo = $this->geometry();
#	my $w = $this->mw()->width();
#	my $h = $this->mw()->height();
#	my $x = $this->mw()->x();
#	my $y = $this->mw()->y();
#	my $geo = "${w}x$h+$x+$y";
#print("Current geometry from whxy: $geo\n");
	$this->{geometry} = $geo if($this->IsValidGeometry($geo));

	$this->SUPER::DESTROY(@_);
}

#============================================================
#　継承クラスで定義しなおす関数
#============================================================
sub InitWindow 
{
	my ($this) = @_;
#Windowが初めて表示されたときだけ、InitWindowを実行する
	return if($this->{'Initialized'});
	$this->{'Initialized'} = 1;

# ウィンドウサイズの変更に対するbind
#	$this->bind( "<Configure>", [ \&Draw, $this ]);

}

# ウィジェットを作製する前に作るメニュー
sub CreateMainMenu
{
	my ($this) = @_;

	$this->{'MainMenu'} = $this->Menu;
	$this->configure(-menu => $this->{'MainMenu'});
	return $this->{'MainMenu'};
}

sub CreateMenu
{
	my ($this) = @_;
	my $menu = $this->CreateMainMenu();
}

sub CreateWidgets
{
	my ($this) = @_;
	$this->CreateStatusBar('bottom');
}

# ウィジェットを作製したあとにメニューを加工する
sub ModifyMenu
{
	my ($this) = @_;
	$this->{'MainMenu'} = $this->Menu;
	return $this->{'MainMenu'};
}


sub CreateToolBar
{
	my ($this, $position) = @_;
	my $balloon = $this->Balloon();
# 枠作成
	$this->{'ToolBarFrame'} = $this->MyFrame(
			-borderwidth => 2,
			-relief => 'groove',
		)->pack(-side => $position, -fill => 'x');
	$this->{'OpenButton'} = $this->{'ToolBarFrame'}->MyButton(
			-text => 'Open',
			-command => sub { print "Open\n"; },
		)->pack(-side => 'left', -fill => 'x');
	$balloon->attach($this->{'OpenButton'}, -msg => "Open file", 
		-balloonposition => 'mouse');
}

sub CreateStatusBar
{
	my ($this, $position) = @_;
# 枠作成
	$this->{'StatusBarFrame'} = $this->MyFrame(
			-borderwidth => 2,
			-relief => 'ridge',
		)->pack(-side => $position, -fill => 'x');
#	$this->{'StatusBar'} = $this->{'StatusBarFrame'}->MyLabel(
	$this->{'StatusBarL'} = $this->{'StatusBarFrame'}->MyEntry(
			-background => 'grey',
			-foreground => 'black',
			-relief     => 'flat',
			-justify    => 'left',
			-takefocus  => 0,
			-insertborderwidth => 0,
			-insertbackground  => 'grey',
			-cursor => 'top_left_arrow',
		)->pack(-side => 'left', -expand => 1, -fill => 'x');
	$this->{'StatusBarR'} = $this->{'StatusBarFrame'}->MyEntry(
			-background => 'grey',
			-foreground => 'black',
			-relief     => 'flat',
			-justify    => 'right',
			-takefocus  => 0,
			-insertborderwidth => 0,
			-insertbackground  => 'grey',
			-cursor => 'top_left_arrow',
		)->pack(-side => 'left', -expand => 1, -fill => 'x');

	my $balloon = $this->Balloon(-statusbar => $this->{'StatusBarR'});
	$balloon->attach($this->{'StatusBarL'}, -msg => "Left StatusBar", 
		-balloonposition => 'mouse');
	$balloon->attach($this->{'StatusBarR'}, -msg => "Right StatusBar", 
		-balloonposition => 'mouse');

	return 1;
}

#============================================================
#　一般関数
#============================================================
sub FloatOnTop
{
	my ($this, $IsTop) = @_;
	if($IsTop) {
#		my $mw = tkinit;
		$this->{'RepeatID'} = $this->repeat(500, 
				sub { $this->deiconify; $this->raise; } );
	}
	else {
		$this->{'RepeatID'}->calcel if($this->{'RepeatID'});
	}
}

sub ShowWindow
{
	my ($this, $status) = @_;
	if($status =~ /^topmost$/i) {
		$this->FloatOnTop(1);
	}
	elsif($status =~ /^notopmost$/i) {
		$this->FloatOnTop(0);
	}
	elsif($status =~ /^minimize$/i) {
		$this->iconify;
	}
	elsif($status =~ /^maximize$/i) {
		$this->deiconify;
	}
	elsif($status =~ /^normal$/i) {
		$this->deiconify;
		$this->raise if($this->state() eq 'withdrawn');
	}
	elsif($status =~ /^hide$/i) {
		$this->withdraw;
	}
}

sub SetMinSize
{
	my ($this, $w, $h) = @_;
	$w = 2 unless(defined $w);
	$h = 2 unless(defined $h);
	return $this->minsize($w, $h);
}

sub SetMaxSize
{
	my ($this, $w, $h) = @_;
	$w = 100 unless(defined $w);
	$h = 100 unless(defined $h);
	return $this->maxsize($w, $h);
}

sub Resizable
{
	my ($this, $WidthResizable, $HeightResizable) = @_;
	$WidthResizable  = 1               unless(defined $WidthResizable);
	$HeightResizable = $WidthResizable unless(defined $HeightResizable);
	return $this->resizable($WidthResizable, $HeightResizable);
}

sub IsValidGeometry
{
	my ($this, $geometry) = @_;
	return $geometry =~ /^\d+x\d+[\+-]\d+[\+-]\d+$/;
}

sub SetGeometry
{
	my ($this, $geometry) = @_;
	$this->{'Geometry'} = $geometry;
	return undef unless($this->IsValidGeometry($geometry));
	return $this->geometry($geometry) if($geometry ne '');
	return undef;
}

sub GetGeometry
{
	my ($this) = @_;
	return $this->geometry();
}

sub SetIcon
{
	my ($this, $icon) = @_;
	return $this->iconname($this->{'Icon'} = 'widget');
}

sub GetIcon
{
	my ($this, $icon) = @_;
	return $this->{'Icon'};
}

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 Close {
	my ($this) = @_;
	my $App = $this->{Application};
	$App->{geometry} = $this->geometry() if($App);
	$this->destroy();
}

1;