#!/usr/bin/perl -w

use Tk;
use strict;

my ($main, $current_file);

$current_file = "";

$main = MainWindow->new();
$main->protocol("WM_DELETE_WINDOW", \&OnQuit);
$main->{menubar} = $main->Frame(-relief=>"raised", -bd=>2);
$main->{menubar}->pack(-side=>"top", -fill=>"both");
$main->{status} = $main->Frame(-relief=>"sunken", -bd=>2);
$main->{status}->pack(-side=>"bottom", -fill=>"both");
$main->{worksp} = $main->Canvas(-width=>300, -height=>200);
$main->{worksp}->pack(-side=>"top", -fill=>"both", -expand=>"yes");

$main->{menubar}{file} = $main->{menubar}->Menubutton(
    -text=>"File", -tearoff=>0, -menuitems=>[
	["command"=>"Open", -command=>\&OnOpen],
	"-",
	["command"=>"Quit", -command=>\&OnQuit]
    ]
);
$main->{menubar}{options} = $main->{menubar}->Menubutton(
    -text=>"Options", -tearoff=>0, -menuitems=>[
	["command"=>"Background", -command=>\&OnChangeBackground],
	["checkbutton"=>"Show border", -command=>\&OnShowBorder],
    ]
);
$main->{menubar}{help} = $main->{menubar}->Menubutton(
    -text=>"Help", -tearoff=>0, -menuitems=>[
	["command"=>"About", -command=>\&HelpAbout],
    ]
);

$main->{menubar}{file}->pack($main->{menubar}{options}, -side=>"left",
    -fill=>"both");
$main->{menubar}{help}->pack(-side=>"right", -fill=>"both");

$main->{status}{filename} = $main->{status}->Label(-textvariable=>\$current_file);
$main->{status}{filename}->pack(-side=>"left", -fill=>"both");

#$main->{worksp}->Photo("fun_picture", -file=>"001.gif");
#$main->{worksp}->createImage(0, 0, -image=>"fun_picture");

MainLoop();

#=================================================================

sub OnOpen {
    my ($fn) = $main->getOpenFile();
    $current_file = $fn if $fn;
}

sub OnQuit {
    my ($ans) = $main->messageBox(-title=>"quit", -type=>"YesNoCancel",
	-message=>"File may have been modified. Save file before quitting?",
    );
    return if "\l$ans" eq "cancel";
    # save file if "\l$ans" eq "yes";
    # clean up
    exit;
}

sub OnChangeBackground {
    my ($color) = $main->{worksp}->cget("-bg");
    $color = $main->chooseColor(-initialcolor=>$color);
    $main->{worksp}->configure("-bg"=>$color) if $color;
}

sub HelpAbout {
    my ($ans) = $main->messageBox(-title=>"About me", -type=>"OK",
	-message=>"Nice to know that you are interested in this program!",
    );
}

sub OnShowBorder {
    my ($mn) = $main->{menubar}{options}->cget("-menu");
    my ($st) = $mn->entrycget(0, "-state");
# Q: I really don't mean "-state" here. Is there a clean way
# to query the current state of a checkbutton entry in a menu,
# without ever having to define an associated variable?
    print "$st\n";
}