#!/usr/bin/perl

use strict;
use vars qw($some_tk $tk_interpreter $tk_mainwindow);
BEGIN { $some_tk = $ARGV[0]; require "some_tk"; }

my (%W, $current_file);

$W{_} = initTk();
$current_file = "";

$W{_}->protocol("WM_DELETE_WINDOW", \&OnQuit);
$W{_mb} = $W{_}->Frame(-relief=>"raised", -bd=>2);
$W{_mb}->pack(-side=>"top", -fill=>"both");
$W{_st} = $W{_}->Frame(-relief=>"sunken", -bd=>2);
$W{_st}->pack(-side=>"bottom", -fill=>"both");
$W{_ws} = $W{_}->Canvas(-width=>300, -height=>200);
$W{_ws}->pack(-side=>"top", -fill=>"both", -expand=>"yes");

$W{_mb_file} = $W{_mb}->Menubutton(
#    -tearoff=>0,
    -text=>"File", -menuitems=>[
	["command"=>"Open", -command=>\&OnOpen],
	"-",
	["command"=>"Quit", -command=>\&OnQuit]
    ]
);
$W{_mb_options} = $W{_mb}->Menubutton(
#    -tearoff=>0, 
    -text=>"Options", -menuitems=>[
	["command"=>"Background", -command=>\&OnChangeBackground],
	["checkbutton"=>"Show border", -command=>\&OnShowBorder],
    ]
);
$W{_mb_help} = $W{_mb}->Menubutton(
#    -tearoff=>0,
    -text=>"Help", -menuitems=>[
	["command"=>"About", -command=>\&HelpAbout],
    ]
);

$W{_mb_file}->pack($W{_mb_options}, -side=>"left", -fill=>"both");
$W{_mb_help}->pack(-side=>"right", -fill=>"both");

$W{_st_filename} = $W{_st}->Label(-textvariable=>\$current_file);
$W{_st_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) = tk_getOpenFile();
    $current_file = $fn if $fn;
}

sub OnQuit {
    my ($ans) = tk_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) = $W{_ws}->cget("-bg");
    $color = tk_chooseColor(-initialcolor=>$color);
    $W{_ws}->configure("-bg"=>$color) if $color;
}

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

sub OnShowBorder {
    my ($mn) = $W{_mb_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";
}

