Index Symbols & Numbers | A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z Copyright © 2002 O'Reilly & Associates, Inc All Rights Reserved Symbols & Numbers | A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z Index: Symbols & Numbers & (ampersand) && operator used with tags: 9.9 Tags attachments and: 2.4.2.2 Widget-to-widget attachments * (asterisk) as wildcard character: 16 User Customization pathname separators: 16.2 Using the Option Database @ (at sign), bitmaps and: 4.5 Displaying an Image or Bitmap 9.6.2 The Bitmap Item (backslash) using with @: 4.5 Displaying an Image or Bitmap Win32 separator: 16.2 Using the Option Database {} (braces) as string delimiter: 1.3.3 Specifying Options [] (brackets) insert method and: 8.6 Inserting Text in Tcl: 20.2.2 Tcl/Tk Slave Processor Code Tk::Pretty and: 13.1.1 The configure Method ^ (caret) grid method and: 2.2.1 Special Characters 2.2.2 grid Options marks as: 8.16 Marks operator used with tags: 9.9 Tags : (colon) as separator: 16 User Customization , (comma) -sticky option and: 2.2.5 Forcing a Widget to Fill a Cell => equivalent: 1.3.3 Specifying Options Tk::Pretty and: 13.1.1 The configure Method $ (dollar sign) $| as special variable: 1.6 Debugging and PrototypingPerl/Tk Programs $^O as operating system identifier: 12.3 The Win32 System Menu Item in Tcl: 20.2.2 Tcl/Tk Slave Processor Code => notation as comma equivalent: 1.3.3 Specifying Options ! (exclamation point) as bang: 1.3.1 Do You Need To Install Anything? operator used with tags: 9.9 Tags / (forward slash) as string delimiters: 1.3.3 Specifying Options Unix pathname separator: 16.2 Using the Option Database - (hyphen) as index modifier: 8.4.2 Index Modifiers configuration parameters and: 1.3.3 Specifying Options grid method and: 2.1.1 Options for pack 2.2.1 Special Characters setPalette method and: 13.4.5 Setting Colors 13.4.5 Setting Colors Text widgets and option: 8.16 Marks ( ) parentheses operator used with tags: 9.9 Tags as string delimiter: 1.3.3 Specifying Options (period) as pathname separator: 16.2 Using the Option Database as separator: 13.2 Building a Family Tree 18.4 The HList Family of Widgets in Tcl: 20.2.2 Tcl/Tk Slave Processor Code || (pipes) as IPC mechanisms: 19 Interprocess Communicationwith Pipes and Sockets operator used with tags: 9.9 Tags + (plus sign) as index modifier: 8.4.2 Index Modifiers " (quotation marks) -w switch and: 1.3.3 Specifying Options indexes and: 8.4 Text Indexes screen units and: 2.1.8.1 Valid screen distances in Tcl: 20.2.2 Tcl/Tk Slave Processor Code text string and: 4.4 Displaying Text on Buttons ~ (tilde) and -label option: 12.2.2 Menubars the Slick, Sophisticated, NewFashioned Way _ (underscore) as private method name: 15.4.2 Tk::ExecuteCommand reserving keys with: 14.3.9 Mega-Widget Instance Variables Symbols & Numbers | A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z Copyright © 2002 O'Reilly & Associates, Inc All Rights Reserved Symbols & Numbers | A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z Index: A -accelerator option creating menu items and: 12.2.1 Menubars the Clunky, Casual, OldFashioned Way examples: 13.16.1.3 Menu Traversal menu item definition and: 12.2.2 Menubars the Slick, Sophisticated, NewFashioned Way -activebackground option activate method and: 6.3.2 Scrollbar Options Button widgets and: 4.3 Table of Options for Button-Type Widgets color options and: 4.15 Color Options Menu widgets and: 12.1.6 Menu Options Menubutton widgets: 12.4.1 Menubutton Options mouse cursor and: 4.15 Color Options Scale widgets and: 10.1 Creating a Scale Scrollbars and: 6.3.2 Scrollbar Options 6.3.2 Scrollbar Options Tix widgets and: 18.2 Item Styles -activeborderwidth option: 12.1.6 Menu Options -activedash option: 9.5.1 Common Canvas Dash, Stipple, and Tile Options -activefill option: 9.5.1 Common Canvas Dash, Stipple, and Tile Options -activeforeground option Button widgets and: 4.3 Table of Options for Button-Type Widgets Menu widgets and: 12.1.6 Menu Options Menubutton widgets: 12.4.1 Menubutton Options mouse cursor and: 4.15 Color Options Tix widgets and: 18.2 Item Styles -activeoutline option: 9.5.1 Common Canvas Dash, Stipple, and Tile Options -activeoutlinestipple option: 9.5.1 Common Canvas Dash, Stipple, and Tile Options -activeoutlinetile option: 9.5.1 Common Canvas Dash, Stipple, and Tile Options -activerelief option: 6.3.2 Scrollbar Options 6.3.2 Scrollbar Options 6.3.4 Scrollbar Style -activestipple option: 9.5.1 Common Canvas Dash, Stipple, and Tile Options -activetile option: 17.11 Tile and Transparent Images -activewidth option: 9.5.1 Common Canvas Dash, Stipple, and Tile Options -after option add method and: 18.4.2 HList Methods packing order and: 2.1.1 Options for pack widget order and: 2.1.7 Widget Order in the Window -align option: 8.16.1 Setting and Getting the Gravity -anchor option add method and: 23.8.1 Creating Pages allocation rectangle: 2.1.1 Options for pack Button widgets and: 4.3 Table of Options for Button-Type Widgets createBitmap method and: 9.6.2 The Bitmap Item createImage method and: 9.6.3 The Image Item createText method and: 9.6.8 The Text Item createWindow method and: 9.6.9 The Widget Item Label widgets and: 5.1.2 Label Options Menubutton widgets: 12.4.1 Menubutton Options option menu example: 12.6.2 A Native Option Menu place method and: 2.1.1 Options for pack ProgressBar widgets and: 23.10.1 ProgressBar Options relative coordinates and: 2.3.3 Relative Coordinates syntax: 2.1.1 Options for pack 2.1.6 Anchoring a Widget in Its Allocation Rectangle 4.11 Text Manipulation Tix widgets and: 18.2 Item Styles -arrow option: 9.6.4 The Line Item -arrowimage option: 23.6 The BrowseEntry Widget -arrowshape option: 9.6.4 The Line Item -ascent option: 3.5 Font Manipulation Methods -async option: 13.2.1 Widget's Children -at option: 18.4.2 HList Methods aboveThis argument: 13.19 Widget Mapping and Layering absolute coordinates: 2.3.2 Absolute Coordinates act_fold image: 18.5 Tix Images Activate event: 15.2.1.2 Event descriptor types 18.4.1 Using Indicators with HList activate method: 6.3.2 Scrollbar Options 7.2 Listbox Options 12.1.4 Manipulating Menu Items active keyword (menu indexes): 12.1.2 Menu Indexes ACTIVE_BG color: 23.1.3 Optionally Exported Symbols ActiveState ) (see PPM (Perl Package Manager) add method creating pages and: 23.8.1 Creating Pages DialogBox widgets and: 23.3.3 The DialogBox Widget HList widgets and: 18.4.2 HList Methods addchild method: 18.4.2 HList Methods addOptions method: 12.6.1 Tk::Optionmenu addtag method: 9.5.3 Canvas Widget Option List 9.9 Tags 9.9.2 Finding Tags Adjuster widget: 23.4 The Adjuster Widget adjustSelect method: 8.16.1 Setting and Getting the Gravity Advertise method: 14.3.8.1 Subroutine Advertise ADVERTISED value: 14.3.6 Subroutine ConfigSpecs after method: 13.2.2 Name of a Widget afterCancel method: 13.22 Time Delays afterIdle method: 13.22 Time Delays "all" tag: 9.5.3 Canvas Widget Option List ALL_EVENTS: 23.1.3 Optionally Exported Symbols allocation rectangles -expand option and: 2.1.5 Expanding the Allocation Rectangle anchoring widgets: 2.1.6 Anchoring a Widget in Its Allocation Rectangle characteristics of: 2.1.1 Options for pack filling: 2.1.1 Options for pack 2.1.4 Filling the Allocation Rectangle ampersand (&) && operator used with tags: 9.9 Tags attachments and: 2.4.2.2 Widget-to-widget attachments anchor points defined: 12.5.2 The Popup Method offsets and: 2.4.2 Attachments angle brackets: 15.2.1 Event Descriptor Syntax anonymous arrays -font option and: 3.3 Using Fonts callbacks with arguments: 15.1 Creating a Callback Checkbuttons and: 12.2.1 Menubars the Clunky, Casual, Old-Fashioned Way insert method and: 8.6 Inserting Text if (not defined $x) { $x = $ROB{'Me','last_x'}; $y = $ROB{'Me','last_y'}; } my $q; if ( $x > $MID_X ) { $q = $y > $MID_Y ? 1 : 4; } else { $q = $y > $MID_Y ? 2 : 3; } return $q; } # end which_quad sub initialize_RCP { # Initialize the Robot Control Program $TEAM = 'LUSOL2'; # kludge team capability team_declare $TEAM; team_send $TEAM; $TICK = -1; # current RCP tick count my $clock = 500; # tick resolution in milliseconds my $tps = 1000 / $clock; # ticks/second my $pi = 3.141592654; # pi $R2D = 180.0 / $pi; # radians to degrees my $d2r = $pi / 180.0; # degrees to radians for (my $i = 0; $i < 360; $i++) { $SINT[$i] = sin($d2r * $i); # sine table $COST[$i] = cos($d2r * $i); # cosine table } $MAX_X = 999; # battlefield X max $MAX_Y = 999; # battlefield Y max $MID_X = $MAX_X / 2; # X midpoint $MID_Y = $MAX_Y / 2; # Y midpoint @ROBL = ( ); # robot list initialize_robot 'Me'; $ROB{'Me','last_x'} = loc_x; # last x coordinate $ROB{'Me','last_y'} = loc_y; # last y coordinate $ROB{'Me','friend'} = 1; # of course @IWSL = ( ); # "I was scanned" list $IWSL_COUNT = 4; # tick interval $IWSL_TICK = -1; # schedule at this tick value alert \&I_was_scanned; # maintain a list of who scanned Me $ATTACK_LIST_ENTRY = undef; # no attack list entry srand $$; $SCAN_HEADING = rand 360; # current scanner direction $CLIP_SIZE = 4; # number of cannon rounds per clip $ROUNDS_LEFT = $CLIP_SIZE; $RELOAD_CLIP = 12 * $tps; # ticks required before reload clip $RELOAD_CLIP_TICK = -1; $RELOAD_ROUND = 4 * $tps; # ticks required before reload round $RELOAD_ROUND_TICK = -1; $CANNON_HEADING = 0; # cannon direction $CANNON_READY = 1; # 1 IFF cannon is ready for firing $MAX_CANNON_RANGE = 700; # I'm no robocop $DANGER_RANGE = 0; # but there's always Heisenburg @HEAT = (0, 0); # current heat results $COOLING = 0; # 1 iff waiting for engine to cool $REBOOST = 0; # 1 iff engine has just cooled $SPEED = 0; # current speed $SPEED_TROLL = 100; # normal speed to minimize heating $SPEED_SLOW_TURN = 20; # slow turn speed $SPEED_TURN = 30; # normal turn speed $TURN_ACTIVE = 0; # 1 IFF we are turning $DRIVE_SPEED = $SPEED_TROLL; $DRIVE_HEADING = 0; # Compute vertices of an $NVERT sided polygon, the robot's continuous pat $NVERT = 8; # polygon vertex count my $dangle = 360 / $NVERT; my $radius = 350; $MOVE_QUAD = 0; $PATHI = 0; for (my $angle = 0; $angle 0.40, minute => 0.75, second => 0.85, 0 => 0.00, intick => 0.95, outtick => 1.00, width => 0.05, scale => 100, type => 'bezier', types => [qw/normal curve angle bezier/], tindx => 3, normal => [qw/minute 0 0 second 0 0 hour 0 0 minute/], curve => [qw/minute 0 second 0 hour 0 minute/], angle => [qw/minute second second hour/], bezier => [qw/minute second 0 hour/], tick => [qw/intick outtick/], ); $pi180 = asin(1) / 90.0; $resize = 0; $mw = MainWindow->new; $clock = $mw->Canvas(qw/-width 200 -height 200/); $clock->pack(qw/-expand 1 -fill both/); $mw->bind('' => \&buildclock); $mw->bind('' => \&incrtype); $mw->bind('' => \&incrwidth); buildclock; $mw->repeat(1000 => sub {my(@t) = localtime; setclock @t[0 2]}); MainLoop; sub buildclock { # Build the clock Puts tickmarks every 30 degrees, tagged # "ticks", and prefills the "hands" line my $pi180 = asin(1)/90.0; Tk::catch {$clock->delete('marks')}; $clock->update; my $w = $clock->width; $mw->geometry("${w}x${w}") if $resize; # ensure clock is square $resize++; $hand{scale} = $w / 2.0; # This is a horrid hack Use the hands( ) procedure to # calculate the tickmark positions by temporarily changing # the clock type my $type = $hand{type}; $hand{type} = 'tick'; my %angles; for (my $ii = 0; $ii < 12; $ii++) { $angles{intick} = $angles{outtick} = $ii * 30 * $pi180; $clock->createLine(hands(\%angles), -tags => [qw/ticks marks/]); } $hand{type} = $type; $clock->createLine(qw/0 0 0 0 -smooth 1 -tags/ => [qw/hands marks/]); $clock->itemconfigure(qw/marks -capstyle round -width/ => $hand{width} * $hand{scale}); } sub hands { # Calculate the set of points for the current hand type and # the angles in the passed array my($aa) = @_; my $ss = $hand{scale}; my @points; foreach my $desc ( @{ $hand{$hand{type}} } ) { push @points, sin($aa->{$desc}) * $hand{$desc} * $ss + $ss; push @points, $ss - cos($aa->{$desc}) * $hand{$desc} * $ss; } #print join(', ', @points), "\n"; return @points; } sub incrtype { $hand{type} = $hand{types}->[ ++$hand{tindx} % @{$hand{types}} ]; } sub incrwidth { my $w = $hand{width} + 05; $hand{width} = $w > 25 ? 0 : $w; $clock->itemconfigure('marks', -width => $hand{width} * $hand{scale}); } sub setclock { # Calculate the angles for the second, minute, and hour hands, # and then update the clock hands to match my($second, $minute, $hour) = @_; my %angles; $angles{0} = 0; $angles{second} = $second * 6 * $pi180; $angles{minute} = $minute * 6 * $pi180; $angles{hour} = $hour * 30 * $pi180 + $angles{minute} / 12; my $sector = int( $angles{second} + 0.5 ); my(@colors) = qw/cyan green blue purple red yellow orange/; $clock->itemconfigure(qw/hands -fill/ => $colors[$sector]); $clock->coords('hands', hands \%angles); } C.10 Robot Control Program complex.ptr tkhanoi.ppl Copyright © 2002 O'Reilly & Associates All rights reserved C.12 C.12 tkhanoi.ppl This next PPL program is a classic Tower of Hanoi game #!/usr/local/bin/perl -w # # Towers of Hanoi, Perl/Tk style 2000/06/14, sol0@Lehigh.EDU # Global package, subroutine and data declarations use Tk; use Tk::Dialog; use subs qw/do_hanoi fini hanoi init move_ring/; use strict; my $canvas; # the Hanoi playing field my @colors; # 24 graduated ring colors my $fly_y; # canvas Y-coord along which rings fly my $max_rings; # be nice and keep @colors count-consistent my $num_moves; # total ring moves my %pole; # tracks pole X-coord and ring count my %ring; # tracks ring canvas ID, width and pole my $ring_base; # canvas Y-coord of base of ring pile my $ring_spacing; # pixels between adjacent rings my $stopped; # 1 IFF simulation is stopped my $velocity; # pixel delta the rings move while flying my $version = '1.0, 2000/06/14'; # Main my $mw = MainWindow->new(-use => $Plugin::brinfo{xwindow_id}); init; MainLoop; sub do_hanoi { # Initialize for a new simulation my($n) = @_; return unless $stopped; # number of rings $stopped = 0; $num_moves = 0; # start # new simulation my $ring_height = 26; $ring_spacing = 0.67 * $ring_height; my $ring_width = 96 + $n * 12; my $canvas_width = 3 * $ring_width + 4 * 12; my $canvas_height = $ring_spacing * $n + $fly_y + 2 * $ring_height; $ring_base = $canvas_height - 32; # Remove all rings from the previous run and resize the canvas for (my $i = 0; $i < $max_rings; $i++) { $canvas->delete($ring{$i, 'id'}) if defined $ring{$i, 'id'}; } $canvas->configure(-width => $canvas_width, -height => $canvas_height); # Initialize the poles: no rings, updated X coordinate for (my $i = 0; $i < 3; $i++) { $pole{$i, 'x'} = ($i * $canvas_width / 3) + ($ring_width / 2) + 8; $pole{$i, 'ring_count'} = 0; } # Initialize the rings: canvas ID, pole number, and width for (my $i = 0; $i < $n; $i++) { my $color = '#' $colors[$i % 24]; my $w = $ring_width - ($i * 12); my $y = $ring_base - $i * $ring_spacing; my $x = $pole{0, 'x'} - $w / 2; my $r = $n - $i; $ring{$r, 'id'} = $canvas->createOval( $x, $y, $x + $w, $y + $ring_height, -fill => $color, -outline => 'black', -width => 1, ); $ring{$r, 'width'} = $w; $ring{$r, 'pole'} = 0; $pole{0, 'ring_count'}++; } # Start the simulation $mw->update; hanoi $n, 0, 2, 1; $stopped = 1; } # end do_hanoi sub hanoi { # Recursively move rings until complete or stopped by the user my($n, $from, $to, $work) = @_; return if $n Dialog( -title => 'About tkhanoi', -bitmap => 'info', -default_button => 'OK', -buttons => ['OK'], -text => "tkhanoi version $version\n\n" "r - run simulation\n" "s - stop simulation\n" "q - quit program\n", -wraplength => '6i', ); # Menubar and menubuttons $mw->title("Towers of Hanoi"); $mw->configure(-menu => my $menubar = $mw->Menu); my $file = $menubar->cascade(-label => 'File'); $file->command(-label => '~Quit', -command => \&fini,-accelerator => 'q') my $game = $menubar->cascade(-label => 'Game'); $game->command(-label => '~Run', -command => sub {}, -accelerator => 'r' $game->command(-label => '~Stop', -command => $stop, -accelerator => 's' my $help = $menubar->cascade(-label => 'Help'); $help->command(-label => 'About', -command => sub {$about->Show}); my $info = $mw->Frame->pack; # Number of rings scale my $rframe = $info->Frame(qw/-borderwidth 2 -relief raised/); my $rlabel = $rframe->Label(-text => 'Number of Rings'); my $rscale = $rframe->Scale( qw/-orient horizontal -from 1 -to 24 -length 200/, ); $rscale->set(4); $game->cget(-menu)->entryconfigure('Run', -command => sub {do_hanoi $rscale->get}, ); $rframe->pack(qw/-side left/); $rscale->pack(qw/-side right -expand 1 -fill x/); $rlabel->pack(qw/-side left/); # Ring velocity scale my $vframe = $info->Frame(qw/-borderwidth 2 -relief raised/); my $vlabel = $vframe->Label(-text => 'Ring Velocity %'); my $vscale = $vframe->Scale( qw/-orient horizontal -from 0 -to 100 -length 200/, -command => sub {$velocity = shift}, ); $vscale->set(2); $vframe->pack(qw/-side left/); $vscale->pack(qw/-side right -expand 1 -fill x/); $vlabel->pack(qw/-side left/); # The simulation is played out on a canvas $canvas = $mw->Canvas(qw/-relief sunken/); $canvas->pack(qw/-expand 1 -fill both/); $canvas->createWindow(40, 10, -window => $canvas->Label(-textvariable => \$num_moves, -foreground => 'blue'), ); # Each ring has a unique color, hopefully @colors = (qw/ ffff0000b000 ffff00006000 ffff40000000 ffff60000000 ffff80000000 ffffa0000000 ffffc0000000 ffffe0000000 ffffffff0000 d000ffff0000 b000ffff0000 9000ffff0000 6000ffff3000 0000ffff6000 0000ffff9000 0000ffffc000 0000ffffffff 0000e000ffff 0000c000ffff 0000a000ffff 00008000ffff 00006000ffff 00004000ffff 00000000ffff /); $max_rings = 24; warn "Too few colors for $max_rings rings!" if $max_rings > $#colors + 1; # Global key bindings that emulate menu commands $mw->bind('' => sub {do_hanoi $rscale->get}); $mw->bind('' => \&fini); $mw->bind('' => $stop); } # end init sub fini { $mw->destroy; } sub move_ring { # Move ring $n - its bounding box coordinates - to pole $to my($n, $to) = @_; $num_moves++; my $r = $ring{$n, 'id'}; my($x0, $y0, $x1, $y1) = map {int($_ + 0.5)} $canvas->coords($r); # Float the ring upwards to the flying Y-coordinate, and decrement # this pole's count my $delta; while ($y0 > $fly_y) { $delta = $y0 - $fly_y > $velocity ? $velocity : $y0 - $fly_y; $canvas->coords($r, $x0, $y0 -= $delta, $x1, $y1 -= $delta); $mw->update; } $pole{$ring{$n, 'pole'}, 'ring_count'} ; # Determine the target X coordinate based on destination pole, and # fly the ring over to the new pole The first while moves rings # left-to-right, the second while moves rings right-to-left my $x = $pole{$to, 'x'} - $ring{$n, 'width'} / 2; while ($x0 < $x) { $delta = $x - $x0 > $velocity ? $velocity : $x - $x0; $canvas->coords($r, $x0 += $delta, $y0, $x1 += $delta, $y1); $mw->update; } while ($x0 > $x) { $delta = $x0 - $x > $velocity ? $velocity : $x0 - $x; $canvas->coords($r, $x0 -= $delta, $y0, $x1 -= $delta, $y1); $mw->update; } # Determine ring's target Y coordinate, based on the destination # pole's ring count, and float the ring down my $y = $ring_base - $pole{$to, 'ring_count'} * $ring_spacing; while ($y0 < $y) { $delta = $y - $y0 > $velocity ? $velocity : $y - $y0; $canvas->coords($r, $x0, $y0 += $delta, $x1, $y1 += $delta); $mw->update; } $pole{$to, 'ring_count'}++; $ring{$n, 'pole'} = $to; } # end move_ring Copyright © 2002 O'Reilly & Associates All rights reserved ... window properties and: 11.3 Options canvas groups: 14.5.2 Tk: :CanvasPlot Canvas widget (see -also -Tk CanvasPlot-widget">TkCanvasPlot widget also TkCanvasPlot widget) (see also TkCanvasPlot widget) -fill option and: 2.1.4... SUPER::Populate and: 14.3.5 Subroutine Populate Thermometer example: 14.4.1 Tk: :Thermometer Tk: :Widget::new: 14.3.1 Tk: :Widget::new, the Real Perl/ Tk Widget Constructor configuration files: 19.2 IPADM Design Considerations... Setting and Getting the Gravity Construct widget: 21.2.3 Square.pm constructors: 1.1 Perl/ Tk Concepts 14.3.1 Tk: :Widget::new, the Real Perl/ Tk Widget Constructor containers attachments and: 2.4.2 Attachments