## From Chapter 2
# Bad Window example
################################################################
#!/usr/bin/perl -w
use Tk;

my $mw = MainWindow->new;
$mw->title("Bad Window");
$mw->Label(-text => "This is an example of a window that looks bad\nwhen 
you don't send any options to pack")->pack;

$mw->Checkbutton(-text => "I like it!")->pack;
$mw->Checkbutton(-text => "I hate it!")->pack;
$mw->Checkbutton(-text => "I don't care")->pack;
$mw->Button(-text => "Exit",
            -command => sub { exit })->pack;
MainLoop;

################################################################
# Good Window example
################################################################
#!/usr/bin/perl -w
use Tk;

my $mw = MainWindow->new;
$mw->title("Good Window");
$mw->Label(-text => "This window looks much more organized, and less 
haphazard\nbecause we used some options to make it look nice")->pack;

$mw->Button(-text => "Exit",
            -command => sub { exit })->pack(-side => 'bottom', 
                                            -expand => 1,
                                            -fill => 'x');
$mw->Checkbutton(-text => "I like it!")->pack(-side => 'left',
                                              -expand => 1);
$mw->Checkbutton(-text => "I hate it!")->pack(-side => 'left', 
                                              -expand => 1);
$mw->Checkbutton(-text => "I don't care")->pack(-side => 'left', 
                                                -expand => 1);
MainLoop; 

################################################################
## From Chapter 3: Code to read in the names of the cursors and allow
## you to see what they look like using a listbox
################################################################
#!/usr/bin/perl -w
use Tk;

## Create elements of window
$mw = MainWindow->new;
$mw->Button(-text => "Exit", 
            -command => sub { exit })->pack(-side => "bottom",
                                      -fill => "x");
$scroll = $mw->Scrollbar;
$lb = $mw->Listbox(-selectmode => 'single',
                   -yscrollcommand => [set => $scroll]);
$scroll->configure(-command => [yview => $lb]);

$scroll->pack(-side => 'right', -fill => 'y');
$lb->pack(-side => 'left', -fill => 'both');

## Open file that contains all available cursors
## Might have to change this if your cursorfont.h is elsewhere
## On Win32 systems look in C:\Perl\lib\site\Tk\X11\cursorfont.h
open (FH, "/usr/X11R6/include/X11/cursorfont.h") ||
  die "Couldn't open cursor file.\n";

while (<FH>) {
  push(@cursors, $1) if (/\#define XC_(\w+) /);
}

close(FH);

$lb->insert('end', sort @cursors);
$lb->bind('<Button-1>', 
     sub { $mw->configure(-cursor => $lb->get($lb->curselection)); });

MainLoop;

################################################################
## Help Label example
################################################################
$mw = MainWindow->new;
$mw->title("Help Label Example");

$mw->Label(-textvariable => \$message)
   ->pack(-side => 'bottom', -fill => 'x');

$b = $mw->Button(-text => "Exit", -command => \&exit)
        ->pack(-side => 'left');
&bind_message($b, "Press to quit the application");

$b2 = $mw->Button(-text => "Do Nothing")->pack(-side => 'left');
&bind_message($b2, "This button does absolutely nothing!");

$b3 = $mw->Button(-text => "Something", -command => sub { print 
"something\n"; })->pack(-side => 'left');
&bind_message($b3, "Prints the text 'something'");

sub bind_message {
  my ($widget, $msg) = @_;
  $widget->bind('<Enter>', [ sub { $message = $_[1]; }, $msg ]);
  $widget->bind('<Leave>', sub { $message = ""; });
}

MainLoop;

################################################################
## Incrementing entry widget
################################################################
#!/usr/bin/perl
use Tk;
$mw = MainWindow->new;
$mw->title("Entry");

$e_txt = "Entry Text";    # Create entry with initial text
$e = $mw->Entry(-textvariable => \$e_txt)->pack(-expand => 1,
                                                -fill => 'x');
$mw->Button(-text => "Exit",
            -command => sub { exit })->pack(-side => 'bottom');

# Create a Button that will insert a counter at the cursor
$i = 1;
$mw->Button(-text => "Insert #", -command => 
            sub { 
              if ($e->selectionPresent()) {
                $e->insert('sel.last', "$i"); $i++;
              }
            })->pack;
MainLoop;

################################################################
## From Chapter 6 - Scrolling more than one listbox with one scrollbar
################################################################
use Tk;

$mw = MainWindow->new();
$mw->title("One Scrollbar/Three Listboxes");
$mw->Button(-text => "Exit", 
            -command => sub { exit })->pack(-side => 'bottom');

$scroll = $mw->Scrollbar();
# Anonymous array of the three listboxes
$listboxes = [ $mw->Listbox(), $mw->Listbox(), $mw->Listbox() ];

# This method is called when one listbox is scrolled with the keyboard
# It makes the scrollbar reflect the change, and scrolls the other lists
sub scroll_listboxes {
  my ($sb, $scrolled, $lbs, @args) = @_;
  $sb->set(@args);
  my ($top, $bottom) = $scrolled->yview();
  foreach $list (@$lbs) {
    $list->yviewMoveto($top);
  }
}

# Configure each listbox to call &scroll_listboxes
foreach $list (@$listboxes) {
  $list->configure(-yscrollcommand => [ \&scroll_listboxes, $scroll,
                                       $list, $listboxes ]);
}

# Configure the scrollbar to scroll each listbox
$scroll->configure(-command => sub { foreach $list (@$listboxes) {
                                       $list->yview(@_);
                                     }});

# Pack the scrollbar and listboxes
$scroll->pack(-side => 'left', -fill => 'y');
foreach $list (@$listboxes) {
  $list->pack(-side => 'left');
  $list->insert('end', "one", "two", "three", "four", "five", "six", 
                       "seven", "eight", "nine", "ten", "eleven");
}

MainLoop;

################################################################
## From Chapter 7: Searching through a listbox
################################################################
use Tk;

$mw = MainWindow->new;
$mw->title("Listbox");
# For example purposes, we'll use one word for each letter
@choices = qw/alpha beta charlie delta echo foxtrot golf hotel india
              juliet kilo lima motel nancy oscar papa quebec radio sierra
              tango uniform victor whiskey xray yankee zulu/;

# Create the entry widget, and bind the do_search sub to any keypress
$entry = $mw->Entry(-textvariable => \$search)->pack(-side => "top", 
                                                     -fill => 'x');
$entry->bind('<KeyPress>', [ \&do_search, Ev('K') ]);

# Create listbox and insert the list of choices into it
my $lb = $mw->Scrolled('Listbox', -scrollbars => "osoe", 
                       )->pack(-side => 'left');
$lb->insert('end', sort @choices);

$mw->Button(-text => "Exit", 
            -command => sub { exit; })->pack(-side => 'bottom');

MainLoop;

# This routine is called each time we push a keyboard key.
sub do_search {
  my ($entry, $key) = @_;
  
  # Ignore the backspace key and anything that doesn't change the word
  # i.e. The Control or Alt keys 
  return if ($key =~ /backspace/i);
  return if ($oldsearch eq $search);

  # Use what's currently displayed in listbox to search through  
  # This is a non-complicated in order search
  my @list = $lb->get(0, 'end');
  foreach (0 .. $#list) {
    if ($list[$_] =~ /^$search/) {
      $lb->see($_);
      $lb->selectionClear(0, 'end');
      $lb->selectionSet($_);
      last;
    }
  }
  $oldsearch = $search;
}



################################################################
## From Chapter 8: Text Widget
## Loads/edits/saves files using text widget
################################################################
use Tk;
$mw = MainWindow->new;
# Create necessary widgets
$f = $mw->Frame->pack(-side => 'top', -fill => 'x');
$f->Label(-text => "Filename:")->pack(-side => 'left', -anchor => 'w');
$f->Entry(-textvariable => \$filename)->pack(-side => 'left', 
   -anchor => 'w', -fill => 'x', -expand => 1);
$f->Button(-text => "Exit", -command => sub { exit; } )->
  pack(-side => 'right');
$f->Button(-text => "Save", -command => \&save_file)->
  pack(-side => 'right', -anchor => 'e');
$f->Button(-text => "Load", -command => \&load_file)->
  pack(-side => 'right', -anchor => 'e');
$mw->Label(-textvariable => \$info, -relief => 'ridge')->
  pack(-side => 'bottom', -fill => 'x');
$t = $mw->Scrolled("Text")->pack(-side => 'bottom', 
  -fill => 'both', -expand => 1);

MainLoop;

# load_file checks to see what the filename is and loads it if possible
sub load_file {
  $info = "Loading file '$filename'...";
  $t->delete("1.0", "end");
  if (!open(FH, "$filename")) {
    $t->insert("end", "ERROR: Could not open $filename\n"); 
	return; 
  }
  while (<FH>) { $t->insert("end", $_); }
  close (FH);
  $info = "File '$filename' loaded";
}

# save_file saves the file using the filename in the entry box.
sub save_file {
  $info = "Saving '$filename'";
  open (FH, ">$filename");
  print FH $t->get("1.0", "end");
  $info = "Saved.";
}

################################################################
## From Chapter 8: Text
## Example of embedding widgets in a Text Widget
################################################################
use Tk;

$mw = MainWindow->new;
$mw->title("Data Entry");
$f = $mw->Frame->pack(-side => 'bottom');
$f->Button(-text => "Exit", 
           -command => sub { exit; })->pack(-side => 'left');
$f->Button(-text => "Save",
           -command => sub {  # do something with %info; 
			  })->pack(-side => 'bottom');
$t = $mw->Scrolled("Text", -width => 40, 
                   -wrap => 'none')->pack(-expand => 1, -fill => 'both');

foreach (qw/Name Address City State Zip Phone Occupation 
            Company Business_Address Business_Phone/) {
	$w = $t->Label(-text => "$_:", -relief => 'groove', -width => 20);
	$t->windowCreate('end', -window => $w);
	$w = $t->Entry(-width => 20, -textvariable => \$info{$_});
	$t->windowCreate('end', -window => $w);
	$t->insert('end', "\n");
}
$t->configure(-state => 'disabled');
MainLoop;

################################################################
## From Chapter 9: Canvas Widget
## Quick Draw using canvas
################################################################
use Tk;

$mw = MainWindow->new;
$mw->title("Quick Draw");

$f = $mw->Frame(-relief => 'groove', 
                -bd => 2, 
                -label => "Draw:")->pack(-side => 'left', -fill => 'y');
$draw_item = "rectangle";
$f->Radiobutton(-variable => \$draw_item,
                -text => "Rectangle",
                -value => "rectangle",
                -command => \&bind_start)->pack(-anchor => 'w');
$f->Radiobutton(-variable => \$draw_item,
                -text => "Oval",
                -value => "oval",
                -command => \&bind_start)->pack(-anchor => 'w');
$f->Radiobutton(-variable => \$draw_item,
                -text => "Line",
                -value => "line",
                -command => \&bind_start)->pack(-anchor => 'w');
$f->Label(-text => "Line Width:")->pack(-anchor => 'w');
$thickness = 1;
$f->Entry(-textvariable => \$thickness)->pack(-anchor => 'w');

$c = $mw->Scrolled("Canvas", -cursor => "crosshair")->pack(
              -side => "left", -fill => 'both', -expand => 1);
$canvas = $c->Subwidget("canvas");

&bind_start();

MainLoop;

sub bind_start {
  # If there is a "Motion" binding, we need to allow the user
  # to finish drawing the item before rebinding Button-1
  # this fcn gets called when the finish drawing the item again
  @bindings = $canvas->Tk::bind("<Motion>");
  return if ($#bindings >= 0);
    
  if ($draw_item eq "rectangle") {
    $canvas->Tk::bind("<Button-1>", [\&start_drawing, Ev('x'), Ev('y')]);
  } elsif ($draw_item eq "oval") {
    $canvas->Tk::bind("<Button-1>", [\&start_drawing, Ev('x'), Ev('y')]);
  } elsif ($draw_item eq "line") {
    $canvas->Tk::bind("<Button-1>", [\&start_drawing, Ev('x'), Ev('y')]);
  }
}

sub start_drawing {
  my ($canv, $x, $y) = @_;
  $x = $canv->canvasx($x);
  $y = $canv->canvasy($y);
  
  # Do a little error checking
  $thickness = 1 if ($thickness !~ /[0-9]+/);

  if ($draw_item eq "rectangle") {
    $canvas->createRectangle($x, $y, $x, $y, 
       -width => $thickness, -tags => "drawmenow");
  } elsif ($draw_item eq "oval") {
    $canvas->createOval($x, $y, $x, $y,
       -width => $thickness, -tags => "drawmenow");
  } elsif ($draw_item eq "line") {
    $canvas->createLine($x, $y, $x, $y, 
       -width => $thickness, -tags => "drawmenow");
  }
  
  $startx = $x; $starty = $y;
  # Map the Button-1 binding to &end_drawing instead of start drawing
  $canvas->Tk::bind("<Motion>", [\&size_item, Ev('x'), Ev('y')]);
  $canvas->Tk::bind("<Button-1>", [\&end_drawing, Ev('x'), Ev('y')]);
}

sub size_item {
  my ($canv, $x, $y) = @_;
  $x = $canv->canvasx($x);
  $y = $canv->canvasy($y);

  $canvas->coords("drawmenow", $startx, $starty, $x, $y);
}

sub end_drawing {
  my ($canv, $x, $y) = @_;
  $x = $canv->canvasx($x);
  $y = $canv->canvasy($y);

  # finalize the size of the item, and remove the tag from the item
  $canvas->coords("drawmenow", $startx, $starty, $x, $y);
  $canvas->dtag("drawmenow");
  
  # remove motion binding.
  $canvas->Tk::bind("<Motion>", "");
  &bind_start();
}

################################################################
## Creating radiobuttons
################################################################
#!/usr/bin/perl -w

use Tk;
my $mw = MainWindow->new;
$mw->title("Menubutton");
$menub = $mw->Menubutton(-text => "Color")->pack(-side => 'left',
                                                 -anchor => 'n');
foreach (qw/red yellow green blue grey/) {
  $menub->radiobutton(-label => $_,
                      -command => \&set_bg,
                      -variable => \$background_color,
                      -value => $_);
}

MainLoop;			       

sub set_bg {
  print "Background value is now: $background_color\n";
  $mw->configure(-background => $background_color);
}

################################################################
# Cascade menu example
################################################################
#!/usr/bin/perl -w
use Tk;
my $mw = MainWindow->new;
$mw->title("Menubutton");
# Create menubutton and put on the screen
$menub = $mw->Menubutton(-text => "Menubutton")->pack;

# make our sub menu to be cascaded a child of upper menu.
$menu1 = $menub->menu->Menu;
foreach (qw/one two three four/) {
  $menu1->add('command', -label => $_);
}

# make second sub menu also a child of the upper menu
$menu2 = $menub->menu->Menu;
foreach (qw/A B C D/) {
  $menu2->radiobutton(-label => $_);
}

# now add the cascade items to the main menu
$menub->cascade(-label => "Numbers");
$menub->cascade(-label => "Letters");

# now configure those cascade entries to point to correct submenu
$menub->entryconfigure("Numbers", -menu => $menu1);
$menub->entryconfigure("Letters", -menu => $menu2);

MainLoop;			



################################################################
## Using Menubuttons to create a menubar example
################################################################
#!/usr/bin/perl -w
use Tk;
my $mw = MainWindow->new;
$mw->title("Menubutton");

$mw->Button(-text => "Exit",
            -command => sub { exit; })->pack(-side => "bottom");

my $f = $mw->Frame(-relief => 'ridge', -bd => 2);
$f->pack(-side => 'top', -anchor => 'n', -expand => 1, -fill => 'x');

foreach (qw/File Edit Options Help/) {
  push (@menus, $f->Menubutton(-text => $_));
}

$menus[3]->pack(-side => 'right');
$menus[0]->pack(-side => 'left');
$menus[1]->pack(-side => 'left');
$menus[2]->pack(-side => 'left');

MainLoop;

################################################################
## Example from Chapter 11: Menus
## Dynamic document list in a menu
################################################################

#!/usr/bin/perl -w

use Tk;
$mw = MainWindow->new;
$mw->title("Documents");

# Create a frame for our 'menubar' across the top of the window
$f = $mw->Frame(-relief => 'ridge', -bd => 2)
  ->pack(-side => 'top', -anchor => 'n', -expand => 1, -fill => 'x');

# Create the menubutton, with two items: New Doc and a separator
$filem = $f->Menubutton(-text => "File",
                        -tearoff => 0,
                        -menuitems => [ ["command" => "New Document",
                                         -command => \&new_document],
                                        "-"
                                      ])->pack(-side => 'left');
# We will open document 1 to begin with, and we want to limit the number 
# of documents in our list to 0-9 (leaves 10 docs max in menu)
$doc_num = 1;
$doc_list_limit = 9;

# Create button that will do the same thing as the New Document menu item
$mw->Button(-text => "New Document",
            -command => \&new_document)->pack(-side => 'bottom',
                                              -anchor => 'e');
# The entry will display the current doc we are "editing".
$entry = $mw->Entry(-width => 80)->pack(-expand => 1, -fill => 'both');

MainLoop;

# Creates the next doc in line, incs the doc counter
# Adds the new doc to the menu, and removes any docs from the
# menu that are over the limit (oldest out first)
sub new_document {
  my $name = "Document $doc_num";
  $doc_num++;
  
  push (@current, $name);
  $filem->command(-label => "$name",
		  -command => [ \&select_document, $name ]);
  
  &select_document($name);
  
  if ($#current > $doc_list_limit) {
    $filem->menu->delete(2);
    shift(@current);
  }
}

sub select_document {
  my ($selected) = @_;
  
  $entry->delete(0, 'end');
  $entry->insert('end', "SELECTED DOCUMENT: $selected");
}