#!/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"; }