URL
https://opencores.org/ocsvn/or1k/or1k/trunk
Subversion Repositories or1k
Compare Revisions
- This comparison shows the changes necessary to convert path
/or1k/tags/start/insight/tk/library
- from Rev 579 to Rev 1765
- ↔ Reverse comparison
Rev 579 → Rev 1765
/palette.tcl
0,0 → 1,224
# palette.tcl -- |
# |
# This file contains procedures that change the color palette used |
# by Tk. |
# |
# SCCS: @(#) palette.tcl 1.11 97/06/23 20:35:44 |
# |
# Copyright (c) 1995-1997 Sun Microsystems, Inc. |
# |
# See the file "license.terms" for information on usage and redistribution |
# of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
# |
|
# tk_setPalette -- |
# Changes the default color scheme for a Tk application by setting |
# default colors in the option database and by modifying all of the |
# color options for existing widgets that have the default value. |
# |
# Arguments: |
# The arguments consist of either a single color name, which |
# will be used as the new background color (all other colors will |
# be computed from this) or an even number of values consisting of |
# option names and values. The name for an option is the one used |
# for the option database, such as activeForeground, not -activeforeground. |
|
proc tk_setPalette {args} { |
global tkPalette |
|
# Create an array that has the complete new palette. If some colors |
# aren't specified, compute them from other colors that are specified. |
|
if {[llength $args] == 1} { |
set new(background) [lindex $args 0] |
} else { |
array set new $args |
} |
if {![info exists new(background)]} { |
error "must specify a background color" |
} |
if {![info exists new(foreground)]} { |
set new(foreground) black |
} |
set bg [winfo rgb . $new(background)] |
set fg [winfo rgb . $new(foreground)] |
set darkerBg [format #%02x%02x%02x [expr {(9*[lindex $bg 0])/2560}] \ |
[expr {(9*[lindex $bg 1])/2560}] [expr {(9*[lindex $bg 2])/2560}]] |
foreach i {activeForeground insertBackground selectForeground \ |
highlightColor} { |
if {![info exists new($i)]} { |
set new($i) $new(foreground) |
} |
} |
if {![info exists new(disabledForeground)]} { |
set new(disabledForeground) [format #%02x%02x%02x \ |
[expr {(3*[lindex $bg 0] + [lindex $fg 0])/1024}] \ |
[expr {(3*[lindex $bg 1] + [lindex $fg 1])/1024}] \ |
[expr {(3*[lindex $bg 2] + [lindex $fg 2])/1024}]] |
} |
if {![info exists new(highlightBackground)]} { |
set new(highlightBackground) $new(background) |
} |
if {![info exists new(activeBackground)]} { |
# Pick a default active background that islighter than the |
# normal background. To do this, round each color component |
# up by 15% or 1/3 of the way to full white, whichever is |
# greater. |
|
foreach i {0 1 2} { |
set light($i) [expr {[lindex $bg $i]/256}] |
set inc1 [expr {($light($i)*15)/100}] |
set inc2 [expr {(255-$light($i))/3}] |
if {$inc1 > $inc2} { |
incr light($i) $inc1 |
} else { |
incr light($i) $inc2 |
} |
if {$light($i) > 255} { |
set light($i) 255 |
} |
} |
set new(activeBackground) [format #%02x%02x%02x $light(0) \ |
$light(1) $light(2)] |
} |
if {![info exists new(selectBackground)]} { |
set new(selectBackground) $darkerBg |
} |
if {![info exists new(troughColor)]} { |
set new(troughColor) $darkerBg |
} |
if {![info exists new(selectColor)]} { |
set new(selectColor) #b03060 |
} |
|
# let's make one of each of the widgets so we know what the |
# defaults are currently for this platform. |
toplevel .___tk_set_palette |
wm withdraw .___tk_set_palette |
foreach q {button canvas checkbutton entry frame label listbox menubutton menu message \ |
radiobutton scale scrollbar text} { |
$q .___tk_set_palette.$q |
} |
|
# Walk the widget hierarchy, recoloring all existing windows. |
# The option database must be set according to what we do here, |
# but it breaks things if we set things in the database while |
# we are changing colors...so, tkRecolorTree now returns the |
# option database changes that need to be made, and they |
# need to be evalled here to take effect. |
# We have to walk the whole widget tree instead of just |
# relying on the widgets we've created above to do the work |
# because different extensions may provide other kinds |
# of widgets that we don't currently know about, so we'll |
# walk the whole hierarchy just in case. |
|
eval [tkRecolorTree . new] |
|
catch {destroy .___tk_set_palette} |
|
# Change the option database so that future windows will get the |
# same colors. |
|
foreach option [array names new] { |
option add *$option $new($option) widgetDefault |
} |
|
# Save the options in the global variable tkPalette, for use the |
# next time we change the options. |
|
array set tkPalette [array get new] |
} |
|
# tkRecolorTree -- |
# This procedure changes the colors in a window and all of its |
# descendants, according to information provided by the colors |
# argument. This looks at the defaults provided by the option |
# database, if it exists, and if not, then it looks at the default |
# value of the widget itself. |
# |
# Arguments: |
# w - The name of a window. This window and all its |
# descendants are recolored. |
# colors - The name of an array variable in the caller, |
# which contains color information. Each element |
# is named after a widget configuration option, and |
# each value is the value for that option. |
|
proc tkRecolorTree {w colors} { |
global tkPalette |
upvar $colors c |
set result {} |
foreach dbOption [array names c] { |
set option -[string tolower $dbOption] |
if {![catch {$w config $option} value]} { |
# if the option database has a preference for this |
# dbOption, then use it, otherwise use the defaults |
# for the widget. |
set defaultcolor [option get $w $dbOption widgetDefault] |
if {[string match {} $defaultcolor]} { |
set defaultcolor [winfo rgb . [lindex $value 3]] |
} else { |
set defaultcolor [winfo rgb . $defaultcolor] |
} |
if {[lindex $value 4] != {}} { |
set chosencolor [winfo rgb . [lindex $value 4]] |
if {[string match $defaultcolor $chosencolor]} { |
# Change the option database so that future windows will get |
# the same colors. |
append result ";\noption add [list \ |
*[winfo class $w].$dbOption $c($dbOption) 60]" |
$w configure $option $c($dbOption) |
} |
} |
} |
} |
foreach child [winfo children $w] { |
append result ";\n[tkRecolorTree $child c]" |
} |
return $result |
} |
|
# tkDarken -- |
# Given a color name, computes a new color value that darkens (or |
# brightens) the given color by a given percent. |
# |
# Arguments: |
# color - Name of starting color. |
# perecent - Integer telling how much to brighten or darken as a |
# percent: 50 means darken by 50%, 110 means brighten |
# by 10%. |
|
proc tkDarken {color percent} { |
set l [winfo rgb . $color] |
set red [expr {[lindex $l 0]/256}] |
set green [expr {[lindex $l 1]/256}] |
set blue [expr {[lindex $l 2]/256}] |
set red [expr {($red*$percent)/100}] |
if {$red > 255} { |
set red 255 |
} |
set green [expr {($green*$percent)/100}] |
if {$green > 255} { |
set green 255 |
} |
set blue [expr {($blue*$percent)/100}] |
if {$blue > 255} { |
set blue 255 |
} |
format #%02x%02x%02x $red $green $blue |
} |
|
# tk_bisque -- |
# Reset the Tk color palette to the old "bisque" colors. |
# |
# Arguments: |
# None. |
|
proc tk_bisque {} { |
tk_setPalette activeBackground #e6ceb1 activeForeground black \ |
background #ffe4c4 disabledForeground #b0b0b0 foreground black \ |
highlightBackground #ffe4c4 highlightColor black \ |
insertBackground black selectColor #b03060 \ |
selectBackground #e6ceb1 selectForeground black \ |
troughColor #cdb79e |
} |
palette.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: dialog.tcl
===================================================================
--- dialog.tcl (nonexistent)
+++ dialog.tcl (revision 1765)
@@ -0,0 +1,175 @@
+# dialog.tcl --
+#
+# This file defines the procedure tk_dialog, which creates a dialog
+# box containing a bitmap, a message, and one or more buttons.
+#
+# SCCS: @(#) dialog.tcl 1.33 97/06/06 11:20:04
+#
+# Copyright (c) 1992-1993 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#
+# tk_dialog:
+#
+# This procedure displays a dialog box, waits for a button in the dialog
+# to be invoked, then returns the index of the selected button. If the
+# dialog somehow gets destroyed, -1 is returned.
+#
+# Arguments:
+# w - Window to use for dialog top-level.
+# title - Title to display in dialog's decorative frame.
+# text - Message to display in dialog.
+# bitmap - Bitmap to display in dialog (empty string means none).
+# default - Index of button that is to display the default ring
+# (-1 means none).
+# args - One or more strings to display in buttons across the
+# bottom of the dialog box.
+
+proc tk_dialog {w title text bitmap default args} {
+ global tkPriv tcl_platform
+
+ # 1. Create the top-level window and divide it into top
+ # and bottom parts.
+
+ catch {destroy $w}
+ toplevel $w -class Dialog
+ wm title $w $title
+ wm iconname $w Dialog
+ wm protocol $w WM_DELETE_WINDOW {set tkPriv(button) -1}
+
+ # The following command means that the dialog won't be posted if
+ # [winfo parent $w] is iconified, but it's really needed; otherwise
+ # the dialog can become obscured by other windows in the application,
+ # even though its grab keeps the rest of the application from being used.
+
+ wm transient $w [winfo toplevel [winfo parent $w]]
+ if {$tcl_platform(platform) == "macintosh"} {
+ unsupported1 style $w dBoxProc
+ }
+
+ frame $w.bot
+ frame $w.top
+ if {$tcl_platform(platform) == "unix"} {
+ $w.bot configure -relief raised -bd 1
+ $w.top configure -relief raised -bd 1
+ }
+ pack $w.bot -side bottom -fill both
+ pack $w.top -side top -fill both -expand 1
+
+ # 2. Fill the top part with bitmap and message (use the option
+ # database for -wraplength so that it can be overridden by
+ # the caller).
+
+ option add *Dialog.msg.wrapLength 3i widgetDefault
+ label $w.msg -justify left -text $text
+ if {$tcl_platform(platform) == "macintosh"} {
+ $w.msg configure -font system
+ } else {
+ $w.msg configure -font {Times 18}
+ }
+ pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
+ if {$bitmap != ""} {
+ if {($tcl_platform(platform) == "macintosh") && ($bitmap == "error")} {
+ set bitmap "stop"
+ }
+ label $w.bitmap -bitmap $bitmap
+ pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
+ }
+
+ # 3. Create a row of buttons at the bottom of the dialog.
+
+ set i 0
+ foreach but $args {
+ button $w.button$i -text $but -command "set tkPriv(button) $i"
+ if {$i == $default} {
+ $w.button$i configure -default active
+ } else {
+ $w.button$i configure -default normal
+ }
+ grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew -padx 10
+ grid columnconfigure $w.bot $i
+ # We boost the size of some Mac buttons for l&f
+ if {$tcl_platform(platform) == "macintosh"} {
+ set tmp [string tolower $but]
+ if {($tmp == "ok") || ($tmp == "cancel")} {
+ grid columnconfigure $w.bot $i -minsize [expr 59 + 20]
+ }
+ }
+ incr i
+ }
+
+ # 4. Create a binding for on the dialog if there is a
+ # default button.
+
+ if {$default >= 0} {
+ bind $w "
+ $w.button$default configure -state active -relief sunken
+ update idletasks
+ after 100
+ set tkPriv(button) $default
+ "
+ }
+
+ # 5. Create a binding for the window that sets the
+ # button variable to -1; this is needed in case something happens
+ # that destroys the window, such as its parent window being destroyed.
+
+ bind $w {set tkPriv(button) -1}
+
+ # 6. Withdraw the window, then update all the geometry information
+ # so we know how big it wants to be, then center the window in the
+ # display and de-iconify it.
+
+ wm withdraw $w
+ update idletasks
+ set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
+ - [winfo vrootx [winfo parent $w]]}]
+ set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
+ - [winfo vrooty [winfo parent $w]]}]
+ wm geom $w +$x+$y
+ update idle
+ wm deiconify $w
+
+ # 7. Set a grab and claim the focus too.
+
+ set oldFocus [focus]
+ set oldGrab [grab current $w]
+ if {$oldGrab != ""} {
+ set grabStatus [grab status $oldGrab]
+ }
+ grab $w
+ if {$default >= 0} {
+ focus $w.button$default
+ } else {
+ focus $w
+ }
+
+ # 8. Wait for the user to respond, then restore the focus and
+ # return the index of the selected button. Restore the focus
+ # before deleting the window, since otherwise the window manager
+ # may take the focus away so we can't redirect it. Finally,
+ # restore any grab that was in effect.
+
+ tkwait variable tkPriv(button)
+ catch {focus $oldFocus}
+ catch {
+ # It's possible that the window has already been destroyed,
+ # hence this "catch". Delete the Destroy handler so that
+ # tkPriv(button) doesn't get reset by it.
+
+ bind $w {}
+ destroy $w
+ }
+ if {$oldGrab != ""} {
+ if {$grabStatus == "global"} {
+ grab -global $oldGrab
+ } else {
+ grab $oldGrab
+ }
+ }
+ return $tkPriv(button)
+}
dialog.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: msgbox.tcl
===================================================================
--- msgbox.tcl (nonexistent)
+++ msgbox.tcl (revision 1765)
@@ -0,0 +1,268 @@
+# msgbox.tcl --
+#
+# Implements messageboxes for platforms that do not have native
+# messagebox support.
+#
+# SCCS: @(#) msgbox.tcl 1.8 97/07/28 17:20:01
+#
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+# tkMessageBox --
+#
+# Pops up a messagebox with an application-supplied message with
+# an icon and a list of buttons. This procedure will be called
+# by tk_messageBox if the platform does not have native
+# messagebox support, or if the particular type of messagebox is
+# not supported natively.
+#
+# This procedure is a private procedure shouldn't be called
+# directly. Call tk_messageBox instead.
+#
+# See the user documentation for details on what tk_messageBox does.
+#
+proc tkMessageBox {args} {
+ global tkPriv tcl_platform
+
+ set w tkPrivMsgBox
+ upvar #0 $w data
+
+ #
+ # The default value of the title is space (" ") not the empty string
+ # because for some window managers, a
+ # wm title .foo ""
+ # causes the window title to be "foo" instead of the empty string.
+ #
+ set specs {
+ {-default "" "" ""}
+ {-icon "" "" "info"}
+ {-message "" "" ""}
+ {-modal "" "" ""}
+ {-parent "" "" .}
+ {-title "" "" " "}
+ {-type "" "" "ok"}
+ }
+
+ tclParseConfigSpec $w $specs "" $args
+
+ if {[lsearch {info warning error question} $data(-icon)] == -1} {
+ error "invalid icon \"$data(-icon)\", must be error, info, question or warning"
+ }
+ if {$tcl_platform(platform) == "macintosh"} {
+ if {$data(-icon) == "error"} {
+ set data(-icon) "stop"
+ } elseif {$data(-icon) == "warning"} {
+ set data(-icon) "caution"
+ } elseif {$data(-icon) == "info"} {
+ set data(-icon) "note"
+ }
+ }
+
+ if {![winfo exists $data(-parent)]} {
+ error "bad window path name \"$data(-parent)\""
+ }
+
+ case $data(-type) {
+ abortretryignore {
+ set buttons {
+ {abort -width 6 -text Abort -under 0}
+ {retry -width 6 -text Retry -under 0}
+ {ignore -width 6 -text Ignore -under 0}
+ }
+ }
+ ok {
+ set buttons {
+ {ok -width 6 -text OK -under 0}
+ }
+ if {$data(-default) == ""} {
+ set data(-default) "ok"
+ }
+ }
+ okcancel {
+ set buttons {
+ {ok -width 6 -text OK -under 0}
+ {cancel -width 6 -text Cancel -under 0}
+ }
+ }
+ retrycancel {
+ set buttons {
+ {retry -width 6 -text Retry -under 0}
+ {cancel -width 6 -text Cancel -under 0}
+ }
+ }
+ yesno {
+ set buttons {
+ {yes -width 6 -text Yes -under 0}
+ {no -width 6 -text No -under 0}
+ }
+ }
+ yesnocancel {
+ set buttons {
+ {yes -width 6 -text Yes -under 0}
+ {no -width 6 -text No -under 0}
+ {cancel -width 6 -text Cancel -under 0}
+ }
+ }
+ default {
+ error "invalid message box type \"$data(-type)\", must be abortretryignore, ok, okcancel, retrycancel, yesno or yesnocancel"
+ }
+ }
+
+ if {[string compare $data(-default) ""]} {
+ set valid 0
+ foreach btn $buttons {
+ if {![string compare [lindex $btn 0] $data(-default)]} {
+ set valid 1
+ break
+ }
+ }
+ if {!$valid} {
+ error "invalid default button \"$data(-default)\""
+ }
+ }
+
+ # 2. Set the dialog to be a child window of $parent
+ #
+ #
+ if {[string compare $data(-parent) .]} {
+ set w $data(-parent).__tk__messagebox
+ } else {
+ set w .__tk__messagebox
+ }
+
+ # 3. Create the top-level window and divide it into top
+ # and bottom parts.
+
+ catch {destroy $w}
+ toplevel $w -class Dialog
+ wm title $w $data(-title)
+ wm iconname $w Dialog
+ wm protocol $w WM_DELETE_WINDOW { }
+ wm transient $w $data(-parent)
+ if {$tcl_platform(platform) == "macintosh"} {
+ unsupported1 style $w dBoxProc
+ }
+
+ frame $w.bot
+ pack $w.bot -side bottom -fill both
+ frame $w.top
+ pack $w.top -side top -fill both -expand 1
+ if {$tcl_platform(platform) != "macintosh"} {
+ $w.bot configure -relief raised -bd 1
+ $w.top configure -relief raised -bd 1
+ }
+
+ # 4. Fill the top part with bitmap and message (use the option
+ # database for -wraplength so that it can be overridden by
+ # the caller).
+
+ option add *Dialog.msg.wrapLength 3i widgetDefault
+ label $w.msg -justify left -text $data(-message)
+ catch {$w.msg configure -font \
+ -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
+ }
+ pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
+ if {$data(-icon) != ""} {
+ label $w.bitmap -bitmap $data(-icon)
+ pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
+ }
+
+ # 5. Create a row of buttons at the bottom of the dialog.
+
+ set i 0
+ foreach but $buttons {
+ set name [lindex $but 0]
+ set opts [lrange $but 1 end]
+ if {![string compare $opts {}]} {
+ # Capitalize the first letter of $name
+ set capName \
+ [string toupper \
+ [string index $name 0]][string range $name 1 end]
+ set opts [list -text $capName]
+ }
+
+ eval button $w.$name $opts -command [list "set tkPriv(button) $name"]
+
+ if {![string compare $name $data(-default)]} {
+ $w.$name configure -default active
+ }
+ pack $w.$name -in $w.bot -side left -expand 1 \
+ -padx 3m -pady 2m
+
+ # create the binding for the key accelerator, based on the underline
+ #
+ set underIdx [$w.$name cget -under]
+ if {$underIdx >= 0} {
+ set key [string index [$w.$name cget -text] $underIdx]
+ bind $w "$w.$name invoke"
+ bind $w "$w.$name invoke"
+ }
+
+ # CYGNUS LOCAL - bind all buttons so that
+ # activates them
+ bind $w.$name "$w.$name invoke"
+
+ incr i
+ }
+
+ # 6. Create a binding for on the dialog if there is a
+ # default button.
+
+ # CYGNUS LOCAL - This seems like a bad idea. If the user
+ # uses the keyboard to select something other than the default and
+ # then hits to activate that button, the wrong value will
+ # be returned
+
+ #if [string compare $data(-default) ""] {
+ #bind $w "tkButtonInvoke $w.$data(-default)"
+ #}
+
+ # 7. Withdraw the window, then update all the geometry information
+ # so we know how big it wants to be, then center the window in the
+ # display and de-iconify it.
+
+ wm withdraw $w
+ update idletasks
+ set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
+ - [winfo vrootx [winfo parent $w]]}]
+ set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
+ - [winfo vrooty [winfo parent $w]]}]
+ wm geom $w +$x+$y
+ wm deiconify $w
+
+ # 8. Set a grab and claim the focus too.
+
+ set oldFocus [focus]
+ set oldGrab [grab current $w]
+ if {$oldGrab != ""} {
+ set grabStatus [grab status $oldGrab]
+ }
+ grab $w
+ if {[string compare $data(-default) ""]} {
+ focus $w.$data(-default)
+ } else {
+ focus $w
+ }
+
+ # 9. Wait for the user to respond, then restore the focus and
+ # return the index of the selected button. Restore the focus
+ # before deleting the window, since otherwise the window manager
+ # may take the focus away so we can't redirect it. Finally,
+ # restore any grab that was in effect.
+
+ tkwait variable tkPriv(button)
+ catch {focus $oldFocus}
+ destroy $w
+ if {$oldGrab != ""} {
+ if {$grabStatus == "global"} {
+ grab -global $oldGrab
+ } else {
+ grab $oldGrab
+ }
+ }
+ return $tkPriv(button)
+}
msgbox.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: entry.tcl
===================================================================
--- entry.tcl (nonexistent)
+++ entry.tcl (revision 1765)
@@ -0,0 +1,610 @@
+# entry.tcl --
+#
+# This file defines the default bindings for Tk entry widgets and provides
+# procedures that help in implementing those bindings.
+#
+# SCCS: @(#) entry.tcl 1.49 97/09/17 19:08:48
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#-------------------------------------------------------------------------
+# Elements of tkPriv that are used in this file:
+#
+# afterId - If non-null, it means that auto-scanning is underway
+# and it gives the "after" id for the next auto-scan
+# command to be executed.
+# mouseMoved - Non-zero means the mouse has moved a significant
+# amount since the button went down (so, for example,
+# start dragging out a selection).
+# pressX - X-coordinate at which the mouse button was pressed.
+# selectMode - The style of selection currently underway:
+# char, word, or line.
+# x, y - Last known mouse coordinates for scanning
+# and auto-scanning.
+#-------------------------------------------------------------------------
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for entries.
+#-------------------------------------------------------------------------
+bind Entry <> {
+ if {![catch {set data [string range [%W get] [%W index sel.first]\
+ [expr {[%W index sel.last] - 1}]]}]} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W $data
+ %W delete sel.first sel.last
+ }
+}
+bind Entry <> {
+ if {![catch {set data [string range [%W get] [%W index sel.first]\
+ [expr {[%W index sel.last] - 1}]]}]} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W $data
+ }
+}
+bind Entry <> {
+ global tcl_platform
+ catch {
+ if {"$tcl_platform(platform)" != "unix"} {
+ catch {
+ %W delete sel.first sel.last
+ }
+ }
+ %W insert insert [selection get -displayof %W -selection CLIPBOARD]
+ tkEntrySeeInsert %W
+ }
+}
+bind Entry <> {
+ %W delete sel.first sel.last
+}
+bind Entry <> {
+ if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
+ tkEntryPaste %W %x
+ }
+}
+
+# Standard Motif bindings:
+
+bind Entry <1> {
+ tkEntryButton1 %W %x
+ %W selection clear
+}
+bind Entry {
+ set tkPriv(x) %x
+ tkEntryMouseSelect %W %x
+}
+bind Entry {
+ set tkPriv(selectMode) word
+ tkEntryMouseSelect %W %x
+ catch {%W icursor sel.first}
+}
+bind Entry {
+ set tkPriv(selectMode) line
+ tkEntryMouseSelect %W %x
+ %W icursor 0
+}
+bind Entry {
+ set tkPriv(selectMode) char
+ %W selection adjust @%x
+}
+bind Entry {
+ set tkPriv(selectMode) word
+ tkEntryMouseSelect %W %x
+}
+bind Entry {
+ set tkPriv(selectMode) line
+ tkEntryMouseSelect %W %x
+}
+bind Entry {
+ set tkPriv(x) %x
+ tkEntryAutoScan %W
+}
+bind Entry {
+ tkCancelRepeat
+}
+bind Entry {
+ tkCancelRepeat
+}
+bind Entry {
+ %W icursor @%x
+}
+
+bind Entry {
+ tkEntrySetCursor %W [expr {[%W index insert] - 1}]
+}
+bind Entry {
+ tkEntrySetCursor %W [expr {[%W index insert] + 1}]
+}
+bind Entry {
+ tkEntryKeySelect %W [expr {[%W index insert] - 1}]
+ tkEntrySeeInsert %W
+}
+bind Entry {
+ tkEntryKeySelect %W [expr {[%W index insert] + 1}]
+ tkEntrySeeInsert %W
+}
+bind Entry {
+ tkEntrySetCursor %W [tkEntryPreviousWord %W insert]
+}
+bind Entry {
+ tkEntrySetCursor %W [tkEntryNextWord %W insert]
+}
+bind Entry {
+ tkEntryKeySelect %W [tkEntryPreviousWord %W insert]
+ tkEntrySeeInsert %W
+}
+bind Entry {
+ tkEntryKeySelect %W [tkEntryNextWord %W insert]
+ tkEntrySeeInsert %W
+}
+bind Entry {
+ tkEntrySetCursor %W 0
+}
+bind Entry {
+ tkEntryKeySelect %W 0
+ tkEntrySeeInsert %W
+}
+bind Entry {
+ tkEntrySetCursor %W end
+}
+bind Entry {
+ tkEntryKeySelect %W end
+ tkEntrySeeInsert %W
+}
+
+bind Entry {
+ if {[%W selection present]} {
+ %W delete sel.first sel.last
+ } else {
+ %W delete insert
+ }
+}
+bind Entry {
+ tkEntryBackspace %W
+}
+
+bind Entry {
+ %W selection from insert
+}
+bind Entry
entry.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: console.tcl
===================================================================
--- console.tcl (nonexistent)
+++ console.tcl (revision 1765)
@@ -0,0 +1,481 @@
+# console.tcl --
+#
+# This code constructs the console window for an application. It
+# can be used by non-unix systems that do not have built-in support
+# for shells.
+#
+# SCCS: @(#) console.tcl 1.45 97/09/17 16:52:40
+#
+# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+# TODO: history - remember partially written command
+
+# tkConsoleInit --
+# This procedure constructs and configures the console windows.
+#
+# Arguments:
+# None.
+
+proc tkConsoleInit {} {
+ global tcl_platform
+
+ if {! [consoleinterp eval {set tcl_interactive}]} {
+ wm withdraw .
+ }
+
+ if {"$tcl_platform(platform)" == "macintosh"} {
+ set mod "Cmd"
+ } else {
+ set mod "Ctrl"
+ }
+
+ menu .menubar
+ .menubar add cascade -label File -menu .menubar.file -underline 0
+ .menubar add cascade -label Edit -menu .menubar.edit -underline 0
+
+ menu .menubar.file -tearoff 0
+ .menubar.file add command -label "Source..." -underline 0 \
+ -command tkConsoleSource
+ .menubar.file add command -label "Hide Console" -underline 0 \
+ -command {wm withdraw .}
+ if {"$tcl_platform(platform)" == "macintosh"} {
+ .menubar.file add command -label "Quit" -command exit -accel Cmd-Q
+ } else {
+ .menubar.file add command -label "Exit" -underline 1 -command exit
+ }
+
+ menu .menubar.edit -tearoff 0
+ .menubar.edit add command -label "Cut" -underline 2 \
+ -command { event generate .console <> } -accel "$mod+X"
+ .menubar.edit add command -label "Copy" -underline 0 \
+ -command { event generate .console <> } -accel "$mod+C"
+ .menubar.edit add command -label "Paste" -underline 1 \
+ -command { event generate .console <> } -accel "$mod+V"
+
+ if {"$tcl_platform(platform)" == "windows"} {
+ .menubar.edit add command -label "Delete" -underline 0 \
+ -command { event generate .console <> } -accel "Del"
+
+ .menubar add cascade -label Help -menu .menubar.help -underline 0
+ menu .menubar.help -tearoff 0
+ .menubar.help add command -label "About..." -underline 0 \
+ -command tkConsoleAbout
+ } else {
+ .menubar.edit add command -label "Clear" -underline 2 \
+ -command { event generate .console <> }
+ }
+
+ . conf -menu .menubar
+
+ text .console -yscrollcommand ".sb set" -setgrid true
+ scrollbar .sb -command ".console yview"
+ pack .sb -side right -fill both
+ pack .console -fill both -expand 1 -side left
+ if {$tcl_platform(platform) == "macintosh"} {
+ .console configure -font {Monaco 9 normal} -highlightthickness 0
+ }
+
+ tkConsoleBind .console
+
+ .console tag configure stderr -foreground red
+ .console tag configure stdin -foreground blue
+
+ focus .console
+
+ wm protocol . WM_DELETE_WINDOW { wm withdraw . }
+ wm title . "Console"
+ flush stdout
+ .console mark set output [.console index "end - 1 char"]
+ tkTextSetCursor .console end
+ .console mark set promptEnd insert
+ .console mark gravity promptEnd left
+}
+
+# tkConsoleSource --
+#
+# Prompts the user for a file to source in the main interpreter.
+#
+# Arguments:
+# None.
+
+proc tkConsoleSource {} {
+ set filename [tk_getOpenFile -defaultextension .tcl -parent . \
+ -title "Select a file to source" \
+ -filetypes {{"Tcl Scripts" .tcl} {"All Files" *}}]
+ if {"$filename" != ""} {
+ set cmd [list source $filename]
+ if {[catch {consoleinterp eval $cmd} result]} {
+ tkConsoleOutput stderr "$result\n"
+ }
+ }
+}
+
+# tkConsoleInvoke --
+# Processes the command line input. If the command is complete it
+# is evaled in the main interpreter. Otherwise, the continuation
+# prompt is added and more input may be added.
+#
+# Arguments:
+# None.
+
+proc tkConsoleInvoke {args} {
+ set ranges [.console tag ranges input]
+ set cmd ""
+ if {$ranges != ""} {
+ set pos 0
+ while {[lindex $ranges $pos] != ""} {
+ set start [lindex $ranges $pos]
+ set end [lindex $ranges [incr pos]]
+ append cmd [.console get $start $end]
+ incr pos
+ }
+ }
+ if {$cmd == ""} {
+ tkConsolePrompt
+ } elseif {[info complete $cmd]} {
+ .console mark set output end
+ .console tag delete input
+ set result [consoleinterp record $cmd]
+ if {$result != ""} {
+ .console insert insert "$result\n"
+ }
+ tkConsoleHistory reset
+ tkConsolePrompt
+ } else {
+ tkConsolePrompt partial
+ }
+ .console yview -pickplace insert
+}
+
+# tkConsoleHistory --
+# This procedure implements command line history for the
+# console. In general is evals the history command in the
+# main interpreter to obtain the history. The global variable
+# histNum is used to store the current location in the history.
+#
+# Arguments:
+# cmd - Which action to take: prev, next, reset.
+
+set histNum 1
+proc tkConsoleHistory {cmd} {
+ global histNum
+
+ switch $cmd {
+ prev {
+ incr histNum -1
+ if {$histNum == 0} {
+ set cmd {history event [expr {[history nextid] -1}]}
+ } else {
+ set cmd "history event $histNum"
+ }
+ if {[catch {consoleinterp eval $cmd} cmd]} {
+ incr histNum
+ return
+ }
+ .console delete promptEnd end
+ .console insert promptEnd $cmd {input stdin}
+ }
+ next {
+ incr histNum
+ if {$histNum == 0} {
+ set cmd {history event [expr {[history nextid] -1}]}
+ } elseif {$histNum > 0} {
+ set cmd ""
+ set histNum 1
+ } else {
+ set cmd "history event $histNum"
+ }
+ if {$cmd != ""} {
+ catch {consoleinterp eval $cmd} cmd
+ }
+ .console delete promptEnd end
+ .console insert promptEnd $cmd {input stdin}
+ }
+ reset {
+ set histNum 1
+ }
+ }
+}
+
+# tkConsolePrompt --
+# This procedure draws the prompt. If tcl_prompt1 or tcl_prompt2
+# exists in the main interpreter it will be called to generate the
+# prompt. Otherwise, a hard coded default prompt is printed.
+#
+# Arguments:
+# partial - Flag to specify which prompt to print.
+
+proc tkConsolePrompt {{partial normal}} {
+ if {$partial == "normal"} {
+ set temp [.console index "end - 1 char"]
+ .console mark set output end
+ if {[consoleinterp eval "info exists tcl_prompt1"]} {
+ consoleinterp eval "eval \[set tcl_prompt1\]"
+ } else {
+ puts -nonewline "% "
+ }
+ } else {
+ set temp [.console index output]
+ .console mark set output end
+ if {[consoleinterp eval "info exists tcl_prompt2"]} {
+ consoleinterp eval "eval \[set tcl_prompt2\]"
+ } else {
+ puts -nonewline "> "
+ }
+ }
+ flush stdout
+ .console mark set output $temp
+ tkTextSetCursor .console end
+ .console mark set promptEnd insert
+ .console mark gravity promptEnd left
+}
+
+# tkConsoleBind --
+# This procedure first ensures that the default bindings for the Text
+# class have been defined. Then certain bindings are overridden for
+# the class.
+#
+# Arguments:
+# None.
+
+proc tkConsoleBind {win} {
+ bindtags $win "$win Text . all"
+
+ # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
+ # Otherwise, if a widget binding for one of these is defined, the
+ # class binding will also fire and insert the character,
+ # which is wrong. Ditto for .
+
+ bind $win {# nothing }
+ bind $win {# nothing}
+ bind $win {# nothing}
+ bind $win {# nothing}
+ bind $win {# nothing}
+
+ bind $win {
+ tkConsoleInsert %W \t
+ focus %W
+ break
+ }
+ bind $win {
+ %W mark set insert {end - 1c}
+ tkConsoleInsert %W "\n"
+ tkConsoleInvoke
+ break
+ }
+ bind $win {
+ if {[%W tag nextrange sel 1.0 end] != ""} {
+ %W tag remove sel sel.first promptEnd
+ } else {
+ if {[%W compare insert < promptEnd]} {
+ break
+ }
+ }
+ }
+ bind $win {
+ if {[%W tag nextrange sel 1.0 end] != ""} {
+ %W tag remove sel sel.first promptEnd
+ } else {
+ if {[%W compare insert <= promptEnd]} {
+ break
+ }
+ }
+ }
+ foreach left {Control-a Home} {
+ bind $win <$left> {
+ if {[%W compare insert < promptEnd]} {
+ tkTextSetCursor %W {insert linestart}
+ } else {
+ tkTextSetCursor %W promptEnd
+ }
+ break
+ }
+ }
+ foreach right {Control-e End} {
+ bind $win <$right> {
+ tkTextSetCursor %W {insert lineend}
+ break
+ }
+ }
+ bind $win {
+ if {[%W compare insert < promptEnd]} {
+ break
+ }
+ }
+ bind $win {
+ if {[%W compare insert < promptEnd]} {
+ %W mark set insert promptEnd
+ }
+ }
+ bind $win {
+ if {[%W compare insert < promptEnd]} {
+ break
+ }
+ }
+ bind $win {
+ if {[%W compare insert < promptEnd]} {
+ break
+ }
+ }
+ bind $win {
+ if {[%W compare insert <= promptEnd]} {
+ break
+ }
+ }
+ bind $win {
+ if {[%W compare insert <= promptEnd]} {
+ break
+ }
+ }
+ foreach prev {Control-p Up} {
+ bind $win <$prev> {
+ tkConsoleHistory prev
+ break
+ }
+ }
+ foreach prev {Control-n Down} {
+ bind $win <$prev> {
+ tkConsoleHistory next
+ break
+ }
+ }
+ bind $win {
+ catch {tkConsoleInsert %W [selection get -displayof %W]}
+ break
+ }
+ bind $win {
+ tkConsoleInsert %W %A
+ break
+ }
+ foreach left {Control-b Left} {
+ bind $win <$left> {
+ if {[%W compare insert == promptEnd]} {
+ break
+ }
+ tkTextSetCursor %W insert-1c
+ break
+ }
+ }
+ foreach right {Control-f Right} {
+ bind $win <$right> {
+ tkTextSetCursor %W insert+1c
+ break
+ }
+ }
+ bind $win {
+ eval destroy [winfo child .]
+ if {$tcl_platform(platform) == "macintosh"} {
+ source -rsrc Console
+ } else {
+ source [file join $tk_library console.tcl]
+ }
+ }
+ bind $win <> {
+ # Same as the copy event
+ if {![catch {set data [%W get sel.first sel.last]}]} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W $data
+ }
+ break
+ }
+ bind $win <> {
+ if {![catch {set data [%W get sel.first sel.last]}]} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W $data
+ }
+ break
+ }
+ bind $win <> {
+ catch {
+ set clip [selection get -displayof %W -selection CLIPBOARD]
+ set list [split $clip \n\r]
+ tkConsoleInsert %W [lindex $list 0]
+ foreach x [lrange $list 1 end] {
+ %W mark set insert {end - 1c}
+ tkConsoleInsert %W "\n"
+ tkConsoleInvoke
+ tkConsoleInsert %W $x
+ }
+ }
+ break
+ }
+}
+
+# tkConsoleInsert --
+# Insert a string into a text at the point of the insertion cursor.
+# If there is a selection in the text, and it covers the point of the
+# insertion cursor, then delete the selection before inserting. Insertion
+# is restricted to the prompt area.
+#
+# Arguments:
+# w - The text window in which to insert the string
+# s - The string to insert (usually just a single character)
+
+proc tkConsoleInsert {w s} {
+ if {$s == ""} {
+ return
+ }
+ catch {
+ if {[$w compare sel.first <= insert]
+ && [$w compare sel.last >= insert]} {
+ $w tag remove sel sel.first promptEnd
+ $w delete sel.first sel.last
+ }
+ }
+ if {[$w compare insert < promptEnd]} {
+ $w mark set insert end
+ }
+ $w insert insert $s {input stdin}
+ $w see insert
+}
+
+# tkConsoleOutput --
+#
+# This routine is called directly by ConsolePutsCmd to cause a string
+# to be displayed in the console.
+#
+# Arguments:
+# dest - The output tag to be used: either "stderr" or "stdout".
+# string - The string to be displayed.
+
+proc tkConsoleOutput {dest string} {
+ .console insert output $string $dest
+ .console see insert
+}
+
+# tkConsoleExit --
+#
+# This routine is called by ConsoleEventProc when the main window of
+# the application is destroyed. Don't call exit - that probably already
+# happened. Just delete our window.
+#
+# Arguments:
+# None.
+
+proc tkConsoleExit {} {
+ destroy .
+}
+
+# tkConsoleAbout --
+#
+# This routine displays an About box to show Tcl/Tk version info.
+#
+# Arguments:
+# None.
+
+proc tkConsoleAbout {} {
+ global tk_patchLevel
+ tk_messageBox -type ok -message "Tcl for Windows
+Copyright \251 1996 Sun Microsystems, Inc.
+
+Tcl [info patchlevel]
+Tk $tk_patchLevel"
+}
+
+# now initialize the console
+
+tkConsoleInit
console.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: bgerror.tcl
===================================================================
--- bgerror.tcl (nonexistent)
+++ bgerror.tcl (revision 1765)
@@ -0,0 +1,99 @@
+# bgerror.tcl --
+#
+# This file contains a default version of the bgerror procedure. It
+# posts a dialog box with the error message and gives the user a chance
+# to see a more detailed stack trace.
+#
+# SCCS: @(#) bgerror.tcl 1.16 97/08/06 09:19:50
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+
+# bgerror --
+# This is the default version of bgerror.
+# It tries to execute tkerror, if that fails it posts a dialog box containing
+# the error message and gives the user a chance to ask to see a stack
+# trace.
+# Arguments:
+# err - The error message.
+
+proc bgerror err {
+ global errorInfo tcl_platform
+
+ # save errorInfo which would be erased in the catch below otherwise.
+ set info $errorInfo ;
+
+ # For backward compatibility :
+ # Let's try to execute "tkerror" (using catch {tkerror ...}
+ # instead of searching it with info procs so the application gets
+ # a chance to auto load it using its favorite "unknown" mecanism.
+ # (we do the default dialog only if we get a TCL_ERROR (=1) return
+ # code from the tkerror trial, other ret codes are passed back
+ # to our caller (tcl background error handler) so the called "tkerror"
+ # can still use return -code break, to skip remaining messages
+ # in the error queue for instance) -- dl
+ set ret [catch {tkerror $err} msg];
+ if {$ret != 1} {return -code $ret $msg}
+
+ # Ok the application's tkerror either failed or was not found
+ # we use the default dialog then :
+ if {$tcl_platform(platform) == "macintosh"} {
+ set ok Ok
+ } else {
+ set ok OK
+ }
+ set button [tk_dialog .bgerrorDialog "Error in Tcl Script" \
+ "Error: $err" error 0 $ok "Skip Messages" "Stack Trace"]
+ if {$button == 0} {
+ return
+ } elseif {$button == 1} {
+ return -code break
+ }
+
+ set w .bgerrorTrace
+ catch {destroy $w}
+ toplevel $w -class ErrorTrace
+ wm minsize $w 1 1
+ wm title $w "Stack Trace for Error"
+ wm iconname $w "Stack Trace"
+ button $w.ok -text OK -command "destroy $w" -default active
+ if {$tcl_platform(platform) == "macintosh"} {
+ text $w.text -relief flat -bd 2 -highlightthickness 0 -setgrid true \
+ -yscrollcommand "$w.scroll set" -width 60 -height 20
+ } else {
+ text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \
+ -setgrid true -width 60 -height 20
+ }
+ scrollbar $w.scroll -relief sunken -command "$w.text yview"
+ pack $w.ok -side bottom -padx 3m -pady 2m
+ pack $w.scroll -side right -fill y
+ pack $w.text -side left -expand yes -fill both
+ $w.text insert 0.0 $info
+ $w.text mark set insert 0.0
+
+ bind $w "destroy $w"
+ bind $w.text "destroy $w; break"
+
+ # Center the window on the screen.
+
+ wm withdraw $w
+ update idletasks
+ set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
+ - [winfo vrootx [winfo parent $w]]}]
+ set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
+ - [winfo vrooty [winfo parent $w]]}]
+ wm geom $w +$x+$y
+ wm deiconify $w
+
+ # Be sure to release any grabs that might be present on the
+ # screen, since they could make it impossible for the user
+ # to interact with the stack trace.
+
+ if {[grab current .] != ""} {
+ grab release [grab current .]
+ }
+}
bgerror.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: prolog.ps
===================================================================
--- prolog.ps (nonexistent)
+++ prolog.ps (revision 1765)
@@ -0,0 +1,284 @@
+%%BeginProlog
+50 dict begin
+
+% This is a standard prolog for Postscript generated by Tk's canvas
+% widget.
+% SCCS: @(#) prolog.ps 1.7 96/07/08 17:52:14
+
+% The definitions below just define all of the variables used in
+% any of the procedures here. This is needed for obscure reasons
+% explained on p. 716 of the Postscript manual (Section H.2.7,
+% "Initializing Variables," in the section on Encapsulated Postscript).
+
+/baseline 0 def
+/stipimage 0 def
+/height 0 def
+/justify 0 def
+/lineLength 0 def
+/spacing 0 def
+/stipple 0 def
+/strings 0 def
+/xoffset 0 def
+/yoffset 0 def
+/tmpstip null def
+
+% Define the array ISOLatin1Encoding (which specifies how characters are
+% encoded for ISO-8859-1 fonts), if it isn't already present (Postscript
+% level 2 is supposed to define it, but level 1 doesn't).
+
+systemdict /ISOLatin1Encoding known not {
+ /ISOLatin1Encoding [
+ /space /space /space /space /space /space /space /space
+ /space /space /space /space /space /space /space /space
+ /space /space /space /space /space /space /space /space
+ /space /space /space /space /space /space /space /space
+ /space /exclam /quotedbl /numbersign /dollar /percent /ampersand
+ /quoteright
+ /parenleft /parenright /asterisk /plus /comma /minus /period /slash
+ /zero /one /two /three /four /five /six /seven
+ /eight /nine /colon /semicolon /less /equal /greater /question
+ /at /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 /bracketleft /backslash /bracketright /asciicircum /underscore
+ /quoteleft /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 /braceleft /bar /braceright /asciitilde /space
+ /space /space /space /space /space /space /space /space
+ /space /space /space /space /space /space /space /space
+ /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
+ /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron
+ /space /exclamdown /cent /sterling /currency /yen /brokenbar /section
+ /dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen
+ /registered /macron
+ /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph
+ /periodcentered
+ /cedillar /onesuperior /ordmasculine /guillemotright /onequarter
+ /onehalf /threequarters /questiondown
+ /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla
+ /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex
+ /Idieresis
+ /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply
+ /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn
+ /germandbls
+ /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla
+ /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex
+ /idieresis
+ /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide
+ /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn
+ /ydieresis
+ ] def
+} if
+
+% font ISOEncode font
+% This procedure changes the encoding of a font from the default
+% Postscript encoding to ISOLatin1. It's typically invoked just
+% before invoking "setfont". The body of this procedure comes from
+% Section 5.6.1 of the Postscript book.
+
+/ISOEncode {
+ dup length dict begin
+ {1 index /FID ne {def} {pop pop} ifelse} forall
+ /Encoding ISOLatin1Encoding def
+ currentdict
+ end
+
+ % I'm not sure why it's necessary to use "definefont" on this new
+ % font, but it seems to be important; just use the name "Temporary"
+ % for the font.
+
+ /Temporary exch definefont
+} bind def
+
+% StrokeClip
+%
+% This procedure converts the current path into a clip area under
+% the assumption of stroking. It's a bit tricky because some Postscript
+% interpreters get errors during strokepath for dashed lines. If
+% this happens then turn off dashes and try again.
+
+/StrokeClip {
+ {strokepath} stopped {
+ (This Postscript printer gets limitcheck overflows when) =
+ (stippling dashed lines; lines will be printed solid instead.) =
+ [] 0 setdash strokepath} if
+ clip
+} bind def
+
+% desiredSize EvenPixels closestSize
+%
+% The procedure below is used for stippling. Given the optimal size
+% of a dot in a stipple pattern in the current user coordinate system,
+% compute the closest size that is an exact multiple of the device's
+% pixel size. This allows stipple patterns to be displayed without
+% aliasing effects.
+
+/EvenPixels {
+ % Compute exact number of device pixels per stipple dot.
+ dup 0 matrix currentmatrix dtransform
+ dup mul exch dup mul add sqrt
+
+ % Round to an integer, make sure the number is at least 1, and compute
+ % user coord distance corresponding to this.
+ dup round dup 1 lt {pop 1} if
+ exch div mul
+} bind def
+
+% width height string StippleFill --
+%
+% Given a path already set up and a clipping region generated from
+% it, this procedure will fill the clipping region with a stipple
+% pattern. "String" contains a proper image description of the
+% stipple pattern and "width" and "height" give its dimensions. Each
+% stipple dot is assumed to be about one unit across in the current
+% user coordinate system. This procedure trashes the graphics state.
+
+/StippleFill {
+ % The following code is needed to work around a NeWSprint bug.
+
+ /tmpstip 1 index def
+
+ % Change the scaling so that one user unit in user coordinates
+ % corresponds to the size of one stipple dot.
+ 1 EvenPixels dup scale
+
+ % Compute the bounding box occupied by the path (which is now
+ % the clipping region), and round the lower coordinates down
+ % to the nearest starting point for the stipple pattern. Be
+ % careful about negative numbers, since the rounding works
+ % differently on them.
+
+ pathbbox
+ 4 2 roll
+ 5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll
+ 6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll
+
+ % Stack now: width height string y1 y2 x1 x2
+ % Below is a doubly-nested for loop to iterate across this area
+ % in units of the stipple pattern size, going up columns then
+ % across rows, blasting out a stipple-pattern-sized rectangle at
+ % each position
+
+ 6 index exch {
+ 2 index 5 index 3 index {
+ % Stack now: width height string y1 y2 x y
+
+ gsave
+ 1 index exch translate
+ 5 index 5 index true matrix tmpstip imagemask
+ grestore
+ } for
+ pop
+ } for
+ pop pop pop pop pop
+} bind def
+
+% -- AdjustColor --
+% Given a color value already set for output by the caller, adjusts
+% that value to a grayscale or mono value if requested by the CL
+% variable.
+
+/AdjustColor {
+ CL 2 lt {
+ currentgray
+ CL 0 eq {
+ .5 lt {0} {1} ifelse
+ } if
+ setgray
+ } if
+} bind def
+
+% x y strings spacing xoffset yoffset justify stipple DrawText --
+% This procedure does all of the real work of drawing text. The
+% color and font must already have been set by the caller, and the
+% following arguments must be on the stack:
+%
+% x, y - Coordinates at which to draw text.
+% strings - An array of strings, one for each line of the text item,
+% in order from top to bottom.
+% spacing - Spacing between lines.
+% xoffset - Horizontal offset for text bbox relative to x and y: 0 for
+% nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.
+% yoffset - Vertical offset for text bbox relative to x and y: 0 for
+% nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.
+% justify - 0 for left justification, 0.5 for center, 1 for right justify.
+% stipple - Boolean value indicating whether or not text is to be
+% drawn in stippled fashion. If text is stippled,
+% procedure StippleText must have been defined to call
+% StippleFill in the right way.
+%
+% Also, when this procedure is invoked, the color and font must already
+% have been set for the text.
+
+/DrawText {
+ /stipple exch def
+ /justify exch def
+ /yoffset exch def
+ /xoffset exch def
+ /spacing exch def
+ /strings exch def
+
+ % First scan through all of the text to find the widest line.
+
+ /lineLength 0 def
+ strings {
+ stringwidth pop
+ dup lineLength gt {/lineLength exch def} {pop} ifelse
+ newpath
+ } forall
+
+ % Compute the baseline offset and the actual font height.
+
+ 0 0 moveto (TXygqPZ) false charpath
+ pathbbox dup /baseline exch def
+ exch pop exch sub /height exch def pop
+ newpath
+
+ % Translate coordinates first so that the origin is at the upper-left
+ % corner of the text's bounding box. Remember that x and y for
+ % positioning are still on the stack.
+
+ translate
+ lineLength xoffset mul
+ strings length 1 sub spacing mul height add yoffset mul translate
+
+ % Now use the baseline and justification information to translate so
+ % that the origin is at the baseline and positioning point for the
+ % first line of text.
+
+ justify lineLength mul baseline neg translate
+
+ % Iterate over each of the lines to output it. For each line,
+ % compute its width again so it can be properly justified, then
+ % display it.
+
+ strings {
+ dup stringwidth pop
+ justify neg mul 0 moveto
+ stipple {
+
+ % The text is stippled, so turn it into a path and print
+ % by calling StippledText, which in turn calls StippleFill.
+ % Unfortunately, many Postscript interpreters will get
+ % overflow errors if we try to do the whole string at
+ % once, so do it a character at a time.
+
+ gsave
+ /char (X) def
+ {
+ char 0 3 -1 roll put
+ currentpoint
+ gsave
+ char true charpath clip StippleText
+ grestore
+ char stringwidth translate
+ moveto
+ } forall
+ grestore
+ } {show} ifelse
+ 0 spacing neg translate
+ } forall
+} bind def
+
+%%EndProlog
prolog.ps
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: xmfbox.tcl
===================================================================
--- xmfbox.tcl (nonexistent)
+++ xmfbox.tcl (revision 1765)
@@ -0,0 +1,650 @@
+# xmfbox.tcl --
+#
+# Implements the "Motif" style file selection dialog for the
+# Unix platform. This implementation is used only if the
+# "tk_strictMotif" flag is set.
+#
+# SCCS: @(#) xmfbox.tcl 1.6 97/10/01 15:06:07
+#
+# Copyright (c) 1996 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+# tkMotifFDialog --
+#
+# Implements a file dialog similar to the standard Motif file
+# selection box.
+#
+# Return value:
+#
+# A list of two members. The first member is the absolute
+# pathname of the selected file or "" if user hits cancel. The
+# second member is the name of the selected file type, or ""
+# which stands for "default file type"
+#
+proc tkMotifFDialog {args} {
+ global tkPriv
+ set w __tk_filedialog
+ upvar #0 $w data
+
+ if {![string compare [lindex [info level 0] 0] tk_getOpenFile]} {
+ set type open
+ } else {
+ set type save
+ }
+
+ tkMotifFDialog_Config $w $type $args
+
+ if {![string compare $data(-parent) .]} {
+ set w .$w
+ } else {
+ set w $data(-parent).$w
+ }
+
+ # (re)create the dialog box if necessary
+ #
+ if {![winfo exists $w]} {
+ tkMotifFDialog_Create $w
+ } elseif {[string compare [winfo class $w] TkMotifFDialog]} {
+ destroy $w
+ tkMotifFDialog_Create $w
+ } else {
+ set data(fEnt) $w.top.f1.ent
+ set data(dList) $w.top.f2.a.l
+ set data(fList) $w.top.f2.b.l
+ set data(sEnt) $w.top.f3.ent
+ set data(okBtn) $w.bot.ok
+ set data(filterBtn) $w.bot.filter
+ set data(cancelBtn) $w.bot.cancel
+ }
+ wm transient $w $data(-parent)
+
+ tkMotifFDialog_Update $w
+
+ # 5. Withdraw the window, then update all the geometry information
+ # so we know how big it wants to be, then center the window in the
+ # display and de-iconify it.
+
+ wm withdraw $w
+ update idletasks
+ set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
+ - [winfo vrootx [winfo parent $w]]}]
+ set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
+ - [winfo vrooty [winfo parent $w]]}]
+ wm geom $w +$x+$y
+ wm deiconify $w
+ wm title $w $data(-title)
+
+ # 6. Set a grab and claim the focus too.
+
+ set oldFocus [focus]
+ set oldGrab [grab current $w]
+ if {$oldGrab != ""} {
+ set grabStatus [grab status $oldGrab]
+ }
+ grab $w
+ focus $data(sEnt)
+ $data(sEnt) select from 0
+ $data(sEnt) select to end
+
+ # 7. Wait for the user to respond, then restore the focus and
+ # return the index of the selected button. Restore the focus
+ # before deleting the window, since otherwise the window manager
+ # may take the focus away so we can't redirect it. Finally,
+ # restore any grab that was in effect.
+
+ tkwait variable tkPriv(selectFilePath)
+ catch {focus $oldFocus}
+ grab release $w
+ wm withdraw $w
+ if {$oldGrab != ""} {
+ if {$grabStatus == "global"} {
+ grab -global $oldGrab
+ } else {
+ grab $oldGrab
+ }
+ }
+ return $tkPriv(selectFilePath)
+}
+
+proc tkMotifFDialog_Config {w type argList} {
+ upvar #0 $w data
+
+ set data(type) $type
+
+ # 1: the configuration specs
+ #
+ set specs {
+ {-defaultextension "" "" ""}
+ {-filetypes "" "" ""}
+ {-initialdir "" "" ""}
+ {-initialfile "" "" ""}
+ {-parent "" "" "."}
+ {-title "" "" ""}
+ }
+
+ # 2: default values depending on the type of the dialog
+ #
+ if {![info exists data(selectPath)]} {
+ # first time the dialog has been popped up
+ set data(selectPath) [pwd]
+ set data(selectFile) ""
+ }
+
+ # 3: parse the arguments
+ #
+ tclParseConfigSpec $w $specs "" $argList
+
+ if {![string compare $data(-title) ""]} {
+ if {![string compare $type "open"]} {
+ set data(-title) "Open"
+ } else {
+ set data(-title) "Save As"
+ }
+ }
+
+ # 4: set the default directory and selection according to the -initial
+ # settings
+ #
+ if {[string compare $data(-initialdir) ""]} {
+ if {[file isdirectory $data(-initialdir)]} {
+ set data(selectPath) [glob $data(-initialdir)]
+ } else {
+ set data(selectPath) [pwd]
+ }
+
+ # Convert the initialdir to an absolute path name.
+
+ set old [pwd]
+ cd $data(selectPath)
+ set data(selectPath) [pwd]
+ cd $old
+ }
+ set data(selectFile) $data(-initialfile)
+
+ # 5. Parse the -filetypes option. It is not used by the motif
+ # file dialog, but we check for validity of the value to make sure
+ # the application code also runs fine with the TK file dialog.
+ #
+ set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]
+
+ if {![info exists data(filter)]} {
+ set data(filter) *
+ }
+ if {![winfo exists $data(-parent)]} {
+ error "bad window path name \"$data(-parent)\""
+ }
+}
+
+proc tkMotifFDialog_Create {w} {
+ set dataName [lindex [split $w .] end]
+ upvar #0 $dataName data
+
+ # 1: Create the dialog ...
+ #
+ toplevel $w -class TkMotifFDialog
+ set top [frame $w.top -relief raised -bd 1]
+ set bot [frame $w.bot -relief raised -bd 1]
+
+ pack $w.bot -side bottom -fill x
+ pack $w.top -side top -expand yes -fill both
+
+ set f1 [frame $top.f1]
+ set f2 [frame $top.f2]
+ set f3 [frame $top.f3]
+
+ pack $f1 -side top -fill x
+ pack $f3 -side bottom -fill x
+ pack $f2 -expand yes -fill both
+
+ set f2a [frame $f2.a]
+ set f2b [frame $f2.b]
+
+ grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
+ -sticky news
+ grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
+ -sticky news
+ grid rowconfig $f2 0 -minsize 0 -weight 1
+ grid columnconfig $f2 0 -minsize 0 -weight 1
+ grid columnconfig $f2 1 -minsize 150 -weight 2
+
+ # The Filter box
+ #
+ label $f1.lab -text "Filter:" -under 3 -anchor w
+ entry $f1.ent
+ pack $f1.lab -side top -fill x -padx 6 -pady 4
+ pack $f1.ent -side top -fill x -padx 4 -pady 0
+ set data(fEnt) $f1.ent
+
+ # The file and directory lists
+ #
+ set data(dList) [tkMotifFDialog_MakeSList $w $f2a Directory: 0 DList]
+ set data(fList) [tkMotifFDialog_MakeSList $w $f2b Files: 2 FList]
+
+ # The Selection box
+ #
+ label $f3.lab -text "Selection:" -under 0 -anchor w
+ entry $f3.ent
+ pack $f3.lab -side top -fill x -padx 6 -pady 0
+ pack $f3.ent -side top -fill x -padx 4 -pady 4
+ set data(sEnt) $f3.ent
+
+ # The buttons
+ #
+ set data(okBtn) [button $bot.ok -text OK -width 6 -under 0 \
+ -command "tkMotifFDialog_OkCmd $w"]
+ set data(filterBtn) [button $bot.filter -text Filter -width 6 -under 0 \
+ -command "tkMotifFDialog_FilterCmd $w"]
+ set data(cancelBtn) [button $bot.cancel -text Cancel -width 6 -under 0 \
+ -command "tkMotifFDialog_CancelCmd $w"]
+
+ pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \
+ -side left
+
+ # Create the bindings:
+ #
+ bind $w "focus $data(fEnt)"
+ bind $w "focus $data(dList)"
+ bind $w "focus $data(fList)"
+ bind $w "focus $data(sEnt)"
+
+ bind $w "tkButtonInvoke $bot.ok "
+ bind $w "tkButtonInvoke $bot.filter"
+ bind $w "tkButtonInvoke $bot.cancel"
+
+ bind $data(fEnt) "tkMotifFDialog_ActivateFEnt $w"
+ bind $data(sEnt) "tkMotifFDialog_ActivateSEnt $w"
+
+ wm protocol $w WM_DELETE_WINDOW "tkMotifFDialog_CancelCmd $w"
+}
+
+proc tkMotifFDialog_MakeSList {w f label under cmd} {
+ label $f.lab -text $label -under $under -anchor w
+ listbox $f.l -width 12 -height 5 -selectmode browse -exportselection 0\
+ -xscrollcommand "$f.h set" \
+ -yscrollcommand "$f.v set"
+ scrollbar $f.v -orient vertical -takefocus 0 \
+ -command "$f.l yview"
+ scrollbar $f.h -orient horizontal -takefocus 0 \
+ -command "$f.l xview"
+ grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \
+ -padx 2 -pady 2
+ grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
+ grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news
+ grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news
+
+ grid rowconfig $f 0 -weight 0 -minsize 0
+ grid rowconfig $f 1 -weight 1 -minsize 0
+ grid columnconfig $f 0 -weight 1 -minsize 0
+
+ # bindings for the listboxes
+ #
+ set list $f.l
+ bind $list "tkMotifFDialog_Browse$cmd $w"
+ bind $list "tkMotifFDialog_Browse$cmd $w"
+ bind $list "tkMotifFDialog_Browse$cmd $w"
+ bind $list <1> "tkMotifFDialog_Browse$cmd $w"
+ bind $list "tkMotifFDialog_Browse$cmd $w"
+ bind $list "tkMotifFDialog_Activate$cmd $w"
+ bind $list "tkMotifFDialog_Browse$cmd $w; tkMotifFDialog_Activate$cmd $w"
+
+ bindtags $list "Listbox $list [winfo toplevel $list] all"
+ tkListBoxKeyAccel_Set $list
+
+ return $f.l
+}
+
+proc tkMotifFDialog_BrowseDList {w} {
+ upvar #0 [winfo name $w] data
+
+ focus $data(dList)
+ if {![string compare [$data(dList) curselection] ""]} {
+ return
+ }
+ set subdir [$data(dList) get [$data(dList) curselection]]
+ if {![string compare $subdir ""]} {
+ return
+ }
+
+ $data(fList) selection clear 0 end
+
+ set list [tkMotifFDialog_InterpFilter $w]
+ set data(filter) [lindex $list 1]
+
+ case $subdir {
+ . {
+ set newSpec [file join $data(selectPath) $data(filter)]
+ }
+ .. {
+ set newSpec [file join [file dirname $data(selectPath)] \
+ $data(filter)]
+ }
+ default {
+ set newSpec [file join $data(selectPath) $subdir $data(filter)]
+ }
+ }
+
+ $data(fEnt) delete 0 end
+ $data(fEnt) insert 0 $newSpec
+}
+
+proc tkMotifFDialog_ActivateDList {w} {
+ upvar #0 [winfo name $w] data
+
+ if {![string compare [$data(dList) curselection] ""]} {
+ return
+ }
+ set subdir [$data(dList) get [$data(dList) curselection]]
+ if {![string compare $subdir ""]} {
+ return
+ }
+
+ $data(fList) selection clear 0 end
+
+ case $subdir {
+ . {
+ set newDir $data(selectPath)
+ }
+ .. {
+ set newDir [file dirname $data(selectPath)]
+ }
+ default {
+ set newDir [file join $data(selectPath) $subdir]
+ }
+ }
+
+ set data(selectPath) $newDir
+ tkMotifFDialog_Update $w
+
+ if {[string compare $subdir ..]} {
+ $data(dList) selection set 0
+ $data(dList) activate 0
+ } else {
+ $data(dList) selection set 1
+ $data(dList) activate 1
+ }
+}
+
+proc tkMotifFDialog_BrowseFList {w} {
+ upvar #0 [winfo name $w] data
+
+ focus $data(fList)
+ if {![string compare [$data(fList) curselection] ""]} {
+ return
+ }
+ set data(selectFile) [$data(fList) get [$data(fList) curselection]]
+ if {![string compare $data(selectFile) ""]} {
+ return
+ }
+
+ $data(dList) selection clear 0 end
+
+ $data(fEnt) delete 0 end
+ $data(fEnt) insert 0 [file join $data(selectPath) $data(filter)]
+ $data(fEnt) xview end
+
+ $data(sEnt) delete 0 end
+ $data(sEnt) insert 0 [file join $data(selectPath) $data(selectFile)]
+ $data(sEnt) xview end
+}
+
+proc tkMotifFDialog_ActivateFList {w} {
+ upvar #0 [winfo name $w] data
+
+ if {![string compare [$data(fList) curselection] ""]} {
+ return
+ }
+ set data(selectFile) [$data(fList) get [$data(fList) curselection]]
+ if {![string compare $data(selectFile) ""]} {
+ return
+ } else {
+ tkMotifFDialog_ActivateSEnt $w
+ }
+}
+
+proc tkMotifFDialog_ActivateFEnt {w} {
+ upvar #0 [winfo name $w] data
+
+ set list [tkMotifFDialog_InterpFilter $w]
+ set data(selectPath) [lindex $list 0]
+ set data(filter) [lindex $list 1]
+
+ tkMotifFDialog_Update $w
+}
+
+proc tkMotifFDialog_InterpFilter {w} {
+ upvar #0 [winfo name $w] data
+
+ set text [string trim [$data(fEnt) get]]
+ # Perform tilde substitution
+ #
+ if {![string compare [string index $text 0] ~]} {
+ set list [file split $text]
+ set tilde [lindex $list 0]
+ catch {
+ set tilde [glob $tilde]
+ }
+ set text [eval file join [concat $tilde [lrange $list 1 end]]]
+ }
+
+ set resolved [file join [file dirname $text] [file tail $text]]
+
+ if {[file isdirectory $resolved]} {
+ set dir $resolved
+ set fil $data(filter)
+ } else {
+ set dir [file dirname $resolved]
+ set fil [file tail $resolved]
+ }
+
+ return [list $dir $fil]
+}
+
+
+proc tkMotifFDialog_ActivateSEnt {w} {
+ global tkPriv
+ upvar #0 [winfo name $w] data
+
+ set selectFilePath [string trim [$data(sEnt) get]]
+ set selectFile [file tail $selectFilePath]
+ set selectPath [file dirname $selectFilePath]
+
+
+ if {![string compare $selectFilePath ""]} {
+ tkMotifFDialog_FilterCmd $w
+ return
+ }
+
+ if {[file isdirectory $selectFilePath]} {
+ set data(selectPath) [glob $selectFilePath]
+ set data(selectFile) ""
+ tkMotifFDialog_Update $w
+ return
+ }
+
+ if {[string compare [file pathtype $selectFilePath] "absolute"]} {
+ tk_messageBox -icon warning -type ok \
+ -message "\"$selectFilePath\" must be an absolute pathname"
+ return
+ }
+
+ if {![file exists $selectPath]} {
+ tk_messageBox -icon warning -type ok \
+ -message "Directory \"$selectPath\" does not exist."
+ return
+ }
+
+ if {![file exists $selectFilePath]} {
+ if {![string compare $data(type) open]} {
+ tk_messageBox -icon warning -type ok \
+ -message "File \"$selectFilePath\" does not exist."
+ return
+ }
+ } else {
+ if {![string compare $data(type) save]} {
+ set message [format %s%s \
+ "File \"$selectFilePath\" already exists.\n\n" \
+ "Replace existing file?"]
+ set answer [tk_messageBox -icon warning -type yesno \
+ -message $message]
+ if {![string compare $answer "no"]} {
+ return
+ }
+ }
+ }
+
+ set tkPriv(selectFilePath) $selectFilePath
+ set tkPriv(selectFile) $selectFile
+ set tkPriv(selectPath) $selectPath
+}
+
+
+proc tkMotifFDialog_OkCmd {w} {
+ upvar #0 [winfo name $w] data
+
+ tkMotifFDialog_ActivateSEnt $w
+}
+
+proc tkMotifFDialog_FilterCmd {w} {
+ upvar #0 [winfo name $w] data
+
+ tkMotifFDialog_ActivateFEnt $w
+}
+
+proc tkMotifFDialog_CancelCmd {w} {
+ global tkPriv
+
+ set tkPriv(selectFilePath) ""
+ set tkPriv(selectFile) ""
+ set tkPriv(selectPath) ""
+}
+
+# tkMotifFDialog_Update
+#
+# Load the files and synchronize the "filter" and "selection" fields
+# boxes.
+#
+# popup:
+# If this is true, then update the selection field according to the
+# "-selection" flag
+#
+proc tkMotifFDialog_Update {w} {
+ upvar #0 [winfo name $w] data
+
+ $data(fEnt) delete 0 end
+ $data(fEnt) insert 0 [file join $data(selectPath) $data(filter)]
+ $data(sEnt) delete 0 end
+ $data(sEnt) insert 0 [file join $data(selectPath) $data(selectFile)]
+
+ tkMotifFDialog_LoadFiles $w
+}
+
+proc tkMotifFDialog_LoadFiles {w} {
+ upvar #0 [winfo name $w] data
+
+ $data(dList) delete 0 end
+ $data(fList) delete 0 end
+
+ set appPWD [pwd]
+ if {[catch {
+ cd $data(selectPath)
+ }]} {
+ cd $appPWD
+
+ $data(dList) insert end ".."
+ return
+ }
+
+ # Make the dir list
+ #
+ foreach f [lsort -command tclSortNoCase [glob -nocomplain .* *]] {
+ if {[file isdirectory $f]} {
+ $data(dList) insert end $f
+ }
+ }
+ # Make the file list
+ #
+ if {![string compare $data(filter) *]} {
+ set files [lsort -command tclSortNoCase [glob -nocomplain .* *]]
+ } else {
+ set files [lsort -command tclSortNoCase \
+ [glob -nocomplain $data(filter)]]
+ }
+
+ set top 0
+ foreach f $files {
+ if {![file isdir $f]} {
+ $data(fList) insert end $f
+ if {[string match .* $f]} {
+ incr top
+ }
+ }
+ }
+
+ # The user probably doesn't want to see the . files. We adjust the view
+ # so that the listbox displays all the non-dot files
+ $data(fList) yview $top
+
+ cd $appPWD
+}
+
+proc tkListBoxKeyAccel_Set {w} {
+ bind Listbox ""
+ bind $w "tkListBoxKeyAccel_Unset $w"
+ bind $w "tkListBoxKeyAccel_Key $w %A"
+}
+
+proc tkListBoxKeyAccel_Unset {w} {
+ global tkPriv
+
+ catch {after cancel $tkPriv(lbAccel,$w,afterId)}
+ catch {unset tkPriv(lbAccel,$w)}
+ catch {unset tkPriv(lbAccel,$w,afterId)}
+}
+
+proc tkListBoxKeyAccel_Key {w key} {
+ global tkPriv
+
+ append tkPriv(lbAccel,$w) $key
+ tkListBoxKeyAccel_Goto $w $tkPriv(lbAccel,$w)
+ catch {
+ after cancel $tkPriv(lbAccel,$w,afterId)
+ }
+ set tkPriv(lbAccel,$w,afterId) [after 500 tkListBoxKeyAccel_Reset $w]
+}
+
+proc tkListBoxKeyAccel_Goto {w string} {
+ global tkPriv
+
+ set string [string tolower $string]
+ set end [$w index end]
+ set theIndex -1
+
+ for {set i 0} {$i < $end} {incr i} {
+ set item [string tolower [$w get $i]]
+ if {[string compare $string $item] >= 0} {
+ set theIndex $i
+ }
+ if {[string compare $string $item] <= 0} {
+ set theIndex $i
+ break
+ }
+ }
+
+ if {$theIndex >= 0} {
+ $w selection clear 0 end
+ $w selection set $theIndex $theIndex
+ $w activate $theIndex
+ $w see $theIndex
+ }
+}
+
+proc tkListBoxKeyAccel_Reset {w} {
+ global tkPriv
+
+ catch {unset tkPriv(lbAccel,$w)}
+}
+
xmfbox.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: menu.tcl
===================================================================
--- menu.tcl (nonexistent)
+++ menu.tcl (revision 1765)
@@ -0,0 +1,1235 @@
+# menu.tcl --
+#
+# This file defines the default bindings for Tk menus and menubuttons.
+# It also implements keyboard traversal of menus and implements a few
+# other utility procedures related to menus.
+#
+# SCCS: @(#) menu.tcl 1.103 97/10/31 15:26:08
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#-------------------------------------------------------------------------
+# Elements of tkPriv that are used in this file:
+#
+# cursor - Saves the -cursor option for the posted menubutton.
+# focus - Saves the focus during a menu selection operation.
+# Focus gets restored here when the menu is unposted.
+# grabGlobal - Used in conjunction with tkPriv(oldGrab): if
+# tkPriv(oldGrab) is non-empty, then tkPriv(grabGlobal)
+# contains either an empty string or "-global" to
+# indicate whether the old grab was a local one or
+# a global one.
+# inMenubutton - The name of the menubutton widget containing
+# the mouse, or an empty string if the mouse is
+# not over any menubutton.
+# menuBar - The name of the menubar that is the root
+# of the cascade hierarchy which is currently
+# posted. This is null when there is no menu currently
+# being pulled down from a menu bar.
+# oldGrab - Window that had the grab before a menu was posted.
+# Used to restore the grab state after the menu
+# is unposted. Empty string means there was no
+# grab previously set.
+# popup - If a menu has been popped up via tk_popup, this
+# gives the name of the menu. Otherwise this
+# value is empty.
+# postedMb - Name of the menubutton whose menu is currently
+# posted, or an empty string if nothing is posted
+# A grab is set on this widget.
+# relief - Used to save the original relief of the current
+# menubutton.
+# window - When the mouse is over a menu, this holds the
+# name of the menu; it's cleared when the mouse
+# leaves the menu.
+# tearoff - Whether the last menu posted was a tearoff or not.
+# This is true always for unix, for tearoffs for Mac
+# and Windows.
+# activeMenu - This is the last active menu for use
+# with the <> virtual event.
+# activeItem - This is the last active menu item for
+# use with the <> virtual event.
+#-------------------------------------------------------------------------
+
+#-------------------------------------------------------------------------
+# Overall note:
+# This file is tricky because there are five different ways that menus
+# can be used:
+#
+# 1. As a pulldown from a menubutton. In this style, the variable
+# tkPriv(postedMb) identifies the posted menubutton.
+# 2. As a torn-off menu copied from some other menu. In this style
+# tkPriv(postedMb) is empty, and menu's type is "tearoff".
+# 3. As an option menu, triggered from an option menubutton. In this
+# style tkPriv(postedMb) identifies the posted menubutton.
+# 4. As a popup menu. In this style tkPriv(postedMb) is empty and
+# the top-level menu's type is "normal".
+# 5. As a pulldown from a menubar. The variable tkPriv(menubar) has
+# the owning menubar, and the menu itself is of type "normal".
+#
+# The various binding procedures use the state described above to
+# distinguish the various cases and take different actions in each
+# case.
+#-------------------------------------------------------------------------
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for menus
+# and menubuttons.
+#-------------------------------------------------------------------------
+
+bind Menubutton {}
+bind Menubutton {
+ tkMbEnter %W
+}
+bind Menubutton {
+ tkMbLeave %W
+}
+bind Menubutton <1> {
+ if {$tkPriv(inMenubutton) != ""} {
+ tkMbPost $tkPriv(inMenubutton) %X %Y
+ }
+}
+bind Menubutton {
+ tkMbMotion %W up %X %Y
+}
+bind Menubutton {
+ tkMbMotion %W down %X %Y
+}
+bind Menubutton {
+ tkMbButtonUp %W
+}
+bind Menubutton {
+ tkMbPost %W
+ tkMenuFirstEntry [%W cget -menu]
+}
+
+# Must set focus when mouse enters a menu, in order to allow
+# mixed-mode processing using both the mouse and the keyboard.
+# Don't set the focus if the event comes from a grab release,
+# though: such an event can happen after as part of unposting
+# a cascaded chain of menus, after the focus has already been
+# restored to wherever it was before menu selection started.
+
+bind Menu {}
+
+bind Menu {
+ set tkPriv(window) %W
+ if {[%W cget -type] == "tearoff"} {
+ if {"%m" != "NotifyUngrab"} {
+ if {$tcl_platform(platform) == "unix"} {
+ tk_menuSetFocus %W
+ }
+ }
+ }
+ tkMenuMotion %W %x %y %s
+}
+
+bind Menu {
+ tkMenuLeave %W %X %Y %s
+}
+bind Menu {
+ tkMenuMotion %W %x %y %s
+}
+bind Menu {
+ tkMenuButtonDown %W
+}
+bind Menu {
+ tkMenuInvoke %W 1
+}
+bind Menu {
+ tkMenuInvoke %W 0
+}
+bind Menu {
+ tkMenuInvoke %W 0
+}
+bind Menu {
+ tkMenuEscape %W
+}
+bind Menu {
+ tkMenuLeftArrow %W
+}
+bind Menu {
+ tkMenuRightArrow %W
+}
+bind Menu {
+ tkMenuUpArrow %W
+}
+bind Menu {
+ tkMenuDownArrow %W
+}
+bind Menu {
+ tkTraverseWithinMenu %W %A
+}
+
+# The following bindings apply to all windows, and are used to
+# implement keyboard menu traversal.
+
+if {$tcl_platform(platform) == "unix"} {
+ bind all {
+ tkTraverseToMenu %W %A
+ }
+
+ bind all {
+ tkFirstMenu %W
+ }
+} else {
+ bind Menubutton {
+ tkTraverseToMenu %W %A
+ }
+
+ bind Menubutton {
+ tkFirstMenu %W
+ }
+}
+
+# tkMbEnter --
+# This procedure is invoked when the mouse enters a menubutton
+# widget. It activates the widget unless it is disabled. Note:
+# this procedure is only invoked when mouse button 1 is *not* down.
+# The procedure tkMbB1Enter is invoked if the button is down.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkMbEnter w {
+ global tkPriv
+
+ if {$tkPriv(inMenubutton) != ""} {
+ tkMbLeave $tkPriv(inMenubutton)
+ }
+ set tkPriv(inMenubutton) $w
+ if {[$w cget -state] != "disabled"} {
+ $w configure -state active
+ }
+}
+
+# tkMbLeave --
+# This procedure is invoked when the mouse leaves a menubutton widget.
+# It de-activates the widget, if the widget still exists.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkMbLeave w {
+ global tkPriv
+
+ set tkPriv(inMenubutton) {}
+ if {![winfo exists $w]} {
+ return
+ }
+ if {[$w cget -state] == "active"} {
+ $w configure -state normal
+ }
+}
+
+# tkMbPost --
+# Given a menubutton, this procedure does all the work of posting
+# its associated menu and unposting any other menu that is currently
+# posted.
+#
+# Arguments:
+# w - The name of the menubutton widget whose menu
+# is to be posted.
+# x, y - Root coordinates of cursor, used for positioning
+# option menus. If not specified, then the center
+# of the menubutton is used for an option menu.
+
+proc tkMbPost {w {x {}} {y {}}} {
+ global tkPriv errorInfo
+ global tcl_platform
+
+ if {([$w cget -state] == "disabled") || ($w == $tkPriv(postedMb))} {
+ return
+ }
+ set menu [$w cget -menu]
+ if {$menu == ""} {
+ return
+ }
+ set tearoff [expr {($tcl_platform(platform) == "unix") \
+ || ([$menu cget -type] == "tearoff")}]
+ if {[string first $w $menu] != 0} {
+ error "can't post $menu: it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)"
+ }
+ set cur $tkPriv(postedMb)
+ if {$cur != ""} {
+ tkMenuUnpost {}
+ }
+ set tkPriv(cursor) [$w cget -cursor]
+ set tkPriv(relief) [$w cget -relief]
+ $w configure -cursor arrow
+ $w configure -relief raised
+
+ set tkPriv(postedMb) $w
+ set tkPriv(focus) [focus]
+ $menu activate none
+ tkGenerateMenuSelect $menu
+
+ # If this looks like an option menubutton then post the menu so
+ # that the current entry is on top of the mouse. Otherwise post
+ # the menu just below the menubutton, as for a pull-down.
+
+ update idletasks
+ if {[catch {
+ switch [$w cget -direction] {
+ above {
+ set x [winfo rootx $w]
+ set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}]
+ $menu post $x $y
+ }
+ below {
+ set x [winfo rootx $w]
+ set y [expr {[winfo rooty $w] + [winfo height $w]}]
+ $menu post $x $y
+ }
+ left {
+ set x [expr {[winfo rootx $w] - [winfo reqwidth $menu]}]
+ set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]
+ set entry [tkMenuFindName $menu [$w cget -text]]
+ if {[$w cget -indicatoron]} {
+ if {$entry == [$menu index last]} {
+ incr y [expr {-([$menu yposition $entry] \
+ + [winfo reqheight $menu])/2}]
+ } else {
+ incr y [expr {-([$menu yposition $entry] \
+ + [$menu yposition [expr {$entry+1}]])/2}]
+ }
+ }
+ $menu post $x $y
+ if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} {
+ $menu activate $entry
+ tkGenerateMenuSelect $menu
+ }
+ }
+ right {
+ set x [expr {[winfo rootx $w] + [winfo width $w]}]
+ set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]
+ set entry [tkMenuFindName $menu [$w cget -text]]
+ if {[$w cget -indicatoron]} {
+ if {$entry == [$menu index last]} {
+ incr y [expr {-([$menu yposition $entry] \
+ + [winfo reqheight $menu])/2}]
+ } else {
+ incr y [expr {-([$menu yposition $entry] \
+ + [$menu yposition [expr {$entry+1}]])/2}]
+ }
+ }
+ $menu post $x $y
+ if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} {
+ $menu activate $entry
+ tkGenerateMenuSelect $menu
+ }
+ }
+ default {
+ if {[$w cget -indicatoron]} {
+ if {$y == ""} {
+ set x [expr {[winfo rootx $w] + [winfo width $w]/2}]
+ set y [expr {[winfo rooty $w] + [winfo height $w]/2}]
+ }
+ tkPostOverPoint $menu $x $y [tkMenuFindName $menu [$w cget -text]]
+ } else {
+ $menu post [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}]
+ }
+ }
+ }
+ } msg]} {
+ # Error posting menu (e.g. bogus -postcommand). Unpost it and
+ # reflect the error.
+
+ set savedInfo $errorInfo
+ tkMenuUnpost {}
+ error $msg $savedInfo
+
+ }
+
+ set tkPriv(tearoff) $tearoff
+ if {$tearoff != 0} {
+ focus $menu
+ tkSaveGrabInfo $w
+ grab -global $w
+ }
+}
+
+# tkMenuUnpost --
+# This procedure unposts a given menu, plus all of its ancestors up
+# to (and including) a menubutton, if any. It also restores various
+# values to what they were before the menu was posted, and releases
+# a grab if there's a menubutton involved. Special notes:
+# 1. It's important to unpost all menus before releasing the grab, so
+# that any Enter-Leave events (e.g. from menu back to main
+# application) have mode NotifyGrab.
+# 2. Be sure to enclose various groups of commands in "catch" so that
+# the procedure will complete even if the menubutton or the menu
+# or the grab window has been deleted.
+#
+# Arguments:
+# menu - Name of a menu to unpost. Ignored if there
+# is a posted menubutton.
+
+proc tkMenuUnpost menu {
+ global tcl_platform
+ global tkPriv
+ set mb $tkPriv(postedMb)
+
+ # Restore focus right away (otherwise X will take focus away when
+ # the menu is unmapped and under some window managers (e.g. olvwm)
+ # we'll lose the focus completely).
+
+ catch {focus $tkPriv(focus)}
+ set tkPriv(focus) ""
+
+ # Unpost menu(s) and restore some stuff that's dependent on
+ # what was posted.
+
+ catch {
+ if {$mb != ""} {
+ set menu [$mb cget -menu]
+ $menu unpost
+ set tkPriv(postedMb) {}
+ $mb configure -cursor $tkPriv(cursor)
+ $mb configure -relief $tkPriv(relief)
+ } elseif {$tkPriv(popup) != ""} {
+ $tkPriv(popup) unpost
+ set tkPriv(popup) {}
+ } elseif {(!([$menu cget -type] == "menubar")
+ && !([$menu cget -type] == "tearoff"))} {
+ # We're in a cascaded sub-menu from a torn-off menu or popup.
+ # Unpost all the menus up to the toplevel one (but not
+ # including the top-level torn-off one) and deactivate the
+ # top-level torn off menu if there is one.
+
+ while 1 {
+ set parent [winfo parent $menu]
+ if {([winfo class $parent] != "Menu")
+ || ![winfo ismapped $parent]} {
+ break
+ }
+ $parent activate none
+ $parent postcascade none
+ tkGenerateMenuSelect $parent
+ set type [$parent cget -type]
+ if {($type == "menubar")|| ($type == "tearoff")} {
+ break
+ }
+ set menu $parent
+ }
+ if {[$menu cget -type] != "menubar"} {
+ $menu unpost
+ }
+ }
+ }
+
+ if {($tkPriv(tearoff) != 0) || ($tkPriv(menuBar) != "")} {
+ # Release grab, if any, and restore the previous grab, if there
+ # was one.
+
+ if {$menu != ""} {
+ set grab [grab current $menu]
+ if {$grab != ""} {
+ grab release $grab
+ }
+ }
+ tkRestoreOldGrab
+ if {$tkPriv(menuBar) != ""} {
+ $tkPriv(menuBar) configure -cursor $tkPriv(cursor)
+ set tkPriv(menuBar) {}
+ }
+ if {$tcl_platform(platform) != "unix"} {
+ set tkPriv(tearoff) 0
+ }
+ }
+}
+
+# tkMbMotion --
+# This procedure handles mouse motion events inside menubuttons, and
+# also outside menubuttons when a menubutton has a grab (e.g. when a
+# menu selection operation is in progress).
+#
+# Arguments:
+# w - The name of the menubutton widget.
+# upDown - "down" means button 1 is pressed, "up" means
+# it isn't.
+# rootx, rooty - Coordinates of mouse, in (virtual?) root window.
+
+proc tkMbMotion {w upDown rootx rooty} {
+ global tkPriv
+
+ if {$tkPriv(inMenubutton) == $w} {
+ return
+ }
+ set new [winfo containing $rootx $rooty]
+ if {($new != $tkPriv(inMenubutton)) && (($new == "")
+ || ([winfo toplevel $new] == [winfo toplevel $w]))} {
+ if {$tkPriv(inMenubutton) != ""} {
+ tkMbLeave $tkPriv(inMenubutton)
+ }
+ if {($new != "") && ([winfo class $new] == "Menubutton")
+ && ([$new cget -indicatoron] == 0)
+ && ([$w cget -indicatoron] == 0)} {
+ if {$upDown == "down"} {
+ tkMbPost $new $rootx $rooty
+ } else {
+ tkMbEnter $new
+ }
+ }
+ }
+}
+
+# tkMbButtonUp --
+# This procedure is invoked to handle button 1 releases for menubuttons.
+# If the release happens inside the menubutton then leave its menu
+# posted with element 0 activated. Otherwise, unpost the menu.
+#
+# Arguments:
+# w - The name of the menubutton widget.
+
+proc tkMbButtonUp w {
+ global tkPriv
+ global tcl_platform
+
+ set tearoff [expr {($tcl_platform(platform) == "unix") \
+ || ([[$w cget -menu] cget -type] == "tearoff")}]
+ if {($tearoff != 0) && ($tkPriv(postedMb) == $w)
+ && ($tkPriv(inMenubutton) == $w)} {
+ tkMenuFirstEntry [$tkPriv(postedMb) cget -menu]
+ } else {
+ tkMenuUnpost {}
+ }
+}
+
+# tkMenuMotion --
+# This procedure is called to handle mouse motion events for menus.
+# It does two things. First, it resets the active element in the
+# menu, if the mouse is over the menu. Second, if a mouse button
+# is down, it posts and unposts cascade entries to match the mouse
+# position.
+#
+# Arguments:
+# menu - The menu window.
+# x - The x position of the mouse.
+# y - The y position of the mouse.
+# state - Modifier state (tells whether buttons are down).
+
+proc tkMenuMotion {menu x y state} {
+ global tkPriv
+ if {$menu == $tkPriv(window)} {
+ if {[$menu cget -type] == "menubar"} {
+ if {[info exists tkPriv(focus)] && \
+ ([string compare $menu $tkPriv(focus)] != 0)} {
+ $menu activate @$x,$y
+ tkGenerateMenuSelect $menu
+ }
+ } else {
+ $menu activate @$x,$y
+ tkGenerateMenuSelect $menu
+ }
+ }
+ if {($state & 0x1f00) != 0} {
+ $menu postcascade active
+ }
+}
+
+# tkMenuButtonDown --
+# Handles button presses in menus. There are a couple of tricky things
+# here:
+# 1. Change the posted cascade entry (if any) to match the mouse position.
+# 2. If there is a posted menubutton, must grab to the menubutton; this
+# overrrides the implicit grab on button press, so that the menu
+# button can track mouse motions over other menubuttons and change
+# the posted menu.
+# 3. If there's no posted menubutton (e.g. because we're a torn-off menu
+# or one of its descendants) must grab to the top-level menu so that
+# we can track mouse motions across the entire menu hierarchy.
+#
+# Arguments:
+# menu - The menu window.
+
+proc tkMenuButtonDown menu {
+ global tkPriv
+ global tcl_platform
+ $menu postcascade active
+ if {$tkPriv(postedMb) != ""} {
+ grab -global $tkPriv(postedMb)
+ } else {
+ while {([$menu cget -type] == "normal")
+ && ([winfo class [winfo parent $menu]] == "Menu")
+ && [winfo ismapped [winfo parent $menu]]} {
+ set menu [winfo parent $menu]
+ }
+
+ if {$tkPriv(menuBar) == {}} {
+ set tkPriv(menuBar) $menu
+ set tkPriv(cursor) [$menu cget -cursor]
+ $menu configure -cursor arrow
+ }
+
+ # Don't update grab information if the grab window isn't changing.
+ # Otherwise, we'll get an error when we unpost the menus and
+ # restore the grab, since the old grab window will not be viewable
+ # anymore.
+
+ if {$menu != [grab current $menu]} {
+ tkSaveGrabInfo $menu
+ }
+
+ # Must re-grab even if the grab window hasn't changed, in order
+ # to release the implicit grab from the button press.
+
+ if {$tcl_platform(platform) == "unix"} {
+ grab -global $menu
+ }
+ }
+}
+
+# tkMenuLeave --
+# This procedure is invoked to handle Leave events for a menu. It
+# deactivates everything unless the active element is a cascade element
+# and the mouse is now over the submenu.
+#
+# Arguments:
+# menu - The menu window.
+# rootx, rooty - Root coordinates of mouse.
+# state - Modifier state.
+
+proc tkMenuLeave {menu rootx rooty state} {
+ global tkPriv
+ set tkPriv(window) {}
+ if {[$menu index active] == "none"} {
+ return
+ }
+ if {([$menu type active] == "cascade")
+ && ([winfo containing $rootx $rooty]
+ == [$menu entrycget active -menu])} {
+ return
+ }
+ $menu activate none
+ tkGenerateMenuSelect $menu
+}
+
+# tkMenuInvoke --
+# This procedure is invoked when button 1 is released over a menu.
+# It invokes the appropriate menu action and unposts the menu if
+# it came from a menubutton.
+#
+# Arguments:
+# w - Name of the menu widget.
+# buttonRelease - 1 means this procedure is called because of
+# a button release; 0 means because of keystroke.
+
+proc tkMenuInvoke {w buttonRelease} {
+ global tkPriv
+
+ if {$buttonRelease && ($tkPriv(window) == "")} {
+ # Mouse was pressed over a menu without a menu button, then
+ # dragged off the menu (possibly with a cascade posted) and
+ # released. Unpost everything and quit.
+
+ $w postcascade none
+ $w activate none
+ event generate $w <>
+ tkMenuUnpost $w
+ return
+ }
+ if {[$w type active] == "cascade"} {
+ $w postcascade active
+ set menu [$w entrycget active -menu]
+ tkMenuFirstEntry $menu
+ } elseif {[$w type active] == "tearoff"} {
+ tkMenuUnpost $w
+ tkTearOffMenu $w
+ } elseif {[$w cget -type] == "menubar"} {
+ $w postcascade none
+ $w activate none
+ event generate $w <>
+ tkMenuUnpost $w
+ } else {
+ tkMenuUnpost $w
+ uplevel #0 [list $w invoke active]
+ }
+}
+
+# tkMenuEscape --
+# This procedure is invoked for the Cancel (or Escape) key. It unposts
+# the given menu and, if it is the top-level menu for a menu button,
+# unposts the menu button as well.
+#
+# Arguments:
+# menu - Name of the menu window.
+
+proc tkMenuEscape menu {
+ set parent [winfo parent $menu]
+ if {([winfo class $parent] != "Menu")} {
+ tkMenuUnpost $menu
+ } elseif {([$parent cget -type] == "menubar")} {
+ tkMenuUnpost $menu
+ tkRestoreOldGrab
+ } else {
+ tkMenuNextMenu $menu left
+ }
+}
+
+# The following routines handle arrow keys. Arrow keys behave
+# differently depending on whether the menu is a menu bar or not.
+
+proc tkMenuUpArrow {menu} {
+ if {[$menu cget -type] == "menubar"} {
+ tkMenuNextMenu $menu left
+ } else {
+ tkMenuNextEntry $menu -1
+ }
+}
+
+proc tkMenuDownArrow {menu} {
+ if {[$menu cget -type] == "menubar"} {
+ tkMenuNextMenu $menu right
+ } else {
+ tkMenuNextEntry $menu 1
+ }
+}
+
+proc tkMenuLeftArrow {menu} {
+ if {[$menu cget -type] == "menubar"} {
+ tkMenuNextEntry $menu -1
+ } else {
+ tkMenuNextMenu $menu left
+ }
+}
+
+proc tkMenuRightArrow {menu} {
+ if {[$menu cget -type] == "menubar"} {
+ tkMenuNextEntry $menu 1
+ } else {
+ tkMenuNextMenu $menu right
+ }
+}
+
+# tkMenuNextMenu --
+# This procedure is invoked to handle "left" and "right" traversal
+# motions in menus. It traverses to the next menu in a menu bar,
+# or into or out of a cascaded menu.
+#
+# Arguments:
+# menu - The menu that received the keyboard
+# event.
+# direction - Direction in which to move: "left" or "right"
+
+proc tkMenuNextMenu {menu direction} {
+ global tkPriv
+
+ # First handle traversals into and out of cascaded menus.
+
+ if {$direction == "right"} {
+ set count 1
+ set parent [winfo parent $menu]
+ set class [winfo class $parent]
+ if {[$menu type active] == "cascade"} {
+ $menu postcascade active
+ set m2 [$menu entrycget active -menu]
+ if {$m2 != ""} {
+ tkMenuFirstEntry $m2
+ }
+ return
+ } else {
+ set parent [winfo parent $menu]
+ while {($parent != ".")} {
+ if {([winfo class $parent] == "Menu")
+ && ([$parent cget -type] == "menubar")} {
+ tk_menuSetFocus $parent
+ tkMenuNextEntry $parent 1
+ return
+ }
+ set parent [winfo parent $parent]
+ }
+ }
+ } else {
+ set count -1
+ set m2 [winfo parent $menu]
+ if {[winfo class $m2] == "Menu"} {
+ if {[$m2 cget -type] != "menubar"} {
+ $menu activate none
+ tkGenerateMenuSelect $menu
+ tk_menuSetFocus $m2
+
+ # This code unposts any posted submenu in the parent.
+
+ set tmp [$m2 index active]
+ $m2 activate none
+ $m2 activate $tmp
+ return
+ }
+ }
+ }
+
+ # Can't traverse into or out of a cascaded menu. Go to the next
+ # or previous menubutton, if that makes sense.
+
+ set m2 [winfo parent $menu]
+ if {[winfo class $m2] == "Menu"} {
+ if {[$m2 cget -type] == "menubar"} {
+ tk_menuSetFocus $m2
+ tkMenuNextEntry $m2 -1
+ return
+ }
+ }
+
+ set w $tkPriv(postedMb)
+ if {$w == ""} {
+ return
+ }
+ set buttons [winfo children [winfo parent $w]]
+ set length [llength $buttons]
+ set i [expr {[lsearch -exact $buttons $w] + $count}]
+ while 1 {
+ while {$i < 0} {
+ incr i $length
+ }
+ while {$i >= $length} {
+ incr i -$length
+ }
+ set mb [lindex $buttons $i]
+ if {([winfo class $mb] == "Menubutton")
+ && ([$mb cget -state] != "disabled")
+ && ([$mb cget -menu] != "")
+ && ([[$mb cget -menu] index last] != "none")} {
+ break
+ }
+ if {$mb == $w} {
+ return
+ }
+ incr i $count
+ }
+ tkMbPost $mb
+ tkMenuFirstEntry [$mb cget -menu]
+}
+
+# tkMenuNextEntry --
+# Activate the next higher or lower entry in the posted menu,
+# wrapping around at the ends. Disabled entries are skipped.
+#
+# Arguments:
+# menu - Menu window that received the keystroke.
+# count - 1 means go to the next lower entry,
+# -1 means go to the next higher entry.
+
+proc tkMenuNextEntry {menu count} {
+ global tkPriv
+
+ if {[$menu index last] == "none"} {
+ return
+ }
+ set length [expr {[$menu index last]+1}]
+ set quitAfter $length
+ set active [$menu index active]
+ if {$active == "none"} {
+ set i 0
+ } else {
+ set i [expr {$active + $count}]
+ }
+ while 1 {
+ if {$quitAfter <= 0} {
+ # We've tried every entry in the menu. Either there are
+ # none, or they're all disabled. Just give up.
+
+ return
+ }
+ while {$i < 0} {
+ incr i $length
+ }
+ while {$i >= $length} {
+ incr i -$length
+ }
+ if {[catch {$menu entrycget $i -state} state] == 0} {
+ if {$state != "disabled"} {
+ break
+ }
+ }
+ if {$i == $active} {
+ return
+ }
+ incr i $count
+ incr quitAfter -1
+ }
+ $menu activate $i
+ tkGenerateMenuSelect $menu
+ if {[$menu type $i] == "cascade"} {
+ set cascade [$menu entrycget $i -menu]
+ if {[string compare $cascade ""] != 0} {
+ $menu postcascade $i
+ tkMenuFirstEntry $cascade
+ }
+ }
+}
+
+# tkMenuFind --
+# This procedure searches the entire window hierarchy under w for
+# a menubutton that isn't disabled and whose underlined character
+# is "char" or an entry in a menubar that isn't disabled and whose
+# underlined character is "char".
+# It returns the name of that window, if found, or an
+# empty string if no matching window was found. If "char" is an
+# empty string then the procedure returns the name of the first
+# menubutton found that isn't disabled.
+#
+# Arguments:
+# w - Name of window where key was typed.
+# char - Underlined character to search for;
+# may be either upper or lower case, and
+# will match either upper or lower case.
+
+proc tkMenuFind {w char} {
+ global tkPriv
+ set char [string tolower $char]
+ set windowlist [winfo child $w]
+
+ foreach child $windowlist {
+ switch [winfo class $child] {
+ Menu {
+ if {[$child cget -type] == "menubar"} {
+ if {$char == ""} {
+ return $child
+ }
+ set last [$child index last]
+ for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {
+ if {[$child type $i] == "separator"} {
+ continue
+ }
+ set char2 [string index [$child entrycget $i -label] \
+ [$child entrycget $i -underline]]
+ if {([string compare $char [string tolower $char2]] \
+ == 0) || ($char == "")} {
+ if {[$child entrycget $i -state] != "disabled"} {
+ return $child
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+
+ foreach child $windowlist {
+ switch [winfo class $child] {
+ Menubutton {
+ set char2 [string index [$child cget -text] \
+ [$child cget -underline]]
+ if {([string compare $char [string tolower $char2]] == 0)
+ || ($char == "")} {
+ if {[$child cget -state] != "disabled"} {
+ return $child
+ }
+ }
+ }
+
+ default {
+ set match [tkMenuFind $child $char]
+ if {$match != ""} {
+ return $match
+ }
+ }
+ }
+ }
+ return {}
+}
+
+# tkTraverseToMenu --
+# This procedure implements keyboard traversal of menus. Given an
+# ASCII character "char", it looks for a menubutton with that character
+# underlined. If one is found, it posts the menubutton's menu
+#
+# Arguments:
+# w - Window in which the key was typed (selects
+# a toplevel window).
+# char - Character that selects a menu. The case
+# is ignored. If an empty string, nothing
+# happens.
+
+proc tkTraverseToMenu {w char} {
+ global tkPriv
+ if {$char == ""} {
+ return
+ }
+ while {[winfo class $w] == "Menu"} {
+ if {([$w cget -type] != "menubar") && ($tkPriv(postedMb) == "")} {
+ return
+ }
+ if {[$w cget -type] == "menubar"} {
+ break
+ }
+ set w [winfo parent $w]
+ }
+ set w [tkMenuFind [winfo toplevel $w] $char]
+ if {$w != ""} {
+ if {[winfo class $w] == "Menu"} {
+ tk_menuSetFocus $w
+ set tkPriv(window) $w
+ tkSaveGrabInfo $w
+ grab -global $w
+ tkTraverseWithinMenu $w $char
+ } else {
+ tkMbPost $w
+ tkMenuFirstEntry [$w cget -menu]
+ }
+ }
+}
+
+# tkFirstMenu --
+# This procedure traverses to the first menubutton in the toplevel
+# for a given window, and posts that menubutton's menu.
+#
+# Arguments:
+# w - Name of a window. Selects which toplevel
+# to search for menubuttons.
+
+proc tkFirstMenu w {
+ set w [tkMenuFind [winfo toplevel $w] ""]
+ if {$w != ""} {
+ if {[winfo class $w] == "Menu"} {
+ tk_menuSetFocus $w
+ set tkPriv(window) $w
+ tkSaveGrabInfo $w
+ grab -global $w
+ tkMenuFirstEntry $w
+ } else {
+ tkMbPost $w
+ tkMenuFirstEntry [$w cget -menu]
+ }
+ }
+}
+
+# tkTraverseWithinMenu
+# This procedure implements keyboard traversal within a menu. It
+# searches for an entry in the menu that has "char" underlined. If
+# such an entry is found, it is invoked and the menu is unposted.
+#
+# Arguments:
+# w - The name of the menu widget.
+# char - The character to look for; case is
+# ignored. If the string is empty then
+# nothing happens.
+
+proc tkTraverseWithinMenu {w char} {
+ if {$char == ""} {
+ return
+ }
+ set char [string tolower $char]
+ set last [$w index last]
+ if {$last == "none"} {
+ return
+ }
+ for {set i 0} {$i <= $last} {incr i} {
+ if {[catch {set char2 [string index \
+ [$w entrycget $i -label] \
+ [$w entrycget $i -underline]]}]} {
+ continue
+ }
+ if {[string compare $char [string tolower $char2]] == 0} {
+ if {[$w type $i] == "cascade"} {
+ $w activate $i
+ $w postcascade active
+ event generate $w <>
+ set m2 [$w entrycget $i -menu]
+ if {$m2 != ""} {
+ tkMenuFirstEntry $m2
+ }
+ } else {
+ tkMenuUnpost $w
+ uplevel #0 [list $w invoke $i]
+ }
+ return
+ }
+ }
+}
+
+# tkMenuFirstEntry --
+# Given a menu, this procedure finds the first entry that isn't
+# disabled or a tear-off or separator, and activates that entry.
+# However, if there is already an active entry in the menu (e.g.,
+# because of a previous call to tkPostOverPoint) then the active
+# entry isn't changed. This procedure also sets the input focus
+# to the menu.
+#
+# Arguments:
+# menu - Name of the menu window (possibly empty).
+
+proc tkMenuFirstEntry menu {
+ if {$menu == ""} {
+ return
+ }
+ tk_menuSetFocus $menu
+ if {[$menu index active] != "none"} {
+ return
+ }
+ set last [$menu index last]
+ if {$last == "none"} {
+ return
+ }
+ for {set i 0} {$i <= $last} {incr i} {
+ if {([catch {set state [$menu entrycget $i -state]}] == 0)
+ && ($state != "disabled") && ([$menu type $i] != "tearoff")} {
+ $menu activate $i
+ tkGenerateMenuSelect $menu
+ if {[$menu type $i] == "cascade"} {
+ set cascade [$menu entrycget $i -menu]
+ if {[string compare $cascade ""] != 0} {
+ $menu postcascade $i
+ tkMenuFirstEntry $cascade
+ }
+ }
+ return
+ }
+ }
+}
+
+# tkMenuFindName --
+# Given a menu and a text string, return the index of the menu entry
+# that displays the string as its label. If there is no such entry,
+# return an empty string. This procedure is tricky because some names
+# like "active" have a special meaning in menu commands, so we can't
+# always use the "index" widget command.
+#
+# Arguments:
+# menu - Name of the menu widget.
+# s - String to look for.
+
+proc tkMenuFindName {menu s} {
+ set i ""
+ if {![regexp {^active$|^last$|^none$|^[0-9]|^@} $s]} {
+ catch {set i [$menu index $s]}
+ return $i
+ }
+ set last [$menu index last]
+ if {$last == "none"} {
+ return
+ }
+ for {set i 0} {$i <= $last} {incr i} {
+ if {![catch {$menu entrycget $i -label} label]} {
+ if {$label == $s} {
+ return $i
+ }
+ }
+ }
+ return ""
+}
+
+# tkPostOverPoint --
+# This procedure posts a given menu such that a given entry in the
+# menu is centered over a given point in the root window. It also
+# activates the given entry.
+#
+# Arguments:
+# menu - Menu to post.
+# x, y - Root coordinates of point.
+# entry - Index of entry within menu to center over (x,y).
+# If omitted or specified as {}, then the menu's
+# upper-left corner goes at (x,y).
+
+proc tkPostOverPoint {menu x y {entry {}}} {
+ global tcl_platform
+
+ if {$entry != {}} {
+ if {$entry == [$menu index last]} {
+ incr y [expr {-([$menu yposition $entry] \
+ + [winfo reqheight $menu])/2}]
+ } else {
+ incr y [expr {-([$menu yposition $entry] \
+ + [$menu yposition [expr {$entry+1}]])/2}]
+ }
+ incr x [expr {-[winfo reqwidth $menu]/2}]
+ }
+ $menu post $x $y
+ if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} {
+ $menu activate $entry
+ tkGenerateMenuSelect $menu
+ }
+}
+
+# tkSaveGrabInfo --
+# Sets the variables tkPriv(oldGrab) and tkPriv(grabStatus) to record
+# the state of any existing grab on the w's display.
+#
+# Arguments:
+# w - Name of a window; used to select the display
+# whose grab information is to be recorded.
+
+proc tkSaveGrabInfo w {
+ global tkPriv
+ set tkPriv(oldGrab) [grab current $w]
+ if {$tkPriv(oldGrab) != ""} {
+ set tkPriv(grabStatus) [grab status $tkPriv(oldGrab)]
+ }
+}
+
+# tkRestoreOldGrab --
+# Restores the grab to what it was before TkSaveGrabInfo was called.
+#
+
+proc tkRestoreOldGrab {} {
+ global tkPriv
+
+ if {$tkPriv(oldGrab) != ""} {
+
+ # Be careful restoring the old grab, since it's window may not
+ # be visible anymore.
+
+ catch {
+ if {$tkPriv(grabStatus) == "global"} {
+ grab set -global $tkPriv(oldGrab)
+ } else {
+ grab set $tkPriv(oldGrab)
+ }
+ }
+ set tkPriv(oldGrab) ""
+ }
+}
+
+proc tk_menuSetFocus {menu} {
+ global tkPriv
+ if {![info exists tkPriv(focus)] || [string length $tkPriv(focus)] == 0} {
+ set tkPriv(focus) [focus]
+ }
+ focus $menu
+}
+
+proc tkGenerateMenuSelect {menu} {
+ global tkPriv
+
+ if {([string compare $tkPriv(activeMenu) $menu] == 0) \
+ && ([string compare $tkPriv(activeItem) [$menu index active]] \
+ == 0)} {
+ return
+ }
+
+ set tkPriv(activeMenu) $menu
+ set tkPriv(activeItem) [$menu index active]
+ event generate $menu <>
+}
+
+# tk_popup --
+# This procedure pops up a menu and sets things up for traversing
+# the menu and its submenus.
+#
+# Arguments:
+# menu - Name of the menu to be popped up.
+# x, y - Root coordinates at which to pop up the
+# menu.
+# entry - Index of a menu entry to center over (x,y).
+# If omitted or specified as {}, then menu's
+# upper-left corner goes at (x,y).
+
+proc tk_popup {menu x y {entry {}}} {
+ global tkPriv
+ global tcl_platform
+ if {($tkPriv(popup) != "") || ($tkPriv(postedMb) != "")} {
+ tkMenuUnpost {}
+ }
+ tkPostOverPoint $menu $x $y $entry
+ if {$tcl_platform(platform) == "unix"} {
+ tkSaveGrabInfo $menu
+ grab -global $menu
+ set tkPriv(popup) $menu
+ tk_menuSetFocus $menu
+ }
+}
menu.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: comdlg.tcl
===================================================================
--- comdlg.tcl (nonexistent)
+++ comdlg.tcl (revision 1765)
@@ -0,0 +1,308 @@
+# comdlg.tcl --
+#
+# Some functions needed for the common dialog boxes. Probably need to go
+# in a different file.
+#
+# SCCS: @(#) comdlg.tcl 1.4 96/09/05 09:07:54
+#
+# Copyright (c) 1996 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+# tclParseConfigSpec --
+#
+# Parses a list of "-option value" pairs. If all options and
+# values are legal, the values are stored in
+# $data($option). Otherwise an error message is returned. When
+# an error happens, the data() array may have been partially
+# modified, but all the modified members of the data(0 array are
+# guaranteed to have valid values. This is different than
+# Tk_ConfigureWidget() which does not modify the value of a
+# widget record if any error occurs.
+#
+# Arguments:
+#
+# w = widget record to modify. Must be the pathname of a widget.
+#
+# specs = {
+# {-commandlineswitch resourceName ResourceClass defaultValue verifier}
+# {....}
+# }
+#
+# flags = currently unused.
+#
+# argList = The list of "-option value" pairs.
+#
+proc tclParseConfigSpec {w specs flags argList} {
+ upvar #0 $w data
+
+ # 1: Put the specs in associative arrays for faster access
+ #
+ foreach spec $specs {
+ if {[llength $spec] < 4} {
+ error "\"spec\" should contain 5 or 4 elements"
+ }
+ set cmdsw [lindex $spec 0]
+ set cmd($cmdsw) ""
+ set rname($cmdsw) [lindex $spec 1]
+ set rclass($cmdsw) [lindex $spec 2]
+ set def($cmdsw) [lindex $spec 3]
+ set verproc($cmdsw) [lindex $spec 4]
+ }
+
+ if {([llength $argList]%2) != 0} {
+ foreach {cmdsw value} $argList {
+ if {![info exists cmd($cmdsw)]} {
+ error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]"
+ }
+ }
+ error "value for \"[lindex $argList end]\" missing"
+ }
+
+ # 2: set the default values
+ #
+ foreach cmdsw [array names cmd] {
+ set data($cmdsw) $def($cmdsw)
+ }
+
+ # 3: parse the argument list
+ #
+ foreach {cmdsw value} $argList {
+ if {![info exists cmd($cmdsw)]} {
+ error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]"
+ }
+ set data($cmdsw) $value
+ }
+
+ # Done!
+}
+
+proc tclListValidFlags {v} {
+ upvar $v cmd
+
+ set len [llength [array names cmd]]
+ set i 1
+ set separator ""
+ set errormsg ""
+ foreach cmdsw [lsort [array names cmd]] {
+ append errormsg "$separator$cmdsw"
+ incr i
+ if {$i == $len} {
+ set separator " or "
+ } else {
+ set separator ", "
+ }
+ }
+ return $errormsg
+}
+
+# This procedure is used to sort strings in a case-insenstive mode.
+#
+proc tclSortNoCase {str1 str2} {
+ return [string compare [string toupper $str1] [string toupper $str2]]
+}
+
+
+# Gives an error if the string does not contain a valid integer
+# number
+#
+proc tclVerifyInteger {string} {
+ lindex {1 2 3} $string
+}
+
+
+#----------------------------------------------------------------------
+#
+# Focus Group
+#
+# Focus groups are used to handle the user's focusing actions inside a
+# toplevel.
+#
+# One example of using focus groups is: when the user focuses on an
+# entry, the text in the entry is highlighted and the cursor is put to
+# the end of the text. When the user changes focus to another widget,
+# the text in the previously focused entry is validated.
+#
+#----------------------------------------------------------------------
+
+
+# tkFocusGroup_Create --
+#
+# Create a focus group. All the widgets in a focus group must be
+# within the same focus toplevel. Each toplevel can have only
+# one focus group, which is identified by the name of the
+# toplevel widget.
+#
+proc tkFocusGroup_Create {t} {
+ global tkPriv
+ if {[string compare [winfo toplevel $t] $t]} {
+ error "$t is not a toplevel window"
+ }
+ if {![info exists tkPriv(fg,$t)]} {
+ set tkPriv(fg,$t) 1
+ set tkPriv(focus,$t) ""
+ bind $t "tkFocusGroup_In $t %W %d"
+ bind $t "tkFocusGroup_Out $t %W %d"
+ bind $t "tkFocusGroup_Destroy $t %W"
+ }
+}
+
+# tkFocusGroup_BindIn --
+#
+# Add a widget into the "FocusIn" list of the focus group. The $cmd will be
+# called when the widget is focused on by the user.
+#
+proc tkFocusGroup_BindIn {t w cmd} {
+ global tkFocusIn tkPriv
+ if {![info exists tkPriv(fg,$t)]} {
+ error "focus group \"$t\" doesn't exist"
+ }
+ set tkFocusIn($t,$w) $cmd
+}
+
+
+# tkFocusGroup_BindOut --
+#
+# Add a widget into the "FocusOut" list of the focus group. The
+# $cmd will be called when the widget loses the focus (User
+# types Tab or click on another widget).
+#
+proc tkFocusGroup_BindOut {t w cmd} {
+ global tkFocusOut tkPriv
+ if {![info exists tkPriv(fg,$t)]} {
+ error "focus group \"$t\" doesn't exist"
+ }
+ set tkFocusOut($t,$w) $cmd
+}
+
+# tkFocusGroup_Destroy --
+#
+# Cleans up when members of the focus group is deleted, or when the
+# toplevel itself gets deleted.
+#
+proc tkFocusGroup_Destroy {t w} {
+ global tkPriv tkFocusIn tkFocusOut
+
+ if {![string compare $t $w]} {
+ unset tkPriv(fg,$t)
+ unset tkPriv(focus,$t)
+
+ foreach name [array names tkFocusIn $t,*] {
+ unset tkFocusIn($name)
+ }
+ foreach name [array names tkFocusOut $t,*] {
+ unset tkFocusOut($name)
+ }
+ } else {
+ if {[info exists tkPriv(focus,$t)]} {
+ if {![string compare $tkPriv(focus,$t) $w]} {
+ set tkPriv(focus,$t) ""
+ }
+ }
+ catch {
+ unset tkFocusIn($t,$w)
+ }
+ catch {
+ unset tkFocusOut($t,$w)
+ }
+ }
+}
+
+# tkFocusGroup_In --
+#
+# Handles the event. Calls the FocusIn command for the newly
+# focused widget in the focus group.
+#
+proc tkFocusGroup_In {t w detail} {
+ global tkPriv tkFocusIn
+
+ if {![info exists tkFocusIn($t,$w)]} {
+ set tkFocusIn($t,$w) ""
+ return
+ }
+ if {![info exists tkPriv(focus,$t)]} {
+ return
+ }
+ if {![string compare $tkPriv(focus,$t) $w]} {
+ # This is already in focus
+ #
+ return
+ } else {
+ set tkPriv(focus,$t) $w
+ eval $tkFocusIn($t,$w)
+ }
+}
+
+# tkFocusGroup_Out --
+#
+# Handles the event. Checks if this is really a lose
+# focus event, not one generated by the mouse moving out of the
+# toplevel window. Calls the FocusOut command for the widget
+# who loses its focus.
+#
+proc tkFocusGroup_Out {t w detail} {
+ global tkPriv tkFocusOut
+
+ if {[string compare $detail NotifyNonlinear] &&
+ [string compare $detail NotifyNonlinearVirtual]} {
+ # This is caused by mouse moving out of the window
+ return
+ }
+ if {![info exists tkPriv(focus,$t)]} {
+ return
+ }
+ if {![info exists tkFocusOut($t,$w)]} {
+ return
+ } else {
+ eval $tkFocusOut($t,$w)
+ set tkPriv(focus,$t) ""
+ }
+}
+
+# tkFDGetFileTypes --
+#
+# Process the string given by the -filetypes option of the file
+# dialogs. Similar to the C function TkGetFileFilters() on the Mac
+# and Windows platform.
+#
+proc tkFDGetFileTypes {string} {
+ foreach t $string {
+ if {[llength $t] < 2 || [llength $t] > 3} {
+ error "bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\""
+ }
+ eval lappend [list fileTypes([lindex $t 0])] [lindex $t 1]
+ }
+
+ set types {}
+ foreach t $string {
+ set label [lindex $t 0]
+ set exts {}
+
+ if {[info exists hasDoneType($label)]} {
+ continue
+ }
+
+ set name "$label ("
+ set sep ""
+ foreach ext $fileTypes($label) {
+ if {![string compare $ext ""]} {
+ continue
+ }
+ regsub {^[.]} $ext "*." ext
+ if {![info exists hasGotExt($label,$ext)]} {
+ append name $sep$ext
+ lappend exts $ext
+ set hasGotExt($label,$ext) 1
+ }
+ set sep ,
+ }
+ append name ")"
+ lappend types [list $name $exts]
+
+ set hasDoneType($label) 1
+ }
+
+ return $types
+}
comdlg.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: button.tcl
===================================================================
--- button.tcl (nonexistent)
+++ button.tcl (revision 1765)
@@ -0,0 +1,465 @@
+# button.tcl --
+#
+# This file defines the default bindings for Tk label, button,
+# checkbutton, and radiobutton widgets and provides procedures
+# that help in implementing those bindings.
+#
+# SCCS: @(#) button.tcl 1.22 96/11/14 14:49:11
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for buttons.
+#-------------------------------------------------------------------------
+
+if {$tcl_platform(platform) == "macintosh"} {
+ bind Radiobutton {
+ tkButtonEnter %W
+ }
+ bind Radiobutton <1> {
+ tkButtonDown %W
+ }
+ bind Radiobutton {
+ tkButtonUp %W
+ }
+ bind Checkbutton {
+ tkButtonEnter %W
+ }
+ bind Checkbutton <1> {
+ tkButtonDown %W
+ }
+ bind Checkbutton {
+ tkButtonUp %W
+ }
+}
+if {$tcl_platform(platform) == "windows"} {
+ bind Button {
+ tkButtonInvoke %W
+ }
+ bind Checkbutton {
+ tkCheckRadioInvoke %W
+ }
+ bind Radiobutton {
+ tkCheckRadioInvoke %W
+ }
+ bind Checkbutton {
+ tkCheckRadioInvoke %W select
+ }
+ bind Checkbutton {
+ tkCheckRadioInvoke %W select
+ }
+ bind Checkbutton {
+ tkCheckRadioInvoke %W deselect
+ }
+ bind Checkbutton <1> {
+ tkCheckRadioDown %W
+ }
+ bind Checkbutton {
+ tkButtonUp %W
+ }
+ bind Checkbutton {
+ tkCheckRadioEnter %W
+ }
+
+ bind Radiobutton <1> {
+ tkCheckRadioDown %W
+ }
+ bind Radiobutton {
+ tkButtonUp %W
+ }
+ bind Radiobutton {
+ tkCheckRadioEnter %W
+ }
+}
+if {$tcl_platform(platform) == "unix"} {
+ bind Checkbutton {
+ if {!$tk_strictMotif} {
+ tkCheckRadioInvoke %W
+ }
+ }
+ bind Radiobutton {
+ if {!$tk_strictMotif} {
+ tkCheckRadioInvoke %W
+ }
+ }
+ bind Checkbutton <1> {
+ tkCheckRadioInvoke %W
+ }
+ bind Radiobutton <1> {
+ tkCheckRadioInvoke %W
+ }
+ bind Checkbutton {
+ tkButtonEnter %W
+ }
+ bind Radiobutton {
+ tkButtonEnter %W
+ }
+}
+
+bind Button {
+ tkButtonInvoke %W
+}
+bind Checkbutton {
+ tkCheckRadioInvoke %W
+}
+bind Radiobutton {
+ tkCheckRadioInvoke %W
+}
+
+bind Button {}
+bind Button {
+ tkButtonEnter %W
+}
+bind Button {
+ tkButtonLeave %W
+}
+bind Button <1> {
+ tkButtonDown %W
+}
+bind Button {
+ tkButtonUp %W
+}
+
+bind Checkbutton {}
+bind Checkbutton {
+ tkButtonLeave %W
+}
+
+bind Radiobutton {}
+bind Radiobutton {
+ tkButtonLeave %W
+}
+
+if {$tcl_platform(platform) == "windows"} {
+
+#########################
+# Windows implementation
+#########################
+
+# tkButtonEnter --
+# The procedure below is invoked when the mouse pointer enters a
+# button widget. It records the button we're in and changes the
+# state of the button to active unless the button is disabled.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonEnter w {
+ global tkPriv
+ if {[$w cget -state] != "disabled"} {
+ if {$tkPriv(buttonWindow) == $w} {
+ $w configure -state active -relief sunken
+ }
+ }
+ set tkPriv(window) $w
+}
+
+# tkButtonLeave --
+# The procedure below is invoked when the mouse pointer leaves a
+# button widget. It changes the state of the button back to
+# inactive. If we're leaving the button window with a mouse button
+# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
+# button too.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonLeave w {
+ global tkPriv
+ if {[$w cget -state] != "disabled"} {
+ $w config -state normal
+ }
+ if {$w == $tkPriv(buttonWindow)} {
+ $w configure -relief $tkPriv(relief)
+ }
+ set tkPriv(window) ""
+}
+
+# tkCheckRadioEnter --
+# The procedure below is invoked when the mouse pointer enters a
+# checkbutton or radiobutton widget. It records the button we're in
+# and changes the state of the button to active unless the button is
+# disabled.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkCheckRadioEnter w {
+ global tkPriv
+ if {[$w cget -state] != "disabled"} {
+ if {$tkPriv(buttonWindow) == $w} {
+ $w configure -state active
+ }
+ }
+ set tkPriv(window) $w
+}
+
+# tkButtonDown --
+# The procedure below is invoked when the mouse button is pressed in
+# a button widget. It records the fact that the mouse is in the button,
+# saves the button's relief so it can be restored later, and changes
+# the relief to sunken.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonDown w {
+ global tkPriv
+ set tkPriv(relief) [lindex [$w conf -relief] 4]
+ if {[$w cget -state] != "disabled"} {
+ set tkPriv(buttonWindow) $w
+ $w config -relief sunken -state active
+ }
+}
+
+# tkCheckRadioDown --
+# The procedure below is invoked when the mouse button is pressed in
+# a button widget. It records the fact that the mouse is in the button,
+# saves the button's relief so it can be restored later, and changes
+# the relief to sunken.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkCheckRadioDown w {
+ global tkPriv
+ set tkPriv(relief) [lindex [$w conf -relief] 4]
+ if {[$w cget -state] != "disabled"} {
+ set tkPriv(buttonWindow) $w
+ $w config -state active
+ }
+}
+
+# tkButtonUp --
+# The procedure below is invoked when the mouse button is released
+# in a button widget. It restores the button's relief and invokes
+# the command as long as the mouse hasn't left the button.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonUp w {
+ global tkPriv
+ if {$w == $tkPriv(buttonWindow)} {
+ set tkPriv(buttonWindow) ""
+ if {($w == $tkPriv(window))
+ && ([$w cget -state] != "disabled")} {
+ $w config -relief $tkPriv(relief) -state normal
+ uplevel #0 [list $w invoke]
+ }
+ }
+}
+
+}
+
+if {$tcl_platform(platform) == "unix"} {
+
+#####################
+# Unix implementation
+#####################
+
+# tkButtonEnter --
+# The procedure below is invoked when the mouse pointer enters a
+# button widget. It records the button we're in and changes the
+# state of the button to active unless the button is disabled.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonEnter {w} {
+ global tkPriv
+ if {[$w cget -state] != "disabled"} {
+ $w config -state active
+ if {$tkPriv(buttonWindow) == $w} {
+ $w configure -state active -relief sunken
+ }
+ }
+ set tkPriv(window) $w
+}
+
+# tkButtonLeave --
+# The procedure below is invoked when the mouse pointer leaves a
+# button widget. It changes the state of the button back to
+# inactive. If we're leaving the button window with a mouse button
+# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
+# button too.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonLeave w {
+ global tkPriv
+ if {[$w cget -state] != "disabled"} {
+ $w config -state normal
+ }
+ if {$w == $tkPriv(buttonWindow)} {
+ $w configure -relief $tkPriv(relief)
+ }
+ set tkPriv(window) ""
+}
+
+# tkButtonDown --
+# The procedure below is invoked when the mouse button is pressed in
+# a button widget. It records the fact that the mouse is in the button,
+# saves the button's relief so it can be restored later, and changes
+# the relief to sunken.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonDown w {
+ global tkPriv
+ set tkPriv(relief) [lindex [$w config -relief] 4]
+ if {[$w cget -state] != "disabled"} {
+ set tkPriv(buttonWindow) $w
+ $w config -relief sunken
+ }
+}
+
+# tkButtonUp --
+# The procedure below is invoked when the mouse button is released
+# in a button widget. It restores the button's relief and invokes
+# the command as long as the mouse hasn't left the button.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonUp w {
+ global tkPriv
+ if {$w == $tkPriv(buttonWindow)} {
+ set tkPriv(buttonWindow) ""
+ $w config -relief $tkPriv(relief)
+ if {($w == $tkPriv(window))
+ && ([$w cget -state] != "disabled")} {
+ uplevel #0 [list $w invoke]
+ }
+ }
+}
+
+}
+
+if {$tcl_platform(platform) == "macintosh"} {
+
+####################
+# Mac implementation
+####################
+
+# tkButtonEnter --
+# The procedure below is invoked when the mouse pointer enters a
+# button widget. It records the button we're in and changes the
+# state of the button to active unless the button is disabled.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonEnter {w} {
+ global tkPriv
+ if {[$w cget -state] != "disabled"} {
+ if {$tkPriv(buttonWindow) == $w} {
+ $w configure -state active
+ }
+ }
+ set tkPriv(window) $w
+}
+
+# tkButtonLeave --
+# The procedure below is invoked when the mouse pointer leaves a
+# button widget. It changes the state of the button back to
+# inactive. If we're leaving the button window with a mouse button
+# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
+# button too.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonLeave w {
+ global tkPriv
+ if {$w == $tkPriv(buttonWindow)} {
+ $w configure -state normal
+ }
+ set tkPriv(window) ""
+}
+
+# tkButtonDown --
+# The procedure below is invoked when the mouse button is pressed in
+# a button widget. It records the fact that the mouse is in the button,
+# saves the button's relief so it can be restored later, and changes
+# the relief to sunken.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonDown w {
+ global tkPriv
+ if {[$w cget -state] != "disabled"} {
+ set tkPriv(buttonWindow) $w
+ $w config -state active
+ }
+}
+
+# tkButtonUp --
+# The procedure below is invoked when the mouse button is released
+# in a button widget. It restores the button's relief and invokes
+# the command as long as the mouse hasn't left the button.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonUp w {
+ global tkPriv
+ if {$w == $tkPriv(buttonWindow)} {
+ $w config -state normal
+ set tkPriv(buttonWindow) ""
+ if {($w == $tkPriv(window))
+ && ([$w cget -state] != "disabled")} {
+ uplevel #0 [list $w invoke]
+ }
+ }
+}
+
+}
+
+##################
+# Shared routines
+##################
+
+# tkButtonInvoke --
+# The procedure below is called when a button is invoked through
+# the keyboard. It simulate a press of the button via the mouse.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonInvoke w {
+ if {[$w cget -state] != "disabled"} {
+ set oldRelief [$w cget -relief]
+ set oldState [$w cget -state]
+ $w configure -state active -relief sunken
+ update idletasks
+ after 100
+ $w configure -state $oldState -relief $oldRelief
+ uplevel #0 [list $w invoke]
+ }
+}
+
+# tkCheckRadioInvoke --
+# The procedure below is invoked when the mouse button is pressed in
+# a checkbutton or radiobutton widget, or when the widget is invoked
+# through the keyboard. It invokes the widget if it
+# isn't disabled.
+#
+# Arguments:
+# w - The name of the widget.
+# cmd - The subcommand to invoke (one of invoke, select, or deselect).
+
+proc tkCheckRadioInvoke {w {cmd invoke}} {
+ if {[$w cget -state] != "disabled"} {
+ uplevel #0 [list $w $cmd]
+ }
+}
+
button.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: obsolete.tcl
===================================================================
--- obsolete.tcl (nonexistent)
+++ obsolete.tcl (revision 1765)
@@ -0,0 +1,21 @@
+# obsolete.tcl --
+#
+# This file contains obsolete procedures that people really shouldn't
+# be using anymore, but which are kept around for backward compatibility.
+#
+# SCCS: @(#) obsolete.tcl 1.3 96/02/16 10:48:19
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+# The procedures below are here strictly for backward compatibility with
+# Tk version 3.6 and earlier. The procedures are no longer needed, so
+# they are no-ops. You should not use these procedures anymore, since
+# they may be removed in some future release.
+
+proc tk_menuBar args {}
+proc tk_bindForTraversal args {}
obsolete.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: safetk.tcl
===================================================================
--- safetk.tcl (nonexistent)
+++ safetk.tcl (revision 1765)
@@ -0,0 +1,204 @@
+# safetk.tcl --
+#
+# Support procs to use Tk in safe interpreters.
+#
+# SCCS: @(#) safetk.tcl 1.8 97/10/29 14:59:16
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# see safetk.n for documentation
+
+#
+#
+# Note: It is now ok to let untrusted code being executed
+# between the creation of the interp and the actual loading
+# of Tk in that interp because the C side Tk_Init will
+# now look up the master interp and ask its safe::TkInit
+# for the actual parameters to use for it's initialization (if allowed),
+# not relying on the slave state.
+#
+
+# We use opt (optional arguments parsing)
+package require opt 0.1;
+
+namespace eval ::safe {
+
+ # counter for safe toplevels
+ variable tkSafeId 0;
+
+ #
+ # tkInterpInit : prepare the slave interpreter for tk loading
+ # most of the real job is done by loadTk
+ # returns the slave name (tkInterpInit does)
+ #
+ proc ::safe::tkInterpInit {slave argv} {
+ global env tk_library
+
+ # Clear Tk's access for that interp (path).
+ allowTk $slave $argv
+
+ # there seems to be an obscure case where the tk_library
+ # variable value is changed to point to a sym link destination
+ # dir instead of the sym link itself, and thus where the $tk_library
+ # would then not be anymore one of the auto_path dir, so we use
+ # the addToAccessPath which adds if it's not already in instead
+ # of the more conventional findInAccessPath.
+ # Might be usefull for masters without Tk really loaded too.
+ ::interp eval $slave [list set tk_library [::safe::interpAddToAccessPath $slave $tk_library]]
+ return $slave;
+ }
+
+
+# tkInterpLoadTk :
+# Do additional configuration as needed (calling tkInterpInit)
+# and actually load Tk into the slave.
+#
+# Either contained in the specified windowId (-use) or
+# creating a decorated toplevel for it.
+
+# empty definition for auto_mkIndex
+proc ::safe::loadTk {} {}
+
+ ::tcl::OptProc loadTk {
+ {slave -interp "name of the slave interpreter"}
+ {-use -windowId {} "window Id to use (new toplevel otherwise)"}
+ {-display -displayName {} "display name to use (current one otherwise)"}
+ } {
+ set displayGiven [::tcl::OptProcArgGiven "-display"]
+ if {!$displayGiven} {
+ # Try to get the current display from "."
+ # (which might not exist if the master is tk-less)
+ if {[catch {set display [winfo screen .]}]} {
+ if {[info exists ::env(DISPLAY)]} {
+ set display $::env(DISPLAY)
+ } else {
+ Log $slave "no winfo screen . nor env(DISPLAY)" WARNING
+ set display ":0.0"
+ }
+ }
+ }
+ if {![::tcl::OptProcArgGiven "-use"]} {
+ # create a decorated toplevel
+ ::tcl::Lassign [tkTopLevel $slave $display] w use;
+ # set our delete hook (slave arg is added by interpDelete)
+ Set [DeleteHookName $slave] [list tkDelete {} $w];
+ } else {
+ # Let's be nice and also accept tk window names instead of ids
+ if {[string match ".*" $use]} {
+ set windowName $use
+ set use [winfo id $windowName]
+ set nDisplay [winfo screen $windowName]
+ } else {
+ # Check for a better -display value
+ # (works only for multi screens on single host, but not
+ # cross hosts, for that a tk window name would be better
+ # but embeding is also usefull for non tk names)
+ if {![catch {winfo pathname $use} name]} {
+ set nDisplay [winfo screen $name]
+ } else {
+ # Can't have a better one
+ set nDisplay $display
+ }
+ }
+ if {[string compare $nDisplay $display]} {
+ if {$displayGiven} {
+ error "conflicting -display $display and -use\
+ $use -> $nDisplay"
+ } else {
+ set display $nDisplay
+ }
+ }
+ }
+
+ # Prepares the slave for tk with those parameters
+
+ tkInterpInit $slave [list "-use" $use "-display" $display]
+
+ load {} Tk $slave
+
+ return $slave
+ }
+
+proc ::safe::TkInit {interpPath} {
+ variable tkInit
+ if {[info exists tkInit($interpPath)]} {
+ set value $tkInit($interpPath)
+ Log $interpPath "TkInit called, returning \"$value\"" NOTICE
+ return $value
+ } else {
+ Log $interpPath "TkInit called for interp with clearance:\
+ preventing Tk init" ERROR
+ error "not allowed"
+ }
+}
+
+proc ::safe::allowTk {interpPath argv} {
+ variable tkInit
+ set tkInit($interpPath) $argv
+}
+
+ proc ::safe::tkDelete {W window slave} {
+ # we are going to be called for each widget... skip untill it's
+ # top level
+ Log $slave "Called tkDelete $W $window" NOTICE;
+ if {[::interp exists $slave]} {
+ if {[catch {::safe::interpDelete $slave} msg]} {
+ Log $slave "Deletion error : $msg";
+ }
+ }
+ if {[winfo exists $window]} {
+ Log $slave "Destroy toplevel $window" NOTICE;
+ destroy $window;
+ }
+ }
+
+proc ::safe::tkTopLevel {slave display} {
+ variable tkSafeId;
+ incr tkSafeId;
+ set w ".safe$tkSafeId";
+ if {[catch {toplevel $w -screen $display -class SafeTk} msg]} {
+ return -code error "Unable to create toplevel for\
+ safe slave \"$slave\" ($msg)";
+ }
+ Log $slave "New toplevel $w" NOTICE
+
+ set msg "Untrusted Tcl applet ($slave)"
+ wm title $w $msg;
+
+ # Control frame
+ set wc $w.fc
+ frame $wc -bg red -borderwidth 3 -relief ridge ;
+
+ # We will destroy the interp when the window is destroyed
+ bindtags $wc [concat Safe$wc [bindtags $wc]]
+ bind Safe$wc [list ::safe::tkDelete %W $w $slave];
+
+ label $wc.l -text $msg \
+ -padx 2 -pady 0 -anchor w;
+
+ # We want the button to be the last visible item
+ # (so be packed first) and at the right and not resizing horizontally
+
+ # frame the button so it does not expand horizontally
+ # but still have the default background instead of red one from the parent
+ frame $wc.fb -bd 0 ;
+ button $wc.fb.b -text "Delete" \
+ -bd 1 -padx 2 -pady 0 -highlightthickness 0 \
+ -command [list ::safe::tkDelete $w $w $slave]
+ pack $wc.fb.b -side right -fill both ;
+ pack $wc.fb -side right -fill both -expand 1;
+ pack $wc.l -side left -fill both -expand 1;
+ pack $wc -side bottom -fill x ;
+
+ # Container frame
+ frame $w.c -container 1;
+ pack $w.c -fill both -expand 1;
+
+ # return both the toplevel window name and the id to use for embedding
+ list $w [winfo id $w.c] ;
+}
+
+}
safetk.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: tk.tcl
===================================================================
--- tk.tcl (nonexistent)
+++ tk.tcl (revision 1765)
@@ -0,0 +1,192 @@
+# tk.tcl --
+#
+# Initialization script normally executed in the interpreter for each
+# Tk-based application. Arranges class bindings for widgets.
+#
+# SCCS: @(#) tk.tcl 1.98 97/10/28 15:21:04
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# Insist on running with compatible versions of Tcl and Tk.
+
+package require -exact Tk 8.0
+package require -exact Tcl 8.0
+
+# Add Tk's directory to the end of the auto-load search path, if it
+# isn't already on the path:
+
+if {[info exists auto_path]} {
+ if {[lsearch -exact $auto_path $tk_library] < 0} {
+ lappend auto_path $tk_library
+ }
+}
+
+# Turn off strict Motif look and feel as a default.
+
+set tk_strictMotif 0
+
+# tkScreenChanged --
+# This procedure is invoked by the binding mechanism whenever the
+# "current" screen is changing. The procedure does two things.
+# First, it uses "upvar" to make global variable "tkPriv" point at an
+# array variable that holds state for the current display. Second,
+# it initializes the array if it didn't already exist.
+#
+# Arguments:
+# screen - The name of the new screen.
+
+proc tkScreenChanged screen {
+ set x [string last . $screen]
+ if {$x > 0} {
+ set disp [string range $screen 0 [expr {$x - 1}]]
+ } else {
+ set disp $screen
+ }
+
+ uplevel #0 upvar #0 tkPriv.$disp tkPriv
+ global tkPriv
+ global tcl_platform
+
+ if {[info exists tkPriv]} {
+ set tkPriv(screen) $screen
+ return
+ }
+ set tkPriv(activeMenu) {}
+ set tkPriv(activeItem) {}
+ set tkPriv(afterId) {}
+ set tkPriv(buttons) 0
+ set tkPriv(buttonWindow) {}
+ set tkPriv(dragging) 0
+ set tkPriv(focus) {}
+ set tkPriv(grab) {}
+ set tkPriv(initPos) {}
+ set tkPriv(inMenubutton) {}
+ set tkPriv(listboxPrev) {}
+ set tkPriv(menuBar) {}
+ set tkPriv(mouseMoved) 0
+ set tkPriv(oldGrab) {}
+ set tkPriv(popup) {}
+ set tkPriv(postedMb) {}
+ set tkPriv(pressX) 0
+ set tkPriv(pressY) 0
+ set tkPriv(prevPos) 0
+ set tkPriv(screen) $screen
+ set tkPriv(selectMode) char
+ if {[string compare $tcl_platform(platform) "unix"] == 0} {
+ set tkPriv(tearoff) 1
+ } else {
+ set tkPriv(tearoff) 0
+ }
+ set tkPriv(window) {}
+}
+
+# Do initial setup for tkPriv, so that it is always bound to something
+# (otherwise, if someone references it, it may get set to a non-upvar-ed
+# value, which will cause trouble later).
+
+tkScreenChanged [winfo screen .]
+
+# tkEventMotifBindings --
+# This procedure is invoked as a trace whenever tk_strictMotif is
+# changed. It is used to turn on or turn off the motif virtual
+# bindings.
+#
+# Arguments:
+# n1 - the name of the variable being changed ("tk_strictMotif").
+
+proc tkEventMotifBindings {n1 dummy dummy} {
+ upvar $n1 name
+
+ if {$name} {
+ set op delete
+ } else {
+ set op add
+ }
+
+ event $op <>
+ event $op <>
+ event $op <>
+}
+
+#----------------------------------------------------------------------
+# Define the set of common virtual events.
+#----------------------------------------------------------------------
+
+switch $tcl_platform(platform) {
+ "unix" {
+ event add <>
+ event add <>
+ event add <>
+ event add <>
+ trace variable tk_strictMotif w tkEventMotifBindings
+ set tk_strictMotif $tk_strictMotif
+ }
+ "windows" {
+ event add <>
+ event add <>
+ event add <>
+ event add <>
+ }
+ "macintosh" {
+ event add <>
+ event add <>
+ event add <>
+ event add <>
+ event add <>
+ }
+}
+
+# ----------------------------------------------------------------------
+# Read in files that define all of the class bindings.
+# ----------------------------------------------------------------------
+
+if {$tcl_platform(platform) != "macintosh"} {
+ source $tk_library/button.tcl
+ source $tk_library/entry.tcl
+ source $tk_library/listbox.tcl
+ source $tk_library/menu.tcl
+ source $tk_library/scale.tcl
+ source $tk_library/scrlbar.tcl
+ source $tk_library/text.tcl
+}
+
+# ----------------------------------------------------------------------
+# Default bindings for keyboard traversal.
+# ----------------------------------------------------------------------
+
+bind all {tkTabToWindow [tk_focusNext %W]}
+bind all {tkTabToWindow [tk_focusPrev %W]}
+
+# tkCancelRepeat --
+# This procedure is invoked to cancel an auto-repeat action described
+# by tkPriv(afterId). It's used by several widgets to auto-scroll
+# the widget when the mouse is dragged out of the widget with a
+# button pressed.
+#
+# Arguments:
+# None.
+
+proc tkCancelRepeat {} {
+ global tkPriv
+ after cancel $tkPriv(afterId)
+ set tkPriv(afterId) {}
+}
+
+# tkTabToWindow --
+# This procedure moves the focus to the given widget. If the widget
+# is an entry, it selects the entire contents of the widget.
+#
+# Arguments:
+# w - Window to which focus should be set.
+
+proc tkTabToWindow {w} {
+ if {"[winfo class $w]" == "Entry"} {
+ $w select range 0 end
+ $w icur end
+ }
+ focus $w
+}
tk.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: focus.tcl
===================================================================
--- focus.tcl (nonexistent)
+++ focus.tcl (revision 1765)
@@ -0,0 +1,180 @@
+# focus.tcl --
+#
+# This file defines several procedures for managing the input
+# focus.
+#
+# SCCS: @(#) focus.tcl 1.17 96/02/16 10:48:21
+#
+# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+# tk_focusNext --
+# This procedure returns the name of the next window after "w" in
+# "focus order" (the window that should receive the focus next if
+# Tab is typed in w). "Next" is defined by a pre-order search
+# of a top-level and its non-top-level descendants, with the stacking
+# order determining the order of siblings. The "-takefocus" options
+# on windows determine whether or not they should be skipped.
+#
+# Arguments:
+# w - Name of a window.
+
+proc tk_focusNext w {
+ set cur $w
+ while 1 {
+
+ # Descend to just before the first child of the current widget.
+
+ set parent $cur
+ set children [winfo children $cur]
+ set i -1
+
+ # Look for the next sibling that isn't a top-level.
+
+ while 1 {
+ incr i
+ if {$i < [llength $children]} {
+ set cur [lindex $children $i]
+ if {[winfo toplevel $cur] == $cur} {
+ continue
+ } else {
+ break
+ }
+ }
+
+ # No more siblings, so go to the current widget's parent.
+ # If it's a top-level, break out of the loop, otherwise
+ # look for its next sibling.
+
+ set cur $parent
+ if {[winfo toplevel $cur] == $cur} {
+ break
+ }
+ set parent [winfo parent $parent]
+ set children [winfo children $parent]
+ set i [lsearch -exact $children $cur]
+ }
+ if {($cur == $w) || [tkFocusOK $cur]} {
+ return $cur
+ }
+ }
+}
+
+# tk_focusPrev --
+# This procedure returns the name of the previous window before "w" in
+# "focus order" (the window that should receive the focus next if
+# Shift-Tab is typed in w). "Next" is defined by a pre-order search
+# of a top-level and its non-top-level descendants, with the stacking
+# order determining the order of siblings. The "-takefocus" options
+# on windows determine whether or not they should be skipped.
+#
+# Arguments:
+# w - Name of a window.
+
+proc tk_focusPrev w {
+ set cur $w
+ while 1 {
+
+ # Collect information about the current window's position
+ # among its siblings. Also, if the window is a top-level,
+ # then reposition to just after the last child of the window.
+
+ if {[winfo toplevel $cur] == $cur} {
+ set parent $cur
+ set children [winfo children $cur]
+ set i [llength $children]
+ } else {
+ set parent [winfo parent $cur]
+ set children [winfo children $parent]
+ set i [lsearch -exact $children $cur]
+ }
+
+ # Go to the previous sibling, then descend to its last descendant
+ # (highest in stacking order. While doing this, ignore top-levels
+ # and their descendants. When we run out of descendants, go up
+ # one level to the parent.
+
+ while {$i > 0} {
+ incr i -1
+ set cur [lindex $children $i]
+ if {[winfo toplevel $cur] == $cur} {
+ continue
+ }
+ set parent $cur
+ set children [winfo children $parent]
+ set i [llength $children]
+ }
+ set cur $parent
+ if {($cur == $w) || [tkFocusOK $cur]} {
+ return $cur
+ }
+ }
+}
+
+# tkFocusOK --
+#
+# This procedure is invoked to decide whether or not to focus on
+# a given window. It returns 1 if it's OK to focus on the window,
+# 0 if it's not OK. The code first checks whether the window is
+# viewable. If not, then it never focuses on the window. Then it
+# checks the -takefocus option for the window and uses it if it's
+# set. If there's no -takefocus option, the procedure checks to
+# see if (a) the widget isn't disabled, and (b) it has some key
+# bindings. If all of these are true, then 1 is returned.
+#
+# Arguments:
+# w - Name of a window.
+
+proc tkFocusOK w {
+ set code [catch {$w cget -takefocus} value]
+ if {($code == 0) && ($value != "")} {
+ if {$value == 0} {
+ return 0
+ } elseif {$value == 1} {
+ return [winfo viewable $w]
+ } else {
+ set value [uplevel #0 $value $w]
+ if {$value != ""} {
+ return $value
+ }
+ }
+ }
+ if {![winfo viewable $w]} {
+ return 0
+ }
+ set code [catch {$w cget -state} value]
+ if {($code == 0) && ($value == "disabled")} {
+ return 0
+ }
+ regexp Key|Focus "[bind $w] [bind [winfo class $w]]"
+}
+
+# tk_focusFollowsMouse --
+#
+# If this procedure is invoked, Tk will enter "focus-follows-mouse"
+# mode, where the focus is always on whatever window contains the
+# mouse. If this procedure isn't invoked, then the user typically
+# has to click on a window to give it the focus.
+#
+# Arguments:
+# None.
+
+proc tk_focusFollowsMouse {} {
+ set old [bind all ]
+ set script {
+ if {("%d" == "NotifyAncestor") || ("%d" == "NotifyNonlinear")
+ || ("%d" == "NotifyInferior")} {
+ if {[tkFocusOK %W]} {
+ focus %W
+ }
+ }
+ }
+ if {$old != ""} {
+ bind all "$old; $script"
+ } else {
+ bind all $script
+ }
+}
focus.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: listbox.tcl
===================================================================
--- listbox.tcl (nonexistent)
+++ listbox.tcl (revision 1765)
@@ -0,0 +1,452 @@
+# listbox.tcl --
+#
+# This file defines the default bindings for Tk listbox widgets
+# and provides procedures that help in implementing those bindings.
+#
+# SCCS: @(#) listbox.tcl 1.21 97/06/10 17:13:55
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+#--------------------------------------------------------------------------
+# tkPriv elements used in this file:
+#
+# afterId - Token returned by "after" for autoscanning.
+# listboxPrev - The last element to be selected or deselected
+# during a selection operation.
+# listboxSelection - All of the items that were selected before the
+# current selection operation (such as a mouse
+# drag) started; used to cancel an operation.
+#--------------------------------------------------------------------------
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for listboxes.
+#-------------------------------------------------------------------------
+
+# Note: the check for existence of %W below is because this binding
+# is sometimes invoked after a window has been deleted (e.g. because
+# there is a double-click binding on the widget that deletes it). Users
+# can put "break"s in their bindings to avoid the error, but this check
+# makes that unnecessary.
+
+bind Listbox <1> {
+ if {[winfo exists %W]} {
+ tkListboxBeginSelect %W [%W index @%x,%y]
+ }
+}
+
+# Ignore double clicks so that users can define their own behaviors.
+# Among other things, this prevents errors if the user deletes the
+# listbox on a double click.
+
+bind Listbox {
+ # Empty script
+}
+
+bind Listbox {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ tkListboxMotion %W [%W index @%x,%y]
+}
+bind Listbox {
+ tkCancelRepeat
+ %W activate @%x,%y
+}
+bind Listbox {
+ tkListboxBeginExtend %W [%W index @%x,%y]
+}
+bind Listbox {
+ tkListboxBeginToggle %W [%W index @%x,%y]
+}
+bind Listbox {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ tkListboxAutoScan %W
+}
+bind Listbox {
+ tkCancelRepeat
+}
+
+bind Listbox {
+ tkListboxUpDown %W -1
+}
+bind Listbox {
+ tkListboxExtendUpDown %W -1
+}
+bind Listbox {
+ tkListboxUpDown %W 1
+}
+bind Listbox {
+ tkListboxExtendUpDown %W 1
+}
+bind Listbox {
+ %W xview scroll -1 units
+}
+bind Listbox {
+ %W xview scroll -1 pages
+}
+bind Listbox {
+ %W xview scroll 1 units
+}
+bind Listbox {
+ %W xview scroll 1 pages
+}
+bind Listbox {
+ %W yview scroll -1 pages
+ %W activate @0,0
+}
+bind Listbox {
+ %W yview scroll 1 pages
+ %W activate @0,0
+}
+bind Listbox {
+ %W xview scroll -1 pages
+}
+bind Listbox {
+ %W xview scroll 1 pages
+}
+bind Listbox {
+ %W xview moveto 0
+}
+bind Listbox {
+ %W xview moveto 1
+}
+bind Listbox {
+ %W activate 0
+ %W see 0
+ %W selection clear 0 end
+ %W selection set 0
+}
+bind Listbox {
+ tkListboxDataExtend %W 0
+}
+bind Listbox {
+ %W activate end
+ %W see end
+ %W selection clear 0 end
+ %W selection set end
+}
+bind Listbox {
+ tkListboxDataExtend %W [%W index end]
+}
+bind Listbox <> {
+ if {[selection own -displayof %W] == "%W"} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W [selection get -displayof %W]
+ }
+}
+bind Listbox {
+ tkListboxBeginSelect %W [%W index active]
+}
+bind Listbox
listbox.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: text.tcl
===================================================================
--- text.tcl (nonexistent)
+++ text.tcl (revision 1765)
@@ -0,0 +1,1010 @@
+# text.tcl --
+#
+# This file defines the default bindings for Tk text widgets and provides
+# procedures that help in implementing the bindings.
+#
+# SCCS: @(#) text.tcl 1.58 97/09/17 18:54:56
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#-------------------------------------------------------------------------
+# Elements of tkPriv that are used in this file:
+#
+# afterId - If non-null, it means that auto-scanning is underway
+# and it gives the "after" id for the next auto-scan
+# command to be executed.
+# char - Character position on the line; kept in order
+# to allow moving up or down past short lines while
+# still remembering the desired position.
+# mouseMoved - Non-zero means the mouse has moved a significant
+# amount since the button went down (so, for example,
+# start dragging out a selection).
+# prevPos - Used when moving up or down lines via the keyboard.
+# Keeps track of the previous insert position, so
+# we can distinguish a series of ups and downs, all
+# in a row, from a new up or down.
+# selectMode - The style of selection currently underway:
+# char, word, or line.
+# x, y - Last known mouse coordinates for scanning
+# and auto-scanning.
+#-------------------------------------------------------------------------
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for entries.
+#-------------------------------------------------------------------------
+
+# Standard Motif bindings:
+
+bind Text <1> {
+ tkTextButton1 %W %x %y
+ %W tag remove sel 0.0 end
+}
+bind Text {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ tkTextSelectTo %W %x %y
+}
+bind Text {
+ set tkPriv(selectMode) word
+ tkTextSelectTo %W %x %y
+ catch {%W mark set insert sel.first}
+}
+bind Text {
+ set tkPriv(selectMode) line
+ tkTextSelectTo %W %x %y
+ catch {%W mark set insert sel.first}
+}
+bind Text {
+ tkTextResetAnchor %W @%x,%y
+ set tkPriv(selectMode) char
+ tkTextSelectTo %W %x %y
+}
+bind Text {
+ set tkPriv(selectMode) word
+ tkTextSelectTo %W %x %y
+}
+bind Text {
+ set tkPriv(selectMode) line
+ tkTextSelectTo %W %x %y
+}
+bind Text {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ tkTextAutoScan %W
+}
+bind Text {
+ tkCancelRepeat
+}
+bind Text {
+ tkCancelRepeat
+}
+bind Text {
+ %W mark set insert @%x,%y
+}
+bind Text {
+ tkTextSetCursor %W insert-1c
+}
+bind Text {
+ tkTextSetCursor %W insert+1c
+}
+bind Text {
+ tkTextSetCursor %W [tkTextUpDownLine %W -1]
+}
+bind Text {
+ tkTextSetCursor %W [tkTextUpDownLine %W 1]
+}
+bind Text {
+ tkTextKeySelect %W [%W index {insert - 1c}]
+}
+bind Text {
+ tkTextKeySelect %W [%W index {insert + 1c}]
+}
+bind Text {
+ tkTextKeySelect %W [tkTextUpDownLine %W -1]
+}
+bind Text {
+ tkTextKeySelect %W [tkTextUpDownLine %W 1]
+}
+bind Text {
+ tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
+}
+bind Text {
+ tkTextSetCursor %W [tkTextNextWord %W insert]
+}
+bind Text {
+ tkTextSetCursor %W [tkTextPrevPara %W insert]
+}
+bind Text {
+ tkTextSetCursor %W [tkTextNextPara %W insert]
+}
+bind Text {
+ tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
+}
+bind Text {
+ tkTextKeySelect %W [tkTextNextWord %W insert]
+}
+bind Text {
+ tkTextKeySelect %W [tkTextPrevPara %W insert]
+}
+bind Text {
+ tkTextKeySelect %W [tkTextNextPara %W insert]
+}
+bind Text {
+ tkTextSetCursor %W [tkTextScrollPages %W -1]
+}
+bind Text {
+ tkTextKeySelect %W [tkTextScrollPages %W -1]
+}
+bind Text {
+ tkTextSetCursor %W [tkTextScrollPages %W 1]
+}
+bind Text {
+ tkTextKeySelect %W [tkTextScrollPages %W 1]
+}
+bind Text {
+ %W xview scroll -1 page
+}
+bind Text {
+ %W xview scroll 1 page
+}
+
+bind Text {
+ tkTextSetCursor %W {insert linestart}
+}
+bind Text {
+ tkTextKeySelect %W {insert linestart}
+}
+bind Text {
+ tkTextSetCursor %W {insert lineend}
+}
+bind Text {
+ tkTextKeySelect %W {insert lineend}
+}
+bind Text {
+ tkTextSetCursor %W 1.0
+}
+bind Text {
+ tkTextKeySelect %W 1.0
+}
+bind Text {
+ tkTextSetCursor %W {end - 1 char}
+}
+bind Text {
+ tkTextKeySelect %W {end - 1 char}
+}
+
+bind Text {
+ tkTextInsert %W \t
+ focus %W
+ break
+}
+bind Text {
+ # Needed only to keep binding from triggering; doesn't
+ # have to actually do anything.
+ break
+}
+bind Text {
+ focus [tk_focusNext %W]
+}
+bind Text {
+ focus [tk_focusPrev %W]
+}
+bind Text {
+ tkTextInsert %W \t
+}
+bind Text {
+ tkTextInsert %W \n
+}
+bind Text {
+ if {[%W tag nextrange sel 1.0 end] != ""} {
+ %W delete sel.first sel.last
+ } else {
+ %W delete insert
+ %W see insert
+ }
+}
+bind Text {
+ if {[%W tag nextrange sel 1.0 end] != ""} {
+ %W delete sel.first sel.last
+ } elseif {[%W compare insert != 1.0]} {
+ %W delete insert-1c
+ %W see insert
+ }
+}
+
+bind Text {
+ %W mark set anchor insert
+}
+bind Text
text.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: images/logoLarge.gif
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: images/logoLarge.gif
===================================================================
--- images/logoLarge.gif (nonexistent)
+++ images/logoLarge.gif (revision 1765)
images/logoLarge.gif
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Index: images/pwrdLogo100.gif
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: images/pwrdLogo100.gif
===================================================================
--- images/pwrdLogo100.gif (nonexistent)
+++ images/pwrdLogo100.gif (revision 1765)
images/pwrdLogo100.gif
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Index: images/pwrdLogo200.gif
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: images/pwrdLogo200.gif
===================================================================
--- images/pwrdLogo200.gif (nonexistent)
+++ images/pwrdLogo200.gif (revision 1765)
images/pwrdLogo200.gif
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Index: images/logo100.gif
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: images/logo100.gif
===================================================================
--- images/logo100.gif (nonexistent)
+++ images/logo100.gif (revision 1765)
images/logo100.gif
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Index: images/pwrdLogo150.gif
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: images/pwrdLogo150.gif
===================================================================
--- images/pwrdLogo150.gif (nonexistent)
+++ images/pwrdLogo150.gif (revision 1765)
images/pwrdLogo150.gif
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Index: images/logoMed.gif
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: images/logoMed.gif
===================================================================
--- images/logoMed.gif (nonexistent)
+++ images/logoMed.gif (revision 1765)
images/logoMed.gif
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Index: images/README
===================================================================
--- images/README (nonexistent)
+++ images/README (revision 1765)
@@ -0,0 +1,12 @@
+README - images directory
+
+SCCS: @(#) README 1.1 97/08/06 13:19:19
+
+
+This directory includes images for the Tcl Logo and the Tcl Powered
+Logo. Please feel free to use the Tcl Powered Logo on any of your
+products that employ the use of Tcl or Tk. The Tcl logo may also be
+used to promote Tcl in your product documentation, web site or other
+places you so desire.
+
+
images/README
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: images/pwrdLogo75.gif
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: images/pwrdLogo75.gif
===================================================================
--- images/pwrdLogo75.gif (nonexistent)
+++ images/pwrdLogo75.gif (revision 1765)
images/pwrdLogo75.gif
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Index: images/logo64.gif
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: images/logo64.gif
===================================================================
--- images/logo64.gif (nonexistent)
+++ images/logo64.gif (revision 1765)
images/logo64.gif
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Index: images/pwrdLogo175.gif
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: images/pwrdLogo175.gif
===================================================================
--- images/pwrdLogo175.gif (nonexistent)
+++ images/pwrdLogo175.gif (revision 1765)
images/pwrdLogo175.gif
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Index: tearoff.tcl
===================================================================
--- tearoff.tcl (nonexistent)
+++ tearoff.tcl (revision 1765)
@@ -0,0 +1,145 @@
+# tearoff.tcl --
+#
+# This file contains procedures that implement tear-off menus.
+#
+# SCCS: @(#) tearoff.tcl 1.20 97/08/21 14:49:27
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+# tkTearoffMenu --
+# Given the name of a menu, this procedure creates a torn-off menu
+# that is identical to the given menu (including nested submenus).
+# The new torn-off menu exists as a toplevel window managed by the
+# window manager. The return value is the name of the new menu.
+# The window is created at the point specified by x and y
+#
+# Arguments:
+# w - The menu to be torn-off (duplicated).
+# x - x coordinate where window is created
+# y - y coordinate where window is created
+
+proc tkTearOffMenu {w {x 0} {y 0}} {
+ # Find a unique name to use for the torn-off menu. Find the first
+ # ancestor of w that is a toplevel but not a menu, and use this as
+ # the parent of the new menu. This guarantees that the torn off
+ # menu will be on the same screen as the original menu. By making
+ # it a child of the ancestor, rather than a child of the menu, it
+ # can continue to live even if the menu is deleted; it will go
+ # away when the toplevel goes away.
+
+ if {$x == 0} {
+ set x [winfo rootx $w]
+ }
+ if {$y == 0} {
+ set y [winfo rooty $w]
+ }
+
+ set parent [winfo parent $w]
+ while {([winfo toplevel $parent] != $parent)
+ || ([winfo class $parent] == "Menu")} {
+ set parent [winfo parent $parent]
+ }
+ if {$parent == "."} {
+ set parent ""
+ }
+ for {set i 1} 1 {incr i} {
+ set menu $parent.tearoff$i
+ if {![winfo exists $menu]} {
+ break
+ }
+ }
+
+ $w clone $menu tearoff
+
+ # Pick a title for the new menu by looking at the parent of the
+ # original: if the parent is a menu, then use the text of the active
+ # entry. If it's a menubutton then use its text.
+
+ set parent [winfo parent $w]
+ if {[$menu cget -title] != ""} {
+ wm title $menu [$menu cget -title]
+ } else {
+ switch [winfo class $parent] {
+ Menubutton {
+ wm title $menu [$parent cget -text]
+ }
+ Menu {
+ wm title $menu [$parent entrycget active -label]
+ }
+ }
+ }
+
+ $menu post $x $y
+
+ if {[winfo exists $menu] == 0} {
+ return ""
+ }
+
+ # Set tkPriv(focus) on entry: otherwise the focus will get lost
+ # after keyboard invocation of a sub-menu (it will stay on the
+ # submenu).
+
+ bind $menu {
+ set tkPriv(focus) %W
+ }
+
+ # If there is a -tearoffcommand option for the menu, invoke it
+ # now.
+
+ set cmd [$w cget -tearoffcommand]
+ if {$cmd != ""} {
+ uplevel #0 $cmd $w $menu
+ }
+ return $menu
+}
+
+# tkMenuDup --
+# Given a menu (hierarchy), create a duplicate menu (hierarchy)
+# in a given window.
+#
+# Arguments:
+# src - Source window. Must be a menu. It and its
+# menu descendants will be duplicated at dst.
+# dst - Name to use for topmost menu in duplicate
+# hierarchy.
+
+proc tkMenuDup {src dst type} {
+ set cmd [list menu $dst -type $type]
+ foreach option [$src configure] {
+ if {[llength $option] == 2} {
+ continue
+ }
+ if {[string compare [lindex $option 0] "-type"] == 0} {
+ continue
+ }
+ lappend cmd [lindex $option 0] [lindex $option 4]
+ }
+ eval $cmd
+ set last [$src index last]
+ if {$last == "none"} {
+ return
+ }
+ for {set i [$src cget -tearoff]} {$i <= $last} {incr i} {
+ set cmd [list $dst add [$src type $i]]
+ foreach option [$src entryconfigure $i] {
+ lappend cmd [lindex $option 0] [lindex $option 4]
+ }
+ eval $cmd
+ }
+
+ # Duplicate the binding tags and bindings from the source menu.
+
+ regsub -all . $src {\\&} quotedSrc
+ regsub -all . $dst {\\&} quotedDst
+ regsub -all $quotedSrc [bindtags $src] $dst x
+ bindtags $dst $x
+ foreach event [bind $src] {
+ regsub -all $quotedSrc [bind $src $event] $dst x
+ bind $dst $event $x
+ }
+}
tearoff.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/msgbox.tcl
===================================================================
--- demos/msgbox.tcl (nonexistent)
+++ demos/msgbox.tcl (revision 1765)
@@ -0,0 +1,65 @@
+# msgbox.tcl --
+#
+# This demonstration script creates message boxes of various type
+#
+# SCCS: @(#) msgbox.tcl 1.3 97/03/02 16:26:07
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .msgbox
+catch {destroy $w}
+toplevel $w
+wm title $w "Message Box Demonstration"
+wm iconname $w "messagebox"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "Choose the icon and type option of the message box. Then press the \"Message Box\" button to see the message box."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+button $w.buttons.vars -text "Message Box" \
+ -command "showMessageBox $w"
+pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1
+
+frame $w.left
+frame $w.right
+pack $w.left $w.right -side left -expand yes -fill y -pady .5c -padx .5c
+
+label $w.left.label -text "Icon"
+frame $w.left.sep -relief ridge -bd 1 -height 2
+pack $w.left.label -side top
+pack $w.left.sep -side top -fill x -expand no
+
+set msgboxIcon info
+foreach i {error info question warning} {
+ radiobutton $w.left.b$i -text $i -variable msgboxIcon \
+ -relief flat -value $i -width 16 -anchor w
+ pack $w.left.b$i -side top -pady 2 -anchor w -fill x
+}
+
+label $w.right.label -text "Type"
+frame $w.right.sep -relief ridge -bd 1 -height 2
+pack $w.right.label -side top
+pack $w.right.sep -side top -fill x -expand no
+
+set msgboxType ok
+foreach t {abortretryignore ok okcancel retrycancel yesno yesnocancel} {
+ radiobutton $w.right.$t -text $t -variable msgboxType \
+ -relief flat -value $t -width 16 -anchor w
+ pack $w.right.$t -side top -pady 2 -anchor w -fill x
+}
+
+proc showMessageBox {w} {
+ global msgboxIcon msgboxType
+ set button [tk_messageBox -icon $msgboxIcon -type $msgboxType \
+ -title Message -parent $w\
+ -message "This is a \"$msgboxType\" type messagebox with the \"$msgboxIcon\" icon"]
+
+ tk_messageBox -icon info -message "You have selected \"$button\"" -type ok\
+ -parent $w
+}
demos/msgbox.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/style.tcl
===================================================================
--- demos/style.tcl (nonexistent)
+++ demos/style.tcl (revision 1765)
@@ -0,0 +1,152 @@
+# style.tcl --
+#
+# This demonstration script creates a text widget that illustrates the
+# various display styles that may be set for tags.
+#
+# SCCS: @(#) style.tcl 1.8 97/04/18 11:41:47
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .style
+catch {destroy $w}
+toplevel $w
+wm title $w "Text Demonstration - Display Styles"
+wm iconname $w "style"
+positionWindow $w
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+text $w.text -yscrollcommand "$w.scroll set" -setgrid true \
+ -width 70 -height 32 -wrap word
+scrollbar $w.scroll -command "$w.text yview"
+pack $w.scroll -side right -fill y
+pack $w.text -expand yes -fill both
+
+# Set up display styles
+
+$w.text tag configure bold -font {Courier 12 bold italic}
+$w.text tag configure big -font {Courier 14 bold}
+$w.text tag configure verybig -font {Helvetica 24 bold}
+if {[winfo depth $w] > 1} {
+ $w.text tag configure color1 -background #a0b7ce
+ $w.text tag configure color2 -foreground red
+ $w.text tag configure raised -relief raised -borderwidth 1
+ $w.text tag configure sunken -relief sunken -borderwidth 1
+} else {
+ $w.text tag configure color1 -background black -foreground white
+ $w.text tag configure color2 -background black -foreground white
+ $w.text tag configure raised -background white -relief raised \
+ -borderwidth 1
+ $w.text tag configure sunken -background white -relief sunken \
+ -borderwidth 1
+}
+$w.text tag configure bgstipple -background black -borderwidth 0 \
+ -bgstipple gray12
+$w.text tag configure fgstipple -fgstipple gray50
+$w.text tag configure underline -underline on
+$w.text tag configure overstrike -overstrike on
+$w.text tag configure right -justify right
+$w.text tag configure center -justify center
+$w.text tag configure super -offset 4p -font {Courier 10}
+$w.text tag configure sub -offset -2p -font {Courier 10}
+$w.text tag configure margins -lmargin1 12m -lmargin2 6m -rmargin 10m
+$w.text tag configure spacing -spacing1 10p -spacing2 2p \
+ -lmargin1 12m -lmargin2 6m -rmargin 10m
+
+$w.text insert end {Text widgets like this one allow you to display information in a
+variety of styles. Display styles are controlled using a mechanism
+called }
+$w.text insert end tags bold
+$w.text insert end {. Tags are just textual names that you can apply to one
+or more ranges of characters within a text widget. You can configure
+tags with various display styles. If you do this, then the tagged
+characters will be displayed with the styles you chose. The
+available display styles are:
+}
+$w.text insert end "\n1. Font." big
+$w.text insert end " You can choose any X font, "
+$w.text insert end large verybig
+$w.text insert end " or "
+$w.text insert end "small.\n"
+$w.text insert end "\n2. Color." big
+$w.text insert end " You can change either the "
+$w.text insert end background color1
+$w.text insert end " or "
+$w.text insert end foreground color2
+$w.text insert end "\ncolor, or "
+$w.text insert end both {color1 color2}
+$w.text insert end ".\n"
+$w.text insert end "\n3. Stippling." big
+$w.text insert end " You can cause either the "
+$w.text insert end background bgstipple
+$w.text insert end " or "
+$w.text insert end foreground fgstipple
+$w.text insert end {
+information to be drawn with a stipple fill instead of a solid fill.
+}
+$w.text insert end "\n4. Underlining." big
+$w.text insert end " You can "
+$w.text insert end underline underline
+$w.text insert end " ranges of text.\n"
+$w.text insert end "\n5. Overstrikes." big
+$w.text insert end " You can "
+$w.text insert end "draw lines through" overstrike
+$w.text insert end " ranges of text.\n"
+$w.text insert end "\n6. 3-D effects." big
+$w.text insert end { You can arrange for the background to be drawn
+with a border that makes characters appear either }
+$w.text insert end raised raised
+$w.text insert end " or "
+$w.text insert end sunken sunken
+$w.text insert end ".\n"
+$w.text insert end "\n7. Justification." big
+$w.text insert end " You can arrange for lines to be displayed\n"
+$w.text insert end "left-justified,\n"
+$w.text insert end "right-justified, or\n" right
+$w.text insert end "centered.\n" center
+$w.text insert end "\n8. Superscripts and subscripts." big
+$w.text insert end " You can control the vertical\n"
+$w.text insert end "position of text to generate superscript effects like 10"
+$w.text insert end "n" super
+$w.text insert end " or\nsubscript effects like X"
+$w.text insert end "i" sub
+$w.text insert end ".\n"
+$w.text insert end "\n9. Margins." big
+$w.text insert end " You can control the amount of extra space left"
+$w.text insert end " on\neach side of the text:\n"
+$w.text insert end "This paragraph is an example of the use of " margins
+$w.text insert end "margins. It consists of a single line of text " margins
+$w.text insert end "that wraps around on the screen. There are two " margins
+$w.text insert end "separate left margin values, one for the first " margins
+$w.text insert end "display line associated with the text line, " margins
+$w.text insert end "and one for the subsequent display lines, which " margins
+$w.text insert end "occur because of wrapping. There is also a " margins
+$w.text insert end "separate specification for the right margin, " margins
+$w.text insert end "which is used to choose wrap points for lines.\n" margins
+$w.text insert end "\n10. Spacing." big
+$w.text insert end " You can control the spacing of lines with three\n"
+$w.text insert end "separate parameters. \"Spacing1\" tells how much "
+$w.text insert end "extra space to leave\nabove a line, \"spacing3\" "
+$w.text insert end "tells how much space to leave below a line,\nand "
+$w.text insert end "if a text line wraps, \"spacing2\" tells how much "
+$w.text insert end "space to leave\nbetween the display lines that "
+$w.text insert end "make up the text line.\n"
+$w.text insert end "These indented paragraphs illustrate how spacing " spacing
+$w.text insert end "can be used. Each paragraph is actually a " spacing
+$w.text insert end "single line in the text widget, which is " spacing
+$w.text insert end "word-wrapped by the widget.\n" spacing
+$w.text insert end "Spacing1 is set to 10 points for this text, " spacing
+$w.text insert end "which results in relatively large gaps between " spacing
+$w.text insert end "the paragraphs. Spacing2 is set to 2 points, " spacing
+$w.text insert end "which results in just a bit of extra space " spacing
+$w.text insert end "within a pararaph. Spacing3 isn't used " spacing
+$w.text insert end "in this example.\n" spacing
+$w.text insert end "To see where the space is, select ranges of " spacing
+$w.text insert end "text within these paragraphs. The selection " spacing
+$w.text insert end "highlight will cover the extra space." spacing
demos/style.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/colors.tcl
===================================================================
--- demos/colors.tcl (nonexistent)
+++ demos/colors.tcl (revision 1765)
@@ -0,0 +1,101 @@
+# colors.tcl --
+#
+# This demonstration script creates a listbox widget that displays
+# many of the colors from the X color database. You can click on
+# a color to change the application's palette.
+#
+# SCCS: @(#) colors.tcl 1.4 97/03/02 16:20:29
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .colors
+catch {destroy $w}
+toplevel $w
+wm title $w "Listbox Demonstration (colors)"
+wm iconname $w "Listbox"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "A listbox containing several color names is displayed below, along with a scrollbar. You can scan the list either using the scrollbar or by dragging in the listbox window with button 2 pressed. If you double-click button 1 on a color, then the application's color palette will be set to match that color"
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.frame -borderwidth 10
+pack $w.frame -side top -expand yes -fill y
+
+scrollbar $w.frame.scroll -command "$w.frame.list yview"
+listbox $w.frame.list -yscroll "$w.frame.scroll set" \
+ -width 20 -height 16 -setgrid 1
+pack $w.frame.list $w.frame.scroll -side left -fill y -expand 1
+
+bind $w.frame.list {
+ tk_setPalette [selection get]
+}
+$w.frame.list insert 0 gray60 gray70 gray80 gray85 gray90 gray95 \
+ snow1 snow2 snow3 snow4 seashell1 seashell2 \
+ seashell3 seashell4 AntiqueWhite1 AntiqueWhite2 AntiqueWhite3 \
+ AntiqueWhite4 bisque1 bisque2 bisque3 bisque4 PeachPuff1 \
+ PeachPuff2 PeachPuff3 PeachPuff4 NavajoWhite1 NavajoWhite2 \
+ NavajoWhite3 NavajoWhite4 LemonChiffon1 LemonChiffon2 \
+ LemonChiffon3 LemonChiffon4 cornsilk1 cornsilk2 cornsilk3 \
+ cornsilk4 ivory1 ivory2 ivory3 ivory4 honeydew1 honeydew2 \
+ honeydew3 honeydew4 LavenderBlush1 LavenderBlush2 \
+ LavenderBlush3 LavenderBlush4 MistyRose1 MistyRose2 \
+ MistyRose3 MistyRose4 azure1 azure2 azure3 azure4 \
+ SlateBlue1 SlateBlue2 SlateBlue3 SlateBlue4 RoyalBlue1 \
+ RoyalBlue2 RoyalBlue3 RoyalBlue4 blue1 blue2 blue3 blue4 \
+ DodgerBlue1 DodgerBlue2 DodgerBlue3 DodgerBlue4 SteelBlue1 \
+ SteelBlue2 SteelBlue3 SteelBlue4 DeepSkyBlue1 DeepSkyBlue2 \
+ DeepSkyBlue3 DeepSkyBlue4 SkyBlue1 SkyBlue2 SkyBlue3 \
+ SkyBlue4 LightSkyBlue1 LightSkyBlue2 LightSkyBlue3 \
+ LightSkyBlue4 SlateGray1 SlateGray2 SlateGray3 SlateGray4 \
+ LightSteelBlue1 LightSteelBlue2 LightSteelBlue3 \
+ LightSteelBlue4 LightBlue1 LightBlue2 LightBlue3 \
+ LightBlue4 LightCyan1 LightCyan2 LightCyan3 LightCyan4 \
+ PaleTurquoise1 PaleTurquoise2 PaleTurquoise3 PaleTurquoise4 \
+ CadetBlue1 CadetBlue2 CadetBlue3 CadetBlue4 turquoise1 \
+ turquoise2 turquoise3 turquoise4 cyan1 cyan2 cyan3 cyan4 \
+ DarkSlateGray1 DarkSlateGray2 DarkSlateGray3 \
+ DarkSlateGray4 aquamarine1 aquamarine2 aquamarine3 \
+ aquamarine4 DarkSeaGreen1 DarkSeaGreen2 DarkSeaGreen3 \
+ DarkSeaGreen4 SeaGreen1 SeaGreen2 SeaGreen3 SeaGreen4 \
+ PaleGreen1 PaleGreen2 PaleGreen3 PaleGreen4 SpringGreen1 \
+ SpringGreen2 SpringGreen3 SpringGreen4 green1 green2 \
+ green3 green4 chartreuse1 chartreuse2 chartreuse3 \
+ chartreuse4 OliveDrab1 OliveDrab2 OliveDrab3 OliveDrab4 \
+ DarkOliveGreen1 DarkOliveGreen2 DarkOliveGreen3 \
+ DarkOliveGreen4 khaki1 khaki2 khaki3 khaki4 \
+ LightGoldenrod1 LightGoldenrod2 LightGoldenrod3 \
+ LightGoldenrod4 LightYellow1 LightYellow2 LightYellow3 \
+ LightYellow4 yellow1 yellow2 yellow3 yellow4 gold1 gold2 \
+ gold3 gold4 goldenrod1 goldenrod2 goldenrod3 goldenrod4 \
+ DarkGoldenrod1 DarkGoldenrod2 DarkGoldenrod3 DarkGoldenrod4 \
+ RosyBrown1 RosyBrown2 RosyBrown3 RosyBrown4 IndianRed1 \
+ IndianRed2 IndianRed3 IndianRed4 sienna1 sienna2 sienna3 \
+ sienna4 burlywood1 burlywood2 burlywood3 burlywood4 wheat1 \
+ wheat2 wheat3 wheat4 tan1 tan2 tan3 tan4 chocolate1 \
+ chocolate2 chocolate3 chocolate4 firebrick1 firebrick2 \
+ firebrick3 firebrick4 brown1 brown2 brown3 brown4 salmon1 \
+ salmon2 salmon3 salmon4 LightSalmon1 LightSalmon2 \
+ LightSalmon3 LightSalmon4 orange1 orange2 orange3 orange4 \
+ DarkOrange1 DarkOrange2 DarkOrange3 DarkOrange4 coral1 \
+ coral2 coral3 coral4 tomato1 tomato2 tomato3 tomato4 \
+ OrangeRed1 OrangeRed2 OrangeRed3 OrangeRed4 red1 red2 red3 \
+ red4 DeepPink1 DeepPink2 DeepPink3 DeepPink4 HotPink1 \
+ HotPink2 HotPink3 HotPink4 pink1 pink2 pink3 pink4 \
+ LightPink1 LightPink2 LightPink3 LightPink4 PaleVioletRed1 \
+ PaleVioletRed2 PaleVioletRed3 PaleVioletRed4 maroon1 \
+ maroon2 maroon3 maroon4 VioletRed1 VioletRed2 VioletRed3 \
+ VioletRed4 magenta1 magenta2 magenta3 magenta4 orchid1 \
+ orchid2 orchid3 orchid4 plum1 plum2 plum3 plum4 \
+ MediumOrchid1 MediumOrchid2 MediumOrchid3 MediumOrchid4 \
+ DarkOrchid1 DarkOrchid2 DarkOrchid3 DarkOrchid4 purple1 \
+ purple2 purple3 purple4 MediumPurple1 MediumPurple2 \
+ MediumPurple3 MediumPurple4 thistle1 thistle2 thistle3 \
+ thistle4
demos/colors.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/widget
===================================================================
--- demos/widget (nonexistent)
+++ demos/widget (revision 1765)
@@ -0,0 +1,391 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+# widget --
+# This script demonstrates the various widgets provided by Tk,
+# along with many of the features of the Tk toolkit. This file
+# only contains code to generate the main window for the
+# application, which invokes individual demonstrations. The
+# code for the actual demonstrations is contained in separate
+# ".tcl" files is this directory, which are sourced by this script
+# as needed.
+#
+# SCCS: @(#) widget 1.35 97/07/19 15:42:22
+
+eval destroy [winfo child .]
+wm title . "Widget Demonstration"
+set widgetDemo 1
+
+#----------------------------------------------------------------
+# The code below create the main window, consisting of a menu bar
+# and a text widget that explains how to use the program, plus lists
+# all of the demos as hypertext items.
+#----------------------------------------------------------------
+
+set font {Helvetica 14}
+menu .menuBar -tearoff 0
+.menuBar add cascade -menu .menuBar.file -label "File" -underline 0
+menu .menuBar.file -tearoff 0
+
+# On the Mac use the specia .apple menu for the about item
+if {$tcl_platform(platform) == "macintosh"} {
+ .menuBar add cascade -menu .menuBar.apple
+ menu .menuBar.apple -tearoff 0
+ .menuBar.apple add command -label "About..." -command "aboutBox"
+} else {
+ .menuBar.file add command -label "About..." -command "aboutBox" \
+ -underline 0 -accelerator ""
+ .menuBar.file add sep
+}
+
+.menuBar.file add command -label "Quit" -command "exit" -underline 0 \
+ -accelerator "Meta-Q"
+. configure -menu .menuBar
+bind . aboutBox
+
+frame .statusBar
+label .statusBar.lab -text " " -relief sunken -bd 1 \
+ -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w
+label .statusBar.foo -width 8 -relief sunken -bd 1 \
+ -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w
+pack .statusBar.lab -side left -padx 2 -expand yes -fill both
+pack .statusBar.foo -side left -padx 2
+pack .statusBar -side bottom -fill x -pady 2
+
+frame .textFrame
+scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \
+ -takefocus 1
+pack .s -in .textFrame -side right -fill y
+text .t -yscrollcommand {.s set} -wrap word -width 60 -height 30 -font $font \
+ -setgrid 1 -highlightthickness 0 -padx 4 -pady 2 -takefocus 0
+pack .t -in .textFrame -expand y -fill both -padx 1
+pack .textFrame -expand yes -fill both
+
+# Create a bunch of tags to use in the text widget, such as those for
+# section titles and demo descriptions. Also define the bindings for
+# tags.
+
+.t tag configure title -font {Helvetica 18 bold}
+
+# We put some "space" characters to the left and right of each demo description
+# so that the descriptions are highlighted only when the mouse cursor
+# is right over them (but not when the cursor is to their left or right)
+#
+.t tag configure demospace -lmargin1 1c -lmargin2 1c
+
+
+if {[winfo depth .] == 1} {
+ .t tag configure demo -lmargin1 1c -lmargin2 1c \
+ -underline 1
+ .t tag configure visited -lmargin1 1c -lmargin2 1c \
+ -underline 1
+ .t tag configure hot -background black -foreground white
+} else {
+ .t tag configure demo -lmargin1 1c -lmargin2 1c \
+ -foreground blue -underline 1
+ .t tag configure visited -lmargin1 1c -lmargin2 1c \
+ -foreground #303080 -underline 1
+ .t tag configure hot -foreground red -underline 1
+}
+.t tag bind demo {
+ invoke [.t index {@%x,%y}]
+}
+set lastLine ""
+.t tag bind demo {
+ set lastLine [.t index {@%x,%y linestart}]
+ .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
+ .t config -cursor hand2
+ showStatus [.t index {@%x,%y}]
+}
+.t tag bind demo {
+ .t tag remove hot 1.0 end
+ .t config -cursor xterm
+ .statusBar.lab config -text ""
+}
+.t tag bind demo {
+ set newLine [.t index {@%x,%y linestart}]
+ if {[string compare $newLine $lastLine] != 0} {
+ .t tag remove hot 1.0 end
+ set lastLine $newLine
+
+ set tags [.t tag names {@%x,%y}]
+ set i [lsearch -glob $tags demo-*]
+ if {$i >= 0} {
+ .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
+ }
+ }
+ showStatus [.t index {@%x,%y}]
+}
+
+# Create the text for the text widget.
+
+.t insert end "Tk Widget Demonstrations\n" title
+.t insert end {
+This application provides a front end for several short scripts that demonstrate what you can do with Tk widgets. Each of the numbered lines below describes a demonstration; you can click on it to invoke the demonstration. Once the demonstration window appears, you can click the "See Code" button to see the Tcl/Tk code that created the demonstration. If you wish, you can edit the code and click the "Rerun Demo" button in the code window to reinvoke the demonstration with the modified code.
+
+}
+.t insert end "Labels, buttons, checkbuttons, and radiobuttons" title
+.t insert end " \n " {demospace}
+.t insert end "1. Labels (text and bitmaps)." {demo demo-label}
+.t insert end " \n " {demospace}
+.t insert end "2. Buttons." {demo demo-button}
+.t insert end " \n " {demospace}
+.t insert end "3. Checkbuttons (select any of a group)." {demo demo-check}
+.t insert end " \n " {demospace}
+.t insert end "4. Radiobuttons (select one of a group)." {demo demo-radio}
+.t insert end " \n " {demospace}
+.t insert end "5. A 15-puzzle game made out of buttons." {demo demo-puzzle}
+.t insert end " \n " {demospace}
+.t insert end "6. Iconic buttons that use bitmaps." {demo demo-icon}
+.t insert end " \n " {demospace}
+.t insert end "7. Two labels displaying images." {demo demo-image1}
+.t insert end " \n " {demospace}
+.t insert end "8. A simple user interface for viewing images." \
+ {demo demo-image2}
+.t insert end " \n " {demospace}
+
+.t insert end \n {} "Listboxes" title
+.t insert end " \n " {demospace}
+.t insert end "1. 50 states." {demo demo-states}
+.t insert end " \n " {demospace}
+.t insert end "2. Colors: change the color scheme for the application." \
+ {demo demo-colors}
+.t insert end " \n " {demospace}
+.t insert end "3. A collection of famous sayings." {demo demo-sayings}
+.t insert end " \n " {demospace}
+
+.t insert end \n {} "Entries" title
+.t insert end " \n " {demospace}
+.t insert end "1. Without scrollbars." {demo demo-entry1}
+.t insert end " \n " {demospace}
+.t insert end "2. With scrollbars." {demo demo-entry2}
+.t insert end " \n " {demospace}
+.t insert end "3. Simple Rolodex-like form." {demo demo-form}
+.t insert end " \n " {demospace}
+
+.t insert end \n {} "Text" title
+.t insert end " \n " {demospace}
+.t insert end "1. Basic editable text." {demo demo-text}
+.t insert end " \n " {demospace}
+.t insert end "2. Text display styles." {demo demo-style}
+.t insert end " \n " {demospace}
+.t insert end "3. Hypertext (tag bindings)." {demo demo-bind}
+.t insert end " \n " {demospace}
+.t insert end "4. A text widget with embedded windows." {demo demo-twind}
+.t insert end " \n " {demospace}
+.t insert end "5. A search tool built with a text widget." {demo demo-search}
+.t insert end " \n " {demospace}
+
+.t insert end \n {} "Canvases" title
+.t insert end " \n " {demospace}
+.t insert end "1. The canvas item types." {demo demo-items}
+.t insert end " \n " {demospace}
+.t insert end "2. A simple 2-D plot." {demo demo-plot}
+.t insert end " \n " {demospace}
+.t insert end "3. Text items in canvases." {demo demo-ctext}
+.t insert end " \n " {demospace}
+.t insert end "4. An editor for arrowheads on canvas lines." {demo demo-arrow}
+.t insert end " \n " {demospace}
+.t insert end "5. A ruler with adjustable tab stops." {demo demo-ruler}
+.t insert end " \n " {demospace}
+.t insert end "6. A building floor plan." {demo demo-floor}
+.t insert end " \n " {demospace}
+.t insert end "7. A simple scrollable canvas." {demo demo-cscroll}
+.t insert end " \n " {demospace}
+
+.t insert end \n {} "Scales" title
+.t insert end " \n " {demospace}
+.t insert end "1. Vertical scale." {demo demo-vscale}
+.t insert end " \n " {demospace}
+.t insert end "2. Horizontal scale." {demo demo-hscale}
+.t insert end " \n " {demospace}
+
+.t insert end \n {} "Menus" title
+.t insert end " \n " {demospace}
+.t insert end "1. Menus and cascades." \
+ {demo demo-menu}
+.t insert end " \n " {demospace}
+.t insert end "2. Menubuttons"\
+ {demo demo-menubu}
+.t insert end " \n " {demospace}
+
+.t insert end \n {} "Common Dialogs" title
+.t insert end " \n " {demospace}
+.t insert end "1. Message boxes." {demo demo-msgbox}
+.t insert end " \n " {demospace}
+.t insert end "2. File selection dialog." {demo demo-filebox}
+.t insert end " \n " {demospace}
+.t insert end "3. Color picker." {demo demo-clrpick}
+.t insert end " \n " {demospace}
+
+.t insert end \n {} "Miscellaneous" title
+.t insert end " \n " {demospace}
+.t insert end "1. The built-in bitmaps." {demo demo-bitmap}
+.t insert end " \n " {demospace}
+.t insert end "2. A dialog box with a local grab." {demo demo-dialog1}
+.t insert end " \n " {demospace}
+.t insert end "3. A dialog box with a global grab." {demo demo-dialog2}
+.t insert end " \n " {demospace}
+
+.t configure -state disabled
+focus .s
+
+# positionWindow --
+# This procedure is invoked by most of the demos to position a
+# new demo window.
+#
+# Arguments:
+# w - The name of the window to position.
+
+proc positionWindow w {
+ wm geometry $w +300+300
+}
+
+# showVars --
+# Displays the values of one or more variables in a window, and
+# updates the display whenever any of the variables changes.
+#
+# Arguments:
+# w - Name of new window to create for display.
+# args - Any number of names of variables.
+
+proc showVars {w args} {
+ catch {destroy $w}
+ toplevel $w
+ wm title $w "Variable values"
+ label $w.title -text "Variable values:" -width 20 -anchor center \
+ -font {Helvetica 18}
+ pack $w.title -side top -fill x
+ set len 1
+ foreach i $args {
+ if {[string length $i] > $len} {
+ set len [string length $i]
+ }
+ }
+ foreach i $args {
+ frame $w.$i
+ label $w.$i.name -text "$i: " -width [expr $len + 2] -anchor w
+ label $w.$i.value -textvar $i -anchor w
+ pack $w.$i.name -side left
+ pack $w.$i.value -side left -expand 1 -fill x
+ pack $w.$i -side top -anchor w -fill x
+ }
+ button $w.ok -text OK -command "destroy $w" -default active
+ bind $w "tkButtonInvoke $w.ok"
+ pack $w.ok -side bottom -pady 2
+}
+
+# invoke --
+# This procedure is called when the user clicks on a demo description.
+# It is responsible for invoking the demonstration.
+#
+# Arguments:
+# index - The index of the character that the user clicked on.
+
+proc invoke index {
+ global tk_library
+ set tags [.t tag names $index]
+ set i [lsearch -glob $tags demo-*]
+ if {$i < 0} {
+ return
+ }
+ set cursor [.t cget -cursor]
+ .t configure -cursor watch
+ update
+ set demo [string range [lindex $tags $i] 5 end]
+ uplevel [list source [file join $tk_library demos $demo.tcl]]
+ update
+ .t configure -cursor $cursor
+
+ .t tag add visited "$index linestart +1 chars" "$index lineend -1 chars"
+}
+
+# showStatus --
+#
+# Show the name of the demo program in the status bar. This procedure
+# is called when the user moves the cursor over a demo description.
+#
+proc showStatus index {
+ global tk_library
+ set tags [.t tag names $index]
+ set i [lsearch -glob $tags demo-*]
+ set cursor [.t cget -cursor]
+ if {$i < 0} {
+ .statusBar.lab config -text " "
+ set newcursor xterm
+ } else {
+ set demo [string range [lindex $tags $i] 5 end]
+ .statusBar.lab config -text "Run the \"$demo\" sample program"
+ set newcursor hand2
+ }
+ if [string compare $cursor $newcursor] {
+ .t config -cursor $newcursor
+ }
+}
+
+
+# showCode --
+# This procedure creates a toplevel window that displays the code for
+# a demonstration and allows it to be edited and reinvoked.
+#
+# Arguments:
+# w - The name of the demonstration's window, which can be
+# used to derive the name of the file containing its code.
+
+proc showCode w {
+ global tk_library
+ set file [string range $w 1 end].tcl
+ if ![winfo exists .code] {
+ toplevel .code
+ frame .code.buttons
+ pack .code.buttons -side bottom -fill x
+ button .code.buttons.dismiss -text Dismiss \
+ -default active -command "destroy .code"
+ button .code.buttons.rerun -text "Rerun Demo" -command {
+ eval [.code.text get 1.0 end]
+ }
+ pack .code.buttons.dismiss .code.buttons.rerun -side left \
+ -expand 1 -pady 2
+ frame .code.frame
+ pack .code.frame -expand yes -fill both -padx 1 -pady 1
+ text .code.text -height 40 -wrap word\
+ -xscrollcommand ".code.xscroll set" \
+ -yscrollcommand ".code.yscroll set" \
+ -setgrid 1 -highlightthickness 0 -pady 2 -padx 3
+ scrollbar .code.xscroll -command ".code.text xview" \
+ -highlightthickness 0 -orient horizontal
+ scrollbar .code.yscroll -command ".code.text yview" \
+ -highlightthickness 0 -orient vertical
+
+ grid .code.text -in .code.frame -padx 1 -pady 1 \
+ -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
+ grid .code.yscroll -in .code.frame -padx 1 -pady 1 \
+ -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
+# grid .code.xscroll -in .code.frame -padx 1 -pady 1 \
+# -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
+ grid rowconfig .code.frame 0 -weight 1 -minsize 0
+ grid columnconfig .code.frame 0 -weight 1 -minsize 0
+ } else {
+ wm deiconify .code
+ raise .code
+ }
+ wm title .code "Demo code: [file join $tk_library demos $file]"
+ wm iconname .code $file
+ set id [open [file join $tk_library demos $file]]
+ .code.text delete 1.0 end
+ .code.text insert 1.0 [read $id]
+ .code.text mark set insert 1.0
+ close $id
+}
+
+# aboutBox --
+#
+# Pops up a message box with an "about" message
+#
+proc aboutBox {} {
+ tk_messageBox -icon info -type ok -title "About Widget Demo" -message \
+"Tk widget demonstration\n\n\
+Copyright (c) 1996-1997 Sun Microsystems, Inc."
+}
+
demos/widget
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/form.tcl
===================================================================
--- demos/form.tcl (nonexistent)
+++ demos/form.tcl (revision 1765)
@@ -0,0 +1,40 @@
+# form.tcl --
+#
+# This demonstration script creates a simple form with a bunch
+# of entry widgets.
+#
+# SCCS: @(#) form.tcl 1.5 97/03/02 16:23:48
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .form
+catch {destroy $w}
+toplevel $w
+wm title $w "Form Demonstration"
+wm iconname $w "form"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "This window contains a simple form where you can type in the various entries and use tabs to move circularly between the entries."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+foreach i {f1 f2 f3 f4 f5} {
+ frame $w.$i -bd 2
+ entry $w.$i.entry -relief sunken -width 40
+ label $w.$i.label
+ pack $w.$i.entry -side right
+ pack $w.$i.label -side left
+}
+$w.f1.label config -text Name:
+$w.f2.label config -text Address:
+$w.f5.label config -text Phone:
+pack $w.msg $w.f1 $w.f2 $w.f3 $w.f4 $w.f5 -side top -fill x
+bind $w "destroy $w"
+focus $w.f1.entry
demos/form.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/states.tcl
===================================================================
--- demos/states.tcl (nonexistent)
+++ demos/states.tcl (revision 1765)
@@ -0,0 +1,45 @@
+# states.tcl --
+#
+# This demonstration script creates a listbox widget that displays
+# the names of the 50 states in the United States of America.
+#
+# SCCS: @(#) states.tcl 1.4 97/03/02 16:27:37
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .states
+catch {destroy $w}
+toplevel $w
+wm title $w "Listbox Demonstration (50 states)"
+wm iconname $w "states"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "A listbox containing the 50 states is displayed below, along with a scrollbar. You can scan the list either using the scrollbar or by scanning. To scan, press button 2 in the widget and drag up or down."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.frame -borderwidth .5c
+pack $w.frame -side top -expand yes -fill y
+
+scrollbar $w.frame.scroll -command "$w.frame.list yview"
+listbox $w.frame.list -yscroll "$w.frame.scroll set" -setgrid 1 -height 12
+pack $w.frame.scroll -side right -fill y
+pack $w.frame.list -side left -expand 1 -fill both
+
+$w.frame.list insert 0 Alabama Alaska Arizona Arkansas California \
+ Colorado Connecticut Delaware Florida Georgia Hawaii Idaho Illinois \
+ Indiana Iowa Kansas Kentucky Louisiana Maine Maryland \
+ Massachusetts Michigan Minnesota Mississippi Missouri \
+ Montana Nebraska Nevada "New Hampshire" "New Jersey" "New Mexico" \
+ "New York" "North Carolina" "North Dakota" \
+ Ohio Oklahoma Oregon Pennsylvania "Rhode Island" \
+ "South Carolina" "South Dakota" \
+ Tennessee Texas Utah Vermont Virginia Washington \
+ "West Virginia" Wisconsin Wyoming
demos/states.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/ixset
===================================================================
--- demos/ixset (nonexistent)
+++ demos/ixset (revision 1765)
@@ -0,0 +1,312 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+# ixset --
+# A nice interface to "xset" to change X server settings
+#
+# History :
+# 91/11/23 : pda@masi.ibp.fr, jt@ratp.fr : design
+# 92/08/01 : pda@masi.ibp.fr : cleaning
+#
+# SCCS: @(#) ixset 1.7 96/02/16 10:49:19
+
+#
+# Button actions
+#
+
+proc quit {} {
+ destroy .
+}
+
+proc ok {} {
+ writesettings
+ quit
+}
+
+proc cancel {} {
+ readsettings
+ dispsettings
+}
+
+# apply is just "writesettings"
+
+
+#
+# Read current settings
+#
+
+proc readsettings {} {
+ global kbdrep ; set kbdrep "on"
+ global kbdcli ; set kbdcli 0
+ global bellvol ; set bellvol 100
+ global bellpit ; set bellpit 440
+ global belldur ; set belldur 100
+ global mouseacc ; set mouseacc "3/1"
+ global mousethr ; set mousethr 4
+ global screenbla ; set screenbla "blank"
+ global screentim ; set screentim 600
+ global screencyc ; set screencyc 600
+
+ set xfd [open "|xset q" r]
+ while {[gets $xfd line] > -1} {
+ set kw [lindex $line 0]
+
+ case $kw in {
+ {auto}
+ {
+ set rpt [lindex $line 1]
+ if {[expr "{$rpt} == {repeat:}"]} then {
+ set kbdrep [lindex $line 2]
+ set kbdcli [lindex $line 6]
+ }
+ }
+ {bell}
+ {
+ set bellvol [lindex $line 2]
+ set bellpit [lindex $line 5]
+ set belldur [lindex $line 8]
+ }
+ {acceleration:}
+ {
+ set mouseacc [lindex $line 1]
+ set mousethr [lindex $line 3]
+ }
+ {prefer}
+ {
+ set bla [lindex $line 2]
+ set screenbla [expr "{$bla} == {yes} ? {blank} : {noblank}"]
+ }
+ {timeout:}
+ {
+ set screentim [lindex $line 1]
+ set screencyc [lindex $line 3]
+ }
+ }
+ }
+ close $xfd
+
+ # puts stdout [format "Key REPEAT = %s\n" $kbdrep]
+ # puts stdout [format "Key CLICK = %s\n" $kbdcli]
+ # puts stdout [format "Bell VOLUME = %s\n" $bellvol]
+ # puts stdout [format "Bell PITCH = %s\n" $bellpit]
+ # puts stdout [format "Bell DURATION = %s\n" $belldur]
+ # puts stdout [format "Mouse ACCELERATION = %s\n" $mouseacc]
+ # puts stdout [format "Mouse THRESHOLD = %s\n" $mousethr]
+ # puts stdout [format "Screen BLANCK = %s\n" $screenbla]
+ # puts stdout [format "Screen TIMEOUT = %s\n" $screentim]
+ # puts stdout [format "Screen CYCLE = %s\n" $screencyc]
+}
+
+
+#
+# Write settings into the X server
+#
+
+proc writesettings {} {
+ global kbdrep kbdcli bellvol bellpit belldur
+ global mouseacc mousethr screenbla screentim screencyc
+
+ set bellvol [.bell.vol get]
+ set bellpit [.bell.val.pit.entry get]
+ set belldur [.bell.val.dur.entry get]
+
+ if {[expr "{$kbdrep} == {on}"]} then {
+ set kbdcli [.kbd.val.cli get]
+ } else {
+ set kbdcli "off"
+ }
+
+ set mouseacc [.mouse.hor.acc.entry get]
+ set mousethr [.mouse.hor.thr.entry get]
+
+ set screentim [.screen.val.le.tim.entry get]
+ set screencyc [.screen.val.le.cyc.entry get]
+
+ exec xset \
+ b $bellvol $bellpit $belldur \
+ c $kbdcli \
+ r $kbdrep \
+ m $mouseacc $mousethr \
+ s $screentim $screencyc \
+ s $screenbla
+}
+
+
+#
+# Sends all settings to the window
+#
+
+proc dispsettings {} {
+ global kbdrep kbdcli bellvol bellpit belldur
+ global mouseacc mousethr screenbla screentim screencyc
+
+ .bell.vol set $bellvol
+ .bell.val.pit.entry delete 0 end
+ .bell.val.pit.entry insert 0 $bellpit
+ .bell.val.dur.entry delete 0 end
+ .bell.val.dur.entry insert 0 $belldur
+
+ .kbd.val.onoff [expr "{$kbdrep} == {on} ? {select} : {deselect}"]
+ .kbd.val.cli set $kbdcli
+
+ .mouse.hor.acc.entry delete 0 end
+ .mouse.hor.acc.entry insert 0 $mouseacc
+ .mouse.hor.thr.entry delete 0 end
+ .mouse.hor.thr.entry insert 0 $mousethr
+
+ .screen.val.rb.blank [expr "{$screenbla}=={blank} ? {select} : {deselect}"]
+ .screen.val.rb.pat [expr "{$screenbla}!={blank} ? {select} : {deselect}"]
+ .screen.val.le.tim.entry delete 0 end
+ .screen.val.le.tim.entry insert 0 $screentim
+ .screen.val.le.cyc.entry delete 0 end
+ .screen.val.le.cyc.entry insert 0 $screencyc
+}
+
+
+#
+# Create all windows, and pack them
+#
+
+proc labelentry {path text length} {
+ frame $path
+ label $path.label -text $text
+ entry $path.entry -width $length -relief sunken
+ pack $path.label -side left -expand y
+ pack $path.entry -side right -expand y
+}
+
+proc createwindows {} {
+ #
+ # Buttons
+ #
+
+ frame .buttons
+ button .buttons.ok -command "ok" -text "Ok"
+ button .buttons.apply -command "writesettings" -text "Apply"
+ button .buttons.cancel -command "cancel" -text "Cancel"
+ button .buttons.quit -command "quit" -text "Quit"
+
+ pack .buttons.ok .buttons.apply .buttons.cancel .buttons.quit \
+ -side left -expand yes -pady 5
+
+ #
+ # Bell settings
+ #
+
+ frame .bell -relief raised -borderwidth 2
+ label .bell.label -text "Bell Settings"
+ scale .bell.vol \
+ -from 0 -to 100 -length 200 -tickinterval 20 \
+ -label "Volume (%)" -orient horizontal
+
+ frame .bell.val
+ labelentry .bell.val.pit "Pitch (Hz)" 6
+ labelentry .bell.val.dur "Duration (ms)" 6
+ pack .bell.val.pit -side left -padx 5
+ pack .bell.val.dur -side right -padx 5
+ pack .bell.label .bell.vol .bell.val -side top -expand yes
+
+ #
+ # Keyboard settings
+ #
+
+ frame .kbd -relief raised -borderwidth 2
+
+ label .kbd.label -text "Keyboard Repeat Settings"
+
+ frame .kbd.val
+ checkbutton .kbd.val.onoff \
+ -text "On" \
+ -onvalue "on" -offvalue "off" -variable kbdrep \
+ -relief flat
+ scale .kbd.val.cli \
+ -from 0 -to 100 -length 200 -tickinterval 20 \
+ -label "Click Volume (%)" -orient horizontal
+ pack .kbd.val.onoff -side left -expand yes -fill both
+ pack .kbd.val.cli -side left -expand yes
+
+ pack .kbd.label -side top -expand yes
+ pack .kbd.val -side top -expand yes -pady 2 -fill x
+
+ #
+ # Mouse settings
+ #
+
+ frame .mouse -relief raised -borderwidth 2
+
+ label .mouse.label -text "Mouse Settings"
+ frame .mouse.hor
+ labelentry .mouse.hor.acc "Acceleration" 3
+ labelentry .mouse.hor.thr "Threshold (pixels)" 3
+
+ pack .mouse.hor.acc -side left
+ pack .mouse.hor.thr -side right
+
+ pack .mouse.label -side top
+ pack .mouse.hor -side top -expand yes
+
+ #
+ # Screen Saver settings
+ #
+
+ frame .screen -relief raised -borderwidth 2
+
+ label .screen.label -text "Screen-saver Settings"
+ frame .screen.val
+
+ frame .screen.val.rb
+ radiobutton .screen.val.rb.blank \
+ -variable screenblank -text "Blank" -relief flat \
+ -value "blank" -variable screenbla
+ radiobutton .screen.val.rb.pat \
+ -variable screenblank -text "Pattern" -relief flat \
+ -value "noblank" -variable screenbla
+ pack .screen.val.rb.blank .screen.val.rb.pat -side top -pady 2 -anchor w
+ frame .screen.val.le
+ labelentry .screen.val.le.tim "Timeout (s)" 5
+ labelentry .screen.val.le.cyc "Cycle (s)" 5
+ pack .screen.val.le.tim .screen.val.le.cyc -side top -pady 2 -anchor e
+
+ pack .screen.val.rb .screen.val.le -side left
+
+ pack .screen.label -side top
+ pack .screen.val -side top -expand y
+
+ #
+ # Main window
+ #
+
+ pack .buttons -side top -fill both
+ pack .bell .kbd .mouse .screen -side top -fill both -ipady 5 -expand yes
+
+ #
+ # Let the user resize our window
+ #
+ wm minsize . 10 10
+}
+
+##############################################################################
+# Main program
+
+#
+# Listen what "xset" tells us...
+#
+
+readsettings
+
+#
+# Create all windows
+#
+
+createwindows
+
+#
+# Write xset parameters
+#
+
+dispsettings
+
+#
+# Now, wait for user actions...
+#
demos/ixset
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/button.tcl
===================================================================
--- demos/button.tcl (nonexistent)
+++ demos/button.tcl (revision 1765)
@@ -0,0 +1,36 @@
+# button.tcl --
+#
+# This demonstration script creates a toplevel window containing
+# several button widgets.
+#
+# SCCS: @(#) button.tcl 1.5 97/03/02 16:19:39
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .button
+catch {destroy $w}
+toplevel $w
+wm title $w "Button Demonstration"
+wm iconname $w "button"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "If you click on any of the four buttons below, the background of the button area will change to the color indicated in the button. You can press Tab to move among the buttons, then press Space to invoke the current button."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+button $w.b1 -text "Peach Puff" -width 10 \
+ -command "$w config -bg PeachPuff1; $w.buttons config -bg PeachPuff1"
+button $w.b2 -text "Light Blue" -width 10 \
+ -command "$w config -bg LightBlue1; $w.buttons config -bg LightBlue1"
+button $w.b3 -text "Sea Green" -width 10 \
+ -command "$w config -bg SeaGreen2; $w.buttons config -bg SeaGreen2"
+button $w.b4 -text "Yellow" -width 10 \
+ -command "$w config -bg Yellow1; $w.buttons config -bg Yellow1"
+pack $w.b1 $w.b2 $w.b3 $w.b4 -side top -expand yes -pady 2
demos/button.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/label.tcl
===================================================================
--- demos/label.tcl (nonexistent)
+++ demos/label.tcl (revision 1765)
@@ -0,0 +1,40 @@
+# label.tcl --
+#
+# This demonstration script creates a toplevel window containing
+# several label widgets.
+#
+# SCCS: @(#) label.tcl 1.7 97/03/02 16:25:27
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .label
+catch {destroy $w}
+toplevel $w
+wm title $w "Label Demonstration"
+wm iconname $w "label"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "Five labels are displayed below: three textual ones on the left, and a bitmap label and a text label on the right. Labels are pretty boring because you can't do anything with them."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.left
+frame $w.right
+pack $w.left $w.right -side left -expand yes -padx 10 -pady 10 -fill both
+
+label $w.left.l1 -text "First label"
+label $w.left.l2 -text "Second label, raised" -relief raised
+label $w.left.l3 -text "Third label, sunken" -relief sunken
+pack $w.left.l1 $w.left.l2 $w.left.l3 -side top -expand yes -pady 2 -anchor w
+
+label $w.right.bitmap -borderwidth 2 -relief sunken \
+ -bitmap @[file join $tk_library demos images face.bmp]
+label $w.right.caption -text "Tcl/Tk Proprietor"
+pack $w.right.bitmap $w.right.caption -side top
demos/label.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/square
===================================================================
--- demos/square (nonexistent)
+++ demos/square (revision 1765)
@@ -0,0 +1,55 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+# square --
+# This script generates a demo application containing only a "square"
+# widget. It's only usable in the "tktest" application or if Tk has
+# been compiled with tkSquare.c. This demo arranges the following
+# bindings for the widget:
+#
+# Button-1 press/drag: moves square to mouse
+# "a": toggle size animation on/off
+#
+# SCCS: @(#) square 1.7 97/02/24 16:42:31
+
+square .s
+pack .s -expand yes -fill both
+wm minsize . 1 1
+
+bind .s <1> {center %x %y}
+bind .s {center %x %y}
+bind .s a animate
+focus .s
+
+# The procedure below centers the square on a given position.
+
+proc center {x y} {
+ set a [.s size]
+ .s position [expr $x-($a/2)] [expr $y-($a/2)]
+}
+
+# The procedures below provide a simple form of animation where
+# the box changes size in a pulsing pattern: larger, smaller, larger,
+# and so on.
+
+set inc 0
+proc animate {} {
+ global inc
+ if {$inc == 0} {
+ set inc 3
+ timer
+ } else {
+ set inc 0
+ }
+}
+
+proc timer {} {
+ global inc
+ set s [.s size]
+ if {$inc == 0} return
+ if {$s >= 40} {set inc -3}
+ if {$s <= 10} {set inc 3}
+ .s size [expr {$s+$inc}]
+ after 30 timer
+}
demos/square
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/browse
===================================================================
--- demos/browse (nonexistent)
+++ demos/browse (revision 1765)
@@ -0,0 +1,56 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+# browse --
+# This script generates a directory browser, which lists the working
+# directory and allows you to open files or subdirectories by
+# double-clicking.
+#
+# SCCS: @(#) browse 1.8 96/02/16 10:49:18
+
+# Create a scrollbar on the right side of the main window and a listbox
+# on the left side.
+
+scrollbar .scroll -command ".list yview"
+pack .scroll -side right -fill y
+listbox .list -yscroll ".scroll set" -relief sunken -width 20 -height 20 \
+ -setgrid yes
+pack .list -side left -fill both -expand yes
+wm minsize . 1 1
+
+# The procedure below is invoked to open a browser on a given file; if the
+# file is a directory then another instance of this program is invoked; if
+# the file is a regular file then the Mx editor is invoked to display
+# the file.
+
+proc browse {dir file} {
+ global env
+ if {[string compare $dir "."] != 0} {set file $dir/$file}
+ if [file isdirectory $file] {
+ exec browse $file &
+ } else {
+ if [file isfile $file] {
+ if [info exists env(EDITOR)] {
+ eval exec $env(EDITOR) $file &
+ } else {
+ exec xedit $file &
+ }
+ } else {
+ puts stdout "\"$file\" isn't a directory or regular file"
+ }
+ }
+}
+
+# Fill the listbox with a list of all the files in the directory (run
+# the "ls" command to get that information).
+
+if $argc>0 {set dir [lindex $argv 0]} else {set dir "."}
+foreach i [exec ls -a $dir] {
+ .list insert end $i
+}
+
+# Set up bindings for the browser.
+
+bind all {destroy .}
+bind .list {foreach i [selection get] {browse $dir $i}}
demos/browse
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/items.tcl
===================================================================
--- demos/items.tcl (nonexistent)
+++ demos/items.tcl (revision 1765)
@@ -0,0 +1,285 @@
+# items.tcl --
+#
+# This demonstration script creates a canvas that displays the
+# canvas item types.
+#
+# SCCS: @(#) items.tcl 1.16 97/03/02 16:25:05
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .items
+catch {destroy $w}
+toplevel $w
+wm title $w "Canvas Item Demonstration"
+wm iconname $w "Items"
+positionWindow $w
+set c $w.frame.c
+
+label $w.msg -font $font -wraplength 5i -justify left -text "This window contains a canvas widget with examples of the various kinds of items supported by canvases. The following operations are supported:\n Button-1 drag:\tmoves item under pointer.\n Button-2 drag:\trepositions view.\n Button-3 drag:\tstrokes out area.\n Ctrl+f:\t\tprints items under area."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.frame
+pack $w.frame -side top -fill both -expand yes
+
+canvas $c -scrollregion {0c 0c 30c 24c} -width 15c -height 10c \
+ -relief sunken -borderwidth 2 \
+ -xscrollcommand "$w.frame.hscroll set" \
+ -yscrollcommand "$w.frame.vscroll set"
+scrollbar $w.frame.vscroll -command "$c yview"
+scrollbar $w.frame.hscroll -orient horiz -command "$c xview"
+
+grid $c -in $w.frame \
+ -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
+grid $w.frame.vscroll \
+ -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
+grid $w.frame.hscroll \
+ -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
+grid rowconfig $w.frame 0 -weight 1 -minsize 0
+grid columnconfig $w.frame 0 -weight 1 -minsize 0
+
+# Display a 3x3 rectangular grid.
+
+$c create rect 0c 0c 30c 24c -width 2
+$c create line 0c 8c 30c 8c -width 2
+$c create line 0c 16c 30c 16c -width 2
+$c create line 10c 0c 10c 24c -width 2
+$c create line 20c 0c 20c 24c -width 2
+
+set font1 {Helvetica 12}
+set font2 {Helvetica 24 bold}
+if {[winfo depth $c] > 1} {
+ set blue DeepSkyBlue3
+ set red red
+ set bisque bisque3
+ set green SeaGreen3
+} else {
+ set blue black
+ set red black
+ set bisque black
+ set green black
+}
+
+# Set up demos within each of the areas of the grid.
+
+$c create text 5c .2c -text Lines -anchor n
+$c create line 1c 1c 3c 1c 1c 4c 3c 4c -width 2m -fill $blue \
+ -cap butt -join miter -tags item
+$c create line 4.67c 1c 4.67c 4c -arrow last -tags item
+$c create line 6.33c 1c 6.33c 4c -arrow both -tags item
+$c create line 5c 6c 9c 6c 9c 1c 8c 1c 8c 4.8c 8.8c 4.8c 8.8c 1.2c \
+ 8.2c 1.2c 8.2c 4.6c 8.6c 4.6c 8.6c 1.4c 8.4c 1.4c 8.4c 4.4c \
+ -width 3 -fill $red -tags item
+$c create line 1c 5c 7c 5c 7c 7c 9c 7c -width .5c \
+ -stipple @[file join $tk_library demos images gray25.bmp] \
+ -arrow both -arrowshape {15 15 7} -tags item
+$c create line 1c 7c 1.75c 5.8c 2.5c 7c 3.25c 5.8c 4c 7c -width .5c \
+ -cap round -join round -tags item
+
+$c create text 15c .2c -text "Curves (smoothed lines)" -anchor n
+$c create line 11c 4c 11.5c 1c 13.5c 1c 14c 4c -smooth on \
+ -fill $blue -tags item
+$c create line 15.5c 1c 19.5c 1.5c 15.5c 4.5c 19.5c 4c -smooth on \
+ -arrow both -width 3 -tags item
+$c create line 12c 6c 13.5c 4.5c 16.5c 7.5c 18c 6c \
+ 16.5c 4.5c 13.5c 7.5c 12c 6c -smooth on -width 3m -cap round \
+ -stipple @[file join $tk_library demos images gray25.bmp] \
+ -fill $red -tags item
+
+$c create text 25c .2c -text Polygons -anchor n
+$c create polygon 21c 1.0c 22.5c 1.75c 24c 1.0c 23.25c 2.5c \
+ 24c 4.0c 22.5c 3.25c 21c 4.0c 21.75c 2.5c -fill $green \
+ -outline black -width 4 -tags item
+$c create polygon 25c 4c 25c 4c 25c 1c 26c 1c 27c 4c 28c 1c \
+ 29c 1c 29c 4c 29c 4c -fill $red -smooth on -tags item
+$c create polygon 22c 4.5c 25c 4.5c 25c 6.75c 28c 6.75c \
+ 28c 5.25c 24c 5.25c 24c 6.0c 26c 6c 26c 7.5c 22c 7.5c \
+ -stipple @[file join $tk_library demos images gray25.bmp] \
+ -outline black -tags item
+
+$c create text 5c 8.2c -text Rectangles -anchor n
+$c create rectangle 1c 9.5c 4c 12.5c -outline $red -width 3m -tags item
+$c create rectangle 0.5c 13.5c 4.5c 15.5c -fill $green -tags item
+$c create rectangle 6c 10c 9c 15c -outline {} \
+ -stipple @[file join $tk_library demos images gray25.bmp] \
+ -fill $blue -tags item
+
+$c create text 15c 8.2c -text Ovals -anchor n
+$c create oval 11c 9.5c 14c 12.5c -outline $red -width 3m -tags item
+$c create oval 10.5c 13.5c 14.5c 15.5c -fill $green -tags item
+$c create oval 16c 10c 19c 15c -outline {} \
+ -stipple @[file join $tk_library demos images gray25.bmp] \
+ -fill $blue -tags item
+
+$c create text 25c 8.2c -text Text -anchor n
+$c create rectangle 22.4c 8.9c 22.6c 9.1c
+$c create text 22.5c 9c -anchor n -font $font1 -width 4c \
+ -text "A short string of text, word-wrapped, justified left, and anchored north (at the top). The rectangles show the anchor points for each piece of text." -tags item
+$c create rectangle 25.4c 10.9c 25.6c 11.1c
+$c create text 25.5c 11c -anchor w -font $font1 -fill $blue \
+ -text "Several lines,\n each centered\nindividually,\nand all anchored\nat the left edge." \
+ -justify center -tags item
+$c create rectangle 24.9c 13.9c 25.1c 14.1c
+$c create text 25c 14c -font $font2 -anchor c -fill $red -stipple gray50 \
+ -text "Stippled characters" -tags item
+
+$c create text 5c 16.2c -text Arcs -anchor n
+$c create arc 0.5c 17c 7c 20c -fill $green -outline black \
+ -start 45 -extent 270 -style pieslice -tags item
+$c create arc 6.5c 17c 9.5c 20c -width 4m -style arc \
+ -outline $blue -start -135 -extent 270 -tags item \
+ -outlinestipple @[file join $tk_library demos images gray25.bmp]
+$c create arc 0.5c 20c 9.5c 24c -width 4m -style pieslice \
+ -fill {} -outline $red -start 225 -extent -90 -tags item
+$c create arc 5.5c 20.5c 9.5c 23.5c -width 4m -style chord \
+ -fill $blue -outline {} -start 45 -extent 270 -tags item
+
+$c create text 15c 16.2c -text Bitmaps -anchor n
+$c create bitmap 13c 20c -tags item \
+ -bitmap @[file join $tk_library demos images face.bmp]
+$c create bitmap 17c 18.5c -tags item \
+ -bitmap @[file join $tk_library demos images noletter.bmp]
+$c create bitmap 17c 21.5c -tags item \
+ -bitmap @[file join $tk_library demos images letters.bmp]
+
+$c create text 25c 16.2c -text Windows -anchor n
+button $c.button -text "Press Me" -command "butPress $c $red"
+$c create window 21c 18c -window $c.button -anchor nw -tags item
+entry $c.entry -width 20 -relief sunken
+$c.entry insert end "Edit this text"
+$c create window 21c 21c -window $c.entry -anchor nw -tags item
+scale $c.scale -from 0 -to 100 -length 6c -sliderlength .4c \
+ -width .5c -tickinterval 0
+$c create window 28.5c 17.5c -window $c.scale -anchor n -tags item
+$c create text 21c 17.9c -text Button: -anchor sw
+$c create text 21c 20.9c -text Entry: -anchor sw
+$c create text 28.5c 17.4c -text Scale: -anchor s
+
+# Set up event bindings for canvas:
+
+$c bind item "itemEnter $c"
+$c bind item "itemLeave $c"
+bind $c <2> "$c scan mark %x %y"
+bind $c "$c scan dragto %x %y"
+bind $c <3> "itemMark $c %x %y"
+bind $c "itemStroke $c %x %y"
+bind $c "itemsUnderArea $c"
+bind $c <1> "itemStartDrag $c %x %y"
+bind $c "itemDrag $c %x %y"
+
+# Utility procedures for highlighting the item under the pointer:
+
+proc itemEnter {c} {
+ global restoreCmd
+
+ if {[winfo depth $c] == 1} {
+ set restoreCmd {}
+ return
+ }
+ set type [$c type current]
+ if {$type == "window"} {
+ set restoreCmd {}
+ return
+ }
+ if {$type == "bitmap"} {
+ set bg [lindex [$c itemconf current -background] 4]
+ set restoreCmd [list $c itemconfig current -background $bg]
+ $c itemconfig current -background SteelBlue2
+ return
+ }
+ set fill [lindex [$c itemconfig current -fill] 4]
+ if {(($type == "rectangle") || ($type == "oval") || ($type == "arc"))
+ && ($fill == "")} {
+ set outline [lindex [$c itemconfig current -outline] 4]
+ set restoreCmd "$c itemconfig current -outline $outline"
+ $c itemconfig current -outline SteelBlue2
+ } else {
+ set restoreCmd "$c itemconfig current -fill $fill"
+ $c itemconfig current -fill SteelBlue2
+ }
+}
+
+proc itemLeave {c} {
+ global restoreCmd
+
+ eval $restoreCmd
+}
+
+# Utility procedures for stroking out a rectangle and printing what's
+# underneath the rectangle's area.
+
+proc itemMark {c x y} {
+ global areaX1 areaY1
+ set areaX1 [$c canvasx $x]
+ set areaY1 [$c canvasy $y]
+ $c delete area
+}
+
+proc itemStroke {c x y} {
+ global areaX1 areaY1 areaX2 areaY2
+ set x [$c canvasx $x]
+ set y [$c canvasy $y]
+ if {($areaX1 != $x) && ($areaY1 != $y)} {
+ $c delete area
+ $c addtag area withtag [$c create rect $areaX1 $areaY1 $x $y \
+ -outline black]
+ set areaX2 $x
+ set areaY2 $y
+ }
+}
+
+proc itemsUnderArea {c} {
+ global areaX1 areaY1 areaX2 areaY2
+ set area [$c find withtag area]
+ set items ""
+ foreach i [$c find enclosed $areaX1 $areaY1 $areaX2 $areaY2] {
+ if {[lsearch [$c gettags $i] item] != -1} {
+ lappend items $i
+ }
+ }
+ puts stdout "Items enclosed by area: $items"
+ set items ""
+ foreach i [$c find overlapping $areaX1 $areaY1 $areaX2 $areaY2] {
+ if {[lsearch [$c gettags $i] item] != -1} {
+ lappend items $i
+ }
+ }
+ puts stdout "Items overlapping area: $items"
+}
+
+set areaX1 0
+set areaY1 0
+set areaX2 0
+set areaY2 0
+
+# Utility procedures to support dragging of items.
+
+proc itemStartDrag {c x y} {
+ global lastX lastY
+ set lastX [$c canvasx $x]
+ set lastY [$c canvasy $y]
+}
+
+proc itemDrag {c x y} {
+ global lastX lastY
+ set x [$c canvasx $x]
+ set y [$c canvasy $y]
+ $c move current [expr $x-$lastX] [expr $y-$lastY]
+ set lastX $x
+ set lastY $y
+}
+
+# Procedure that's invoked when the button embedded in the canvas
+# is invoked.
+
+proc butPress {w color} {
+ set i [$w create text 25c 18.1c -text "Ouch!!" -fill $color -anchor n]
+ after 500 "$w delete $i"
+}
demos/items.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/floor.tcl
===================================================================
--- demos/floor.tcl (nonexistent)
+++ demos/floor.tcl (revision 1765)
@@ -0,0 +1,1370 @@
+# floor.tcl --
+#
+# This demonstration script creates a canvas widet that displays the
+# floorplan for DEC's Western Research Laboratory.
+#
+# SCCS: @(#) floor.tcl 1.6 97/03/02 16:23:32
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+# floorDisplay --
+# Recreate the floorplan display in the canvas given by "w". The
+# floor given by "active" is displayed on top with its office structure
+# visible.
+#
+# Arguments:
+# w - Name of the canvas window.
+# active - Number of active floor (1, 2, or 3).
+
+proc floorDisplay {w active} {
+ global floorLabels floorItems colors activeFloor
+
+ if {$activeFloor == $active} {
+ return
+ }
+
+ $w delete all
+ set activeFloor $active
+
+ # First go through the three floors, displaying the backgrounds for
+ # each floor.
+
+ bg1 $w $colors(bg1) $colors(outline1)
+ bg2 $w $colors(bg2) $colors(outline2)
+ bg3 $w $colors(bg3) $colors(outline3)
+
+ # Raise the background for the active floor so that it's on top.
+
+ $w raise floor$active
+
+ # Create a dummy item just to mark this point in the display list,
+ # so we can insert highlights here.
+
+ $w create rect 0 100 1 101 -fill {} -outline {} -tags marker
+
+ # Add the walls and labels for the active floor, along with
+ # transparent polygons that define the rooms on the floor.
+ # Make sure that the room polygons are on top.
+
+ catch {unset floorLabels}
+ catch {unset floorItems}
+ fg$active $w $colors(offices)
+ $w raise room
+
+ # Offset the floors diagonally from each other.
+
+ $w move floor1 2c 2c
+ $w move floor2 1c 1c
+
+ # Create items for the room entry and its label.
+
+ $w create window 600 100 -anchor w -window $w.entry
+ $w create text 600 100 -anchor e -text "Room: "
+ $w config -scrollregion [$w bbox all]
+}
+
+# newRoom --
+# This procedure is invoked whenever the mouse enters a room
+# in the floorplan. It changes tags so that the current room is
+# highlighted.
+#
+# Arguments:
+# w - The name of the canvas window.
+
+proc newRoom w {
+ global currentRoom floorLabels
+
+ set id [$w find withtag current]
+ if {$id != ""} {
+ set currentRoom $floorLabels($id)
+ }
+ update idletasks
+}
+
+# roomChanged --
+# This procedure is invoked whenever the currentRoom variable changes.
+# It highlights the current room and unhighlights any previous room.
+#
+# Arguments:
+# w - The canvas window displaying the floorplan.
+# args - Not used.
+
+proc roomChanged {w args} {
+ global currentRoom floorItems colors
+ $w delete highlight
+ if [catch {set item $floorItems($currentRoom)}] {
+ return
+ }
+ set new [eval \
+ "$w create polygon [$w coords $item] -fill $colors(active) \
+ -tags highlight"]
+ $w raise $new marker
+}
+
+# bg1 --
+# This procedure represents part of the floorplan database. When
+# invoked, it instantiates the background information for the first
+# floor.
+#
+# Arguments:
+# w - The canvas window.
+# fill - Fill color to use for the floor's background.
+# outline - Color to use for the floor's outline.
+
+proc bg1 {w fill outline} {
+ $w create poly 347 80 349 82 351 84 353 85 363 92 375 99 386 104 \
+ 386 129 398 129 398 162 484 162 484 129 559 129 559 133 725 \
+ 133 725 129 802 129 802 389 644 389 644 391 559 391 559 327 \
+ 508 327 508 311 484 311 484 278 395 278 395 288 400 288 404 \
+ 288 409 290 413 292 418 297 421 302 422 309 421 318 417 325 \
+ 411 330 405 332 397 333 344 333 340 334 336 336 335 338 332 \
+ 342 331 347 332 351 334 354 336 357 341 359 340 360 335 363 \
+ 331 365 326 366 304 366 304 355 258 355 258 387 60 387 60 391 \
+ 0 391 0 337 3 337 3 114 8 114 8 25 30 25 30 5 93 5 98 5 104 7 \
+ 110 10 116 16 119 20 122 28 123 32 123 68 220 68 220 34 221 \
+ 22 223 17 227 13 231 8 236 4 242 2 246 0 260 0 283 1 300 5 \
+ 321 14 335 22 348 25 365 29 363 39 358 48 352 56 337 70 \
+ 344 76 347 80 \
+ -tags {floor1 bg} -fill $fill
+ $w create line 386 129 398 129 -fill $outline -tags {floor1 bg}
+ $w create line 258 355 258 387 -fill $outline -tags {floor1 bg}
+ $w create line 60 387 60 391 -fill $outline -tags {floor1 bg}
+ $w create line 0 337 0 391 -fill $outline -tags {floor1 bg}
+ $w create line 60 391 0 391 -fill $outline -tags {floor1 bg}
+ $w create line 3 114 3 337 -fill $outline -tags {floor1 bg}
+ $w create line 258 387 60 387 -fill $outline -tags {floor1 bg}
+ $w create line 484 162 398 162 -fill $outline -tags {floor1 bg}
+ $w create line 398 162 398 129 -fill $outline -tags {floor1 bg}
+ $w create line 484 278 484 311 -fill $outline -tags {floor1 bg}
+ $w create line 484 311 508 311 -fill $outline -tags {floor1 bg}
+ $w create line 508 327 508 311 -fill $outline -tags {floor1 bg}
+ $w create line 559 327 508 327 -fill $outline -tags {floor1 bg}
+ $w create line 644 391 559 391 -fill $outline -tags {floor1 bg}
+ $w create line 644 389 644 391 -fill $outline -tags {floor1 bg}
+ $w create line 559 129 484 129 -fill $outline -tags {floor1 bg}
+ $w create line 484 162 484 129 -fill $outline -tags {floor1 bg}
+ $w create line 725 133 559 133 -fill $outline -tags {floor1 bg}
+ $w create line 559 129 559 133 -fill $outline -tags {floor1 bg}
+ $w create line 725 129 802 129 -fill $outline -tags {floor1 bg}
+ $w create line 802 389 802 129 -fill $outline -tags {floor1 bg}
+ $w create line 3 337 0 337 -fill $outline -tags {floor1 bg}
+ $w create line 559 391 559 327 -fill $outline -tags {floor1 bg}
+ $w create line 802 389 644 389 -fill $outline -tags {floor1 bg}
+ $w create line 725 133 725 129 -fill $outline -tags {floor1 bg}
+ $w create line 8 25 8 114 -fill $outline -tags {floor1 bg}
+ $w create line 8 114 3 114 -fill $outline -tags {floor1 bg}
+ $w create line 30 25 8 25 -fill $outline -tags {floor1 bg}
+ $w create line 484 278 395 278 -fill $outline -tags {floor1 bg}
+ $w create line 30 25 30 5 -fill $outline -tags {floor1 bg}
+ $w create line 93 5 30 5 -fill $outline -tags {floor1 bg}
+ $w create line 98 5 93 5 -fill $outline -tags {floor1 bg}
+ $w create line 104 7 98 5 -fill $outline -tags {floor1 bg}
+ $w create line 110 10 104 7 -fill $outline -tags {floor1 bg}
+ $w create line 116 16 110 10 -fill $outline -tags {floor1 bg}
+ $w create line 119 20 116 16 -fill $outline -tags {floor1 bg}
+ $w create line 122 28 119 20 -fill $outline -tags {floor1 bg}
+ $w create line 123 32 122 28 -fill $outline -tags {floor1 bg}
+ $w create line 123 68 123 32 -fill $outline -tags {floor1 bg}
+ $w create line 220 68 123 68 -fill $outline -tags {floor1 bg}
+ $w create line 386 129 386 104 -fill $outline -tags {floor1 bg}
+ $w create line 386 104 375 99 -fill $outline -tags {floor1 bg}
+ $w create line 375 99 363 92 -fill $outline -tags {floor1 bg}
+ $w create line 353 85 363 92 -fill $outline -tags {floor1 bg}
+ $w create line 220 68 220 34 -fill $outline -tags {floor1 bg}
+ $w create line 337 70 352 56 -fill $outline -tags {floor1 bg}
+ $w create line 352 56 358 48 -fill $outline -tags {floor1 bg}
+ $w create line 358 48 363 39 -fill $outline -tags {floor1 bg}
+ $w create line 363 39 365 29 -fill $outline -tags {floor1 bg}
+ $w create line 365 29 348 25 -fill $outline -tags {floor1 bg}
+ $w create line 348 25 335 22 -fill $outline -tags {floor1 bg}
+ $w create line 335 22 321 14 -fill $outline -tags {floor1 bg}
+ $w create line 321 14 300 5 -fill $outline -tags {floor1 bg}
+ $w create line 300 5 283 1 -fill $outline -tags {floor1 bg}
+ $w create line 283 1 260 0 -fill $outline -tags {floor1 bg}
+ $w create line 260 0 246 0 -fill $outline -tags {floor1 bg}
+ $w create line 246 0 242 2 -fill $outline -tags {floor1 bg}
+ $w create line 242 2 236 4 -fill $outline -tags {floor1 bg}
+ $w create line 236 4 231 8 -fill $outline -tags {floor1 bg}
+ $w create line 231 8 227 13 -fill $outline -tags {floor1 bg}
+ $w create line 223 17 227 13 -fill $outline -tags {floor1 bg}
+ $w create line 221 22 223 17 -fill $outline -tags {floor1 bg}
+ $w create line 220 34 221 22 -fill $outline -tags {floor1 bg}
+ $w create line 340 360 335 363 -fill $outline -tags {floor1 bg}
+ $w create line 335 363 331 365 -fill $outline -tags {floor1 bg}
+ $w create line 331 365 326 366 -fill $outline -tags {floor1 bg}
+ $w create line 326 366 304 366 -fill $outline -tags {floor1 bg}
+ $w create line 304 355 304 366 -fill $outline -tags {floor1 bg}
+ $w create line 395 288 400 288 -fill $outline -tags {floor1 bg}
+ $w create line 404 288 400 288 -fill $outline -tags {floor1 bg}
+ $w create line 409 290 404 288 -fill $outline -tags {floor1 bg}
+ $w create line 413 292 409 290 -fill $outline -tags {floor1 bg}
+ $w create line 418 297 413 292 -fill $outline -tags {floor1 bg}
+ $w create line 421 302 418 297 -fill $outline -tags {floor1 bg}
+ $w create line 422 309 421 302 -fill $outline -tags {floor1 bg}
+ $w create line 421 318 422 309 -fill $outline -tags {floor1 bg}
+ $w create line 421 318 417 325 -fill $outline -tags {floor1 bg}
+ $w create line 417 325 411 330 -fill $outline -tags {floor1 bg}
+ $w create line 411 330 405 332 -fill $outline -tags {floor1 bg}
+ $w create line 405 332 397 333 -fill $outline -tags {floor1 bg}
+ $w create line 397 333 344 333 -fill $outline -tags {floor1 bg}
+ $w create line 344 333 340 334 -fill $outline -tags {floor1 bg}
+ $w create line 340 334 336 336 -fill $outline -tags {floor1 bg}
+ $w create line 336 336 335 338 -fill $outline -tags {floor1 bg}
+ $w create line 335 338 332 342 -fill $outline -tags {floor1 bg}
+ $w create line 331 347 332 342 -fill $outline -tags {floor1 bg}
+ $w create line 332 351 331 347 -fill $outline -tags {floor1 bg}
+ $w create line 334 354 332 351 -fill $outline -tags {floor1 bg}
+ $w create line 336 357 334 354 -fill $outline -tags {floor1 bg}
+ $w create line 341 359 336 357 -fill $outline -tags {floor1 bg}
+ $w create line 341 359 340 360 -fill $outline -tags {floor1 bg}
+ $w create line 395 288 395 278 -fill $outline -tags {floor1 bg}
+ $w create line 304 355 258 355 -fill $outline -tags {floor1 bg}
+ $w create line 347 80 344 76 -fill $outline -tags {floor1 bg}
+ $w create line 344 76 337 70 -fill $outline -tags {floor1 bg}
+ $w create line 349 82 347 80 -fill $outline -tags {floor1 bg}
+ $w create line 351 84 349 82 -fill $outline -tags {floor1 bg}
+ $w create line 353 85 351 84 -fill $outline -tags {floor1 bg}
+}
+
+# bg2 --
+# This procedure represents part of the floorplan database. When
+# invoked, it instantiates the background information for the second
+# floor.
+#
+# Arguments:
+# w - The canvas window.
+# fill - Fill color to use for the floor's background.
+# outline - Color to use for the floor's outline.
+
+proc bg2 {w fill outline} {
+ $w create poly 559 129 484 129 484 162 398 162 398 129 315 129 \
+ 315 133 176 133 176 129 96 129 96 133 3 133 3 339 0 339 0 391 \
+ 60 391 60 387 258 387 258 329 350 329 350 311 395 311 395 280 \
+ 484 280 484 311 508 311 508 327 558 327 558 391 644 391 644 \
+ 367 802 367 802 129 725 129 725 133 559 133 559 129 \
+ -tags {floor2 bg} -fill $fill
+ $w create line 350 311 350 329 -fill $outline -tags {floor2 bg}
+ $w create line 398 129 398 162 -fill $outline -tags {floor2 bg}
+ $w create line 802 367 802 129 -fill $outline -tags {floor2 bg}
+ $w create line 802 129 725 129 -fill $outline -tags {floor2 bg}
+ $w create line 725 133 725 129 -fill $outline -tags {floor2 bg}
+ $w create line 559 129 559 133 -fill $outline -tags {floor2 bg}
+ $w create line 559 133 725 133 -fill $outline -tags {floor2 bg}
+ $w create line 484 162 484 129 -fill $outline -tags {floor2 bg}
+ $w create line 559 129 484 129 -fill $outline -tags {floor2 bg}
+ $w create line 802 367 644 367 -fill $outline -tags {floor2 bg}
+ $w create line 644 367 644 391 -fill $outline -tags {floor2 bg}
+ $w create line 644 391 558 391 -fill $outline -tags {floor2 bg}
+ $w create line 558 327 558 391 -fill $outline -tags {floor2 bg}
+ $w create line 558 327 508 327 -fill $outline -tags {floor2 bg}
+ $w create line 508 327 508 311 -fill $outline -tags {floor2 bg}
+ $w create line 484 311 508 311 -fill $outline -tags {floor2 bg}
+ $w create line 484 280 484 311 -fill $outline -tags {floor2 bg}
+ $w create line 398 162 484 162 -fill $outline -tags {floor2 bg}
+ $w create line 484 280 395 280 -fill $outline -tags {floor2 bg}
+ $w create line 395 280 395 311 -fill $outline -tags {floor2 bg}
+ $w create line 258 387 60 387 -fill $outline -tags {floor2 bg}
+ $w create line 3 133 3 339 -fill $outline -tags {floor2 bg}
+ $w create line 3 339 0 339 -fill $outline -tags {floor2 bg}
+ $w create line 60 391 0 391 -fill $outline -tags {floor2 bg}
+ $w create line 0 339 0 391 -fill $outline -tags {floor2 bg}
+ $w create line 60 387 60 391 -fill $outline -tags {floor2 bg}
+ $w create line 258 329 258 387 -fill $outline -tags {floor2 bg}
+ $w create line 350 329 258 329 -fill $outline -tags {floor2 bg}
+ $w create line 395 311 350 311 -fill $outline -tags {floor2 bg}
+ $w create line 398 129 315 129 -fill $outline -tags {floor2 bg}
+ $w create line 176 133 315 133 -fill $outline -tags {floor2 bg}
+ $w create line 176 129 96 129 -fill $outline -tags {floor2 bg}
+ $w create line 3 133 96 133 -fill $outline -tags {floor2 bg}
+ $w create line 315 133 315 129 -fill $outline -tags {floor2 bg}
+ $w create line 176 133 176 129 -fill $outline -tags {floor2 bg}
+ $w create line 96 133 96 129 -fill $outline -tags {floor2 bg}
+}
+
+# bg3 --
+# This procedure represents part of the floorplan database. When
+# invoked, it instantiates the background information for the third
+# floor.
+#
+# Arguments:
+# w - The canvas window.
+# fill - Fill color to use for the floor's background.
+# outline - Color to use for the floor's outline.
+
+proc bg3 {w fill outline} {
+ $w create poly 159 300 107 300 107 248 159 248 159 129 96 129 96 \
+ 133 21 133 21 331 0 331 0 391 60 391 60 370 159 370 159 300 \
+ -tags {floor3 bg} -fill $fill
+ $w create poly 258 370 258 329 350 329 350 311 399 311 399 129 \
+ 315 129 315 133 176 133 176 129 159 129 159 370 258 370 \
+ -tags {floor3 bg} -fill $fill
+ $w create line 96 133 96 129 -fill $outline -tags {floor3 bg}
+ $w create line 176 129 96 129 -fill $outline -tags {floor3 bg}
+ $w create line 176 129 176 133 -fill $outline -tags {floor3 bg}
+ $w create line 315 133 176 133 -fill $outline -tags {floor3 bg}
+ $w create line 315 133 315 129 -fill $outline -tags {floor3 bg}
+ $w create line 399 129 315 129 -fill $outline -tags {floor3 bg}
+ $w create line 399 311 399 129 -fill $outline -tags {floor3 bg}
+ $w create line 399 311 350 311 -fill $outline -tags {floor3 bg}
+ $w create line 350 329 350 311 -fill $outline -tags {floor3 bg}
+ $w create line 350 329 258 329 -fill $outline -tags {floor3 bg}
+ $w create line 258 370 258 329 -fill $outline -tags {floor3 bg}
+ $w create line 60 370 258 370 -fill $outline -tags {floor3 bg}
+ $w create line 60 370 60 391 -fill $outline -tags {floor3 bg}
+ $w create line 60 391 0 391 -fill $outline -tags {floor3 bg}
+ $w create line 0 391 0 331 -fill $outline -tags {floor3 bg}
+ $w create line 21 331 0 331 -fill $outline -tags {floor3 bg}
+ $w create line 21 331 21 133 -fill $outline -tags {floor3 bg}
+ $w create line 96 133 21 133 -fill $outline -tags {floor3 bg}
+ $w create line 107 300 159 300 159 248 107 248 107 300 \
+ -fill $outline -tags {floor3 bg}
+}
+
+# fg1 --
+# This procedure represents part of the floorplan database. When
+# invoked, it instantiates the foreground information for the first
+# floor (office outlines and numbers).
+#
+# Arguments:
+# w - The canvas window.
+# color - Color to use for drawing foreground information.
+
+proc fg1 {w color} {
+ global floorLabels floorItems
+ set i [$w create polygon 375 246 375 172 341 172 341 246 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 101
+ set {floorItems(101)} $i
+ $w create text 358 209 -text 101 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 307 240 339 240 339 206 307 206 -fill {} -tags {floor1 room}]
+ set floorLabels($i) {Pub Lift1}
+ set {floorItems(Pub Lift1)} $i
+ $w create text 323 223 -text {Pub Lift1} -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 339 205 307 205 307 171 339 171 -fill {} -tags {floor1 room}]
+ set floorLabels($i) {Priv Lift1}
+ set {floorItems(Priv Lift1)} $i
+ $w create text 323 188 -text {Priv Lift1} -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 42 389 42 337 1 337 1 389 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 110
+ set {floorItems(110)} $i
+ $w create text 21.5 363 -text 110 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 59 389 59 385 90 385 90 337 44 337 44 389 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 109
+ set {floorItems(109)} $i
+ $w create text 67 363 -text 109 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 51 300 51 253 6 253 6 300 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 111
+ set {floorItems(111)} $i
+ $w create text 28.5 276.5 -text 111 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 98 248 98 309 79 309 79 248 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 117B
+ set {floorItems(117B)} $i
+ $w create text 88.5 278.5 -text 117B -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 51 251 51 204 6 204 6 251 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 112
+ set {floorItems(112)} $i
+ $w create text 28.5 227.5 -text 112 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 6 156 51 156 51 203 6 203 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 113
+ set {floorItems(113)} $i
+ $w create text 28.5 179.5 -text 113 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 85 169 79 169 79 192 85 192 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 117A
+ set {floorItems(117A)} $i
+ $w create text 82 180.5 -text 117A -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 77 302 77 168 53 168 53 302 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 117
+ set {floorItems(117)} $i
+ $w create text 65 235 -text 117 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 51 155 51 115 6 115 6 155 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 114
+ set {floorItems(114)} $i
+ $w create text 28.5 135 -text 114 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 95 115 53 115 53 168 95 168 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 115
+ set {floorItems(115)} $i
+ $w create text 74 141.5 -text 115 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 87 113 87 27 10 27 10 113 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 116
+ set {floorItems(116)} $i
+ $w create text 48.5 70 -text 116 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 89 91 128 91 128 113 89 113 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 118
+ set {floorItems(118)} $i
+ $w create text 108.5 102 -text 118 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 178 128 178 132 216 132 216 91 163 91 163 112 149 112 149 128 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 120
+ set {floorItems(120)} $i
+ $w create text 189.5 111.5 -text 120 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 79 193 87 193 87 169 136 169 136 192 156 192 156 169 175 169 175 246 79 246 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 122
+ set {floorItems(122)} $i
+ $w create text 131 207.5 -text 122 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 138 169 154 169 154 191 138 191 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 121
+ set {floorItems(121)} $i
+ $w create text 146 180 -text 121 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 99 300 126 300 126 309 99 309 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 106A
+ set {floorItems(106A)} $i
+ $w create text 112.5 304.5 -text 106A -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 128 299 128 309 150 309 150 248 99 248 99 299 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 105
+ set {floorItems(105)} $i
+ $w create text 124.5 278.5 -text 105 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 174 309 174 300 152 300 152 309 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 106B
+ set {floorItems(106B)} $i
+ $w create text 163 304.5 -text 106B -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 176 299 176 309 216 309 216 248 152 248 152 299 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 104
+ set {floorItems(104)} $i
+ $w create text 184 278.5 -text 104 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 138 385 138 337 91 337 91 385 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 108
+ set {floorItems(108)} $i
+ $w create text 114.5 361 -text 108 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 256 337 140 337 140 385 256 385 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 107
+ set {floorItems(107)} $i
+ $w create text 198 361 -text 107 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 300 353 300 329 260 329 260 353 -fill {} -tags {floor1 room}]
+ set floorLabels($i) Smoking
+ set {floorItems(Smoking)} $i
+ $w create text 280 341 -text Smoking -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 314 135 314 170 306 170 306 246 177 246 177 135 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 123
+ set {floorItems(123)} $i
+ $w create text 245.5 190.5 -text 123 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 217 248 301 248 301 326 257 326 257 310 217 310 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 103
+ set {floorItems(103)} $i
+ $w create text 259 287 -text 103 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 396 188 377 188 377 169 316 169 316 131 396 131 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 124
+ set {floorItems(124)} $i
+ $w create text 356 150 -text 124 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 397 226 407 226 407 189 377 189 377 246 397 246 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 125
+ set {floorItems(125)} $i
+ $w create text 392 217.5 -text 125 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 399 187 409 187 409 207 474 207 474 164 399 164 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 126
+ set {floorItems(126)} $i
+ $w create text 436.5 185.5 -text 126 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 409 209 409 229 399 229 399 253 486 253 486 239 474 239 474 209 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 127
+ set {floorItems(127)} $i
+ $w create text 436.5 231 -text 127 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 501 164 501 174 495 174 495 188 490 188 490 204 476 204 476 164 -fill {} -tags {floor1 room}]
+ set floorLabels($i) MShower
+ set {floorItems(MShower)} $i
+ $w create text 488.5 184 -text MShower -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 497 176 513 176 513 204 492 204 492 190 497 190 -fill {} -tags {floor1 room}]
+ set floorLabels($i) Closet
+ set {floorItems(Closet)} $i
+ $w create text 502.5 190 -text Closet -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 476 237 476 206 513 206 513 254 488 254 488 237 -fill {} -tags {floor1 room}]
+ set floorLabels($i) WShower
+ set {floorItems(WShower)} $i
+ $w create text 494.5 230 -text WShower -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 486 131 558 131 558 135 724 135 724 166 697 166 697 275 553 275 531 254 515 254 515 174 503 174 503 161 486 161 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 130
+ set {floorItems(130)} $i
+ $w create text 638.5 205 -text 130 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 308 242 339 242 339 248 342 248 342 246 397 246 397 276 393 276 393 309 300 309 300 248 308 248 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 102
+ set {floorItems(102)} $i
+ $w create text 367.5 278.5 -text 102 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 397 255 486 255 486 276 397 276 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 128
+ set {floorItems(128)} $i
+ $w create text 441.5 265.5 -text 128 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 510 309 486 309 486 255 530 255 552 277 561 277 561 325 510 325 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 129
+ set {floorItems(129)} $i
+ $w create text 535.5 293 -text 129 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 696 281 740 281 740 387 642 387 642 389 561 389 561 277 696 277 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 133
+ set {floorItems(133)} $i
+ $w create text 628.5 335 -text 133 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 742 387 742 281 800 281 800 387 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 132
+ set {floorItems(132)} $i
+ $w create text 771 334 -text 132 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 800 168 800 280 699 280 699 168 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 134
+ set {floorItems(134)} $i
+ $w create text 749.5 224 -text 134 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 726 131 726 166 800 166 800 131 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 135
+ set {floorItems(135)} $i
+ $w create text 763 148.5 -text 135 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 340 360 335 363 331 365 326 366 304 366 304 312 396 312 396 288 400 288 404 288 409 290 413 292 418 297 421 302 422 309 421 318 417 325 411 330 405 332 397 333 344 333 340 334 336 336 335 338 332 342 331 347 332 351 334 354 336 357 341 359 -fill {} -tags {floor1 room}]
+ set floorLabels($i) {Ramona Stair}
+ set {floorItems(Ramona Stair)} $i
+ $w create text 368 323 -text {Ramona Stair} -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 30 23 30 5 93 5 98 5 104 7 110 10 116 16 119 20 122 28 123 32 123 68 220 68 220 87 90 87 90 23 -fill {} -tags {floor1 room}]
+ set floorLabels($i) {University Stair}
+ set {floorItems(University Stair)} $i
+ $w create text 155 77.5 -text {University Stair} -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 282 37 295 40 312 49 323 56 337 70 352 56 358 48 363 39 365 29 348 25 335 22 321 14 300 5 283 1 260 0 246 0 242 2 236 4 231 8 227 13 223 17 221 22 220 34 260 34 -fill {} -tags {floor1 room}]
+ set floorLabels($i) {Plaza Stair}
+ set {floorItems(Plaza Stair)} $i
+ $w create text 317.5 28.5 -text {Plaza Stair} -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 220 34 260 34 282 37 295 40 312 49 323 56 337 70 350 83 365 94 377 100 386 104 386 128 220 128 -fill {} -tags {floor1 room}]
+ set floorLabels($i) {Plaza Deck}
+ set {floorItems(Plaza Deck)} $i
+ $w create text 303 81 -text {Plaza Deck} -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 257 336 77 336 6 336 6 301 77 301 77 310 257 310 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 106
+ set {floorItems(106)} $i
+ $w create text 131.5 318.5 -text 106 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 146 110 162 110 162 91 130 91 130 115 95 115 95 128 114 128 114 151 157 151 157 153 112 153 112 130 97 130 97 168 175 168 175 131 146 131 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 119
+ set {floorItems(119)} $i
+ $w create text 143.5 133 -text 119 -fill $color -anchor c -tags {floor1 label}
+ $w create line 155 191 155 189 -fill $color -tags {floor1 wall}
+ $w create line 155 177 155 169 -fill $color -tags {floor1 wall}
+ $w create line 96 129 96 169 -fill $color -tags {floor1 wall}
+ $w create line 78 169 176 169 -fill $color -tags {floor1 wall}
+ $w create line 176 247 176 129 -fill $color -tags {floor1 wall}
+ $w create line 340 206 307 206 -fill $color -tags {floor1 wall}
+ $w create line 340 187 340 170 -fill $color -tags {floor1 wall}
+ $w create line 340 210 340 201 -fill $color -tags {floor1 wall}
+ $w create line 340 247 340 224 -fill $color -tags {floor1 wall}
+ $w create line 340 241 307 241 -fill $color -tags {floor1 wall}
+ $w create line 376 246 376 170 -fill $color -tags {floor1 wall}
+ $w create line 307 247 307 170 -fill $color -tags {floor1 wall}
+ $w create line 376 170 307 170 -fill $color -tags {floor1 wall}
+ $w create line 315 129 315 170 -fill $color -tags {floor1 wall}
+ $w create line 147 129 176 129 -fill $color -tags {floor1 wall}
+ $w create line 202 133 176 133 -fill $color -tags {floor1 wall}
+ $w create line 398 129 315 129 -fill $color -tags {floor1 wall}
+ $w create line 258 352 258 387 -fill $color -tags {floor1 wall}
+ $w create line 60 387 60 391 -fill $color -tags {floor1 wall}
+ $w create line 0 337 0 391 -fill $color -tags {floor1 wall}
+ $w create line 60 391 0 391 -fill $color -tags {floor1 wall}
+ $w create line 3 114 3 337 -fill $color -tags {floor1 wall}
+ $w create line 258 387 60 387 -fill $color -tags {floor1 wall}
+ $w create line 52 237 52 273 -fill $color -tags {floor1 wall}
+ $w create line 52 189 52 225 -fill $color -tags {floor1 wall}
+ $w create line 52 140 52 177 -fill $color -tags {floor1 wall}
+ $w create line 395 306 395 311 -fill $color -tags {floor1 wall}
+ $w create line 531 254 398 254 -fill $color -tags {floor1 wall}
+ $w create line 475 178 475 238 -fill $color -tags {floor1 wall}
+ $w create line 502 162 398 162 -fill $color -tags {floor1 wall}
+ $w create line 398 129 398 188 -fill $color -tags {floor1 wall}
+ $w create line 383 188 376 188 -fill $color -tags {floor1 wall}
+ $w create line 408 188 408 194 -fill $color -tags {floor1 wall}
+ $w create line 398 227 398 254 -fill $color -tags {floor1 wall}
+ $w create line 408 227 398 227 -fill $color -tags {floor1 wall}
+ $w create line 408 222 408 227 -fill $color -tags {floor1 wall}
+ $w create line 408 206 408 210 -fill $color -tags {floor1 wall}
+ $w create line 408 208 475 208 -fill $color -tags {floor1 wall}
+ $w create line 484 278 484 311 -fill $color -tags {floor1 wall}
+ $w create line 484 311 508 311 -fill $color -tags {floor1 wall}
+ $w create line 508 327 508 311 -fill $color -tags {floor1 wall}
+ $w create line 559 327 508 327 -fill $color -tags {floor1 wall}
+ $w create line 644 391 559 391 -fill $color -tags {floor1 wall}
+ $w create line 644 389 644 391 -fill $color -tags {floor1 wall}
+ $w create line 514 205 475 205 -fill $color -tags {floor1 wall}
+ $w create line 496 189 496 187 -fill $color -tags {floor1 wall}
+ $w create line 559 129 484 129 -fill $color -tags {floor1 wall}
+ $w create line 484 162 484 129 -fill $color -tags {floor1 wall}
+ $w create line 725 133 559 133 -fill $color -tags {floor1 wall}
+ $w create line 559 129 559 133 -fill $color -tags {floor1 wall}
+ $w create line 725 149 725 167 -fill $color -tags {floor1 wall}
+ $w create line 725 129 802 129 -fill $color -tags {floor1 wall}
+ $w create line 802 389 802 129 -fill $color -tags {floor1 wall}
+ $w create line 739 167 802 167 -fill $color -tags {floor1 wall}
+ $w create line 396 188 408 188 -fill $color -tags {floor1 wall}
+ $w create line 0 337 9 337 -fill $color -tags {floor1 wall}
+ $w create line 58 337 21 337 -fill $color -tags {floor1 wall}
+ $w create line 43 391 43 337 -fill $color -tags {floor1 wall}
+ $w create line 105 337 75 337 -fill $color -tags {floor1 wall}
+ $w create line 91 387 91 337 -fill $color -tags {floor1 wall}
+ $w create line 154 337 117 337 -fill $color -tags {floor1 wall}
+ $w create line 139 387 139 337 -fill $color -tags {floor1 wall}
+ $w create line 227 337 166 337 -fill $color -tags {floor1 wall}
+ $w create line 258 337 251 337 -fill $color -tags {floor1 wall}
+ $w create line 258 328 302 328 -fill $color -tags {floor1 wall}
+ $w create line 302 355 302 311 -fill $color -tags {floor1 wall}
+ $w create line 395 311 302 311 -fill $color -tags {floor1 wall}
+ $w create line 484 278 395 278 -fill $color -tags {floor1 wall}
+ $w create line 395 294 395 278 -fill $color -tags {floor1 wall}
+ $w create line 473 278 473 275 -fill $color -tags {floor1 wall}
+ $w create line 473 256 473 254 -fill $color -tags {floor1 wall}
+ $w create line 533 257 531 254 -fill $color -tags {floor1 wall}
+ $w create line 553 276 551 274 -fill $color -tags {floor1 wall}
+ $w create line 698 276 553 276 -fill $color -tags {floor1 wall}
+ $w create line 559 391 559 327 -fill $color -tags {floor1 wall}
+ $w create line 802 389 644 389 -fill $color -tags {floor1 wall}
+ $w create line 741 314 741 389 -fill $color -tags {floor1 wall}
+ $w create line 698 280 698 167 -fill $color -tags {floor1 wall}
+ $w create line 707 280 698 280 -fill $color -tags {floor1 wall}
+ $w create line 802 280 731 280 -fill $color -tags {floor1 wall}
+ $w create line 741 280 741 302 -fill $color -tags {floor1 wall}
+ $w create line 698 167 727 167 -fill $color -tags {floor1 wall}
+ $w create line 725 137 725 129 -fill $color -tags {floor1 wall}
+ $w create line 514 254 514 175 -fill $color -tags {floor1 wall}
+ $w create line 496 175 514 175 -fill $color -tags {floor1 wall}
+ $w create line 502 175 502 162 -fill $color -tags {floor1 wall}
+ $w create line 475 166 475 162 -fill $color -tags {floor1 wall}
+ $w create line 496 176 496 175 -fill $color -tags {floor1 wall}
+ $w create line 491 189 496 189 -fill $color -tags {floor1 wall}
+ $w create line 491 205 491 189 -fill $color -tags {floor1 wall}
+ $w create line 487 238 475 238 -fill $color -tags {floor1 wall}
+ $w create line 487 240 487 238 -fill $color -tags {floor1 wall}
+ $w create line 487 252 487 254 -fill $color -tags {floor1 wall}
+ $w create line 315 133 304 133 -fill $color -tags {floor1 wall}
+ $w create line 256 133 280 133 -fill $color -tags {floor1 wall}
+ $w create line 78 247 270 247 -fill $color -tags {floor1 wall}
+ $w create line 307 247 294 247 -fill $color -tags {floor1 wall}
+ $w create line 214 133 232 133 -fill $color -tags {floor1 wall}
+ $w create line 217 247 217 266 -fill $color -tags {floor1 wall}
+ $w create line 217 309 217 291 -fill $color -tags {floor1 wall}
+ $w create line 217 309 172 309 -fill $color -tags {floor1 wall}
+ $w create line 154 309 148 309 -fill $color -tags {floor1 wall}
+ $w create line 175 300 175 309 -fill $color -tags {floor1 wall}
+ $w create line 151 300 175 300 -fill $color -tags {floor1 wall}
+ $w create line 151 247 151 309 -fill $color -tags {floor1 wall}
+ $w create line 78 237 78 265 -fill $color -tags {floor1 wall}
+ $w create line 78 286 78 309 -fill $color -tags {floor1 wall}
+ $w create line 106 309 78 309 -fill $color -tags {floor1 wall}
+ $w create line 130 309 125 309 -fill $color -tags {floor1 wall}
+ $w create line 99 309 99 247 -fill $color -tags {floor1 wall}
+ $w create line 127 299 99 299 -fill $color -tags {floor1 wall}
+ $w create line 127 309 127 299 -fill $color -tags {floor1 wall}
+ $w create line 155 191 137 191 -fill $color -tags {floor1 wall}
+ $w create line 137 169 137 191 -fill $color -tags {floor1 wall}
+ $w create line 78 171 78 169 -fill $color -tags {floor1 wall}
+ $w create line 78 190 78 218 -fill $color -tags {floor1 wall}
+ $w create line 86 192 86 169 -fill $color -tags {floor1 wall}
+ $w create line 86 192 78 192 -fill $color -tags {floor1 wall}
+ $w create line 52 301 3 301 -fill $color -tags {floor1 wall}
+ $w create line 52 286 52 301 -fill $color -tags {floor1 wall}
+ $w create line 52 252 3 252 -fill $color -tags {floor1 wall}
+ $w create line 52 203 3 203 -fill $color -tags {floor1 wall}
+ $w create line 3 156 52 156 -fill $color -tags {floor1 wall}
+ $w create line 8 25 8 114 -fill $color -tags {floor1 wall}
+ $w create line 63 114 3 114 -fill $color -tags {floor1 wall}
+ $w create line 75 114 97 114 -fill $color -tags {floor1 wall}
+ $w create line 108 114 129 114 -fill $color -tags {floor1 wall}
+ $w create line 129 114 129 89 -fill $color -tags {floor1 wall}
+ $w create line 52 114 52 128 -fill $color -tags {floor1 wall}
+ $w create line 132 89 88 89 -fill $color -tags {floor1 wall}
+ $w create line 88 25 88 89 -fill $color -tags {floor1 wall}
+ $w create line 88 114 88 89 -fill $color -tags {floor1 wall}
+ $w create line 218 89 144 89 -fill $color -tags {floor1 wall}
+ $w create line 147 111 147 129 -fill $color -tags {floor1 wall}
+ $w create line 162 111 147 111 -fill $color -tags {floor1 wall}
+ $w create line 162 109 162 111 -fill $color -tags {floor1 wall}
+ $w create line 162 96 162 89 -fill $color -tags {floor1 wall}
+ $w create line 218 89 218 94 -fill $color -tags {floor1 wall}
+ $w create line 218 89 218 119 -fill $color -tags {floor1 wall}
+ $w create line 8 25 88 25 -fill $color -tags {floor1 wall}
+ $w create line 258 337 258 328 -fill $color -tags {floor1 wall}
+ $w create line 113 129 96 129 -fill $color -tags {floor1 wall}
+ $w create line 302 355 258 355 -fill $color -tags {floor1 wall}
+ $w create line 386 104 386 129 -fill $color -tags {floor1 wall}
+ $w create line 377 100 386 104 -fill $color -tags {floor1 wall}
+ $w create line 365 94 377 100 -fill $color -tags {floor1 wall}
+ $w create line 350 83 365 94 -fill $color -tags {floor1 wall}
+ $w create line 337 70 350 83 -fill $color -tags {floor1 wall}
+ $w create line 337 70 323 56 -fill $color -tags {floor1 wall}
+ $w create line 312 49 323 56 -fill $color -tags {floor1 wall}
+ $w create line 295 40 312 49 -fill $color -tags {floor1 wall}
+ $w create line 282 37 295 40 -fill $color -tags {floor1 wall}
+ $w create line 260 34 282 37 -fill $color -tags {floor1 wall}
+ $w create line 253 34 260 34 -fill $color -tags {floor1 wall}
+ $w create line 386 128 386 104 -fill $color -tags {floor1 wall}
+ $w create line 113 152 156 152 -fill $color -tags {floor1 wall}
+ $w create line 113 152 156 152 -fill $color -tags {floor1 wall}
+ $w create line 113 152 113 129 -fill $color -tags {floor1 wall}
+}
+
+# fg2 --
+# This procedure represents part of the floorplan database. When
+# invoked, it instantiates the foreground information for the second
+# floor (office outlines and numbers).
+#
+# Arguments:
+# w - The canvas window.
+# color - Color to use for drawing foreground information.
+
+proc fg2 {w color} {
+ global floorLabels floorItems
+ set i [$w create polygon 748 188 755 188 755 205 758 205 758 222 800 222 800 168 748 168 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 238
+ set {floorItems(238)} $i
+ $w create text 774 195 -text 238 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 726 188 746 188 746 166 800 166 800 131 726 131 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 237
+ set {floorItems(237)} $i
+ $w create text 763 148.5 -text 237 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 497 187 497 204 559 204 559 324 641 324 643 324 643 291 641 291 641 205 696 205 696 291 694 291 694 314 715 314 715 291 715 205 755 205 755 190 724 190 724 187 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 246
+ set {floorItems(246)} $i
+ $w create text 600 264 -text 246 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 694 279 643 279 643 314 694 314 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 247
+ set {floorItems(247)} $i
+ $w create text 668.5 296.5 -text 247 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 232 250 308 250 308 242 339 242 339 246 397 246 397 255 476 255 476 250 482 250 559 250 559 274 482 274 482 278 396 278 396 274 232 274 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 202
+ set {floorItems(202)} $i
+ $w create text 285.5 260 -text 202 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 53 228 53 338 176 338 233 338 233 196 306 196 306 180 175 180 175 169 156 169 156 196 176 196 176 228 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 206
+ set {floorItems(206)} $i
+ $w create text 143 267 -text 206 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 51 277 6 277 6 338 51 338 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 212
+ set {floorItems(212)} $i
+ $w create text 28.5 307.5 -text 212 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 557 276 486 276 486 309 510 309 510 325 557 325 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 245
+ set {floorItems(245)} $i
+ $w create text 521.5 300.5 -text 245 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 560 389 599 389 599 326 560 326 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 244
+ set {floorItems(244)} $i
+ $w create text 579.5 357.5 -text 244 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 601 389 601 326 643 326 643 389 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 243
+ set {floorItems(243)} $i
+ $w create text 622 357.5 -text 243 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 688 316 645 316 645 365 688 365 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 242
+ set {floorItems(242)} $i
+ $w create text 666.5 340.5 -text 242 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 802 367 759 367 759 226 802 226 -fill {} -tags {floor2 room}]
+ set floorLabels($i) {Barbecue Deck}
+ set {floorItems(Barbecue Deck)} $i
+ $w create text 780.5 296.5 -text {Barbecue Deck} -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 755 262 755 314 717 314 717 262 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 240
+ set {floorItems(240)} $i
+ $w create text 736 288 -text 240 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 755 316 689 316 689 365 755 365 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 241
+ set {floorItems(241)} $i
+ $w create text 722 340.5 -text 241 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 755 206 717 206 717 261 755 261 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 239
+ set {floorItems(239)} $i
+ $w create text 736 233.5 -text 239 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 695 277 643 277 643 206 695 206 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 248
+ set {floorItems(248)} $i
+ $w create text 669 241.5 -text 248 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 676 135 676 185 724 185 724 135 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 236
+ set {floorItems(236)} $i
+ $w create text 700 160 -text 236 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 675 135 635 135 635 145 628 145 628 185 675 185 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 235
+ set {floorItems(235)} $i
+ $w create text 651.5 160 -text 235 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 626 143 633 143 633 135 572 135 572 143 579 143 579 185 626 185 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 234
+ set {floorItems(234)} $i
+ $w create text 606 160 -text 234 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 557 135 571 135 571 145 578 145 578 185 527 185 527 131 557 131 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 233
+ set {floorItems(233)} $i
+ $w create text 552.5 158 -text 233 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 476 249 557 249 557 205 476 205 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 230
+ set {floorItems(230)} $i
+ $w create text 516.5 227 -text 230 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 476 164 486 164 486 131 525 131 525 185 476 185 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 232
+ set {floorItems(232)} $i
+ $w create text 500.5 158 -text 232 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 476 186 495 186 495 204 476 204 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 229
+ set {floorItems(229)} $i
+ $w create text 485.5 195 -text 229 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 474 207 409 207 409 187 399 187 399 164 474 164 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 227
+ set {floorItems(227)} $i
+ $w create text 436.5 185.5 -text 227 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 399 228 399 253 474 253 474 209 409 209 409 228 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 228
+ set {floorItems(228)} $i
+ $w create text 436.5 231 -text 228 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 397 246 397 226 407 226 407 189 377 189 377 246 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 226
+ set {floorItems(226)} $i
+ $w create text 392 217.5 -text 226 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 377 169 316 169 316 131 397 131 397 188 377 188 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 225
+ set {floorItems(225)} $i
+ $w create text 356.5 150 -text 225 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 234 198 306 198 306 249 234 249 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 224
+ set {floorItems(224)} $i
+ $w create text 270 223.5 -text 224 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 270 179 306 179 306 170 314 170 314 135 270 135 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 223
+ set {floorItems(223)} $i
+ $w create text 292 157 -text 223 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 268 179 221 179 221 135 268 135 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 222
+ set {floorItems(222)} $i
+ $w create text 244.5 157 -text 222 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 177 179 219 179 219 135 177 135 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 221
+ set {floorItems(221)} $i
+ $w create text 198 157 -text 221 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 299 327 349 327 349 284 341 284 341 276 299 276 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 204
+ set {floorItems(204)} $i
+ $w create text 324 301.5 -text 204 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 234 276 297 276 297 327 257 327 257 338 234 338 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 205
+ set {floorItems(205)} $i
+ $w create text 265.5 307 -text 205 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 256 385 256 340 212 340 212 385 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 207
+ set {floorItems(207)} $i
+ $w create text 234 362.5 -text 207 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 210 340 164 340 164 385 210 385 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 208
+ set {floorItems(208)} $i
+ $w create text 187 362.5 -text 208 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 115 340 162 340 162 385 115 385 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 209
+ set {floorItems(209)} $i
+ $w create text 138.5 362.5 -text 209 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 89 228 89 156 53 156 53 228 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 217
+ set {floorItems(217)} $i
+ $w create text 71 192 -text 217 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 89 169 97 169 97 190 89 190 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 217A
+ set {floorItems(217A)} $i
+ $w create text 93 179.5 -text 217A -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 89 156 89 168 95 168 95 135 53 135 53 156 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 216
+ set {floorItems(216)} $i
+ $w create text 71 145.5 -text 216 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 51 179 51 135 6 135 6 179 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 215
+ set {floorItems(215)} $i
+ $w create text 28.5 157 -text 215 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 51 227 6 227 6 180 51 180 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 214
+ set {floorItems(214)} $i
+ $w create text 28.5 203.5 -text 214 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 51 275 6 275 6 229 51 229 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 213
+ set {floorItems(213)} $i
+ $w create text 28.5 252 -text 213 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 114 340 67 340 67 385 114 385 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 210
+ set {floorItems(210)} $i
+ $w create text 90.5 362.5 -text 210 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 59 389 59 385 65 385 65 340 1 340 1 389 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 211
+ set {floorItems(211)} $i
+ $w create text 33 364.5 -text 211 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 393 309 350 309 350 282 342 282 342 276 393 276 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 203
+ set {floorItems(203)} $i
+ $w create text 367.5 292.5 -text 203 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 99 191 91 191 91 226 174 226 174 198 154 198 154 192 109 192 109 169 99 169 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 220
+ set {floorItems(220)} $i
+ $w create text 132.5 208.5 -text 220 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 339 205 307 205 307 171 339 171 -fill {} -tags {floor2 room}]
+ set floorLabels($i) {Priv Lift2}
+ set {floorItems(Priv Lift2)} $i
+ $w create text 323 188 -text {Priv Lift2} -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 307 240 339 240 339 206 307 206 -fill {} -tags {floor2 room}]
+ set floorLabels($i) {Pub Lift 2}
+ set {floorItems(Pub Lift 2)} $i
+ $w create text 323 223 -text {Pub Lift 2} -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 175 168 97 168 97 131 175 131 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 218
+ set {floorItems(218)} $i
+ $w create text 136 149.5 -text 218 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 154 191 111 191 111 169 154 169 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 219
+ set {floorItems(219)} $i
+ $w create text 132.5 180 -text 219 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 375 246 375 172 341 172 341 246 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 201
+ set {floorItems(201)} $i
+ $w create text 358 209 -text 201 -fill $color -anchor c -tags {floor2 label}
+ $w create line 641 186 678 186 -fill $color -tags {floor2 wall}
+ $w create line 757 350 757 367 -fill $color -tags {floor2 wall}
+ $w create line 634 133 634 144 -fill $color -tags {floor2 wall}
+ $w create line 634 144 627 144 -fill $color -tags {floor2 wall}
+ $w create line 572 133 572 144 -fill $color -tags {floor2 wall}
+ $w create line 572 144 579 144 -fill $color -tags {floor2 wall}
+ $w create line 398 129 398 162 -fill $color -tags {floor2 wall}
+ $w create line 174 197 175 197 -fill $color -tags {floor2 wall}
+ $w create line 175 197 175 227 -fill $color -tags {floor2 wall}
+ $w create line 757 206 757 221 -fill $color -tags {floor2 wall}
+ $w create line 396 188 408 188 -fill $color -tags {floor2 wall}
+ $w create line 727 189 725 189 -fill $color -tags {floor2 wall}
+ $w create line 747 167 802 167 -fill $color -tags {floor2 wall}
+ $w create line 747 167 747 189 -fill $color -tags {floor2 wall}
+ $w create line 755 189 739 189 -fill $color -tags {floor2 wall}
+ $w create line 769 224 757 224 -fill $color -tags {floor2 wall}
+ $w create line 802 224 802 129 -fill $color -tags {floor2 wall}
+ $w create line 802 129 725 129 -fill $color -tags {floor2 wall}
+ $w create line 725 189 725 129 -fill $color -tags {floor2 wall}
+ $w create line 725 186 690 186 -fill $color -tags {floor2 wall}
+ $w create line 676 133 676 186 -fill $color -tags {floor2 wall}
+ $w create line 627 144 627 186 -fill $color -tags {floor2 wall}
+ $w create line 629 186 593 186 -fill $color -tags {floor2 wall}
+ $w create line 579 144 579 186 -fill $color -tags {floor2 wall}
+ $w create line 559 129 559 133 -fill $color -tags {floor2 wall}
+ $w create line 725 133 559 133 -fill $color -tags {floor2 wall}
+ $w create line 484 162 484 129 -fill $color -tags {floor2 wall}
+ $w create line 559 129 484 129 -fill $color -tags {floor2 wall}
+ $w create line 526 129 526 186 -fill $color -tags {floor2 wall}
+ $w create line 540 186 581 186 -fill $color -tags {floor2 wall}
+ $w create line 528 186 523 186 -fill $color -tags {floor2 wall}
+ $w create line 511 186 475 186 -fill $color -tags {floor2 wall}
+ $w create line 496 190 496 186 -fill $color -tags {floor2 wall}
+ $w create line 496 205 496 202 -fill $color -tags {floor2 wall}
+ $w create line 475 205 527 205 -fill $color -tags {floor2 wall}
+ $w create line 558 205 539 205 -fill $color -tags {floor2 wall}
+ $w create line 558 205 558 249 -fill $color -tags {floor2 wall}
+ $w create line 558 249 475 249 -fill $color -tags {floor2 wall}
+ $w create line 662 206 642 206 -fill $color -tags {floor2 wall}
+ $w create line 695 206 675 206 -fill $color -tags {floor2 wall}
+ $w create line 695 278 642 278 -fill $color -tags {floor2 wall}
+ $w create line 642 291 642 206 -fill $color -tags {floor2 wall}
+ $w create line 695 291 695 206 -fill $color -tags {floor2 wall}
+ $w create line 716 208 716 206 -fill $color -tags {floor2 wall}
+ $w create line 757 206 716 206 -fill $color -tags {floor2 wall}
+ $w create line 757 221 757 224 -fill $color -tags {floor2 wall}
+ $w create line 793 224 802 224 -fill $color -tags {floor2 wall}
+ $w create line 757 262 716 262 -fill $color -tags {floor2 wall}
+ $w create line 716 220 716 264 -fill $color -tags {floor2 wall}
+ $w create line 716 315 716 276 -fill $color -tags {floor2 wall}
+ $w create line 757 315 703 315 -fill $color -tags {floor2 wall}
+ $w create line 757 325 757 224 -fill $color -tags {floor2 wall}
+ $w create line 757 367 644 367 -fill $color -tags {floor2 wall}
+ $w create line 689 367 689 315 -fill $color -tags {floor2 wall}
+ $w create line 647 315 644 315 -fill $color -tags {floor2 wall}
+ $w create line 659 315 691 315 -fill $color -tags {floor2 wall}
+ $w create line 600 325 600 391 -fill $color -tags {floor2 wall}
+ $w create line 627 325 644 325 -fill $color -tags {floor2 wall}
+ $w create line 644 391 644 315 -fill $color -tags {floor2 wall}
+ $w create line 615 325 575 325 -fill $color -tags {floor2 wall}
+ $w create line 644 391 558 391 -fill $color -tags {floor2 wall}
+ $w create line 563 325 558 325 -fill $color -tags {floor2 wall}
+ $w create line 558 391 558 314 -fill $color -tags {floor2 wall}
+ $w create line 558 327 508 327 -fill $color -tags {floor2 wall}
+ $w create line 558 275 484 275 -fill $color -tags {floor2 wall}
+ $w create line 558 302 558 275 -fill $color -tags {floor2 wall}
+ $w create line 508 327 508 311 -fill $color -tags {floor2 wall}
+ $w create line 484 311 508 311 -fill $color -tags {floor2 wall}
+ $w create line 484 275 484 311 -fill $color -tags {floor2 wall}
+ $w create line 475 208 408 208 -fill $color -tags {floor2 wall}
+ $w create line 408 206 408 210 -fill $color -tags {floor2 wall}
+ $w create line 408 222 408 227 -fill $color -tags {floor2 wall}
+ $w create line 408 227 398 227 -fill $color -tags {floor2 wall}
+ $w create line 398 227 398 254 -fill $color -tags {floor2 wall}
+ $w create line 408 188 408 194 -fill $color -tags {floor2 wall}
+ $w create line 383 188 376 188 -fill $color -tags {floor2 wall}
+ $w create line 398 188 398 162 -fill $color -tags {floor2 wall}
+ $w create line 398 162 484 162 -fill $color -tags {floor2 wall}
+ $w create line 475 162 475 254 -fill $color -tags {floor2 wall}
+ $w create line 398 254 475 254 -fill $color -tags {floor2 wall}
+ $w create line 484 280 395 280 -fill $color -tags {floor2 wall}
+ $w create line 395 311 395 275 -fill $color -tags {floor2 wall}
+ $w create line 307 197 293 197 -fill $color -tags {floor2 wall}
+ $w create line 278 197 233 197 -fill $color -tags {floor2 wall}
+ $w create line 233 197 233 249 -fill $color -tags {floor2 wall}
+ $w create line 307 179 284 179 -fill $color -tags {floor2 wall}
+ $w create line 233 249 278 249 -fill $color -tags {floor2 wall}
+ $w create line 269 179 269 133 -fill $color -tags {floor2 wall}
+ $w create line 220 179 220 133 -fill $color -tags {floor2 wall}
+ $w create line 155 191 110 191 -fill $color -tags {floor2 wall}
+ $w create line 90 190 98 190 -fill $color -tags {floor2 wall}
+ $w create line 98 169 98 190 -fill $color -tags {floor2 wall}
+ $w create line 52 133 52 165 -fill $color -tags {floor2 wall}
+ $w create line 52 214 52 177 -fill $color -tags {floor2 wall}
+ $w create line 52 226 52 262 -fill $color -tags {floor2 wall}
+ $w create line 52 274 52 276 -fill $color -tags {floor2 wall}
+ $w create line 234 275 234 339 -fill $color -tags {floor2 wall}
+ $w create line 226 339 258 339 -fill $color -tags {floor2 wall}
+ $w create line 211 387 211 339 -fill $color -tags {floor2 wall}
+ $w create line 214 339 177 339 -fill $color -tags {floor2 wall}
+ $w create line 258 387 60 387 -fill $color -tags {floor2 wall}
+ $w create line 3 133 3 339 -fill $color -tags {floor2 wall}
+ $w create line 165 339 129 339 -fill $color -tags {floor2 wall}
+ $w create line 117 339 80 339 -fill $color -tags {floor2 wall}
+ $w create line 68 339 59 339 -fill $color -tags {floor2 wall}
+ $w create line 0 339 46 339 -fill $color -tags {floor2 wall}
+ $w create line 60 391 0 391 -fill $color -tags {floor2 wall}
+ $w create line 0 339 0 391 -fill $color -tags {floor2 wall}
+ $w create line 60 387 60 391 -fill $color -tags {floor2 wall}
+ $w create line 258 329 258 387 -fill $color -tags {floor2 wall}
+ $w create line 350 329 258 329 -fill $color -tags {floor2 wall}
+ $w create line 395 311 350 311 -fill $color -tags {floor2 wall}
+ $w create line 398 129 315 129 -fill $color -tags {floor2 wall}
+ $w create line 176 133 315 133 -fill $color -tags {floor2 wall}
+ $w create line 176 129 96 129 -fill $color -tags {floor2 wall}
+ $w create line 3 133 96 133 -fill $color -tags {floor2 wall}
+ $w create line 66 387 66 339 -fill $color -tags {floor2 wall}
+ $w create line 115 387 115 339 -fill $color -tags {floor2 wall}
+ $w create line 163 387 163 339 -fill $color -tags {floor2 wall}
+ $w create line 234 275 276 275 -fill $color -tags {floor2 wall}
+ $w create line 288 275 309 275 -fill $color -tags {floor2 wall}
+ $w create line 298 275 298 329 -fill $color -tags {floor2 wall}
+ $w create line 341 283 350 283 -fill $color -tags {floor2 wall}
+ $w create line 321 275 341 275 -fill $color -tags {floor2 wall}
+ $w create line 375 275 395 275 -fill $color -tags {floor2 wall}
+ $w create line 315 129 315 170 -fill $color -tags {floor2 wall}
+ $w create line 376 170 307 170 -fill $color -tags {floor2 wall}
+ $w create line 307 250 307 170 -fill $color -tags {floor2 wall}
+ $w create line 376 245 376 170 -fill $color -tags {floor2 wall}
+ $w create line 340 241 307 241 -fill $color -tags {floor2 wall}
+ $w create line 340 245 340 224 -fill $color -tags {floor2 wall}
+ $w create line 340 210 340 201 -fill $color -tags {floor2 wall}
+ $w create line 340 187 340 170 -fill $color -tags {floor2 wall}
+ $w create line 340 206 307 206 -fill $color -tags {floor2 wall}
+ $w create line 293 250 307 250 -fill $color -tags {floor2 wall}
+ $w create line 271 179 238 179 -fill $color -tags {floor2 wall}
+ $w create line 226 179 195 179 -fill $color -tags {floor2 wall}
+ $w create line 176 129 176 179 -fill $color -tags {floor2 wall}
+ $w create line 182 179 176 179 -fill $color -tags {floor2 wall}
+ $w create line 174 169 176 169 -fill $color -tags {floor2 wall}
+ $w create line 162 169 90 169 -fill $color -tags {floor2 wall}
+ $w create line 96 169 96 129 -fill $color -tags {floor2 wall}
+ $w create line 175 227 90 227 -fill $color -tags {floor2 wall}
+ $w create line 90 190 90 227 -fill $color -tags {floor2 wall}
+ $w create line 52 179 3 179 -fill $color -tags {floor2 wall}
+ $w create line 52 228 3 228 -fill $color -tags {floor2 wall}
+ $w create line 52 276 3 276 -fill $color -tags {floor2 wall}
+ $w create line 155 177 155 169 -fill $color -tags {floor2 wall}
+ $w create line 110 191 110 169 -fill $color -tags {floor2 wall}
+ $w create line 155 189 155 197 -fill $color -tags {floor2 wall}
+ $w create line 350 283 350 329 -fill $color -tags {floor2 wall}
+ $w create line 162 197 155 197 -fill $color -tags {floor2 wall}
+ $w create line 341 275 341 283 -fill $color -tags {floor2 wall}
+}
+
+# fg3 --
+# This procedure represents part of the floorplan database. When
+# invoked, it instantiates the foreground information for the third
+# floor (office outlines and numbers).
+#
+# Arguments:
+# w - The canvas window.
+# color - Color to use for drawing foreground information.
+
+proc fg3 {w color} {
+ global floorLabels floorItems
+ set i [$w create polygon 89 228 89 180 70 180 70 228 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 316
+ set {floorItems(316)} $i
+ $w create text 79.5 204 -text 316 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 115 368 162 368 162 323 115 323 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 309
+ set {floorItems(309)} $i
+ $w create text 138.5 345.5 -text 309 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 164 323 164 368 211 368 211 323 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 308
+ set {floorItems(308)} $i
+ $w create text 187.5 345.5 -text 308 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 256 368 212 368 212 323 256 323 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 307
+ set {floorItems(307)} $i
+ $w create text 234 345.5 -text 307 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 244 276 297 276 297 327 260 327 260 321 244 321 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 305
+ set {floorItems(305)} $i
+ $w create text 270.5 301.5 -text 305 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 251 219 251 203 244 203 244 219 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 324B
+ set {floorItems(324B)} $i
+ $w create text 247.5 211 -text 324B -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 251 249 244 249 244 232 251 232 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 324A
+ set {floorItems(324A)} $i
+ $w create text 247.5 240.5 -text 324A -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 223 135 223 179 177 179 177 135 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 320
+ set {floorItems(320)} $i
+ $w create text 200 157 -text 320 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 114 368 114 323 67 323 67 368 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 310
+ set {floorItems(310)} $i
+ $w create text 90.5 345.5 -text 310 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 23 277 23 321 68 321 68 277 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 312
+ set {floorItems(312)} $i
+ $w create text 45.5 299 -text 312 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 23 229 68 229 68 275 23 275 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 313
+ set {floorItems(313)} $i
+ $w create text 45.5 252 -text 313 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 68 227 23 227 23 180 68 180 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 314
+ set {floorItems(314)} $i
+ $w create text 45.5 203.5 -text 314 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 95 179 95 135 23 135 23 179 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 315
+ set {floorItems(315)} $i
+ $w create text 59 157 -text 315 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 99 226 99 204 91 204 91 226 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 316B
+ set {floorItems(316B)} $i
+ $w create text 95 215 -text 316B -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 91 202 99 202 99 180 91 180 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 316A
+ set {floorItems(316A)} $i
+ $w create text 95 191 -text 316A -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 97 169 109 169 109 192 154 192 154 198 174 198 174 226 101 226 101 179 97 179 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 319
+ set {floorItems(319)} $i
+ $w create text 141.5 209 -text 319 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 65 368 58 368 58 389 1 389 1 333 23 333 23 323 65 323 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 311
+ set {floorItems(311)} $i
+ $w create text 29.5 361 -text 311 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 154 191 111 191 111 169 154 169 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 318
+ set {floorItems(318)} $i
+ $w create text 132.5 180 -text 318 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 175 168 97 168 97 131 175 131 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 317
+ set {floorItems(317)} $i
+ $w create text 136 149.5 -text 317 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 274 194 274 221 306 221 306 194 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 323
+ set {floorItems(323)} $i
+ $w create text 290 207.5 -text 323 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 306 222 274 222 274 249 306 249 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 325
+ set {floorItems(325)} $i
+ $w create text 290 235.5 -text 325 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 263 179 224 179 224 135 263 135 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 321
+ set {floorItems(321)} $i
+ $w create text 243.5 157 -text 321 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 314 169 306 169 306 192 273 192 264 181 264 135 314 135 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 322
+ set {floorItems(322)} $i
+ $w create text 293.5 163.5 -text 322 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 307 240 339 240 339 206 307 206 -fill {} -tags {floor3 room}]
+ set floorLabels($i) {Pub Lift3}
+ set {floorItems(Pub Lift3)} $i
+ $w create text 323 223 -text {Pub Lift3} -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 339 205 307 205 307 171 339 171 -fill {} -tags {floor3 room}]
+ set floorLabels($i) {Priv Lift3}
+ set {floorItems(Priv Lift3)} $i
+ $w create text 323 188 -text {Priv Lift3} -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 350 284 376 284 376 276 397 276 397 309 350 309 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 303
+ set {floorItems(303)} $i
+ $w create text 373.5 292.5 -text 303 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 272 203 272 249 252 249 252 230 244 230 244 221 252 221 252 203 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 324
+ set {floorItems(324)} $i
+ $w create text 262 226 -text 324 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 299 276 299 327 349 327 349 284 341 284 341 276 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 304
+ set {floorItems(304)} $i
+ $w create text 324 301.5 -text 304 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 375 246 375 172 341 172 341 246 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 301
+ set {floorItems(301)} $i
+ $w create text 358 209 -text 301 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 397 246 377 246 377 185 397 185 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 327
+ set {floorItems(327)} $i
+ $w create text 387 215.5 -text 327 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 316 131 316 169 377 169 377 185 397 185 397 131 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 326
+ set {floorItems(326)} $i
+ $w create text 356.5 150 -text 326 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 308 251 242 251 242 274 342 274 342 282 375 282 375 274 397 274 397 248 339 248 339 242 308 242 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 302
+ set {floorItems(302)} $i
+ $w create text 319.5 261 -text 302 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 70 321 242 321 242 200 259 200 259 203 272 203 272 193 263 180 242 180 175 180 175 169 156 169 156 196 177 196 177 228 107 228 70 228 70 275 107 275 107 248 160 248 160 301 107 301 107 275 70 275 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 306
+ set {floorItems(306)} $i
+ $w create text 200.5 284.5 -text 306 -fill $color -anchor c -tags {floor3 label}
+ $w create line 341 275 341 283 -fill $color -tags {floor3 wall}
+ $w create line 162 197 155 197 -fill $color -tags {floor3 wall}
+ $w create line 396 247 399 247 -fill $color -tags {floor3 wall}
+ $w create line 399 129 399 311 -fill $color -tags {floor3 wall}
+ $w create line 258 202 243 202 -fill $color -tags {floor3 wall}
+ $w create line 350 283 350 329 -fill $color -tags {floor3 wall}
+ $w create line 251 231 243 231 -fill $color -tags {floor3 wall}
+ $w create line 243 220 251 220 -fill $color -tags {floor3 wall}
+ $w create line 243 250 243 202 -fill $color -tags {floor3 wall}
+ $w create line 155 197 155 190 -fill $color -tags {floor3 wall}
+ $w create line 110 192 110 169 -fill $color -tags {floor3 wall}
+ $w create line 155 192 110 192 -fill $color -tags {floor3 wall}
+ $w create line 155 177 155 169 -fill $color -tags {floor3 wall}
+ $w create line 176 197 176 227 -fill $color -tags {floor3 wall}
+ $w create line 69 280 69 274 -fill $color -tags {floor3 wall}
+ $w create line 21 276 69 276 -fill $color -tags {floor3 wall}
+ $w create line 69 262 69 226 -fill $color -tags {floor3 wall}
+ $w create line 21 228 69 228 -fill $color -tags {floor3 wall}
+ $w create line 21 179 75 179 -fill $color -tags {floor3 wall}
+ $w create line 69 179 69 214 -fill $color -tags {floor3 wall}
+ $w create line 90 220 90 227 -fill $color -tags {floor3 wall}
+ $w create line 90 204 90 202 -fill $color -tags {floor3 wall}
+ $w create line 90 203 100 203 -fill $color -tags {floor3 wall}
+ $w create line 90 187 90 179 -fill $color -tags {floor3 wall}
+ $w create line 90 227 176 227 -fill $color -tags {floor3 wall}
+ $w create line 100 179 100 227 -fill $color -tags {floor3 wall}
+ $w create line 100 179 87 179 -fill $color -tags {floor3 wall}
+ $w create line 96 179 96 129 -fill $color -tags {floor3 wall}
+ $w create line 162 169 96 169 -fill $color -tags {floor3 wall}
+ $w create line 173 169 176 169 -fill $color -tags {floor3 wall}
+ $w create line 182 179 176 179 -fill $color -tags {floor3 wall}
+ $w create line 176 129 176 179 -fill $color -tags {floor3 wall}
+ $w create line 195 179 226 179 -fill $color -tags {floor3 wall}
+ $w create line 224 133 224 179 -fill $color -tags {floor3 wall}
+ $w create line 264 179 264 133 -fill $color -tags {floor3 wall}
+ $w create line 238 179 264 179 -fill $color -tags {floor3 wall}
+ $w create line 273 207 273 193 -fill $color -tags {floor3 wall}
+ $w create line 273 235 273 250 -fill $color -tags {floor3 wall}
+ $w create line 273 224 273 219 -fill $color -tags {floor3 wall}
+ $w create line 273 193 307 193 -fill $color -tags {floor3 wall}
+ $w create line 273 222 307 222 -fill $color -tags {floor3 wall}
+ $w create line 273 250 307 250 -fill $color -tags {floor3 wall}
+ $w create line 384 247 376 247 -fill $color -tags {floor3 wall}
+ $w create line 340 206 307 206 -fill $color -tags {floor3 wall}
+ $w create line 340 187 340 170 -fill $color -tags {floor3 wall}
+ $w create line 340 210 340 201 -fill $color -tags {floor3 wall}
+ $w create line 340 247 340 224 -fill $color -tags {floor3 wall}
+ $w create line 340 241 307 241 -fill $color -tags {floor3 wall}
+ $w create line 376 247 376 170 -fill $color -tags {floor3 wall}
+ $w create line 307 250 307 170 -fill $color -tags {floor3 wall}
+ $w create line 376 170 307 170 -fill $color -tags {floor3 wall}
+ $w create line 315 129 315 170 -fill $color -tags {floor3 wall}
+ $w create line 376 283 366 283 -fill $color -tags {floor3 wall}
+ $w create line 376 283 376 275 -fill $color -tags {floor3 wall}
+ $w create line 399 275 376 275 -fill $color -tags {floor3 wall}
+ $w create line 341 275 320 275 -fill $color -tags {floor3 wall}
+ $w create line 341 283 350 283 -fill $color -tags {floor3 wall}
+ $w create line 298 275 298 329 -fill $color -tags {floor3 wall}
+ $w create line 308 275 298 275 -fill $color -tags {floor3 wall}
+ $w create line 243 322 243 275 -fill $color -tags {floor3 wall}
+ $w create line 243 275 284 275 -fill $color -tags {floor3 wall}
+ $w create line 258 322 226 322 -fill $color -tags {floor3 wall}
+ $w create line 212 370 212 322 -fill $color -tags {floor3 wall}
+ $w create line 214 322 177 322 -fill $color -tags {floor3 wall}
+ $w create line 163 370 163 322 -fill $color -tags {floor3 wall}
+ $w create line 165 322 129 322 -fill $color -tags {floor3 wall}
+ $w create line 84 322 117 322 -fill $color -tags {floor3 wall}
+ $w create line 71 322 64 322 -fill $color -tags {floor3 wall}
+ $w create line 115 322 115 370 -fill $color -tags {floor3 wall}
+ $w create line 66 322 66 370 -fill $color -tags {floor3 wall}
+ $w create line 52 322 21 322 -fill $color -tags {floor3 wall}
+ $w create line 21 331 0 331 -fill $color -tags {floor3 wall}
+ $w create line 21 331 21 133 -fill $color -tags {floor3 wall}
+ $w create line 96 133 21 133 -fill $color -tags {floor3 wall}
+ $w create line 176 129 96 129 -fill $color -tags {floor3 wall}
+ $w create line 315 133 176 133 -fill $color -tags {floor3 wall}
+ $w create line 315 129 399 129 -fill $color -tags {floor3 wall}
+ $w create line 399 311 350 311 -fill $color -tags {floor3 wall}
+ $w create line 350 329 258 329 -fill $color -tags {floor3 wall}
+ $w create line 258 322 258 370 -fill $color -tags {floor3 wall}
+ $w create line 60 370 258 370 -fill $color -tags {floor3 wall}
+ $w create line 60 370 60 391 -fill $color -tags {floor3 wall}
+ $w create line 0 391 0 331 -fill $color -tags {floor3 wall}
+ $w create line 60 391 0 391 -fill $color -tags {floor3 wall}
+ $w create line 307 250 307 242 -fill $color -tags {floor3 wall}
+ $w create line 273 250 307 250 -fill $color -tags {floor3 wall}
+ $w create line 258 250 243 250 -fill $color -tags {floor3 wall}
+}
+
+# Below is the "main program" that creates the floorplan demonstration.
+
+set w .floor
+global c tk_library currentRoom colors activeFloor
+catch {destroy $w}
+toplevel $w
+wm title $w "Floorplan Canvas Demonstration"
+wm iconname $w "Floorplan"
+wm geometry $w +20+20
+wm minsize $w 100 100
+
+label $w.msg -font $font -wraplength 8i -justify left -text "This window contains a canvas widget showing the floorplan of Digital Equipment Corporation's Western Research Laboratory. It has three levels. At any given time one of the levels is active, meaning that you can see its room structure. To activate a level, click the left mouse button anywhere on it. As the mouse moves over the active level, the room under the mouse lights up and its room number appears in the \"Room:\" entry. You can also type a room number in the entry and the room will light up."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+set f [frame $w.frame]
+pack $f -side top -fill both -expand yes
+set h [scrollbar $f.hscroll -highlightthickness 0 -orient horizontal]
+set v [scrollbar $f.vscroll -highlightthickness 0 -orient vertical]
+set f1 [frame $f.f1 -bd 2 -relief sunken]
+set c [canvas $f1.c -width 900 -height 500 -borderwidth 0 \
+ -highlightthickness 0 -xscrollcommand "$h set" -yscrollcommand "$v set"]
+pack $c -expand yes -fill both
+grid $f1 -padx 1 -pady 1 \
+ -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
+grid $v -padx 1 -pady 1 \
+ -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
+grid $h -padx 1 -pady 1 \
+ -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
+grid rowconfig $f 0 -weight 1 -minsize 0
+grid columnconfig $f 0 -weight 1 -minsize 0
+pack $f -expand yes -fill both -padx 1 -pady 1
+
+$v config -command "$c yview"
+$h config -command "$c xview"
+
+# Create an entry for displaying and typing in current room.
+
+entry $c.entry -width 10 -relief sunken -bd 2 -textvariable currentRoom
+
+# Choose colors, then fill in the floorplan.
+
+if {[winfo depth $c] > 1} {
+ set colors(bg1) #a9c1da
+ set colors(outline1) #77889a
+ set colors(bg2) #9ab0c6
+ set colors(outline2) #687786
+ set colors(bg3) #8ba0b3
+ set colors(outline3) #596673
+ set colors(offices) Black
+ set colors(active) #c4d1df
+} else {
+ set colors(bg1) white
+ set colors(outline1) black
+ set colors(bg2) white
+ set colors(outline2) black
+ set colors(bg3) white
+ set colors(outline3) black
+ set colors(offices) Black
+ set colors(active) black
+}
+set activeFloor ""
+floorDisplay $c 3
+
+# Set up event bindings for canvas:
+
+$c bind floor1 <1> "floorDisplay $c 1"
+$c bind floor2 <1> "floorDisplay $c 2"
+$c bind floor3 <1> "floorDisplay $c 3"
+$c bind room "newRoom $c"
+$c bind room {set currentRoom ""}
+bind $c <2> "$c scan mark %x %y"
+bind $c "$c scan dragto %x %y"
+bind $c "unset currentRoom"
+set currentRoom ""
+trace variable currentRoom w "roomChanged $c"
demos/floor.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/tcolor
===================================================================
--- demos/tcolor (nonexistent)
+++ demos/tcolor (revision 1765)
@@ -0,0 +1,358 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+# tcolor --
+# This script implements a simple color editor, where you can
+# create colors using either the RGB, HSB, or CYM color spaces
+# and apply the color to existing applications.
+#
+# SCCS: @(#) tcolor 1.11 96/06/24 16:43:11
+
+wm title . "Color Editor"
+
+# Global variables that control the program:
+#
+# colorSpace - Color space currently being used for
+# editing. Must be "rgb", "cmy", or "hsb".
+# label1, label2, label3 - Labels for the scales.
+# red, green, blue - Current color intensities in decimal
+# on a scale of 0-65535.
+# color - A string giving the current color value
+# in the proper form for x:
+# #RRRRGGGGBBBB
+# updating - Non-zero means that we're in the middle of
+# updating the scales to load a new color,so
+# information shouldn't be propagating back
+# from the scales to other elements of the
+# program: this would make an infinite loop.
+# command - Holds the command that has been typed
+# into the "Command" entry.
+# autoUpdate - 1 means execute the update command
+# automatically whenever the color changes.
+# name - Name for new color, typed into entry.
+
+set colorSpace hsb
+set red 65535
+set green 0
+set blue 0
+set color #ffff00000000
+set updating 0
+set autoUpdate 1
+set name ""
+
+# Create the menu bar at the top of the window.
+
+frame .menu -relief raised -borderwidth 2
+pack .menu -side top -fill x
+menubutton .menu.file -text File -menu .menu.file.m -underline 0
+menu .menu.file.m
+.menu.file.m add radio -label "RGB color space" -variable colorSpace \
+ -value rgb -underline 0 -command {changeColorSpace rgb}
+.menu.file.m add radio -label "CMY color space" -variable colorSpace \
+ -value cmy -underline 0 -command {changeColorSpace cmy}
+.menu.file.m add radio -label "HSB color space" -variable colorSpace \
+ -value hsb -underline 0 -command {changeColorSpace hsb}
+.menu.file.m add separator
+.menu.file.m add radio -label "Automatic updates" -variable autoUpdate \
+ -value 1 -underline 0
+.menu.file.m add radio -label "Manual updates" -variable autoUpdate \
+ -value 0 -underline 0
+.menu.file.m add separator
+.menu.file.m add command -label "Exit program" -underline 0 \
+ -command "destroy ."
+pack .menu.file -side left
+
+# Create the command entry window at the bottom of the window, along
+# with the update button.
+
+frame .bot -relief raised -borderwidth 2
+pack .bot -side bottom -fill x
+label .commandLabel -text "Command:"
+entry .command -relief sunken -borderwidth 2 -textvariable command \
+ -font {Courier 12}
+button .update -text Update -command doUpdate
+pack .commandLabel -in .bot -side left
+pack .update -in .bot -side right -pady .1c -padx .25c
+pack .command -in .bot -expand yes -fill x -ipadx 0.25c
+
+# Create the listbox that holds all of the color names in rgb.txt,
+# if an rgb.txt file can be found.
+
+frame .middle -relief raised -borderwidth 2
+pack .middle -side top -fill both
+foreach i {/usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt
+ /X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt
+ /usr/openwin/lib/X11/rgb.txt} {
+ if ![file readable $i] {
+ continue;
+ }
+ set f [open $i]
+ frame .middle.left
+ pack .middle.left -side left -padx .25c -pady .25c
+ listbox .names -width 20 -height 12 -yscrollcommand ".scroll set" \
+ -relief sunken -borderwidth 2 -exportselection false
+ bind .names {
+ tc_loadNamedColor [.names get [.names curselection]]
+ }
+ scrollbar .scroll -orient vertical -command ".names yview" \
+ -relief sunken -borderwidth 2
+ pack .names -in .middle.left -side left
+ pack .scroll -in .middle.left -side right -fill y
+ while {[gets $f line] >= 0} {
+ if {[llength $line] == 4} {
+ .names insert end [lindex $line 3]
+ }
+ }
+ close $f
+ break
+}
+
+# Create the three scales for editing the color, and the entry for
+# typing in a color value.
+
+frame .middle.middle
+pack .middle.middle -side left -expand yes -fill y
+frame .middle.middle.1
+frame .middle.middle.2
+frame .middle.middle.3
+frame .middle.middle.4
+pack .middle.middle.1 .middle.middle.2 .middle.middle.3 -side top -expand yes
+pack .middle.middle.4 -side top -expand yes -fill x
+foreach i {1 2 3} {
+ label .label$i -textvariable label$i
+ scale .scale$i -from 0 -to 1000 -length 6c -orient horizontal \
+ -command tc_scaleChanged
+ pack .scale$i .label$i -in .middle.middle.$i -side top -anchor w
+}
+label .nameLabel -text "Name:"
+entry .name -relief sunken -borderwidth 2 -textvariable name -width 10 \
+ -font {Courier 12}
+pack .nameLabel -in .middle.middle.4 -side left
+pack .name -in .middle.middle.4 -side right -expand 1 -fill x
+bind .name {tc_loadNamedColor $name}
+
+# Create the color display swatch on the right side of the window.
+
+frame .middle.right
+pack .middle.right -side left -pady .25c -padx .25c -anchor s
+frame .swatch -width 2c -height 5c -background $color
+label .value -textvariable color -width 13 -font {Courier 12}
+pack .swatch -in .middle.right -side top -expand yes -fill both
+pack .value -in .middle.right -side bottom -pady .25c
+
+# The procedure below is invoked when one of the scales is adjusted.
+# It propagates color information from the current scale readings
+# to everywhere else that it is used.
+
+proc tc_scaleChanged args {
+ global red green blue colorSpace color updating autoUpdate
+ if $updating {
+ return
+ }
+ if {$colorSpace == "rgb"} {
+ set red [format %.0f [expr [.scale1 get]*65.535]]
+ set green [format %.0f [expr [.scale2 get]*65.535]]
+ set blue [format %.0f [expr [.scale3 get]*65.535]]
+ } else {
+ if {$colorSpace == "cmy"} {
+ set red [format %.0f [expr {65535 - [.scale1 get]*65.535}]]
+ set green [format %.0f [expr {65535 - [.scale2 get]*65.535}]]
+ set blue [format %.0f [expr {65535 - [.scale3 get]*65.535}]]
+ } else {
+ set list [hsbToRgb [expr {[.scale1 get]/1000.0}] \
+ [expr {[.scale2 get]/1000.0}] \
+ [expr {[.scale3 get]/1000.0}]]
+ set red [lindex $list 0]
+ set green [lindex $list 1]
+ set blue [lindex $list 2]
+ }
+ }
+ set color [format "#%04x%04x%04x" $red $green $blue]
+ .swatch config -bg $color
+ if $autoUpdate doUpdate
+ update idletasks
+}
+
+# The procedure below is invoked to update the scales from the
+# current red, green, and blue intensities. It's invoked after
+# a change in the color space and after a named color value has
+# been loaded.
+
+proc tc_setScales {} {
+ global red green blue colorSpace updating
+ set updating 1
+ if {$colorSpace == "rgb"} {
+ .scale1 set [format %.0f [expr $red/65.535]]
+ .scale2 set [format %.0f [expr $green/65.535]]
+ .scale3 set [format %.0f [expr $blue/65.535]]
+ } else {
+ if {$colorSpace == "cmy"} {
+ .scale1 set [format %.0f [expr (65535-$red)/65.535]]
+ .scale2 set [format %.0f [expr (65535-$green)/65.535]]
+ .scale3 set [format %.0f [expr (65535-$blue)/65.535]]
+ } else {
+ set list [rgbToHsv $red $green $blue]
+ .scale1 set [format %.0f [expr {[lindex $list 0] * 1000.0}]]
+ .scale2 set [format %.0f [expr {[lindex $list 1] * 1000.0}]]
+ .scale3 set [format %.0f [expr {[lindex $list 2] * 1000.0}]]
+ }
+ }
+ set updating 0
+}
+
+# The procedure below is invoked when a named color has been
+# selected from the listbox or typed into the entry. It loads
+# the color into the editor.
+
+proc tc_loadNamedColor name {
+ global red green blue color autoUpdate
+
+ if {[string index $name 0] != "#"} {
+ set list [winfo rgb .swatch $name]
+ set red [lindex $list 0]
+ set green [lindex $list 1]
+ set blue [lindex $list 2]
+ } else {
+ case [string length $name] {
+ 4 {set format "#%1x%1x%1x"; set shift 12}
+ 7 {set format "#%2x%2x%2x"; set shift 8}
+ 10 {set format "#%3x%3x%3x"; set shift 4}
+ 13 {set format "#%4x%4x%4x"; set shift 0}
+ default {error "syntax error in color name \"$name\""}
+ }
+ if {[scan $name $format red green blue] != 3} {
+ error "syntax error in color name \"$name\""
+ }
+ set red [expr $red<<$shift]
+ set green [expr $green<<$shift]
+ set blue [expr $blue<<$shift]
+ }
+ tc_setScales
+ set color [format "#%04x%04x%04x" $red $green $blue]
+ .swatch config -bg $color
+ if $autoUpdate doUpdate
+}
+
+# The procedure below is invoked when a new color space is selected.
+# It changes the labels on the scales and re-loads the scales with
+# the appropriate values for the current color in the new color space
+
+proc changeColorSpace space {
+ global label1 label2 label3
+ if {$space == "rgb"} {
+ set label1 Red
+ set label2 Green
+ set label3 Blue
+ tc_setScales
+ return
+ }
+ if {$space == "cmy"} {
+ set label1 Cyan
+ set label2 Magenta
+ set label3 Yellow
+ tc_setScales
+ return
+ }
+ if {$space == "hsb"} {
+ set label1 Hue
+ set label2 Saturation
+ set label3 Brightness
+ tc_setScales
+ return
+ }
+}
+
+# The procedure below converts an RGB value to HSB. It takes red, green,
+# and blue components (0-65535) as arguments, and returns a list containing
+# HSB components (floating-point, 0-1) as result. The code here is a copy
+# of the code on page 615 of "Fundamentals of Interactive Computer Graphics"
+# by Foley and Van Dam.
+
+proc rgbToHsv {red green blue} {
+ if {$red > $green} {
+ set max $red.0
+ set min $green.0
+ } else {
+ set max $green.0
+ set min $red.0
+ }
+ if {$blue > $max} {
+ set max $blue.0
+ } else {
+ if {$blue < $min} {
+ set min $blue.0
+ }
+ }
+ set range [expr $max-$min]
+ if {$max == 0} {
+ set sat 0
+ } else {
+ set sat [expr {($max-$min)/$max}]
+ }
+ if {$sat == 0} {
+ set hue 0
+ } else {
+ set rc [expr {($max - $red)/$range}]
+ set gc [expr {($max - $green)/$range}]
+ set bc [expr {($max - $blue)/$range}]
+ if {$red == $max} {
+ set hue [expr {.166667*($bc - $gc)}]
+ } else {
+ if {$green == $max} {
+ set hue [expr {.166667*(2 + $rc - $bc)}]
+ } else {
+ set hue [expr {.166667*(4 + $gc - $rc)}]
+ }
+ }
+ if {$hue < 0.0} {
+ set hue [expr $hue + 1.0]
+ }
+ }
+ return [list $hue $sat [expr {$max/65535}]]
+}
+
+# The procedure below converts an HSB value to RGB. It takes hue, saturation,
+# and value components (floating-point, 0-1.0) as arguments, and returns a
+# list containing RGB components (integers, 0-65535) as result. The code
+# here is a copy of the code on page 616 of "Fundamentals of Interactive
+# Computer Graphics" by Foley and Van Dam.
+
+proc hsbToRgb {hue sat value} {
+ set v [format %.0f [expr 65535.0*$value]]
+ if {$sat == 0} {
+ return "$v $v $v"
+ } else {
+ set hue [expr $hue*6.0]
+ if {$hue >= 6.0} {
+ set hue 0.0
+ }
+ scan $hue. %d i
+ set f [expr $hue-$i]
+ set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]]
+ set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]]
+ set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]]
+ case $i \
+ 0 {return "$v $t $p"} \
+ 1 {return "$q $v $p"} \
+ 2 {return "$p $v $t"} \
+ 3 {return "$p $q $v"} \
+ 4 {return "$t $p $v"} \
+ 5 {return "$v $p $q"}
+ error "i value $i is out of range"
+ }
+}
+
+# The procedure below is invoked when the "Update" button is pressed,
+# and whenever the color changes if update mode is enabled. It
+# propagates color information as determined by the command in the
+# Command entry.
+
+proc doUpdate {} {
+ global color command
+ set newCmd $command
+ regsub -all %% $command $color newCmd
+ eval $newCmd
+}
+
+changeColorSpace hsb
demos/tcolor
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/images/letters.bmp
===================================================================
--- demos/images/letters.bmp (nonexistent)
+++ demos/images/letters.bmp (revision 1765)
@@ -0,0 +1,27 @@
+#define letters_width 48
+#define letters_height 48
+static char letters_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0xfe, 0xff, 0xff, 0xff, 0x3f, 0x00, 0x02, 0x00, 0x00, 0x00, 0x20,
+ 0x00, 0xfa, 0x00, 0x00, 0x00, 0x2e, 0x00, 0x02, 0x00, 0x00, 0x00, 0x2a,
+ 0x00, 0x3a, 0x00, 0x00, 0x00, 0x2a, 0x00, 0x02, 0x00, 0x00, 0x00, 0x2e,
+ 0xe0, 0xff, 0xff, 0xff, 0xff, 0x21, 0x20, 0x00, 0x00, 0x00, 0x00, 0x21,
+ 0xa0, 0x03, 0x00, 0x00, 0x70, 0x21, 0x20, 0x00, 0x00, 0x00, 0x50, 0x21,
+ 0xa0, 0x1f, 0x00, 0x00, 0x50, 0x21, 0x20, 0x00, 0x00, 0x00, 0x70, 0x21,
+ 0xfe, 0xff, 0xff, 0xff, 0x0f, 0x21, 0x02, 0x00, 0x00, 0x00, 0x08, 0x21,
+ 0xfa, 0x01, 0x00, 0x80, 0x0b, 0x21, 0x02, 0x00, 0x00, 0x80, 0x0a, 0x21,
+ 0xba, 0x01, 0x00, 0x80, 0x0a, 0x21, 0x02, 0x00, 0x00, 0x80, 0x0b, 0x21,
+ 0x3a, 0x00, 0x00, 0x00, 0x08, 0x21, 0x02, 0x00, 0x00, 0x00, 0x08, 0x21,
+ 0x02, 0xc0, 0xfb, 0x03, 0x08, 0x21, 0x02, 0x00, 0x00, 0x00, 0x08, 0x3f,
+ 0x02, 0xc0, 0xbd, 0x0f, 0x08, 0x01, 0x02, 0x00, 0x00, 0x00, 0x08, 0x01,
+ 0x02, 0xc0, 0x7f, 0x7b, 0x08, 0x01, 0x02, 0x00, 0x00, 0x00, 0x08, 0x01,
+ 0x02, 0x00, 0x00, 0x00, 0xf8, 0x01, 0x02, 0x00, 0x00, 0x00, 0x08, 0x00,
+ 0x02, 0x00, 0x00, 0x00, 0x08, 0x00, 0x02, 0x00, 0x00, 0x00, 0x08, 0x00,
+ 0x02, 0x00, 0x00, 0x00, 0x08, 0x00, 0x02, 0x00, 0x00, 0x00, 0x08, 0x00,
+ 0xfe, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
demos/images/letters.bmp
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/images/earthris.gif
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: demos/images/earthris.gif
===================================================================
--- demos/images/earthris.gif (nonexistent)
+++ demos/images/earthris.gif (revision 1765)
demos/images/earthris.gif
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Index: demos/images/gray25.bmp
===================================================================
--- demos/images/gray25.bmp (nonexistent)
+++ demos/images/gray25.bmp (revision 1765)
@@ -0,0 +1,6 @@
+#define grey_width 16
+#define grey_height 16
+static char grey_bits[] = {
+ 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44,
+ 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44,
+ 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44};
demos/images/gray25.bmp
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/images/tcllogo.gif
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: demos/images/tcllogo.gif
===================================================================
--- demos/images/tcllogo.gif (nonexistent)
+++ demos/images/tcllogo.gif (revision 1765)
demos/images/tcllogo.gif
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Index: demos/images/earth.gif
===================================================================
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Index: demos/images/earth.gif
===================================================================
--- demos/images/earth.gif (nonexistent)
+++ demos/images/earth.gif (revision 1765)
demos/images/earth.gif
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Index: demos/images/teapot.ppm
===================================================================
--- demos/images/teapot.ppm (nonexistent)
+++ demos/images/teapot.ppm (revision 1765)
@@ -0,0 +1,56 @@
+P6
+256 256
+255
+\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À[7 eOLjQLmSMoTMnSMlRMhPL_9 \À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀnSMtVMzYN~[N~[N\N\O€\O€]O€]O€]O€]O€\O€\O}[NyYNtVM\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀG- wXN}[N€]O„^O†_O†`O‡`Oˆ`Oˆ`OˆaO‰aO‰aO‰aO‰aO‰aO‰aOˆaOˆ`O†_Oƒ^O\N \À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀaMLyYN…_O‰aP‹bPcPŽcPŽdPŽdPdPdPdPdPdPdPdPeP‘eP’eP’eP‘ePdPcP…_OpUM\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀwXN…_OdP“fP•gQ–hQ˜hQ˜iQ™iQ™iQšiQšiQšjQ›jQ›jQœjQœjQœjQœjQœjQ›jQœjQ™iQ“fP‡`O\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀNCJiQL‹bP—hQkQ¡mR¤nR¥oR¥oR¥oR¥oR¥oR¥oR¦oR¦oR¦pR¨pS©qSªqS«rS¬rS«rS©qS¤oRœjQ€]O\KK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀfOLrUMcPŸlR©qS¯tS²uTµwT·xT¸xT¹yTºyT»zT»zU¼zU¼zU¼zU»zUºyT¸xT¶wT¯tS¡mR‰aOhPL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\Àa0 cNLqUM€\O”fQ¦pS²wVºzV¿|VÂ}VÄVÆVÇ€VÉ‚WÌ…[Õeæ w÷³‹êª…Ĉg§qT“fQ{ZNYIK9 \À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀO1 {G#‘JkRMqUMtVN–iS¨v\·€d¹bµzZ±vU°uT®sSªqS¤nRœjQ’eP„^OrUMHh>!T4 \À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀG- V5 wE"~I#†M%U+¥e7²l:°g2®b*a(`(©^(¥])¡^-›]1ŠS,qC$`9 R3 G- \À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À@) J/ i>!pA"tD"wF$yH&xH&tE$wE#yG%}M+ƒT4S5mE*Z7!K/ B* ;' \À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À‰aO¦oR½{UÇ€VÏ…X<( F- a: e!j@#k@$h>"dµf-¨^(¡Z'šW&–T&œN>) F- J/ b; g>#nD(jB&c y< u: r9 o7 l6
+j5
+h4
+g3
+5$ D, K/ b; h>"wM1tK.e="a<#cA,U8&E- <( 9& .!a0 b1 c1
+
++ 3# @) 46G<:HMCIXHK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀU*´vT¿~X¸{YÃk+›W&‰N$|> u: p8 k5
+f3
+a0 _/ ]. [- I¡\*ª_(‘LkRMmSMmSMnSMnSMD, R3 W5 mA"|O0|P1j?"c!a: X/K% & 4$ +2F=;HPEJL&\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀŸlR¶xTsTµd)ŠO$w; m6
+g3
+a0 Z- \/ T*Q(ŠHµm8kRMmSMnTMoTMpTMpUM15G15G05G04G04GpUMpTM5^9 d!Y0 W+]. s=‡M$dPŸlR\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀoTM¥oRdPvE"V+K%A 9 9 †F¤['qUMtVM99H:9H:9H:9H:9H:9H:9H:9H:9H:9H99H99H99H99H99H99H:9H;:H>;HB=HPDJ\JKmSMwXN|ZN°y[ᦆ֘uº{W¹yU¿€]Á„btU£nR—hQˆaO{ZNvWNtVMvXNwXNyYNzYN{ZN|ZN}[N}[N~[N~[N~[N~[N~[N~[N~[N}[N}[N{ZNzYNxXN…L$f3
+ I$L&P(U*\. €J#\O›jQ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀžkR‰aOo9
+L&C!: 4 f3
+X&pUMuWMwXNxXN<:H<:H<:H<:H<;H<;H<;H<;H=;H=;H=;H=;H>;H>;H?HG@ILBIREJ[JKcNLjQL§pR±uTºzUÃ~VÈWË‚XÖŽcäsÒŽe¼{V²vT¨pSžkR•gQŒbP†_O‚^O]O€\O€\O€\O€\O€]O]O]O]O]O]O]O]O]O]O]O€\O€\O~\N}[N|ZNxXN•T%H$ G#K%Q(W+zG#nTM˜iQ\À\À\À\À\À\À\À\À\À\À\À\ÀdOLrUMuWNwXNyYN{ZN}[N{ZNwXNsVM \À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\Àˆ`OcPnA"M&@ 8 F# m6
+›W&rVMvWNyYNzYN|ZN}[N}[N>HE?IG@IIAIKBIODJSFJWHK—hQŸlR§pR°b(¾i*Én+Ù|7Û|6Ïr,Íq+Êp-Ãl+»g)±b(®sS§pS lRšiQ•gQePcPŠaPˆaO‡`O‡`O†_O†_O…_O…_O…_O…_O…_O…_O…_O„_O„^O„^Oƒ^Oƒ^O‚]O]O€\O~[N{ZN•T% F#B!Y,L&U*~I#„^O†`O\À\À\À\ÀcNLrUMzYN\O„^Oˆ`OŠbPŒcPdPeP’fP“fP“fQ“fQ”fQ‘ePcP‰aP~[N \À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À’fPsVM^/ C!7
+ ŽQ%tVMwXNzYN|ZN}[N\N\O€\O]O]O‚]O‚]OA=HB=HB=HB>HC>HC>ID?IE?IF@IG@IIAIKBIŒcPdP’eP–gQšiQŸlR£nR¤\'´d)¿i*Æm+Îs/Ïs/Êo+Én+Ål*¾i*ºg)³c(ª_(ªqS¦oR¡mRkQ™iQ•gQ“fP‘ePŽdPcPŒbP‹bPŠbPŠaP‰aP‰aO‰aOˆaOˆ`Oˆ`O‡`O‡`O‡`O†`O†_O…_O„^Oƒ^O‚]O\O}[N›Q D"? D"K%_/ kRL’fPODJSFJ†_OŠbPŽcP‘eP“fQ–gQ™iQœjQžkR lR¡mR£nR¤nR¥oR¥oR¥oR¤nR¢mRŸlRšiQ‘eP…_O\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀB+ ‘ePI#L&9 0 y< šPxXN{ZN}[N\N€\O]O‚]Oƒ^Oƒ^O„^O„_O…_O…_O†_O†`O‡`O‡`Oˆ`O‰aOŠaP‹bPŒbPcPŽdP‘eP“fP•gQ˜hQšiQžkR¢mR¡Z'«_(¶e)½h)Âk*Çn,Çn,Æm*Æl*Áj*ºf)¶e)²c(«_(¦]'§pR¤nR¡mRžkR›jQ™iQ–gQ”gQ“fP‘ePdPdPŽdPŽcPcPŒcPŒbP‹bP‹bP‹bPŠbPŠaP‰aP‰aO‰aOˆ`O‡`O†_O…_Oƒ^O]Oª_(@ B!I$B!N'w=‘eP`LKbNLeOLkR mR£nR¥oR§pSªqS¬rS®sS¯tS°tS°tS±uS±uS°tS¯tSsSªrS§pS¢mRšjQŒbPjQL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À‹bPpTME"5 ‡M$tVM{ZN}[N\O]O‚^Oƒ^O„_O…_O†_O†`O‡`Oˆ`Oˆ`O‰aO‰aPŠaPŠbP‹bPŒbPcPŽcPdPdP’eP“fP•gQ—hQ™iQ›jQkR lR¢mR¡Z'¬`(µd)ºg)ÇgÀj*Àj*¾i*¿i*»g)µd)²c(¯a(ª_(¤\'§pR¥oR¢nR mRžkRœjQšiQ˜iQ—hQ•gQ”gQ“fP’eP‘eP‘ePdPdPdPŽcPŽcPcPcPŒcPŒbP‹bP‹bPŠbPŠaP‰aOˆ`O†_O„^O\NœQ @ < G#_LKŽcPlSMnTMpUMsVM°tS²uT³vTµwT¶wT¶xT¶xT¶wTµwT´vT²uT¯tS¬sSªqS§pS¤oR¢nRžkR˜hQ‹bPeOL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀwXN\NJ%0 1ŽJvWN}[N\O]Oƒ^O…_O†_O†`O‡`Oˆ`O‰aO‰aPŠaPŠbP‹bPŒbPŒbPcPŽcPŽdPdPdP‘eP’eP”fQ•gQ–gQ˜hQ™iQ›jQkQŸlR¡mRžY&¦]'`(³c(·e)Àc¸\¸\¹\º]»]¶^®a(¬`(©^'£['¢['¥oR£nR¡mR lRžkRœkQ›jQšiQ˜iQ—hQ–gQ•gQ”gQ”fQ“fP’eP’eP‘eP‘ePdPdPdPdPŽdPŽcPcPcPŒbP‹bPŠaPˆaO†`O]O˜O G#7F#uWMƒ^OwXNxXNzYN{ZN|ZN¹yT¸yT·xT´wT±uTsS¨pS¡mRœjQ•gQdPŒbP‰aP‰aPŒbPŽcP‘ePcP|ZN\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À[JKŠbP^/ 1 01|> wXN}[N]Oƒ^O…_O‡`O‡`OˆaO‰aPŠaP‹bP‹bPŒbPŒcPcPŽcPŽcPdPdPdP‘eP’eP“fP”fQ•gQ–gQ—hQ˜hQ™iQ›jQœkQžkRŸlR mRžY&¦]'`(±b(·[Çg Éi Éh ÅfÂdÃe¿c«Uª_(§]'£[' Z'¤nR£nR¡mR mRŸlRžkRkQœjQšjQšiQ™iQ˜hQ—hQ–gQ•gQ•gQ”fQ”fQ“fP“fP’eP’eP‘eP‘ePePdPdPdPŽcPcPŒbPŠbPˆ`Oƒ^O‰D
+ 4M&dPnSM|[N|[O|[OzZOxXNªrS¢nR˜hQŽcPƒ^OvXNiQL^KKRFJMCJJAIKBISFJ\JKnSMxYN†_O€\OaMK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀB!qUMŠaPC!/00a0 uWN}[N‚]O…_O†`Oˆ`O‰aPŠaP‹bPŒbPŒcPcPŽcPŽcPdPdPdP‘eP‘eP’eP“fP“fQ”fQ•gQ–gQ—hQ˜hQ™iQ™iQ›jQœjQkRžlRŸlRœX&¢['¨^'¬`(´ZÂdÄf Èi Æg Âd¿c¿c¼a¸_©T¥\'£[' Z'ŸY&£nR¢mR¡mR lRŸlRžkRkQœjQ›jQšjQšiQ™iQ˜hQ—hQ—hQ–hQ–gQ•gQ•gQ”gQ”fQ”fQ“fQ“fP’fP’eP‘eP‘ePdPdPŽcPŒbP‰aOƒ^Ox< : ŠaP]Oj8sVMmSMfOL^KKUGJIAIQEJ?IeZY638* B\À\À\À\À\À, 4 .G1!\TU¡ƒrsVM{ZN`MK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À[JKyYNŒbP/0 ˆN$]O…_Oˆ`O‹bPŒbPcPŽcPdPdPdP‘eP‘eP’eP’fP“fP“fQ”fQ”gQ•gQ–gQ–gQ—hQ—hQ˜hQ™iQ™iQšiQ›jQœjQœkQkRžkRŸlRœO¡Z'¥\'©^'V¼a¾bÁe Æi!Ãf ¾b»a¹`·_³]²\µZ¢[' Z'ŸY&œQ¡mR¡mR mR lRŸlRŸlRžkRkRkQœkQœjQ›jQ›jQšjQšiQšiQ™iQ™iQ˜iQ˜hQ˜hQ—hQ—hQ—hQ–hQ–gQ–gQ•gQ•gQ”fQ’fPdPcPšW& dPŠaPrUM
+ B\À\À\À\À\À\À\À\À\À\À%7!!C*F#P) {dYœze»p€\OgPL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀSFJ`LKvWNŠaPm6
+ X,uWM‚]O‡`OŠbPcPŽdPdPdP‘eP’eP’fP“fP“fQ”fQ”gQ•gQ•gQ–gQ–gQ—hQ—hQ˜hQ˜iQ™iQ™iQšiQ›jQ›jQœjQœkQkQžkRžlRŸlR¢Z'¤\'§]'·_¹`¼a½bÁe Åi"Áe ¼aº`·_¶_²]²\±\«Y¡Z' Z'¡Z'¡mR¡mR mR lR lRŸlRŸlRžlRžkRžkRkRkQœkQœjQœjQ›jQ›jQ›jQšjQšiQšiQšiQ™iQ™iQ™iQ˜iQ˜hQ˜hQ—hQ–gQ•gQ“fQdP†_Oq8 –gQˆ`OuWM”T%\À\À\À\À\À\À\À\À\À\À B B!!T,c5ƒF‚T3È›~Æ“qƒ^OfOL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀXHK_LKsVM‡`OcP ’S%]OŠbPcPdP‘eP’eP“fP“fQ”fQ”gQ•gQ•gQ–gQ–gQ—hQ—hQ—hQ˜hQ˜iQ™iQ™iQšiQšiQ›jQ›jQœjQœjQkQkRžkRžlRŸlRŸlR¥\'¦]'¨^'Vº`»a½bÁf Äi"Àe »a¹`·_¶_³]±\±\¤R¢Z'¢Z'£['¡mR¡mR¡mR¡mR mR lR lRŸlRŸlRŸlRžlRžkRžkRkRkRkQkQœjQœjQœjQœjQœjQ›jQ›jQ›jQ›jQšjQšiQ™iQ™iQ˜hQ–gQ‘eP§Sq8 ‰aO•gQ‡`OtVMœX&\À\À\À\À\À\À\À\À\À\À B B B l@!{A…L$›Y'½†a“fPˆaO]KK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀODJ[JKaMKqUM\OcPƒ^O vE"‚]OŠaPdP‘eP“fP”fQ•gQ•gQ–gQ–hQ—hQ—hQ˜hQ˜hQ˜iQ™iQ™iQ™iQšiQšjQ›jQ›jQœjQœjQœkQkQkRžkRžkRŸlRŸlRŸlR lR©^'©^'ª_(®W»a¼a¾c Âg Äi"¿e »a¹`·_¶_ ³^±\±\¤R£['£['§]'¢mR¢mR¡mR¡mR¡mR¡mR mR lR lR lR lRŸlRŸlRŸlRŸlRžlRžlRžkRžkRžkRžkRkRkRkRkRkQkQkQœjQœjQšiQ˜hQ’ePšW&M& oTMšiQ‘eP…_OtVMmSMdOL\À\À\À\À\À\À\À\À\À B B B ‘J Z'ª_(œkQ™iQ‡`OSFJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀTFJ\JKcNLlRMzYN‡`O’ePzZN \Nˆ`OdP“fQ•gQ–gQ—hQ˜hQ˜hQ™iQ™iQ™iQšiQšiQšiQ›jQ›jQ›jQœjQœjQœjQœkQkQkRžkRžkRžlRŸlRŸlRŸlR lR lR mR®a(`(¬`(¶[½a½b¿d Ãh!Äi"¿d »a¹`¸_¶_µ^²]³]¦S¤\'§]'«_(¢nR¢mR¢mR¢mR¢mR¢mR¢mR¡mR¡mR¡mR¡mR¡mR mR mR mR mR lR lR lR lR lR lR lR lR lRŸlRŸlR lRŸlRžkRœkQ™iQePt: kQ˜hQcP€]OtVMlSMa2
+\À\À\À\À\À\À\À\À\À B B
+$ 5 ¬`(¶e)£nRœjQƒ^OJAI\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀXIK^KKdNLhPLuWM‚]OŒbP”fQeP
+m6
+†`OŽcP“fQ—hQ˜hQ™iQšiQšjQ›jQ›jQ›jQœjQœjQœjQœkQkQkQkRžkRžkRžkRžlRŸlRŸlRŸlR lR lR lR¡mR¡mR¡mR¡mRºg)³c(²c(±b(V¿cÂe Åi!Åi!Àd ¼bº`¹`·_·_¶^¢Q§]'ª_(`(¹f)£nR£nR£nR£nR£nR£nR£nR¢nR¢nR¢nR¢nR¢nR¢nR¢mR¢mR¢mR¢mR¢mR¢mR¢mR¢mR¢mR¢nR¢mR¢mR£nR¢mR¢mR¡mR mRkR—hQˆGa0 ŠbP mRœjQ“fQ‰aP}[NrUMmSM…L$\À\À\À\À\À\À\À\À B B
+#C, 8& H. Z7 §pR›jQ{ZN\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀQEJ[JK`LKdNLhQLqUM{ZN…_OŽcP–gQ—hQ
+‹bP‘eP–hQšiQ›jQœjQkQkQkRžkRžkRžlRžlRŸlRŸlRŸlRŸlRŸlR lR lR lR mR¡mR¡mR¡mR¡mR¡mR¢mR¢mR¢mR¢nR£nRÀj*ºg)·e)¶d)Âd°XÅg Åh Âe ¿c½b½b¾bªU`(®a(¯a(³c(¾i*¤oR¤oR¤nR¤nR¤nR¤nR¤nR¤nR¤nR¤nR¤nR¤nR¤nR¤nR¤nR¤nR¤nR¤oR¤oR¥oR¥oR¥oR¥oR¥oR¥oR¦oR¦oR¥oR¥oR¤nR¡mR›jQŽQ%Z- œjQ£nRŸlR—hQŽdP…_OuWMpTMnSMkRLa: \À\À\À\À\À\À\À B B&D 2
+@* S6#G@IPDJ˜hQmSM\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀVGJ]KKbMLeOLiQLlRMvWN\OˆaO‘eP—hQœjQ•gQ oTM•gQ™iQkQŸlRŸlR lR mR¡mR¡mR¡mR¡mR¡mR¡mR¡mR¢mR¢mR¢mR¢mR¢mR¢mR¢nR£nR£nR£nR£nR£nR¤nR¤nR¤nR¤nR¤nR¤nRÆl*Ãl+¾j+¹g)¸f)¶e)µd)¶e)¶e)·e)·e)¸f)¾i*Ìs0Ðs.¦oR¦oR¦oR¦oR¦oR¦oR¦oR¦oR¦oR¦oR¦oR¦oR¦oR¦oR¦oR¦oR¦pR§pR§pR§pR§pR§pS§pS¨pS¨qS©qS©qS©qS¨pS©qS§pS¤nRŸlR‘I˜hQ§pR¥oR¡mRšiQ’ePŠaP€\OsVMpTMnTMlRM–X)\À\À\À\À\À\À\À B%C)D $ ; J/ [8"LBITGJYIKWHK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀNCJYIK_LKcNLgPLjQLlRMpUMzYNƒ^O‹bP‘eP˜hQkQŸlR”fQ- —hQ›jQŸlR¢mR£nR£nR£nR¤nR¤nR¤nR¤nR¤nR¤nR¤nR¤oR¤oR¥oR¥oR¥oR¥oR¥oR¥oR¥oR¥oR¥oR¥oR¥oR¦oR¦oR¦oR¦oR¦oR¦pR¦pR§pRàpßy-Ûw-Ûw-Þy.â{-ãu §pS§pS§pS§pS§pS¨pS¨pS¨pS¨pS¨pS¨pS¨pS¨pS¨pS¨pS¨qS©qS©qS©qS©qS©qS©qS©qSªqSªrS«rS«rS¬rS¬rS¬rS¬rS¬sS«rSªqS¦oRšiQ™iQ©qSªqS§pR¡mRœjQ•gQcP„_O{ZNtVMpUMoTMmSMjQL_9 \À\À\À\À\À B "C(D#* A$[<)dI\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀSFJ[JKaMKeOLhPLkRLmSMoTMuWM}[N…_O‹bP’eP˜hQžkR¢mR£nRžkR!-EkR¡mR¤nR¥oR¦pR§pR§pS§pS§pS§pS§pS§pS§pS§pR§pS§pS§pS§pS¨pS¨pS¨pS¨pS¨pS¨pS¨pS¨pS¨pS¨pS¨pS¨pS¨pS¨pS¨qS¨qS¨qS©qS©qS©qS©qS©qS©qS©qS©qS©qS©qS©qSªqSªqSªqSªqSªrS«rS«rS«rS«rS«rS«rS¬rS¬rS¬rS¬sSsS®sS®sS¯tS¯tS¯tS¯tS°tS°uS°tS®sS«rS£nR¦oR®sSsS«rS§pR¢mRœjQ–gQdPˆaO\OyYNuWMqUMoTMnSMkRLo8
+\À\À\À\À\À B'D +E$ ( 1 J/ jH1NCJUGJYIKUGJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀXHK]KKbNLfOLiQLkRMmSMoTMqUMxXN\N†_OŒbP’fP˜hQkQ¡mR¥oR§pS¦pR˜hQ¢mR¥oR¨pSªqS«rS«rS«rS«rS«rS«rS«rS«rS«rS«rS«rSªrSªrSªrS«rS«rS«rS«rS«rS«rS«rS«rS«rS«rS«rS«rS«rS«rS«rS«rS¬rS¬rS¬rS¬rS¬rS¬rS¬rS¬sS¬sSsSsSsSsSsSsS®sS®sS®sS®sS®tS¯tS°tS°uS±uS±uT±uT²uT²uT²uT´vTµwT´vT³vT²uT¯tS¢mR¯tS±uT±uS®tS«rS§pR¢mRkQ—hQ‘ePŠaPƒ^O\N{ZNvXNqUMpTMnSMlRMP%\À\À\À\À B#C*E$.E- .!G$Y:%d<"SFJYIKZIKNCJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀPDJZIK_LKdNLgPLjQLlRMnSMpTMqUMuWMyYN€\O†`OcP’fP—hQœjQ¡mR¥oR¨qS«rS«rSªrS mR «rSsS¯tS°tS°tS°tS¯tS¯tS¯tS¯tS¯tS¯tS¯tS¯tS¯tS¯tS®tS®sS®sS®sS®sS®sS®sS®sS®sS®sS®tS®tS®tS¯tS¯tS¯tS¯tS¯tS¯tS¯tS¯tS¯tS¯tS°tS°tS°tS±uS±uS±uT²uT²vT³vT³vT´vT´vT´wTµwTµwTµwT·xT·xT¸xT¸yT¸yU·xU¥\'©qS³vTµwTµwT´vT±uT®tTªrS¦oR¡mRkQ˜hQ’eP‹bP‡`Oƒ^O€\O|ZNxXNtVMpTMoTMmSMjQLh7\À\À\À B(D"-E*1F, 4# K)pL5PEJWHK[JKXHK:9H\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀUGJ\JKaMLeOLhPLkRLmSMoTMpUMrVMvWNyYN|ZN]O‡`OŒcP‘eP—hQ›jQ lR¤nR§pSªqSsS¯tS°uS¯tSsS mR^/ ²vT³vT´vT´wTµwT´wT´vT³vT´vT´vT´vT³vT³vT³vT³vT³vT³vT³vT³vT³vT³vT³vT³vT³vT³vT³vT³vT³vT´vT´vT´vT´vT´wTµwTµwTµwTµwT¶wT¶wT¶xT·xT·xT·xT¸xT¸xT¸xT¹yTºyT»zU¼zU½{U½{V½|V•gQ¬rSµwT¸xT¹yU¹yU¹zV·yVµxV±vUtT©qS¥oS mRœjQ—hQ’ePcPŠbP‡`O„_O]O}[NyYNuWMpUMoTMmSMkRL}H#\À\À &D -E(1F/!2# 8 W7"iA&UGJ[JK\JKREJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀMCIXIK^KKcNLfOLiQLkRMmSMoTMqUMsVMwXNzYN}[N€\Oƒ^O‡`OŒbP‘eP–gQšjQžkR¢mR¥oR©qS¬rS¯tS±uS³vT´vTµwT´wT²uTsS lR«_(¹yT¹yTºyTºyTºyTºyTºyT¹yT¹yT¸yT¸xT¸xT¸xT¸xT¸xT¸xT¸yT¸yT¸yT¸yT¹yT¹yT¹yT¹yT¹yT¹yT¹yTºyTºyTºyTºyTºzT»zT¼zU¼{U½{U¾{U¾|U¿|UÀ}VÁ~VÂWÀY™iQ«rSµwT¹yT¼zU½|V¿}XÁ€ZÂ]Á]¾€]»~[¶zY±wW¬tU¨qS¤nSŸlR›jQ–gQ“fPePŽcP‹bPˆ`O…_O‚]O~\NzZNvXNqUMoTMnSMlRMiQLg=!\À
+!C +E'0F.4F7% 8% U/lG.SFJZIK]KKZIKB=H\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀREJZJK`LKdNLgPLjQLlRMnSMpTMqUMtWMxXN{ZN~[N]O„^O†`O‰aO‹bPdP•gQ™iQœkQ lR¤nR§pSªrSsS¯tT²uT´vT¶wT·xT¹yT¹yTºyTºyT¹yT¶xT´vT¬rS¢nR—hQ¿|U¿|UÀ|UÀ|UÀ|UÀ|UÀ|UÀ|UÀ|UÀ|UÀ|UÀ|UÀ|UÀ|UÀ}UÀ}UÁ}UÁ}UÁ}UÁ}UÂ}UÂ~UÃ~UÃ~VÃ~VÄVÅ€WÆX®a(ŸlRªrS´vT¸yT¼zU¾|UÁ~VÃXÆ‚[Ɇ_΋dÓ‘jÔ“mÔ“nБlÊŒhĆd½_¶{[°vWªsU¦pS¢nRžkRšiQ˜hQ•gQ“fQ‘ePdPŒbP‰aO†_Oƒ^O€\O|ZNxXNsVMpTMnTMmSMjQL€C B)D&/F-3F47G6% >" Y7 kA$YIK]KK^KKSFJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀVGJ\KKbMLeOLhPLkRLmSMnTMpTMrUMuWNyYN|ZN\N‚]O„_O‡`OŠaPŒbPŽcPeP“fP—hQ›jQžlR¢nR¥oS©qT¬sT¯uU²vU´wV¶xV¸yV¹yUºzU»zU¼{U½{U¾{U¾|U¿|U¿|U¿|U¿|U¾{U½{U¼{U¼zU»zTºyT¹yT¸xTµwT³vT´vT´vT´vT´wT´wTµwT·xT¹yTºzT¼zU½{U¾{U¿|UÀ|UÂ}UÄVÅ€WÇ‚YÉ„\͈_ÑŒdÙ”láuç£|쩂ſtî‡ëª…æ¦ÞŸ{Õ—sËŽl†d¹^³yZuW¨qU¤oSŸlRžkRœjQšiQ˜hQ–gQ”fQ‘ePdPcPŠaP‡`O„^O]O}[NyYNuWMpTMoTMmSMkRLgPL&D#.E,3F46G;' <( D"iB(VGJ]KK`LK[JKB>H\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀNCJYIK^LKcNLfOLiQLkRMmSMoTMqUMsVMvXNzYN}[N€\O‚^O…_Oˆ`OŠaPŒcPdP‘eP“fQ•gQ—hQ™iQkR mS¤oT¨rU¬tW°wY´zZ¸}\»]¾€^À^Á‚^‚^Â\Á€ZÁYÁXÁ~WÁ~WÂ~VÂ~VÂ~VÃ~VÃ~UÃ~UÄ~UÄ~UÄUÄUÅVÅVÅVÅVÆVÆ€VÆ€VÇ€WÇWÈ‚XɃZË…[͇^ЊaÓdØ’iÜ—nâtè£zî©ó¯‡ø´û¸‘üº“û¹“÷¶ñ±Œé©…à¡~Ö˜vËmÇf»€`´z[®vX©rU¥pT£oS¢nS lRžkRœkRšjQ˜iQ–hQ”fQ’ePdPcP‹bPˆ`O…_O‚]O~[NzYNvWNpTMoTMnSMkRMhQLo7 ,2F36G99HC+ @ ]8 nA"\JK`ML_LKSFJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀSFJ[JK`LKdNLgPLjQLlRMnSMpTMqUMtVMwXNzZN}[N€]Oƒ^O†_OˆaO‹bPcPdP‘eP“fQ•gQ—hQ™iQ›jRžlR mS£oU§rW¬vZ²{]¹€a¿…fÅŠjËnГqÓ•sÕ–sÕ–rÕ–qÕ”oÓ’mÑjÏgÍŠcˈaɆ^È„\Ç‚[ÆYÅ€XÅ€WÅWÅWÅVÅVÅWÅ€WÆ€WÇXÈ‚YɃ[Ê…\͇_ÏŠaÒeÕ‘hÙ•mÝ™qávä¡zç¤}ê§€ë©ƒëª„é¨ƒå¥€ß |Ù›wÓ•rÌmƉh¿„c¸~^²yZ®vX¬tWªsV¨qU¦pT¤oS¢nS mRžlRœkR›jQ™iQ—hQ•gQ“fPePŽcP‹bPˆaO…_O‚^O\N{ZNwXNsVMoTMnSMlRMiQL~I#26G99G?IQ2 P+XHK_LLfQOcNLXIK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À©qSºyTÃ~VΈ`遲ޜv¾€]ªqS–LŽG|> g3
+S)? *%.—hQ—hQ‘eP‡`OuWM\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀSFJ[JK`LKdNLgPLjQLlRMnSMoTMqUMsVMwXNzYN}[N€\O‚^O…_O‡`OŠaPŒbPŽdP‘eP“fP•gQ—hQ˜iQšjRœkRŸlS¡nT¤pV§sX«vZ°z^¶b¼…gËmÊ’sјzØŸ€Þ¤…ã©Šèê¯ë°ê¯Žè¬‹å¨‡à¤‚Ûž|Ö™wÑ“qÌŽlljgÃ…bÀ‚_½\»}Zº{X¹zW¸yV·yU·xU·xU·xT·xT·xU·xU·xU·yV·yV·yW¸zW¸{X¹{Y¹|Zº}[º}[º}\º~\¹~]¹~]¸}]·|\µ{\´z[²yZ°wY®vX¬tWªsV¨rU¦pT¤oS¢nS¡mRŸlRkRœjQšiQ˜hQ–gQ”fQ’ePdPcPŠbP‡`O…_O‚]O~[NzZNvWNrUMoTMmSMlRMiQLeOLJAIJ(h>!]KKfQOgQN_LKD>I\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À™iQ°tS¸yT¼{UÂYÎŒeïˆô´Õ—u¶|\ Z'™LˆD
+|> ’eP¦oR¨qS¦oR¡mRšjQ‘eP„^OhPL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀWHJ\KKaMLeOLhPLjQLlRMnSMpTMqUMtVMwXNzZN}[N€]Oƒ^O†_Oˆ`OŠbPcPdP‘eP“fQ•gQ—hQ™iQ›jRkRŸmS¢nT¤qV¨sX¬w[±{_¶€c½†hÄŒnË’tÒ™zØŸ€Þ¥…㩉çꯎꯎê®ç«Šä§†ß£Ûž|Õ˜vГpËŽkljfÃ…bÀ‚_½\»}Yº{X¸zW¸yV·xU·xU·xT¶xT¶xT¶xU¶xU·xU·xU·yV·yV·zW¸zX¸{Y¹|Y¹|Z¹}[¹}[¹}\¹}\¸}\·}\¶|\µ{[³zZ²yZ°wY®vX¬tWªsV¨rU¦pT¤oS£nS¡mRŸlRžkRœjQšiQ˜hQ–gQ”fQ’ePdPŽcP‹bPˆ`O…_O‚^O\N{ZNwXNsVMoTMnSMlRMiQLfOLJ(V.]KKePNkUQcNLQEJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À‚]O¡mR©qS¬rS°tS³vTµwT·xUº{WĆbÒ“qךxÊo
+ K«rS´vT¶wT´vT²uT®sSªqS¤nRkQ•gQˆ`OuWNY,\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀNCJYIK^KKbNLfOLhQLkRLmSMoTMpUMrUMuWMxXN{ZN~[N]O„^O†_O‰aO‹bPcPdP‘eP“fQ•gQ—hQ™iQ›jRkRŸmS¢oT¥qV¨tXw[±|_·d½†iÄŒnË“tÒ™zØŸ€Þ¥…㩉笌鮎ꮎéŒæª‰ã§…ߢ€Ú{Õ—uÏ’pËjƈfÂ…b¿^½\»|Y¹{X¸zV·yV·xU·xU¶xT¶xT¶xT¶xU¶xU¶xU¶xU·yV·yV·yW¸zW¸{X¸{Y¸|Z¹|Z¹|[¹}[¸}\¸}\·|\¶|[µ{[³zZ±xY°wX®vX¬tWªsV¨rU¦pT¥oS£nS¡mRŸlRžkRœjQšjQ˜iQ—hQ”gQ’fPdPŽcP‹bP‰aO†_Oƒ^O€\O|ZNxXNtVMoTMnSMlRMjQLgPLzG#\JKcOMoXUgPMZIK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À’fP”gQ•gQ—hQ™iQkQ lR¤nR§pRªqS¬sS¯tS :"r<zYNsS¹yT¾|UÁ~WÆ„^ËŠeË‹gƈe¾‚aµz[tV¦pS¢mRkQ–gQŠbPzYNkRL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀRFJZJK`LKcNLfPLiQLkRMmSMoTMqUMrVMvWNyYN|ZN\N]O„^O‡`O‰aO‹bPcPdP’eP”fQ–gQ—hQ™iQ›jRlR mS¢oU¥qV©tYx\²|`¸d¾‡iÅoË“uÒ™{ÙŸ€Þ¥…㩉笌é®é®è¬‹å©ˆâ¦„Þ¡ÙœzÔ—tÏ‘oÊŒjƈe„a¿^½~[»|Y¹{X¸zV·yV·xU¶xU¶xT¶xT¶xT¶xT¶xU¶xU¶xU¶xV·yV·yW·zW·zX¸{Y¸{Y¸|Z¸|Z¸|[¸|[·|[·|[¶{[´z[³yZ±xY°wX®vW¬tWªsV¨rU¦pT¥oS£nS¡mRŸlRžkRœkRšjQ™iQ—hQ•gQ“fP‘ePŽdPŒbP‰aP†`Oƒ^O€]O}[NyYNuWNqUMnSMlSMkRLhPLcNLbNLpYVlUP`LK>;H\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À›jQ‡`O{ZN©^'¨^'`(·e)½h)Ãk*Êo+±b(£nRºyTÃ~UÇXÒdãŸwò°‰ñ°‹è©…ÝŸ}Ô˜vÈm¾„eµ}_®x[°y\®x[«tW§qT¡mRœjQ–gQ‹bP}[NlRM\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀVGJ\JKaMKdNLgPLjQLlRMnSMpTMqUMsVMvXNzYN|[N\O‚]O…_O‡`O‰aPŒbPŽcPdP’eP”fQ–gQ˜hQšiQœjRžlS mS£oU¦rW©uY®x\³|`¸d¾‡jÅoÌ“uÒš{Ù €Þ¥…㩉欋èèŒç«Šå©‡á¥ƒÝ ~Ø›yÓ–tΑoÊŒjňe„a¿^¼~[º|Y¹{W¸zV·yV·xU¶xU¶xT¶xT¶xT¶xT¶xU¶xU¶xU¶xU¶xV·yV·yW·zX·zX¸{Y¸{Z¸{Z·|Z·|[·|[¶{[µ{[´zZ³yZ±xY¯wX®uW¬tVªsV¨rU¦pT¥oS£nS¡mR lRžkRœkR›jQ™iQ—hQ•gQ“fQ‘ePdPŒcPŠaP‡`O„^O]O~[NzYNvWNrUMnSMmSMkRLiQLeOLoXUu]XdOLKBI\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À:9H\N–hQ¸}\¯uUsT¯tT¯tS¨qS¤nR£nR¢nRŸlR›jQšiQ˜hQ—hQ–gQ”fQ’eP‘eP—hQœkR mS¥pUªtX«uY¨sW¦qU mS›jQ•gQƒB’S%jQL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀLBIXHK^KKbMLeOLhPLjRLlSMnSMpTMqUMtVMwXNzYN}[N€\O‚^O…_O‡`OŠaPŒbPŽcPeP’fP”fQ–gQ˜hQšiRœkRžlS nT£pU¦rWªuY®y]³}`¹‚e¿ˆjÅŽpÌ”vÓš{Ù Þ¤…⨉櫋笌笋櫊䨆ंܟ~ךxÒ•sÎnÉŒiŇeÁ„a¾€^¼~[º|Y¹{W¸yV·yV·xU¶xU¶xT¶wT¶wT¶wT¶xT¶xU¶xU¶xU¶xV¶yV¶yW·zW·zX·zY·{Y·{Z·{Z·{Z¶{Z¶{ZµzZ³yZ²yY±xY¯vXuW¬tVªsU¨rU¦pT¥oS£nS¡mR lRžlRkR›jQ™iQ—hQ•gQ“fQ‘ePdPcPŠaP‡`O…_O‚]O\N{ZNwXNsVMnSMmSMkRMiQLfOL_LKhQMUGJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À (6BFP>=DKHMqjk€trwf`~kc„ndŠqesete¯Ž{w`¡v[\N†_OcP“fP˜iQœjRŸlS£oT¦qV¥qV£oTžlR™iQº^‡`OQ%hPL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀQEJZIK_LKcNLfOLiQLkRLmSMoTMpUMrUMuWMxXN{ZN~[N€]Oƒ^O…_Oˆ`OŠaPŒcPŽdP‘eP“fP”gQ–hQ˜iQšjRœkRžlS¡nT£pU¦rWªuZ®y]³}a¹‚e¿ˆkÆŽpÌ”vÓš{ÙŸ€Þ¤…⨈媊櫋櫊婈⦅ߣ۞}ÖšxÑ•rÍmÈ‹ićdÁƒa¾€]¼~[º|Y¹zW¸yV·yU¶xU¶xU¶wT¶wT¶wT¶wT¶wT¶xU¶xU¶xU¶xU¶xV¶yV¶yW¶zX·zX·zY¶zY¶{Y¶{Z¶{ZµzZ´zZ³yY²xY°wX¯vXuW«tVªsU¨rU¦pT¥oS£nS¡mS mRžlRkR›jQ™iQ˜hQ–gQ”fQ‘ePdPcP‹bPˆ`O…_O‚]O\O|ZNxXNtVMoTMmSMlRMjQLgPLbML[JK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À%5 (6 $/79CEEKjgkrc_›…{‘uf±{Ÿw_ºq]Oˆ`OŽcP”fQ˜hQ›jRžlR¡nT¢oT¡nTkR˜hQŽdP¦]'ŽQ%\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀUGJ[JK`MKdNLgPLiQLkRMmSMoTMqUMrUMuWNxXN{ZN~[N]Oƒ^O†_Oˆ`OŠbPcPdP£['µd)•gQ—hQ˜iQšjRœkRžlS¡nT£pU§rWªvZ¯y]´~aºƒfÀˆkÆŽpÌ”vÓš{ØŸ€Ý¤„ᧇ䩉媊媉䨇᥄ޡ€Ú|Õ˜wДrÌmÈŠhĆdÀƒ`¾€]»}[º|Y¸zW·yV·xU¶xU¶xU¶wTµwTµwTµwTµwTµwUµwUµxUµxUµxV¶xV¶yW¶yW¶yX¶zX¶zY¶zYµzYµzY´zY´yY²yY±xY°wX®vWuW«tVªsU¨qU¦pT¥oS£nS¢mS mRžlRkR›jQ™iQ˜hQ–gQ”fQ’ePdPcP‹bPˆaO†_Oƒ^O€\O|[NxYNtWMpUMmSMlRMjQLgPLcNLA;=\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À#*6+.8;:AHEJmgjd\]‡pe«}œxc w^»pƒ^OŠaP‘eP–gQšiQžlR mS¢nT mS›jR•gQ»h*œX&ˆM$\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀC+ WHJ]KKaMLdOLgPLjQLlRMnSMoTMqUMrVMvWNyYN|ZN\N]O„^O†_OˆaO‹bPcPžY&«_(³c(•gQ—hQ™iQšjRœkRŸlS¡nT¤pV§sX«vZ¯z^´~bºƒfÀ‰kÆŽpÌ”vÒš{ØŸ€Ý£„à¦‡ã©‰ä©‰ä©ˆâ§†à¤ƒÜ Øœ{Ô—vÏ“qËŽlljgÆcÀ‚`½]»}Z¹{Y¸zW·yV¶xU¶xU¶wUµwTµwTµwTµwTµwTµwTµwUµwUµxUµxVµxVµxVµyWµyWµyXµyXµyYµzY´yY´yY³yY²xY±wX°wX®vWuV«tVªrU¨qU¦pT¥oS£nS¢mS mRžlRkR›jQ™iQ˜hQ–gQ”fQ’ePdPŽcP‹bP‰aO†_Oƒ^O€\O}[NyYNuWNqUMmSMlRMjQLhPLdNL\1\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À+.775;ICFphhŠztŠre¯}Ÿya¢vZ]OŠaP‘eP–gQšiQkRŸlS¡nTžlS™iQÌq.¯b*“S%zG#\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀMCJXHK^KKbMLeOLhPLjRLlSMnSMpTMqUMsVMvWNyYN|ZN\N‚]O„^O†`O‰aO‹bP—U&¥\'¯a(»g)Ìr/—hQ™iQ›jRkRŸmS¡nT¤pV§sX«v[¯z^´~bºƒfÀ‰kÆŽpÌ”vÒ™{מܣƒà¦†â¨ˆã¨ˆã¨‡á¦…Þ£‚ÛŸ~×›yÓ–uÎ’pÊkƉgÂ…c¿‚_½]»}Z¹{X¸zW·yV¶xU¶xUµwTµwTµwTµwTµwTµwTµwTµwUµwUµwUµxUµxVµxVµxWµyWµyWµyXµyX´yX´yY³yY³xX²xX°wX¯vW®uW¬tV«sV©rU¨qT¦pT¥oS£nS¡mR mRžlRkR›jQšiQ˜hQ–gQ”fQ’ePdPŽcPŒbP‰aO†`Oƒ^O€]O}[NzYNvWNrUMmSMlRMjQLhQLeOL_LK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À,)/ZTVXON„uq‡od®}Ÿyb»s]OŠaPeP•gQšiQkRžlRŸlSœkR–hQ»g*¤\(ŽQ%`LK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À B B_LKcNLfOLiQLkRLmSMoTMpTMrUMtVMwXNzYN}[N\O‚]O„_O‡`O‰aOQ%ŸY&©^'±b(¾i*Õ{8—hQ™iQ›jRkRŸmS¡nT¤qV§sX«v[°z^µ~bºƒfÀ‰kÆŽpÌ”vÒ™{מۢƒß¥…ᧇ⧇ᦆऄݢڞ}ÖšxÒ•tÍ‘oÉŒjňfÂ…b¿_¼\º}Z¹{X·zW·yV¶xU¶xUµwTµwTµwTµwTµwTµwTµwTµwT´wU´wU´wU´xVµxVµxVµxW´xW´yW´yX´yX³xX³xX²xX±wX°wW¯vWuW¬tV«sU©rU§qT¦pT¤oS£nS¡mR mRžlRkR›jQšiQ˜hQ–gQ”gQ’fPdPŽcPŒbP‰aP‡`O„^O]O~[N{ZNvXNrVMnSMlRMjRLhQLeOLaML+O+O\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀHFLXQRTJH~pm‚la¬Ž}Ÿzc»t¤tT‰aPdP•gQšiQœjRžlRžlS›jRÖ|:´e*˜V&ˆN$\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À B B`LKdNLgPLiQLkRMmSMoTMpUMrUMtVMwXNzYN}[N€\O‚]O…_O‡`O‰aPšW&£['«_(´d)Âl,݃@Òt.™iQ›jRkRŸmS¡oU¤qV¨sX«w[°z^µbºƒgÀ‰kÆŽpÌ”uÑ™zÖ~Ú¡‚Þ¤„ॆআॅޣ‚Ü Ø{Õ™wÑ”sÌnÈŒjňfÁ„b¾_¼~\º|Z¸{X·yW¶yV¶xUµwUµwTµwTµwTµwT´wT´wT´wT´wT´wU´wU´wU´wU´wV´xV´xV´xW´xW³xW³xW³xX²xX±wX°wW¯vW®uWuV¬tVªsU©rU§qT¦pT¤oS£nS¡mR lRžlRkR›jQšiQ˜hQ–hQ”gQ’fPdPŽcPŒbPŠaP‡`O„^O]O~[N{ZNwXNsVMoTMlRMjRLiQLfOLbML+O+O‚+O‚+O‚\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À6./fZXeVRHAIZIKiQLuWM¤tU‰aOdP–gQšjQkRžlRkR˜iQÄn/¬b,‘R%rC"\À\À\À\À\À\À\À\À\À\À\À\À"Fx"Fx!Fx!Fx B B BdNLgPLjQLlRMmSMoTMqUMrUMtWMwXNzZN}[N€\O‚^O…_O‡`O“S%X&¥\'®a(·g+Ês2Ó{9Àj*™iQ›jRkSŸmS¢oU¤qV¨sX«w[°z^µbº„gÀ‰kÆŽpË“uИyÕœ}٠ܢƒÞ¤„ߤ„Þ£ƒÝ¡ÚŸ~×›zÓ—vÏ“rËmÇ‹ićeÀƒa¾€^»~\¹|Z¸zX·yW¶xVµxUµwUµwTµwT´wT´wT´wT´wT´wT´wT´wT´wU´wU´wU´wU´wV³wV³xV³xW³xW²wW²wW±wW±wW°vW¯vW®uV¬tV«sUªsU¨rT§qT¦pT¤oS£nS¡mR lRžlRkR›jQšiQ˜hQ–gQ”gQ’fPePŽcPŒbPŠaP‡`O„_O]O~\N{ZNxXNsVMoTMlRMjRLiQLfPLbNL +O‚+O‚+P‚+P‚+P‚\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À@89dWT@IIAI\JKlRMyYN„^OcP”gQ™iQkRžlRžkR™iRÍt3±d-’S%I#\À\À\À:^‘:^‘:^‘:^‘:^:^:^:^:^"Fx"Fx B B B BeOLhPLjRLlSMnSMpTMqUMrVMuWMxXN{ZN~[N€]Oƒ^O…_O“S%›W&¢['©^(¹k2½i+Ó{:•gQ—hQ™iQ›jRkSŸmT¢oU¤qV¨tY¬w[°{_µbºƒf¿ˆkÄoÊ’tÏ–xÓš|×~Ù €Û¡Û¡Û €Ùž~×›{Ô˜wДsÌoÉŒkʼngÂ…c¿‚`¼]º}[¸{Y·zX¶yVµxVµwU´wU´wT´wT´vT´vT´vT´vT³vT³vT³vT³vT³vU³vU³vU³wU²wU²wV²wV²wV±wV±vV°vV°vV¯uV®uVtV¬tUªsU©rU¨qT§pT¥pS¤oS¢nS¡mR lRžlRkR›jQ™iQ˜hQ–gQ”gQ’fPePŽdPŒbPŠaPˆ`O…_O‚]O\N|ZNxYNtWMpTMlRMjRLiQLgPLcNL_LK+P‚+P‚+P‚,P‚,P‚,P‚,P‚,P‚Nr¤\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À]QNl\VG@IMCI_LKoTM|ZN†`OdP–gQšjQkRžlRœkR—hQºh*¤^,ŒP%X3:_‘:_‘:_‘:_‘:_‘:_‘:_‘:_‘:^‘:^‘:^‘:^‘"Fx B B B BfOLiQLkRLmSMnTMpTMqUMrVMuWNxYN{ZN~[N€]Oƒ^OŽP%—U&X&£['¬`)½n4Ãn/Àj*•gQ—hQ™iQ›jRkSŸmT¢oU¤qW¨tY«w[°z^´~b¹ƒf¿ˆjÄŒoÉ‘sΕwÒ™{Õœ}ØžÙŸ€ÚŸ€Ùž~ל|ÕšyÒ—vÏ“rËnÇ‹jĈfÁ„c¾`¼]¹}[¸{Y·zW¶xVµxU´wU´wT´wT´vT´vT³vT³vT³vT³vT³vT³vT³vT³vT²vU²vU²vU²vU²vU±vV±vV±vV°vV°vV¯uV®uVuV¬tU«sUªrU©rT¨qT¦pT¥oS£oS¢nS¡mRŸlRžkRœkR›jQ™iQ˜hQ–gQ”gQ“fPePŽdPŒbPŠaPˆ`O…_O‚]O\N|ZNyYNuWMpUMlRMjQLiQLgPLdNL_LK,P‚,P‚,P‚,P‚,P‚Nr¤Nr¤Nr¤Nr¤Nr¥Nr¥\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀaSOD>IJAIQEJbNLrUM~[NˆaO‘eP—hQœjQžkRŸlR›jRÌs0²e,“T&ƒK$;_‘;_‘;_‘;_‘;_‘;_‘;_‘:_‘:_‘:_‘:_‘:_‘:_‘ B B B BgPLiQLkRLmSMoTMpTMqUMsVMuWNxYN{ZN~[N]O‡M$“S%™V&ŸY&¥\'±e-¹j/Ñz:”fQ•gQ—hQ™iR›jRkSŸmT¢oU¤qW¨tY«w[¯z^´~b¹ƒf¾‡jÃŒnÈrÍ”vјyÔ›|Ö~מ~Øž~×}Õ›{Ó˜xЕtÍ’qÊŽmÆŠiÇeÀ„b½_»~\¹|Z·{Y¶yWµxVµxU´wU´wT´vT³vT³vT³vT³vT³vT³vT³vT³vT²vT²vT²vT²vU²vU²vU±vU±vU±vU°vV°vV¯uV®uV®uVtU¬sU«sUªrU¨qT§qT¦pS¥oS£nS¢nR¡mRŸlRžkRœkR›jQ™iQ˜hQ–gQ”gQ’fPePŽdPŒbPŠaPˆ`O…_O‚]O\O|ZNyYNuWMqUMlSMjQLhQLfPLdNL_LK,P‚,P‚Nr¤Nr¤Nr¤Nr¤Nr¥Nr¥Nr¥Ns¥Ns¥Ns¥Ns¥\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀdUOG@IMCITFJeOLtWM€]O‹bP“fP™iQkRŸlRkR™iQ¾j,©c/P%[JK;_‘;_‘;_‘;_‘;_‘;_‘;_‘;_‘;_‘;_‘;_‘;_‘ B B B BgPLiQLkRMmSMoTMpTMqUMsVMvWNyYN{ZN~[N|H#ŽQ%•T%›W& Z'¦]'ºm5¸f*Ív5”fQ•gQ—hQ™iR›jRkSŸmT¡oU¤qW§sY«v[¯z^³~b¸‚e½‡i‹nÇqË“uÏ–xÒ™zÔ›|Öœ}Öœ|Õ›{Ô™yÑ–vÏ“sÌoÈlʼnh†e¿ƒa¼€_º~\¸|Z·zX¶yWµxV´wU´wU³vT³vT³vT³vT³vT³vT³vT²vT²vT²vT²vT²vT²vT±vT±vU±vU±vU°uU°uU°uU¯uU®uU®tUtU¬tU«sUªrU©rT¨qT§pT¥pS¤oS£nS¢mR mRŸlRžkRœjR›jQ™iQ—hQ–gQ”fQ’fPePŽcPŒbPŠaPˆ`O…_O‚^O\O|ZNyYNuWNqUMmSMjQLhQLfPLdNL`LKNr¤Nr¤Nr¥Nr¥Nr¥Ns¥Ns¥Ns¥Ns¥Os¥Os¥Os¥Os¥Os¥Os¥\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À2# TB3REJVGJ`LKpTM}[N‰aO’ePšiQžkR lRžlR˜hQ·e)¢^.P%^8 #Gy#Gy#Gy#Gy#Gy#Gy#Gy#Gy * B B B B BjQLlRMnSMoTMpUMrUMsVMxF#‡M$ŽQ%’S%–U&šW&žY&¢['ªa+¿s;¹g+dP‘eP“fQ”gQ–hQ˜iQšjRœkSžlS nU£pV¦rX©uZ¬x]°{_´~b¸‚e¼…iÀ‰kÃŒnÆŽpÈrÊ‘sË’sË‘rÊqÉoÇmÅ‹kÈhÀ…e¾ƒb¼€`º~^¸|[¶{ZµyX´xW³wV²vU²vU²vT±uT±uT±uT±uT±uT±uT±uT±uT°uT°uT°tT°tT¯tT¯tT¯tT¯tT®tT®tTsTsT¬sT¬sT«rTªrT©rT©qT¨qS§pS¦pS¥oS£nS¢nR¡mR lRŸlRkRœjQ›jQ™iQ˜hQ–gQ•gQ“fP‘ePdPcP‹bP‰aO‡`O„^O‚]O\N|ZNxXNuWMqUMmSMhPLgPLeOLcNL`LKZIK,Pƒ,Pƒ,QƒOs¦Os¦Ot¦Ot¦Ot¦Ot¦Pt¦Pt¦Pt¦Pt¦Pt¦-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀvšÍvšÍv›Ív›Ív›Ív›Ív›Íw›Íw›Í=a“=a“=a“#Gy#Gy#Gy#Gy#Gy#Gy#Gy#GymYPODJUGJXIKeOLtWM‚]OcP•gQœjQ lR mRkRÈp.´g0”T&ˆN$]8 #Gy#Gy#Gy#Gy#Gy#Gy#Gy * B B B B BjQLlRMnSMoTMpUMrUMv>„L$ŒP%‘R%•T%˜V&œX& Z'¤\'°f0¹m5Äq3dP‘eP“fQ”gQ–gQ˜hQ™jR›kSlS nT¢pV¥rX¨tZ«w\¯z_³}a·dº„g¾‡jÁŠlÄŒnÆŽpÇqÈqÈpÇŽoÆmÅ‹kÉiÁ‡g¿„d½‚aº_¸}]·|[µzY´yX³xW³wV²vU²vU±uT±uT±uT±uT±uT±uT°uS°uS°tS°tS°tS¯tS¯tT¯tT¯tT®tT®tT®sTsTsT¬sT¬sT«rTªrTªrT©qT¨qS§pS¦pS¥oS¤oS£nS¢mR¡mRŸlRžlRkRœjQšjQ™iQ—hQ–gQ”fQ’fP‘ePdPcP‹bP‰aO†`O„^O]O~\N{ZNxXNuWMqUMiQLgPLfOLeOLbNL_LKZIK,Qƒ,Qƒ,Qƒ,Qƒ,QƒOt¦Pt¦Pt¦Pt¦Pt¦Pt¦-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\Àv›Ív›Ív›Ív›Íw›Íw›Íw›Íw›Íw›Íw›Íw›Íw›Í=a“=a“=a“=a“=a“#Gz#Gz#Gz#Gz#Gz#Gz#GzgUOS=2RFJWHJ[JKlRMzYN†`OeP˜iQžkR mRŸlR™iQ¼h*°h4‘R%ˆN$^9 [JK#Gy#Gy#Gy#Gy#Gy * B B B B BjQLlRMnSMoTMpUMI#†L$‹O$Q%“S%—U&šW&X&¡Z'¦](·l5´f,Èt5dPeP’fP”fQ–gQ—hQ™iR›kRlSŸmT¢oV¤qW§tY«v[®y^±|aµc¸‚f¼…h¿ˆkÁŠlÃŒnÅnÅoÅnÅŒmÄ‹k‰iÁ‡g¿…e½ƒc»€`¹~^·|\¶{Z´yY³xW²wV²vU±vU±uT±uT±uT°uT°uT°tS°tS°tS°tS°tS¯tS¯tS¯tS¯tS®tS®tS®sSsTsTsT¬sT¬rT«rTªrTªrS©qS¨qS§pS¦pS¦oS¥oS¤nS¢nR¡mR mRŸlRžkRkR›jQšiQ˜iQ—hQ•gQ”fQ’ePePdPcPŠbPˆ`O†_Oƒ^O]O~[N{ZNxXNtVMqUMhPLgPLfOLdNLbML_LKbE6,Qƒ,Qƒ,Qƒ,Qƒ-Qƒ-Qƒ-QƒPt¦-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Qƒ-Q„-Q„-Q„\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À@d–w›Íw›Íw›Íw›Íw›Íw›Íw›Íw›Íw›Íw›Íw›Íw›Îw›Îw›Î=a”=a”=a”=a”=a”=a”=a“#Hz#Gz#Gz#Gz#Gz#Gz#GzmYPPDJUGJYIKbMLqUM\NŠbP”fQ›jQŸlR¡mRžlRËp,µe+ \+R%ˆN$b; ]8 [7 XHKO+N1 L/ L/ L/ K/ K/ eb”>b”>b”>b”>b”>b”>b”>b”=b”=b”=b”=b”=b”=b”=b”=b”YEUGJYIK_LKnSM|ZNˆ`O’ePšiQŸlR¡mR mR™iQºg*´j4šW'‘R%ŽQ%h>!g=!f=!db”>b”>b”>b”>b”>b”>b”$Hz$Hz$Hz$Hz$Hz>b”>b”>b”>b”>b”gVOS=2RFJWHK[JKeOLsVM€]OŒbP•gQœjQ lR¡mRžlRÌr/¹g*²h2–U&“S%‘R%Q%ŽQ%ŒP%£['¨]'¬`(°b(´d)¸f)»g)¾i*Áj*I#¡Z'¡Z' Z' Z'¡Z'£['¤['¥\'¦]'ª_)±d,³d)Äq3‹bPcPdP‘eP’fQ”fQ–gQ—hQ™iR›kSlSŸmU¡oV¤qW¦sY©u[¬x]¯z^±|`´~b¶€d¸‚eºƒf»„f»„f¼„f»ƒe»‚dºb¹€a·~_¶}^µ{\´zZ³yY²wX±wW°vV°uU¯uU¯tT¯tT¯tT®tS®tS®tS®sS®sS®sS®sS®sSsSsSsSsS¬sS¬rS¬rS«rS«rSªrSªqS©qS©qS¨pS§pS¦pS¦oS¥oS¤oR£nR¢nR¡mR mRŸlRžkRkRœjQšjQ™iQ˜hQ–hQ•gQ“fQ’ePdPŽcPŒcPŠbPˆ`O†_O„^O]O\N|ZNyYNuWNrUMnSMjQLdNLcNLaMK_LK[JK`D6Pt¦Pt¦Pt§Pt§Pt§Pu§Pu§Pu§Pu§Qu§Qu§Qu§Qu§Qu§Qu§-Q„-Q„-Q„-R„-R„-R„-R„-R„-R„-R„-R„-R„.R„.R„Rv¨Rv¨Rv¨~¢Ô~¢Ô~¢Ô~¢Ô\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À@e—@e—@e—@e—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae—xœÏxœÏxœÏxÏxÏxÏxÏyÏyÏ>b•>b”>b”$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz>b”>b”>b”>b”>b”YDb”>b”>b”>b”Q@:R<2fL@WHJZJKaMKoTM|ZNˆ`O‘eP™iQŸlR¡mR¡mRœjRÇo-»i-´h0«`)§]'¨]'¬`(°b(´d)¸f)¼h)Àj*Ãk*Æm*Én+Ìp+Ïq+Òr,§]'§]'§]'¨^'ª_(«_(¬`(`(¯b)²c)ºi.ˆ`OŠaPŒbPŽcPdP‘eP“fQ”gQ–hQ˜iRšjR›kSlTŸnU¢oV¤qW¦sY©uZ«w\y]°{_²|`³}aµ~b¶b¶b¶b¶a¶~`µ}_µ|^´{]³z[²yZ±xY°wX¯vW¯uV®uU®tU®tTtTsTsSsSsSsSsSsSsSsS¬sS¬rS¬rS¬rS«rS«rS«rSªrSªqS©qS©qS¨qS¨pS§pS¦pS¦oS¥oR¤oR¤nR£nR¢mR¡mR lRŸlRžkRkRœjQšjQ™iQ˜hQ–hQ•gQ“fQ’ePdPdPcP‹bP‰aO‡`O…_O‚]O\O}[NzYNwXNtVMpTMlRMhPLcNLaMK_LK]KKbR]C5Pu§Pu§Pu§Qu§Qu§Qu§Qu§Qu§Qu§Qu§Qu§Qu§Qu§Qu¨Qu¨Qu¨Qv¨Qv¨Qv¨-R„-R„.R„.R„.R„Rv¨Rv¨Rv¨Rv¨Rv¨Rv¨Rv¨£Õ£Õ£Õ£Õ£Õ£Õ£Õ£Õ£Õ£Õ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀAe—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae˜Ae˜Ae˜Ae˜yÏyÏyÏAf˜Af˜Af˜$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz>b•>b•>b”>b”WD3TFJXHK[JKfOLsVM€]O‹bP”gQœjQ lR¡mR mRœkRÅm,½i,ºj/²d+±c)²c(¶e)ºf)¾h*Áj*Ål*Én+Ëo+Îq+Ñr+Ós,Õt,ƒK$ª^(ª_(«_(¬`(®a(¯a)°b)³d*¶f+¾m1‡`O‰aP‹bPcPdPeP’fQ”fQ•gQ—hR™iR›kSlTŸmT¡oV£pW¥rX§tY©v[¬w\®y]¯z^±{_²|`³}`´}`´}`´}_´|^³{^³{\²z[±yZ°xY°wX¯vW®uV®tUtUtTsTsTsSsS¬sS¬sS¬sS¬rS¬rS¬rS¬rS¬rS«rS«rS«rS«rSªrSªqSªqS©qS©qS¨qS¨pS§pS¦pS¦oS¥oR¤oR¤nR£nR¢mR¡mR mRŸlRžlRkRœjQ›jQšiQ˜iQ—hQ–gQ”fQ“fP‘ePdPŽcPŒbPŠaPˆ`O†_O„^O]O\N|ZNyYNvWNsVMoTMkRLgPLbML`LK^KK\JK~aR[B5Pu§Qu§Qu§Qu§Qu§Qu§Qu§Qu§Qu§Qu§Qu§Qu¨Qu¨Qu¨Qv¨Qv¨Qv¨Rv¨Rv¨Rv¨Rv¨Rv¨Rv¨Rv¨Rv¨Rv¨Rv¨Rv¨Rv©Rv©£Õ£Õ£Õ£Õ£Õ£Õ£Õ£Õ£Õ£Õ£Õ£Õ£Õ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀAe—Ae—Ae—Ae—Ae—Ae—Ae˜Ae˜Ae˜Ae˜Ae˜Ae˜Ae˜Af˜Af˜Af˜yÐAf˜Af˜Af˜Af˜Af˜Bf˜$H{$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz>c•>c•>b•>b•O?:[E|aRZA5-QƒQu§Qu§Qu§Qu§Qu§Qu§Qu§Qu¨Qu¨Qu¨Qv¨Qv¨Qv¨Qv¨Rv¨Rv¨Rv¨Rv¨.R„.R„.R„.R„Rv¨Rv¨Rv©Rv©Rv©Rw©£Ö£Ö£Ö£Ö£Ö£Ö£Ö£Ö£Ö£Ö£Ö£Ö£Ö£Ö£Ö£Ö\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀAe˜Ae˜Ae˜Ae˜Ae˜Ae˜Ae˜Af˜Af˜Af˜Af˜Af˜yžÐyžÐyžÐzžÐzžÐzžÐBf˜Bf˜Bf˜Bf˜Bf˜$H{$H{$H{$H{$H{$H{$H{$H{$H{$Hz$Hz$Hz$Hz$Hz$Hz$Hz$Hz>c•>c•>c•>c•VC^C6W@5-Q„-Q„Qu§Qu§Qu§Qu§Qu¨Qu¨Qv¨Qv¨Qv¨Qv¨Rv¨Rv¨Rv¨Rv¨.R„.R„.R„.R„.R„.R„.R„.R„.R„Rv©Rw©Rw©Rw©¤Ö¤Ö¤Ö¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö¤Ö¤Ö¤Ö\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀAf˜Af˜Af˜Af˜Af˜Af˜Af˜Af˜zžÐzžÐzžÐzžÐzžÐzžÐzžÐzžÐzžÐzžÐzžÐBf˜Bf˜Bf˜Bf˜$I{$I{$I{$H{$H{$H{$H{$H{$H{$H{$H{$H{$H{$H{$H{$H{$Hz$Hz$Hz$Hz$Hz YE\C6T>4-Q„-Q„-Q„-R„Qu¨Qu¨Qv¨Qv¨Qv¨Qv¨Rv¨Rv¨Rv¨.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„Rw©Sw©€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤Ö€¤ÖEi›Ei›Ei›\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀAf˜Af˜Bf˜Bf˜Bf˜zžÐzžÐzžÐzžÐzžÐzžÐzžÐzžÐzžÑzžÑzžÑzŸÑzŸÑzŸÑzŸÑBf˜Bf˜Bf˜$I{$I{$I{$I{$I{$I{$I{$I{$I{$I{$I{$H{$H{$H{$H{?c•?c•?c•?c•$H{$H{$H{SB;R<2zbVUGJXIK[JK[JKuWN€\OŠaP’fP™iQŸlR¡mR£nS£nS¥pTà€9Þ9Õw2Öw0Öv/Öv.Ùx/Üz0Þz0á|1ã~2æ€3è5éƒ6ë…8ë…8ºm4¼o7¾q8Äu;Ãs9Ãs8ºj0‚]O„^O†_Oˆ`OŠaPŒbPcPdP‘eP’fQ”fQ•gQ—hR™iRšjSœkSlTŸnU¡oV¢pV¤qW¦rX§sY¨tY©uYªuZ«uZ«vZ«vY«uY«uX«uX«tW«tV«sVªsUªsUªrTªrTªrTªrSªqSªqSªqSªqSªqS©qS©qS©qS©qS©qS©qS©qS©qS¨qS¨pS¨pS§pS§pR§pR¦oR¦oR¥oR¥oR¤nR£nR£nR¢mR¡mR mR lRŸlRžkRkRœjQ›jQšiQ™iQ—hQ–gQ•gQ”fQ’eP‘ePdPcPŒbPŠaPˆ`O†_O„^O‚]O\O}[NzYNwXNtVMqUMnSMiQLeOL`LK]KKmP?kN?|aSZA5P<4-R„-R„-R„-R„-R„-R„Qv¨Rv¨Rv¨Rv¨Rv¨.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„€¤×€¤×€¤×€¤×€¤×€¤×€¤×€¤×€¤×€¤×€¤×€¤×€¤×€¤×€¤×€¤×Ei›Ei›Ei›Ei›Ei›Ei›Ei›\À\À\À\À\À\À\À\À\À\À\À\ÀBf˜zžÐzžÐzžÐzžÐzžÐzžÐzžÑzžÑzžÑzŸÑzŸÑzŸÑzŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑBf™Bf™Bf™%I{$I{$I{$I{$I{$I{$I{$I{$I{$I{$I{?c–?c–?c–?c–?c–?c•?c•?c•?c•$H{$H{$H{jXP^H=}dXUGJXHKZIKkRLwXN‚]O‹bP”fQšiQžkR mR£nS¥pT¨qU¨rUç…;ç†>ì‰?è†<å‚9ê†;î‰=ðŠ=ðŠ>ôŽAø‘Dü•Hÿ˜Kù’E¿r:Àt;Àt;Át<Ãt:½n4´f,]Oƒ^O…_O‡`O‰aO‹bPŒcPŽcPdP‘eP“fQ”gQ–hQ˜iR™jR›kSœlSžmTŸnU¡oV¢pV¤qW¥rW¦rX§sX¨tX©tX©tX©tX©tXªtWªsW©sV©sV©rU©rU©rT©qT©qT©qS©qS©qS©qS©qS©qS©qS©qS©qS¨qS¨qS¨pS¨pS¨pS¨pS§pS§pS§pR¦pR¦oR¦oR¥oR¥oR¤nR¤nR£nR¢nR¢mR¡mR mR lRŸlRžkRkRœjQ›jQšiQ™iQ˜hQ–hQ•gQ”fQ’fP‘ePdPŽcPŒcP‹bP‰aO‡`O…_Oƒ^O]O~[N{ZNyYNvWNsVMpTMlRMgPLcNL†gUƒeUlO?~bT{`SW@5-R„-R„-R„-R„-R„-R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R….R…Ei›Ei›Ei›€¥×€¥×€¥×€¥×€¥×€¥×€¥×€¥×€¥×€¥×€¥×€¥×Ei›Ei›Ei›Ei›Ei›Ei›Ei›Ei›Ei›Ei›Ei›\À\À\À\À\À\À\À\À\À\ÀzžÑzžÑzžÑzžÑzŸÑzŸÑzŸÑzŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÒBg™Bg™Bg™%I{%I{%I{%I{%I{%I{%I{@d–?d–?d–?d–?d–?d–?d–?d–?d–?c–?c–?c–?c–$I{$I{L=:WD`KA-R„-R„-R„.R„.R„.R„.R„Rv¨Rv¨Rv¨Rv¨.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R„.R….R….R….R…EiœEiœEiœEiœEiœEiœ¥×¥×¥×¥×¥×¥×¥×EiœEiœEiœEiœEiœEiœEiœEiœEiœEiœEiœEiœEiœEiœEiœEiœ\À\À\À\À\À\À\À\ÀzŸÑzŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÒ{ŸÒ{ŸÒ{ŸÒ{ Ò{ Ò{ Ò{ Ò| ÒCg™Cg™%I{%I{%I{@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–?d–?d–?d–?d–?d–?d–$I{$I{dUPYEXG@-R„.R„.R„.R„Rv¨Rv¨Rv¨Rv¨Rv¨Rv¨Rv¨Rv©.R„.R„.R„.R„.R„.R„.R„.R„.R….R….R….R….R….R….S…EiœEiœEiœEjœEjœEjœEjœEjœ¥×¥×¥×EjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEiœEiœEiœ\À\À\À\À\À\À{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÑ{ŸÒ{ŸÒ{ŸÒ{ Ò{ Ò{ Ò{ Ò| Ò| Ò| Ò| Ò| Ò| Ò| Ò| Ò| ÒCg™@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–?d–$I{$I{RA;P<3zcXnVIuh™~pdNLpUMÁ”w¬zZ«vS‘eP–gQœjQžlR¡mR¤oS§pTuV¯vW±xY¶|\¼€_ÆdƉgÈŠhÊŒiÌŽkÎlÿRñF¶k4²g1¯d-b+ª_(¢Z'}[N€\O‚]O„^O†_Oˆ`O‰aP‹bPcPŽcPdP‘eQ’fQ”gQ•gQ—hR˜iR™jR›kSœkSlTžmT nT¡nU¡oU¢oU£pU¤pU¤pU¤pU¥pU¥pT¥pT¥pT¥pT¥pS¥pS¥oS¦oS¦oS¦oS¦oS¦oS¦oR¦oR¦oR¦oR¦oR¦oR¦oR¦oR¥oR¥oR¥oR¥oR¤oR¤nR¤nR£nR£nR¢nR¢mR¡mR¡mR lRŸlRŸlRžkRkRœkQœjQ›jQšiQ™iQ˜hQ—hQ•gQ”gQ“fP’ePePdPcPŒbPŠbP‰aO‡`O…_Oƒ^O]O~\N|[NzYNwXNtVMpUM—pY”oXzWBuUB…gVlP@jO@|bUx`TcMB3!.R„Rv¨Rv¨Rv¨Rv¨Rv¨Rv¨Rv¨Rv©Rv©Rv©Rw©Rw©Rw©.R„.R„.R„.R„.R….R….R….R….R….S….S….S…EjœEjœEjœEjœEjœEjœEjœEjœEjœ¦Ø¦ØEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœEjœ\À\À\À\ÀBg™{ŸÒ{ŸÒ{ŸÒ{ Ò{ Ò{ Ò{ Ò| Ò| Ò| Ò| Ò| Ò| Ò| Ò| Ò| Ò| Ò| Ò| ÒCg™Cg™Cg™Cg™|¡Ó@d—@d—@d—@d—@d—@d—@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–%I{;0/SB;R=4fODpXL‘xkš€r˜vbº“zÀ”x«{[ÃldP•gQ™iQ›jQŸlR£nR¦pS¨qTªrT¬tU°wWµ{Z¸}\¸|\¸}\¹~]»]å}+Ý~6d.ªa+¨_)§^(¤\'zYN|ZN~\N€]Oƒ^O„_O†_Oˆ`OŠaP‹bPcPŽdPdP‘eQ“fQ”gQ•gQ—hR˜iR™jRšjSœkSlSžlTŸmT mT nT¡nT¢nT¢oT£oT£oT£oT£oT¤oS¤oS¤oS¤oS¤oS¤oS¤oS¥oR¥oR¥oR¥oR¥oR¥oR¥oR¥oR¥oR¥oR¤oR¤oR¤nR¤nR¤nR£nR£nR£nR¢mR¢mR¡mR¡mR lR lRŸlRžlRžkRkQœjQ›jQšjQ™iQ™iQ˜hQ—hQ•gQ”gQ“fQ’ePePdPŽcPŒbPŠbP‰aO‡`O…_Oƒ^O]O\N}[NzZNxXNuWMrUM™rZ–pY|XCxVCsTBmQAkOA~cVzaU`I>\IARv¨Rv¨Rv¨Rv¨Rv¨Rv¨Rv¨Rv©Rv©Rv©Rw©Rw©Rw©Sw©Sw©Sw©Sw©.R….R….R….R….R….S….S….S….S…FjœFjœFjœFjœFjœFjœFjœFjœ‚¦Ø‚¦Ø‚¦Ø‚¦Ø‚¦Ø‚¦ØFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœ\À\ÀBg™{ Ò| Ò| Ò| Ò| Ò| Ò| Ò| Ò| Ò| Ò| Ò| Ò| Ò| Ó| ÓCg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™}¡Ó@e—@e—@e—@e—@e—@e—@d—@d—@d—@d—@d—@d—@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–@d–%I{<1/J82^I@gQFqYN‘xl™€s—vc¢{d¿”yª{\«wUÄi‘eP•gQ˜hQkQ mR¢mR¤nR¥oS§pSªrT¬tU¬tU¬tU¬tUtU®tUÒt.ƒL&¤](¢['¡Z'žY&xYN{ZN}[N\N]Oƒ^O…_O‡`OˆaOŠaPŒbPcPdPeP‘eQ“fQ”gQ•gQ—hR˜iR™iRšjR›kSœkSlSžlSŸmSŸmS mS nS¡nS¡nS¢nS¢nS¢nS¢nS£nS£nS£nR£nR£nR£nR¤nR¤nR¤nR¤nR¤nR¤nR¤nR¤nR£nR£nR£nR£nR£nR¢nR¢mR¢mR¡mR¡mR¡mR lR lRŸlRžlRžkRkRœkQœjQ›jQšiQ™iQ˜iQ—hQ–hQ•gQ”fQ“fP’ePePdPŽcPŒbP‹bP‰aO‡`O†_O„^O‚]O\O}[N{ZNxYNvWNsVM›s[˜rZ~ZDnYŒkYqSBkPAiOA|cVbK?\G>NB?Rv¨Rv¨Rv¨Rv¨Rv¨Rv©Rv©Rv©Rw©Rw©Rw©Sw©Sw©Sw©Sw©Sw©Sw©Sw©Sw©.S….S….S….S….S….S…FjœFjœFjœFjœFjœFjœ‚¦Ø‚¦Ø‚¦Ø‚¦Ø‚¦Ø‚¦Ø‚¦Ø‚¦Ø‚¦Ø‚¦Ø‚¦ØFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœCg™Cg™| Ò| Ò| Ò| Ò| Ò| Ó| Ó| Ó| Ó|¡Ó|¡ÓCg™Cg™Cg™Cg™Cg™Cg™Cg™CgšCgšCgšCgšCgš}¡ÓAe—Ae—Ae—@e—@e—@e—@e—@e—@e—@e—@e—@d—@d—@d—@d—@d—@d—@d–@d–@d–@d–%I{@d–@d–<1/H72\I@ePGpYNxm˜€t–vc¡{e¾”zÁ“u‘p«wU¬uQ‘eP•gQ™iQšjQœjQžlR¡mR£nR¤nR¤oR¤oR¤oR¤oR¤oRÇg b; Z'žY&›W&“S%vXNyYN{ZN~[N€\O‚]Oƒ^O…_O‡`O‰aOŠaPŒbPcPdPdP‘eQ“fQ”gQ•gQ–hQ˜iR™iRšjR›jR›kSœkSlSžlSžlSŸlSŸmS mS mS¡mS¡mS¡mR¡mR¢mR¢mR¢mR¢mR¢nR¢nR¢nR£nR£nR£nR£nR£nR¢nR¢nR¢mR¢mR¢mR¢mR¡mR¡mR¡mR mR lRŸlRŸlRžlRžkRkRkQœjQ›jQ›jQšiQ™iQ˜hQ—hQ–gQ•gQ”fQ“fP‘ePdPdPcPŒbP‹bP‰aO‡`O†_O„^O‚]O€\O}[N{ZNyYNvXNtVMu\„]E€[E’oZŽmZŠkYnRBjOB}cVdL@`I?XGARv¨Rv¨Rv¨Rv¨Rv©Rv©Rw©Rw©Rw©Rw©Sw©Sw©Sw©Sw©Sw©Sw©Sw©Sw©Sw©SwªSwª.S….S….S….S…/S…FjœFjœFjœFjœ‚¦Ù‚¦Ù‚¦Ù‚¦Ù‚¦Ù‚¦Ù‚¦Ù‚¦Ù‚¦Ù‚¦Ù‚¦Ù‚¦Ù‚¦Ù‚¦Ù‚¦ÙFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœ‚¦Ù‚¦ÙCg™Cg™| Ó| Ó|¡Ó|¡Ó|¡Ó|¡Ó|¡ÓCg™Cg™Cg™Cg™CgšCgšCgšCgšCgšCgšCgšCgšChšChšChšChšChš}¢ÔAe—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae—@e—@e—@e—@e—@e—@e—@e—@d—%I{%I{%I{%I{%I{@d–@d–<10F61o]Vye]„oeŽxmœ‚u”udŸ{e¥}d¨|aÀ’tÁpÃl¬uQdP’eP”fQ–gQ˜iQ›jQœjQœjQœjQœjQœkQœkQkQ_9 œX&™V&•T%rUMuWMwXNzYN|ZN~[N€\O‚]O„^O…_O‡`O‰aOŠbPŒbPcPŽdPdP‘eQ’fQ”fQ•gQ–hQ—hR˜iR™iRšjR›jRœkRœkRkRlRžlRžlRŸlRŸlRŸlR lR mR mR mR¡mR¡mR¡mR¡mR¡mR¡mR¡mR¡mR¡mR¡mR¡mR¡mR¡mR¡mR¡mR mR lR lRŸlRŸlRŸlRžkRžkRkRkQœjQ›jQ›jQšiQ™iQ˜iQ—hQ–hQ•gQ”gQ“fQ’fP‘ePdPdPcPŒbPŠbP‰aO‡`O†_O„^O‚]O€\O~[N{ZNyYNwXNtVMrUM†^F‚]F”q\o[ŒlZqTD€fX}dWeMAbK@O=6NB@Rv¨Rv©Rv©Rv©Rw©Rw©Rw©Rw©Sw©Sw©Sw©Sw©Sw©Sw©Sw©Sw©Sw©SwªSwªSwªSxªSxªSxª/S…/S…FjœFjœFjœƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§ÙFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœFjœƒ§Ùƒ§Ùƒ§Ùƒ§ÙCg™Cg™Cg™}¡Ó}¡Ó}¡ÓCg™CgšCgšCgšCgšCgšCgšCgšChšChšChšChšChšChšChšChšChšChšDhšDhšDhš~¢ÔAe—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae—%I{%I{%I{%I{%I{%I{%I{%I{%I{@d—@d—E:9D61m\Vwe]lXOuaX„k_¨‹z±|¡|e¥|c§|`©z]ªyXÂnÃlÄŽkÄŽidP’eP“fP“fP“fP’fP“fP“fP“fP[7 —U&”T%P%pTMsVMuWMxXNzYN|ZN~[N€\O‚]O„^O†_O‡`O‰aOŠbPŒbPcPŽdPdP‘eP’eQ“fQ”gQ•gQ–hQ—hQ˜iR™iRšjR›jR›jRœkRœkRkRkRžkRžlRžlRŸlRŸlRŸlRŸlR lR lR lR lR lR lR lR lR lR lR lR lR lRŸlRŸlRŸlRŸlRžkRžkRkRkQœkQœjQ›jQ›jQšiQ™iQ˜iQ˜hQ—hQ–gQ•gQ”fQ“fP’eP‘ePdPŽdPcPŒbPŠbP‰aO‡`O…_O„^O‚]O€\O~[N|ZNyYNwXNuWMrUM‡`G„^G–r]|ZFxXFtVEgY~eY{cXbLA[H?REA.R„.R„Rv©Rw©Rw©Rw©Sw©Sw©Sw©Sw©Sw©Sw©Sw©Sw©Sw©Sw©SwªSwªSxªSxªSxªSxªTxªTxªTxªƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§ÙFjFjFjFjFjFjFjFjFjFjFjƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§Ùƒ§ÙCg™Cgš}¡Ó}¡ÓCgšCgšCgšCgšChšChšChšChšChšChšChšChšChšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhš~¢ÔAe—Ae—Ae—Ae—Ae—Ae—Ae—Ae—Ae—%I|%I|%I|%I{%I{%I{%I{%I{%I{%I{%I{%I{%I{%I{@e—@e—B99B51k[Vud]iWPr_Wye] †yªŒ|²}¡|e¤|c¾’w¨{^¨z\©yZÁp«xW«wU«wU«wU«wUÃŽlÃŽlÂŽlÂŽlkD(’S%ŒP%nSMoTMqUMsVMvWNxXNzYN|ZN~[N€\O‚]O„^O†_O‡`O‰aOŠaP‹bPcPŽcPdPeP’eQ“fQ”fQ•gQ–gQ–hQ—hQ˜iQ™iR™iRšjR›jR›jRœjRœkRœkRkRkRkRžkRžkRžlRžlRŸlRŸlRŸlRŸlRŸlRŸlRŸlRŸlRŸlRžlRžkRžkRžkRkRkQkQœkQœjQ›jQ›jQšjQšiQ™iQ˜iQ˜hQ—hQ–gQ•gQ”gQ“fQ’fP‘ePePdPŽcPcP‹bPŠaPˆaO‡`O…_Oƒ^O‚]O€\O~[N|ZNyYNwXNuWMrUMŸw_œv_˜t^~\GzYGvWF†j[fZ|dYybX\I@VGB5/2.R„.R„.R„.R„Sw©Sw©Sw©Sw©Sw©Sw©Sw©Sw©Sw©SwªSwªSwªSxªSxªSxªSxªTxªTxªTxªTxªFkFkFkFkƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§ÚFkFkFkFkFkFkFkFkƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Úƒ§Ú}¡Ó}¡Ó}¡Ô}¡ÔChšChšChšChšChšChšChšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhš~£ÕAe˜Ae˜Ae˜Ae˜Ae˜%J|%I|%I|%I|%I|%I|%I|%I|%I|%I|%I|%I|%I{%I{%I{%I{%I{%I{@e—@e—<68?31gYVpa\bRMjYTq`Z€j`¡‡z«}²‘}¶’|¸’{º’z»’x¼’w§z^¿‘t¿‘s¿‘s¿s¿r¿r¾r¾r°h2‹O$„L$mSMnSMnTMoTMtVMvWNxXNzYN|ZN~[N€\O‚]O„^O…_O‡`OˆaOŠaP‹bPŒcPŽcPdPdP‘eP’eQ“fQ”fQ•gQ–gQ–hQ—hQ˜hQ˜iQ™iQšiQšiQšjQ›jQ›jQœjQœjQœkQœkQkQkRkRkRkRkRkRkRkRkRkQkQkQœkQœjQœjQœjQ›jQ›jQšjQšiQ™iQ™iQ˜hQ—hQ—hQ–gQ•gQ•gQ”fQ“fP’eP‘ePdPdPcPŒbP‹bP‰aPˆ`O†`O…_Oƒ^O]O€\O~[N|ZNyYNwXNtWM£z` y`w`šu_€]I|[HwXGˆl\ƒi[}eZycYr_WjZU;23.R„.R„.R„.R„.R….R….R…Sw©Sw©Sw©Sw©Sw©SwªSwªSwªSxªSxªSxªTxªTxªTxªTxª/S…/S…GkGkGkGkGkGkGkƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨ÚGkGkGkƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Ú}¢Ô}¢Ô}¢Ô}¢Ô~¢ÔDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhš£ÕAf˜%J|%J|%J|%J|%J|%J|%J|%J|%J|%I|%I|%I|%I|%I|%I|%I|%I|%I|%I|%I|%I{%I{Ae—Ae—Ae—?89H=+[NL^SQWNNKFJ?AI2:HTx«Ty«Ty«Ty«Uy«Uy«Uy«Uy«Uy«‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«ÝImŸImŸImŸImŸ‡«Ý‡«Ý‡«Ý‡«Ý‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«ÞImŸImŸImŸImŸImŸImŸImŸImŸImŸImŸImŸImŸImŸImŸImŸImŸ'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}DhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšChš&K}&K}&K}&K}&K}&K}&K}&K}&K}&K}CgšCg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Bg™Bg™Bg™Bg™Bg™Bg™Bf™Bf™Bf™&J|&J|Bf˜Bf˜Bf˜Bf˜Bf˜Bf˜Bf˜Bf˜Bf˜;HY;HY;HY;HY;HY;HY;GY3("D::B41RB=YG@wcZ}g\ƒk_‡nbŒrdug}aRdT„gV‡iX‰kY¢ƒq¤„r¥…s§†t‘p^’q^Ÿw` x`¢y`£z`¤za¥{a½“x¾“x¿“w¿“wÀ“wÀ“vÀ“vÀ“vÀ“uÀ’uÀ’tÀ‘sÀ‘sÀ‘r¿r¿q¿q¾p¾Žp¾Žo½Žo¥vW¼n¼Œn»Œn»Œn»ŒnºŒnº‹m¢tV¡sV¡sV¡sV sV sWŸsWŸsXžsXµŠpµŠp´ŠpœsY›sYšrZ˜r[–r\”q\‘p]¦†t£„tŸƒsœs€h\{e[vbYo^XhZV`USXPQNJMECJRS[47A+((MYkMYkMYkMZk(5F(5F(5FOHJT=+YML_SRZQQMGJABI2:H/T†Uy«Uy«Uy«Uy«Uy«Uy«‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬ÞImŸImŸImŸImŸImŸImŸImŸImŸImŸImŸImŸImŸˆ¬Þˆ¬Þ'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}DhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhšDhš'K}'K}'K}'K}'K}'K}&K}&K}&K}&K}&K}&K}&K}&K}CgšCgšCgšCgšCg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Bg™Bg™Bg™Bg™&J|&J|Bf™Bf™Bf™Bf™Bf˜Bf˜Bf˜Bf˜Bf˜;HY;HY;HY;HY;HY;HY>DM>DM;HY89<:+#9&B52I94ZHAxd[}g^k`†nc‹rey_R}bTeVƒgX…iYˆk[Šl\Œn]o^¥‡v§ˆvšvaœwažxa yb¢zb¤{b¤{a¼“x½“x¦|a§|a§|`§{`§{_§{_§{^§z^¾‘u¾‘t¾‘t¾s½s½r½r¥wZ¤wZ¤vY¤vY£vY£uX¢uX¢uX¢uX¹Œp¸Œp¸Œp·Œp·‹p¶‹p¶‹pµ‹qµ‹qtZ›t[šs\™s\˜s]–r]”r^’q^p^o^Šn^‡l^ƒj^h]{f\ub[n^YgZW_UTWPQOKOEEKST]JNY>=? JJIMYkMYk(5F(5F(5F(5F(5F)5G)5GK=4S<*XMLbWVYPPLGJ@AI/T†/T†Uy«Uy«Uy«‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬ÞImŸImŸImŸIm ˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬ÞIm Im Im Im Im Im Im Im ˆ¬Þˆ¬Þˆ¬Þˆ¬Þ'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}Dh›Dh›Dh›Dh›DhšDhšDhšDhš'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}&K}&K}&K}&K}ChšChšCgšCgšCgšCgšCgšCg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™Cg™&J|&J|&J|&J|&J|Bg™Bg™Bg™Bf™Bf™Bf™Bf™Bf˜Bf˜;HY;HY;HY;HY;HY;HYCIR>DMCIR;HYCIR.$ 0"8&?* G/ V=+w[F{g^€kanXMs\Px_S{bU~dWfYƒhZ†j\ˆl]Šm^¢…v§ˆwªŠxŒy¯y±Žz´zµz·‘z¹’z£{b£{b¤{b¥{b¥{a¥{a¥{`¥{`¥z_¥z_¥z^¼‘u¥y]¤y]¤x]¤x\£w\£w[¢w[¢v[¢v[¡v[¡v[¸r·r¶r¶ŒsµŒs´Œs´Œs²Œt±‹u°‹u˜t^–s_•s_“r_’r`q`p`¡…wž„v›‚v—€u“~twd]sb[l^ZeYW]TUUORLJOYYaRU^JOZ>>@!$)RXaMYk39B-3<-3<(5F)5G)5G)5G)5G)5GFDJK9*^K=YONg\\TLMIFJ:>I0T†0T†ImŸˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬ÞIm Im In In In In In In ˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆ¬ßIn In In In In ˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆ¬ß'K~'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}Di›Di›Dh›'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}&K}ChšChšChšChšChšCgšCgšCgšCgšCgšCg™Cg™Cg™Cg™Cg™Cg™&J}&J}&J}&J}&J|&J|&J|&J|&J|Bg™Bg™Bg™Bg™Bg™Bf™Bf™EM>EMCIR;HY;HYCIRCIR) 6&8&@*H0 I1!\B0}_JhTKjM8q[Pt]Sw`U{cW~eYg[ƒi\…k^‡m_Ÿ…v¢†w¥ˆx¨Šyª‹zz¯Ž{±{²{³{´{žzdŸzd zc zc¡zc¸‘y¸‘y¸‘y¸‘x¸x¸x·w·w·w·wŸw_Ÿw_žw_µŽv´Žv³v²v²w±w°Œw¯Œw®Œw‹w«‹xªŠx¨‰x¦‰x¥ˆx£‡x¡†xž…x›ƒw—v’~vŽ|t‰ys„vrh\YcXX[TUSNRIHOUXaNS^JFE>>A')+"%(4:C(5F(5F3:B3:B-3<-3<)5G)5G)5G)5G)5G)5GE:4O:*TKLbXWcZZPIKDCJIm Im Im Im ˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬ßˆ¬ßˆ¬ßˆ¬ßIn In In In In In Jn Jn Jn Jn Jn ˆßˆßˆßˆßˆßˆßˆßˆßˆßˆßˆßˆßˆßˆßˆßˆßˆßˆßˆßˆßˆß‰ß‰ß‰ß‰ß‰ßJn ‰ß‰ß‰ß‰ßˆßˆßˆßˆß'K~'K~'K~'K~'K~'K~'K~'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}DhšDhšDhšChšChšChšChšChšChšCgšCgšCgšCgš&K}&K}&J}&J}&J}&J}&J}&J}&J}&J}&J|&J|&J|Cg™Cg™Cg™Bg™Bg™Bg™EMCIRCIRCIR888DGNCJRCIRBBB( 0 8&<) G0 M5"X@0z^K†bFŠkUlXPp[Rs^TvaVzcX}fZg\i]™u›‚v„wŸ†x¢‡y¥‰z§Šz©‹{ªŒ{•ve–ve—we˜we°|°|±{²{²{²{²{²{±z±z±Žz±Žz±Žz°Žy™vb˜vb—vb–ub•ub•uc”tc“tc’sbscrcqc¢‡y †y…y›„x˜‚x•w’w|uˆytƒvs~sqyooslmVQTOLR[\dQU`KHHAAD:<@68; & Z`i-4<%');AJ4:C4:C4:C-4<)5G)5G)5G)5G)6G)6G@84H8-N?5YPQmccoghd`dIn In In In In In ˆ¬ßˆ¬ßˆßˆßˆßˆßˆßˆßˆßˆßJn Jn Jn Jn Jn Jn Jn Jn Jn Jn Jn Jn Jn Jn Jn Jn ‰ß‰ß‰ß‰ß‰ß‰ß‰ß‰ß‰ß‰ß‰ß‰ß‰ß‰ß‰ß‰ß‰ß‰ß‰ß‰ß‰ß‰ß‰ßJn Jn Jn ‰ß‰ß‰ß‰ß‰ß‰ß‰ß'K~'K~'K~'K~'K~'K~'K~'K~'K~'K~'K~'K~Ei›Ei›Ei›Ei›'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}DhšDhšDhšDhšDhšDhšChšChšChš&K}&K}&K}&K}&K}&K}&K}&K}&J}&J}&J}&J}&J}&J}&J}&J}&J}Cg™Cg™Cg™Cg™B9;>68; Z`iZ`iMZk)5G4:C-4<4:C4:C-4<;BJ)5G)6G)6G)6G)6G)6GC6-L;.leg„{{ypqhbeVYcJn Jn Jn Jn Jn Jn Jn ‰ß‰ß‰ß‰ß‰ß‰ßJn Jn Jn Jn Jn Jn Jn Jn Jn Jn Jn Jn Jn Jn Jn Jn Jn Jn Jn Jn ‰ß‰ß‰ß‰ß‰ß‰ß‰à‰à‰à‰à‰à‰à‰à‰à‰à‰à‰à‰à‰àJn¡Jn¡Jn¡Jn¡Jn¡Jn¡Jn¡‰à‰à‰à‰à‰à'L~'L~'L~'L~'L~'L~'K~'K~'K~Ei›Ei›Ei›Ei›Ei›Ei›Ei›Ei›'K~'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}DhšDhšDhšDhšDhš'K}'K}'K}'K}&K}&K}&K}&K}&K}&K}&K}&K}&K}&K}&K}&J}&J}&J}&J}&J}&J}Cg™Cg™Cg™<535=AG=?D?AD==1(B3)B2&F4'E4)gTGlXJs^OzcTzaPqfethgvjhbVTcWUdXVeYWfZXg[Yh\Zi]Zi][j^\€us€ususts~tt~tt}tt|st{stut~tt|sszrsyqrwpquoqsmpqloXTXTQWPOULLSSJEA<:=99757335./2113)+.'),)+.8:= "( 3@Q JMPV\eT[cNZlNZlZ`iZ`iZ`iZ`iSYbY`h4;C.4=)6GCPaCPaCPaCPaCPaEQbZOGa_emhkŠƒ„nfgeaeJn¡Jn¡Jn¡Jn¡Jn¡Jn¡Š®àŠ®àŠ®àŠ®àŠ®àJo¡Jo¡Jo¡Jo¡Jo¡Jo¡Jo¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Š®àŠ®áŠ®áŠ®áŠ®áŠ®áŠ®áŠ®áKo¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡ƒ§Úƒ§Úƒ§Úƒ¨Úƒ¨Úƒ¨Úƒ¨Úƒ¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨ÚEjœEiœEiœEiœEiœ'L~'L~'K~'K~'K~'K~'K~'K~'K~'K~'K~'K~'K~'K}'K}'K}'K}'K}'K}'K}Di›Di›Di›Di›Dh›Dh›'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}&K}&K}&K}&K}&K}&K}&K}&K}&K}$.>=I[=I[2)>0&A2'C3(I8-^OFbRHfUJjXMq^RwcVzfYfRDfQCdN@zdTqijrjksklrklrklrklqjmpjmpjmojmojmnimmimkhliflscYm`Xg\VbYT^VRE>;A<:>98:77645:873220/0,-/)+.*,/#%( & 15;5BS KKKJMP]dlU[dNZlNZlZ`iTZcZaiZaiZ`iZ`iSZbŽ”LS[V]eDPbDPbDPbDPbDPbDPbWMF^^diei®”†…rkeaeJo¡Jo¡Jo¡Jo¡Š®àŠ®àŠ®àŠ®àŠ®àŠ®àŠ®àŠ®àŠ®àKo¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Š¯áŠ¯áŠ¯áŠ¯áKo¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡ƒ¨Úƒ¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Û„¨ÛGk'L~'L~'L~'L~'L~'L~'K~'K~'K~'K~'K~'K~'K~'K~'K~'K~Ei›Ei›Ei›Ei›Ei›Di›Di›Di›Di›Di›'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}&K}&K}&K}&K}&K}%/> ,>=I[=I[ ,> ,>#)2(.7#)2(.7#)2#)2#)2#)2(.7(.7(.767@D>A214$+3#%("$'###""""""&&& 888888cB*}\I@!% +%!5*$:/(;0)<1*>3+@4+>1(bUKN@6OA6L=3QB8M?4_RKaTLbUMcVNcVNcVObVOaVOaUO`UO_UO^UO^TO\SOYRNWPNUOMWPKYSOWRN;63953:76755333,/2'),%(+"%( !' "&,KXi04: JMP]_b^emU[dNZlNZlT[cU[dU[dU[d[aj•ž•ž•žˆŽ—–¥W]fDPbDPbDPbDPbDPbDPb‘nSž…w—|m¨‚ƒqjKo¡Ko¡Ko¡Š®àŠ®àŠ®àŠ®áŠ®áŠ®áŠ®áŠ®áŠ®áŠ¯áŠ¯áŠ¯áKo¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¡Ko¢Ko¢Ko¢Ko¢Ko¢Ko¢Ko¢Ko¢Ko¢Ko¢Ko¢Ko¢Ko¢Ko¢Ko¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Û„¨Û„¨Û„¨Û„¨Û„©Û„©Û„©Û„©ÛGkGkGkGkGkGk'L~'L~'L~'L~'K~'K~'K~Ei›Ei›Ei›Ei›Ei›Ei›Ei›Ei›Ei›Ei›Ei›Ei›Di›Di›'K}'K}'K}'K}HlžHlžHlžHlžHlžHlžHlžHlž'K}'K}'K}'K}'K}'K}'K}'K}'K}'K}&K}*2? ->=I[=I[ ,> ,> ,>#)2#)2#)2(.7(.7#)2#)2(.7(.7(.7(.7/28:79G@A<89',4#%(#%(######"""""" 8888888887'vS:‹jW;)
+
+ & 3#.$ -% .% .& /&!,# ,# @70A71XNHXNHWNHWNHZRLYQLYQLXQLWQLWPLUOLSNLQMKOLJMJJ0//.-.,,-&(+ "( !' 15;6CT37= MMMKMP^ad_enY`hNZlNZlU\dV\eŠ‘™Š™Š™–Ÿ–Ÿ–ž•ž“œ—¦Œ’›ƒ¡DQbDQbDQbDQbDQbMUc¤ƒ‘ylŸ‡|€oiKo¡Š¯áŠ¯áŠ¯áŠ¯áŠ¯áŠ¯áŠ¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯áKo¢Ko¢Ko¢Ko¢Ko¢Ko¢Ko¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢Kp¢‹¯â‹¯â‹¯â‹¯âLp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢„¨Ú„¨Ú„¨Ú„¨Ú„¨Ú„¨Û„¨Û„¨Û„¨Û„©Û„©Û„©Û„©Û„©Û„©Û…©Û…©Û…©Û…©Û…©Û…©ÛGkžGkžGkžGkžGkžGkžGkžGkžGkž…©Û…©Ü…©Ü…©Ü…©Ü…©Ü…©Ü…ªÜ…ªÜ…ªÜ…ªÜ…ªÜ…ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlž'K}'K}'K}'K}'K}'K}'K}'K}'K}HO\=J[=J[=J[ -> ,> ,>(.7#)2#)2(.7(.7(.7#)2(.7(.7(/7(/7)/8/28114H7,99@.05&,5$&)$$$######"""(((8888888888888884"nO9„gXˆjZE/ ( -"
+
+ % ' %$#" ! !$
+
+
+ 48>7CU:GX JJJLLLKMPagp_enNZlLPV˜Ÿ§Œ’›Œ’›Œ’›‹’š‹‘šŠ‘™‘— –Ÿ–Ÿ–Ÿ“œ“œ—¦„¢„¢DQbDQbDQbDQbNVc…uo‡rjѼ³º«§‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯áKp¢Kp¢Kp¢Kp¢Kp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢‹°â‹°â‹°â‹°âŒ°âŒ°âŒ°âLp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢„¨Û„¨Û„¨Û„©Û„©Û„©Û„©Û„©Û„©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©ÛGkžGkžGkžGlžGlžGlž…©Ü…©Ü…©Ü…ªÜ…ªÜ…ªÜ…ªÜ…ªÜ…ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlž'K}'K}'K}'K}DhšDhšDhšIP\=J[=J[=J[=J[ -> ->(.7#)2#)2(.7(.7(.7#)2(.7(/7(/7)/8)/8)/803966:E?AC>A856,07%'*%')$$$######(((DDDBBB888888888 0 cF1w]OcS{`QS;+57'
+
+
+ *
+ ;?E7CU;HY=I[ JJJMMMKMPacfbhq‘— ƒ¡ƒ¡‘— “œ“œ“œŒ“›Œ’›Œ’›‹‘š‘— ‘— —Ÿ™Ÿ¨”œ“œ“œ„‘¢„‘¢„‘¢„‘¢EQcHScNVd´¨§¿®¨Èµ®¯‘‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯á‹¯â‹¯â‹¯â‹¯â‹¯â‹¯â‹°â‹°â‹°â‹°â‹°â‹°â‹°âLp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Œ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âLp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp£Lp£Lp£Lp£Lp£Lp£Lp£Lp£Lp£Lp£Lp£„©Û„©Û„©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Ü…©Ü…©ÜGlžGlž…ªÜ…ªÜ…ªÜ…ªÜ…ªÜ…ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÝHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlž‡«Ý‡«ÝDhšDhšDhšDhš=J[=J[=J[=J[=J[=J[ ->(/7#)2#)2(.7(.7(.7#*2(/7)/8)/8)/8)/8)08*0903:56:88@KBB=;@348*08&(+'(*%%%$$$(((EEE(((&&& ">-"bF3oXMs[Ow]Py^PqbpXMdH5R<,Q;, & % %#'-"'-&3DS_qP\nR_p>J\?K]AG@B::@66:-29'),)'%BBBFFFEEE)))))))))&&& @@@FFFACFZ\_[ajagp„¢„¢„¢ž¥Ÿ¦®—¦–¥–ž•žŽ•Ž””œ“œ‘— —Ÿ›¡ªš ©™ ¨Ž•Ž”Ž”…‘£…‘£…‘£EQcGRcKTdPWd¥§¿¯ª‹°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°ãŒ°ãŒ°ãŒ°ãŒ°ãLp£Lp£Lq£Lq£Lq£Lq£Lq£Lq£Lq£Œ±ãŒ±ãŒ±ãŒ±ãŒ±ãŒ±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ãMq£Mq£Mq£Mq£Mq£Mq£Mq£Mq£Mq£Mq£Mq£Mq£Mq£Mq£Mq£…©Û…©Û…©Û…©Û…©Û…©Û…©Ü…©Ü…©Ü…©Ü…©Ü…ªÜ…ªÜ…ªÜ…ªÜ…ªÜ…ªÜ†ªÜHlžHlžHlžHlžHlž†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÝ†ªÝ†ªÝ†ªÝ†ªÝ†«Ý†«Ý†«Ý†«Ý†«Ý†«Ý†«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«ÝHlžHlžHlŸHlŸHlŸHlŸHlŸ‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Þ‡«Þ‡«Þ‡«ÞŸ>J\>J\=J[=J[=J[=J[FLU39B#*2(/7)/7)/8$*3$*3$*3)/8)08*09*09*19',5(-5*.6.17338@<=G@BH@BXW]UUXLPWFHKDFHKKKHHH+++%%%%%%$$$###!!!!!! 777777777777777777777AAAFFFACFACF\^aeltbhqDQbDQbDQbŸ¥®¡§°¡§°¡§°¡§°—¦–Ÿ”š£”š£“™¢’™¡’˜¡‘˜ ‘— ›¡ª›¡ªš ©•ž™Ÿ¨Ž”ERcERcERcERcHScLUdRXd|njŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°ãŒ°ãŒ°ãŒ°ãŒ°ãŒ±ãŒ±ãŒ±ãŒ±ãŒ±ãŒ±ãŒ±ãŒ±ã±ã±ã±ã±ãMq£Mq£Mq£Mq£Mq£Mq£±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ãMq£Mq£Mq£Mq£Mq£Mq£Mq£Mq£Mq£Mq£Mq£Mq£Mq£…©Ü…©Ü…©Ü…©Ü…©Ü…ªÜ…ªÜ…ªÜ…ªÜ…ªÜ…ªÜ†ªÜ†ªÜ†ªÜ†ªÜHlžHlžHlžHlžHlžHlžHlžHlžHlž†ªÜ†ªÜ†ªÜ†ªÝ†ªÝ†ªÝ†ªÝ†ªÝ†ªÝ†«Ý†«Ý†«Ý†«Ý†«Ý†«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«ÝHlŸHlŸHlŸHlŸHlŸ‡«Ý‡«Ý‡«Ý‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬ÞŽŸŽŸŽŸŽŸ>J\=J[=J[FLUFLU(/7(/7*08*08%+3$*3$+3$+3*09*09*19&,5&,5'-6).6*/7-18NPURRVXUVc]^f^_[X]\XYTUZLQYKMPFHJ)))(((&&&%%%%%%$$$$$$###!!!!!!!!! 777777777BBBEEEACGADGFIL\ckZ`iTZcDQbDQbDQbagpbiqcircir¢©±¢¨±¡¨°¡§°•œ¤•›¤”›£”š£“™¢’™¡’˜¡œ¢«œ¢«›¡ªš¡©•žY`hY_hERcERcERcGSdJTdNVdTYeLp¢Lp¢Œ°ãŒ°ãŒ°ãŒ°ãŒ±ãŒ±ãŒ±ãŒ±ãŒ±ãŒ±ãŒ±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ãMq£Mq£±ã±ã±ã±ä±ä±ä±ä±ä±ä±ä±ä±ä±ä²ä²ä²ä²ä²ä²ä²ä²ä²ä²ä²ä²ä²äMq¤Mq¤Mq¤Mq¤Mq¤Mq¤Mq¤Mq¤Mq¤Mq¤Mq¤…ªÜ…ªÜ…ªÜ…ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlž†ªÝ†ªÝ†«Ý†«Ý†«Ý†«Ý†«Ý†«Ý†«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«ÝHmŸ‡«Þ‡«Þ‡«Þ‡«Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬ÞŽŸŽŸŽŸŽŸŽŸŽŸŽŸFLUFLUFLU)/8+08+08&+3&+3%+4%+4%+4*19+1:&,5'-5'-6(.6FLTHMTINUKOVOQWSTXYWX`[^lbac]_f_\a_aY\aRX_,.1*,.*+-***((('''&&&%%%%%%$$$$$$$$$###!!!!!!!!!!!!!!! %%%%%%%%%%%%"""""""""KKKJJJFFFGIL]_b^dm\bkV]eDQbEQcEQcEQccirdjsdksektdjsdjscir£©²¢¨±¢¨±–œ¥•œ¤•›¤”›£”š£“™¢’™¡£¬œ¢«›¢ª[ajZ`iOU^ERcERcFRdFRdITdLUdPWeVZeLp£Lq£Lq£Lq£±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ã±ä±ä±ä±ä±ä±ä²ä²ä²äMq£²ä²ä²ä²ä²ä²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äMr¤Mr¤Mr¤Mr¤Mr¤Mr¤Mr¤Mr¤Mr¤Mr¤†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlž†«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Þ‡«Þ‡«Þ‡«Þ‡«ÞHmŸHmŸHmŸ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬ÞŽŸŽŸŽŸŽŸ‚Ž ‚Ž ‚Ž ‚Ž ”›£Š™ŠŽ•-18,18',3',4',4&,4%,4+1:,2:'-5DJSEKSEKTFLTFLUHMUINVKOWLPWQSYTUZWWZpjje^`offb\_h`]eaaCCG8;A27?-/2+-/.+)******)))((('''&&&&&&%%%%%%$$$$$$$$$$$$$$$$$$######???EEEEEEEEE((((((###&&&%%%HJMHJMHJMHJM_en]dlZ`i_enEQcEQcEQcEQcbhqektflufluflufluektektdksdjscjr£©²¢©±¢¨±–œ¥•œ¤•›¤”›£”š£“™¢£¬\ckQW`[ajZaiOU^FRdFRdFRdHSdKUdNVeRXeX\fLq£Mq£Mq£Mq£Mq£±ã±ã±ã±ã±ã±ä±ä±ä±ä±ä²ä²ä²ä²ä²ä²ä²ä²äŽ²äŽ²äŽ²äŽ²äŽ²äMr¤Mr¤Mr¤Mr¤Mr¤Ž²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²åŽ²åŽ²åŽ²åŽ²åŽ²åŽ²åŽ²åŽ²åNr¤Nr¤Nr¤Nr¤Nr¤Nr¤Nr¤Nr¤†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlž‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡¬Þ‡¬Þ‡¬ÞHmŸHmŸHmŸHmŸImŸImŸImŸˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þ‚Ž ‚Ž ‚Ž ‚Ž ‚Ž ‚Ž ‚Ž ‚Ž ”›£Š‘™‹•‹•PT[KOVJOV(-4(-4'-5'-5JOXEKSEKSEKTFLTFLTGMUGMUHNVIOWKPWLQXMRYPTZTV[\]a_^asljd^azporjkE@CLEBIEFEDG29A28A17@135,.1+-0+,/./1..0'),)))++++++++++++***FFFFFFACFACFEEEACFACFŠŒJLOJLOKQZ_en]clY_hU[dEQcEQcEQcEQcEQcagp[aj\bk\bkgnvgnvgmvgmvfluflueltektdksdjscjrcir¢©±—¦–œ¥•œ¤•›¤TZcSYbRYaRXaQW`[bj[ajZ`iFSdFSdGSdJTdLVePXeTZfZ]fMq£Mq£Mq£Mq£Mq£Mq£Mq£²ä²ä²ä²ä²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äNr¤Nr¤Nr¤Nr¤Nr¤Nr¤Nr¤Nr¤Nr¤Ž²åŽ²åŽ²åŽ²åŽ³åŽ³åŽ³åŽ³åŽ³åŽ³åŽ³åŽ³åŽ³åŽ³åŽ³åŽ³åŽ³åŽ³åŽ³åŽ³å³å³å³å³å³å³å³åNr¤Nr¤Nr¤Nr¤Nr¤³å³å†ªÜ†ªÜ†ªÝHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlŸHlŸHlŸHlŸHlŸHlŸ‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡«Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬Þ‡¬ÞImŸImŸImŸImŸImŸImŸImŸImŸImŸImŸˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬Þˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆ¬ßˆß‚Ž ‚Ž ‚Ž ‚Ž ‚ ‚ ‚ ‚ ‚ …Œ”’•šŒ•‘”›LPVLPWKPW‹—‹—‹˜•‹‘™FLTFLTFLUGMUGMUHMVHNVINWIOWKPXLQYMRYNSZTX`X[a[]b]^c__ccacib`JDGi__aYYPJLD@C=;AKEDTQR@?A>>A;/5>.4=-4
demos/images/teapot.ppm
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/images/noletter.bmp
===================================================================
--- demos/images/noletter.bmp (nonexistent)
+++ demos/images/noletter.bmp (revision 1765)
@@ -0,0 +1,27 @@
+#define noletters_width 48
+#define noletters_height 48
+static char noletters_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x1f, 0x00, 0x00,
+ 0x00, 0x00, 0xff, 0xff, 0x01, 0x00, 0x00, 0xc0, 0xff, 0xff, 0x07, 0x00,
+ 0x00, 0xf0, 0x0f, 0xe0, 0x1f, 0x00, 0x00, 0xfc, 0x01, 0x00, 0x7f, 0x00,
+ 0x00, 0x3e, 0x00, 0x00, 0xf8, 0x00, 0x00, 0x1f, 0x00, 0x00, 0xf0, 0x01,
+ 0x80, 0x07, 0x00, 0x00, 0xc0, 0x03, 0xc0, 0x03, 0x00, 0x00, 0xe0, 0x07,
+ 0xe0, 0x01, 0x00, 0x00, 0xf0, 0x0f, 0xe0, 0x00, 0x00, 0x00, 0x78, 0x0e,
+ 0xf0, 0x00, 0x00, 0x00, 0x3c, 0x1e, 0x70, 0x00, 0x00, 0x00, 0x1e, 0x1c,
+ 0x38, 0x00, 0x00, 0x00, 0x0f, 0x38, 0x38, 0x00, 0x00, 0x80, 0x07, 0x38,
+ 0x3c, 0xfc, 0xff, 0xff, 0x7f, 0x78, 0x1c, 0x04, 0x00, 0xe0, 0x41, 0x70,
+ 0x1c, 0x04, 0x00, 0xf0, 0x40, 0x70, 0x1c, 0x74, 0x00, 0x78, 0x4e, 0x70,
+ 0x0e, 0x04, 0x00, 0x3c, 0x4a, 0xe0, 0x0e, 0x74, 0x03, 0x1e, 0x4a, 0xe0,
+ 0x0e, 0x04, 0x00, 0x0f, 0x4e, 0xe0, 0x0e, 0x04, 0x80, 0x07, 0x40, 0xe0,
+ 0x0e, 0x04, 0xf8, 0x0f, 0x40, 0xe0, 0x0e, 0x04, 0xe0, 0x01, 0x40, 0xe0,
+ 0x0e, 0x04, 0xf8, 0x00, 0x40, 0xe0, 0x0e, 0x04, 0x78, 0x00, 0x40, 0xe0,
+ 0x0e, 0x04, 0xfc, 0xf3, 0x40, 0xe0, 0x1c, 0x04, 0x1e, 0x00, 0x40, 0x70,
+ 0x1c, 0x04, 0x0f, 0x00, 0x40, 0x70, 0x1c, 0x84, 0x07, 0x00, 0x40, 0x70,
+ 0x3c, 0xfc, 0xff, 0xff, 0x7f, 0x78, 0x38, 0xe0, 0x01, 0x00, 0x00, 0x38,
+ 0x38, 0xf0, 0x00, 0x00, 0x00, 0x38, 0x70, 0x78, 0x00, 0x00, 0x00, 0x1c,
+ 0xf0, 0x3c, 0x00, 0x00, 0x00, 0x1e, 0xe0, 0x1e, 0x00, 0x00, 0x00, 0x0e,
+ 0xe0, 0x0f, 0x00, 0x00, 0x00, 0x0f, 0xc0, 0x07, 0x00, 0x00, 0x80, 0x07,
+ 0x80, 0x07, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x1f, 0x00, 0x00, 0xf0, 0x01,
+ 0x00, 0x3e, 0x00, 0x00, 0xf8, 0x00, 0x00, 0xfc, 0x01, 0x00, 0x7f, 0x00,
+ 0x00, 0xf0, 0x0f, 0xe0, 0x1f, 0x00, 0x00, 0xc0, 0xff, 0xff, 0x07, 0x00,
+ 0x00, 0x00, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0xf0, 0x1f, 0x00, 0x00};
demos/images/noletter.bmp
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/images/pattern.bmp
===================================================================
--- demos/images/pattern.bmp (nonexistent)
+++ demos/images/pattern.bmp (revision 1765)
@@ -0,0 +1,6 @@
+#define foo_width 16
+#define foo_height 16
+static char foo_bits[] = {
+ 0x60, 0x06, 0x90, 0x09, 0x90, 0x09, 0xb0, 0x0d, 0x4e, 0x72, 0x49, 0x92,
+ 0x71, 0x8e, 0x8e, 0x71, 0x8e, 0x71, 0x71, 0x8e, 0x49, 0x92, 0x4e, 0x72,
+ 0xb0, 0x0d, 0x90, 0x09, 0x90, 0x09, 0x60, 0x06};
demos/images/pattern.bmp
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/images/face.bmp
===================================================================
--- demos/images/face.bmp (nonexistent)
+++ demos/images/face.bmp (revision 1765)
@@ -0,0 +1,173 @@
+#define face_width 108
+#define face_height 144
+#define face_x_hot 48
+#define face_y_hot 80
+static char face_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x09,
+ 0x20, 0x80, 0x24, 0x05, 0x00, 0x80, 0x08, 0x00, 0x00, 0x00, 0x00, 0x88,
+ 0x24, 0x20, 0x80, 0x24, 0x00, 0x00, 0x00, 0x10, 0x80, 0x04, 0x00, 0x01,
+ 0x00, 0x01, 0x40, 0x0a, 0x09, 0x00, 0x92, 0x04, 0x80, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x10, 0x40, 0x12, 0x00, 0x00, 0x10, 0x40, 0x00, 0x00, 0x84,
+ 0x24, 0x40, 0x22, 0xa8, 0x02, 0x14, 0x84, 0x92, 0x40, 0x42, 0x12, 0x04,
+ 0x10, 0x00, 0x00, 0x00, 0x00, 0x52, 0x00, 0x52, 0x11, 0x00, 0x12, 0x00,
+ 0x40, 0x02, 0x00, 0x20, 0x00, 0x08, 0x00, 0xaa, 0x02, 0x54, 0x85, 0x24,
+ 0x00, 0x10, 0x12, 0x00, 0x00, 0x81, 0x44, 0x00, 0x90, 0x5a, 0x00, 0xea,
+ 0x1b, 0x00, 0x80, 0x40, 0x40, 0x02, 0x00, 0x08, 0x00, 0x20, 0xa2, 0x05,
+ 0x8a, 0xb4, 0x6e, 0x45, 0x12, 0x04, 0x08, 0x00, 0x00, 0x00, 0x10, 0x02,
+ 0xa8, 0x92, 0x00, 0xda, 0x5f, 0x10, 0x00, 0x10, 0xa1, 0x04, 0x20, 0x41,
+ 0x02, 0x00, 0x5a, 0x25, 0xa0, 0xff, 0xfb, 0x05, 0x41, 0x02, 0x04, 0x00,
+ 0x00, 0x08, 0x40, 0x80, 0xec, 0x9b, 0xec, 0xfe, 0x7f, 0x01, 0x04, 0x20,
+ 0x90, 0x02, 0x04, 0x00, 0x08, 0x20, 0xfb, 0x2e, 0xf5, 0xff, 0xff, 0x57,
+ 0x00, 0x04, 0x02, 0x00, 0x00, 0x20, 0x01, 0xc1, 0x6e, 0xab, 0xfa, 0xff,
+ 0xff, 0x05, 0x90, 0x20, 0x48, 0x02, 0x00, 0x04, 0x20, 0xa8, 0xdf, 0xb5,
+ 0xfe, 0xff, 0xff, 0x0b, 0x01, 0x00, 0x01, 0x00, 0x80, 0x80, 0x04, 0xe0,
+ 0xbb, 0xef, 0xff, 0xff, 0x7f, 0x01, 0x00, 0x04, 0x48, 0x02, 0x00, 0x20,
+ 0x80, 0xf4, 0x6f, 0xfb, 0xff, 0xff, 0xff, 0x20, 0x90, 0x40, 0x02, 0x00,
+ 0x00, 0x04, 0x08, 0xb8, 0xf6, 0xff, 0xff, 0xdf, 0xbe, 0x12, 0x45, 0x10,
+ 0x90, 0x04, 0x90, 0x00, 0x22, 0xfa, 0xff, 0xff, 0xff, 0xbb, 0xd7, 0xe9,
+ 0x3a, 0x02, 0x02, 0x00, 0x04, 0x90, 0x80, 0xfe, 0xdf, 0xf6, 0xb7, 0xef,
+ 0xbe, 0x56, 0x57, 0x40, 0x48, 0x09, 0x00, 0x04, 0x00, 0xfa, 0xf5, 0xdf,
+ 0xed, 0x5a, 0xd5, 0xea, 0xbd, 0x09, 0x00, 0x00, 0x40, 0x00, 0x92, 0xfe,
+ 0xbf, 0x7d, 0xb7, 0x6a, 0x55, 0xbf, 0xf7, 0x02, 0x11, 0x01, 0x00, 0x91,
+ 0x00, 0xff, 0xff, 0xaf, 0x55, 0x55, 0x5b, 0xeb, 0xef, 0x22, 0x04, 0x04,
+ 0x04, 0x00, 0xa4, 0xff, 0xf7, 0xad, 0xaa, 0xaa, 0xaa, 0xbe, 0xfe, 0x03,
+ 0x20, 0x00, 0x10, 0x44, 0x80, 0xff, 0x7f, 0x55, 0x12, 0x91, 0x2a, 0xeb,
+ 0xbf, 0x0b, 0x82, 0x02, 0x00, 0x00, 0xd1, 0x7f, 0xdf, 0xa2, 0xa4, 0x54,
+ 0x55, 0xfd, 0xfd, 0x47, 0x08, 0x08, 0x00, 0x21, 0xe4, 0xff, 0x37, 0x11,
+ 0x09, 0xa5, 0xaa, 0xb6, 0xff, 0x0d, 0x80, 0x00, 0x00, 0x04, 0xd0, 0xff,
+ 0x4f, 0x44, 0x20, 0x48, 0x55, 0xfb, 0xff, 0x27, 0x11, 0x02, 0x40, 0x40,
+ 0xe2, 0xfb, 0x15, 0x11, 0x4a, 0x55, 0x4a, 0x7d, 0xf7, 0x0f, 0x00, 0x00,
+ 0x04, 0x08, 0xf8, 0xdf, 0x52, 0x44, 0x01, 0x52, 0xb5, 0xfa, 0xff, 0x0f,
+ 0x49, 0x02, 0x00, 0x02, 0xe9, 0xf6, 0x0a, 0x11, 0xa4, 0x88, 0x4a, 0x6d,
+ 0xff, 0x5f, 0x00, 0x00, 0x10, 0x20, 0xf0, 0x2f, 0x21, 0x44, 0x10, 0x52,
+ 0xb5, 0xfa, 0xff, 0x0f, 0x44, 0x04, 0x80, 0x08, 0xf8, 0xab, 0x8a, 0x00,
+ 0x81, 0xa4, 0xd4, 0xd6, 0xfe, 0x2f, 0x00, 0x00, 0x04, 0x40, 0xb5, 0x2d,
+ 0x21, 0x08, 0x04, 0x90, 0xaa, 0xfa, 0xff, 0x1f, 0x11, 0x01, 0x00, 0x04,
+ 0xf0, 0x57, 0x0a, 0x22, 0x40, 0x4a, 0xda, 0x5e, 0xfb, 0x1f, 0x40, 0x00,
+ 0x40, 0x20, 0xba, 0x95, 0x90, 0x00, 0x01, 0xa0, 0xaa, 0xea, 0xff, 0x5f,
+ 0x02, 0x02, 0x00, 0x01, 0xe8, 0x57, 0x05, 0x00, 0x00, 0x12, 0xd5, 0xfe,
+ 0xfd, 0x1f, 0x48, 0x00, 0x04, 0x48, 0x7a, 0x95, 0x08, 0x02, 0x10, 0x40,
+ 0xaa, 0x55, 0xf7, 0x1f, 0x00, 0x09, 0x20, 0x00, 0xf8, 0x57, 0x22, 0x10,
+ 0x00, 0x28, 0xa9, 0xfa, 0xff, 0x5f, 0x02, 0x00, 0x00, 0x49, 0xdd, 0x29,
+ 0x01, 0x00, 0x80, 0x80, 0xaa, 0xd7, 0xff, 0x0f, 0x10, 0x00, 0x08, 0x00,
+ 0xf8, 0x96, 0x08, 0x00, 0x00, 0x20, 0x54, 0xfa, 0xee, 0x3f, 0x81, 0x04,
+ 0x40, 0x24, 0xfe, 0x55, 0x82, 0x00, 0x00, 0x82, 0xd2, 0xad, 0xff, 0x0f,
+ 0x08, 0x00, 0x04, 0x80, 0x6c, 0x97, 0x00, 0x00, 0x02, 0x20, 0xa9, 0xf6,
+ 0xdf, 0x5f, 0x00, 0x02, 0x20, 0x09, 0xfa, 0x49, 0x12, 0x00, 0x20, 0x84,
+ 0x54, 0xdb, 0xfe, 0x1f, 0x91, 0x00, 0x00, 0x00, 0xf8, 0x2b, 0x00, 0x20,
+ 0x00, 0x40, 0xa4, 0xf6, 0xbb, 0x1f, 0x04, 0x00, 0x44, 0x92, 0x7e, 0x95,
+ 0x02, 0x00, 0x00, 0x89, 0xaa, 0xdd, 0xff, 0x1f, 0x20, 0x09, 0x10, 0x00,
+ 0xf4, 0x57, 0x20, 0x01, 0x08, 0x20, 0xa9, 0x76, 0xff, 0x5f, 0x02, 0x00,
+ 0x00, 0x21, 0xfc, 0x4a, 0x05, 0x00, 0x01, 0x80, 0x54, 0xdb, 0xff, 0x1e,
+ 0x08, 0x02, 0x04, 0x08, 0xf9, 0x2b, 0x00, 0x00, 0x40, 0x28, 0xd2, 0xf6,
+ 0xff, 0xbf, 0x80, 0x00, 0x90, 0x00, 0xbc, 0x92, 0x08, 0x10, 0x00, 0x82,
+ 0x54, 0xdb, 0xff, 0x1f, 0x20, 0x00, 0x00, 0x44, 0xf9, 0x55, 0x02, 0x01,
+ 0x00, 0x20, 0xaa, 0xbd, 0xfd, 0x3f, 0x08, 0x04, 0x04, 0x10, 0xf4, 0x2a,
+ 0x01, 0x00, 0x22, 0x80, 0xd4, 0xf6, 0xff, 0x5f, 0x82, 0x00, 0x40, 0x02,
+ 0xf8, 0x55, 0x20, 0x00, 0x00, 0x50, 0x6a, 0xdf, 0xfe, 0x3f, 0x00, 0x00,
+ 0x00, 0x48, 0xe9, 0x4a, 0x05, 0x08, 0x00, 0xa5, 0xd5, 0xf5, 0xff, 0x3f,
+ 0x10, 0x01, 0x10, 0x01, 0xb0, 0xab, 0x92, 0x02, 0x40, 0xf8, 0xbf, 0xde,
+ 0xfe, 0x5f, 0x02, 0x04, 0x04, 0x48, 0xfa, 0xd4, 0x6f, 0x20, 0x84, 0xef,
+ 0xff, 0xfb, 0xff, 0x1f, 0x20, 0x00, 0x00, 0x00, 0xe0, 0xed, 0xbf, 0x0b,
+ 0xa1, 0x7e, 0xff, 0xbf, 0xfd, 0x5f, 0x04, 0x01, 0x20, 0x49, 0xd2, 0xfb,
+ 0xfe, 0x55, 0xd4, 0xff, 0xff, 0xf6, 0xff, 0x07, 0x00, 0x04, 0x00, 0x00,
+ 0xc0, 0xaa, 0xfb, 0x2b, 0xa2, 0xfe, 0xff, 0xdf, 0xee, 0x1f, 0x91, 0x00,
+ 0x82, 0xa4, 0xa4, 0xf5, 0xff, 0x57, 0xd5, 0xff, 0xbf, 0xfd, 0xff, 0x4d,
+ 0x00, 0x00, 0x20, 0x00, 0x88, 0x5b, 0xff, 0x2f, 0x69, 0xff, 0xff, 0xdb,
+ 0xfe, 0x1f, 0x24, 0x02, 0x00, 0x49, 0xa2, 0xd6, 0xff, 0x5f, 0xea, 0xff,
+ 0x7f, 0x7f, 0x7f, 0x0d, 0x00, 0x00, 0x10, 0x00, 0x40, 0xab, 0xf7, 0xbb,
+ 0xf0, 0xdf, 0xff, 0xd5, 0xff, 0xbf, 0x82, 0x04, 0x42, 0x24, 0x91, 0xd5,
+ 0xaa, 0xae, 0xd4, 0xaa, 0x52, 0x7b, 0xff, 0x15, 0x08, 0x00, 0x00, 0x01,
+ 0x04, 0x55, 0xd5, 0x55, 0x70, 0x5b, 0x75, 0xdd, 0xdf, 0x1f, 0x40, 0x00,
+ 0x08, 0x48, 0xa0, 0x4a, 0xa9, 0x56, 0xea, 0x56, 0xad, 0x6a, 0x7d, 0x9b,
+ 0x04, 0x01, 0x00, 0x02, 0x42, 0x2a, 0xd5, 0xaa, 0xa8, 0xaa, 0xaa, 0xfa,
+ 0xdf, 0x2f, 0x10, 0x04, 0x22, 0x48, 0x08, 0x45, 0x2a, 0x15, 0x68, 0x55,
+ 0x55, 0xd7, 0x76, 0x1b, 0x00, 0x00, 0x00, 0x01, 0x40, 0x2a, 0x80, 0xa0,
+ 0xb2, 0x09, 0x48, 0xb9, 0xdf, 0x17, 0x22, 0x01, 0x00, 0x24, 0x45, 0x8a,
+ 0x24, 0x4a, 0x54, 0x51, 0x91, 0xf6, 0x6e, 0x4b, 0x00, 0x04, 0x90, 0x00,
+ 0x80, 0x52, 0x00, 0x20, 0x69, 0x05, 0xa4, 0xaa, 0xff, 0x1e, 0x48, 0x00,
+ 0x02, 0x92, 0x08, 0x05, 0x81, 0x94, 0xd4, 0x92, 0x40, 0xfd, 0xb6, 0x8b,
+ 0x00, 0x01, 0x40, 0x00, 0x82, 0x54, 0x00, 0x48, 0x68, 0x05, 0x90, 0xa4,
+ 0xef, 0x06, 0x24, 0x00, 0x08, 0x12, 0x10, 0x05, 0x00, 0x10, 0xb5, 0x01,
+ 0x42, 0xfb, 0xbf, 0x43, 0x00, 0x09, 0x00, 0x40, 0x81, 0xa8, 0x08, 0x4a,
+ 0xaa, 0x96, 0x90, 0xac, 0x6d, 0x15, 0x22, 0x00, 0x20, 0x09, 0x04, 0x15,
+ 0x80, 0x28, 0xdc, 0x01, 0x24, 0xfb, 0xbf, 0x01, 0x80, 0x04, 0x09, 0x00,
+ 0x40, 0x48, 0x02, 0x45, 0xb2, 0x2e, 0x41, 0x6d, 0xef, 0x05, 0x11, 0x00,
+ 0x40, 0x52, 0x02, 0x15, 0x29, 0x2a, 0xac, 0x42, 0x54, 0xfb, 0x3b, 0x51,
+ 0x84, 0x00, 0x08, 0x00, 0x20, 0x54, 0x80, 0x05, 0xb5, 0x3d, 0xa2, 0xb6,
+ 0xdf, 0x00, 0x20, 0x04, 0x20, 0x49, 0x89, 0xa8, 0x6a, 0x29, 0xac, 0xd6,
+ 0x54, 0xff, 0x3f, 0x84, 0x00, 0x01, 0x04, 0x10, 0x00, 0x94, 0xa8, 0x56,
+ 0xda, 0x5f, 0xab, 0xd5, 0x1e, 0x10, 0x48, 0x00, 0x90, 0x82, 0x48, 0xa8,
+ 0xb2, 0xac, 0xfd, 0x55, 0xd5, 0xfe, 0x9f, 0x80, 0x00, 0x0a, 0x02, 0x08,
+ 0x02, 0x55, 0x5a, 0x75, 0xff, 0xaf, 0xb6, 0xf7, 0x2d, 0x12, 0x92, 0x00,
+ 0x10, 0x20, 0x10, 0xa8, 0x54, 0xd5, 0xbf, 0x5d, 0xad, 0xdd, 0x0f, 0x00,
+ 0x00, 0x04, 0x40, 0x09, 0x84, 0xa8, 0xaa, 0x5a, 0xed, 0xeb, 0x6a, 0xff,
+ 0x9f, 0xa4, 0x24, 0x01, 0x02, 0xa0, 0x20, 0x50, 0x55, 0xd5, 0xbe, 0xae,
+ 0xad, 0xfd, 0x16, 0x00, 0x10, 0x04, 0x20, 0x0a, 0x08, 0xb4, 0xaa, 0x95,
+ 0xaa, 0x7b, 0xb7, 0xdb, 0x5f, 0x92, 0x04, 0x01, 0x84, 0x20, 0x21, 0x51,
+ 0xd5, 0x2a, 0xa9, 0xee, 0xd5, 0xfe, 0x0d, 0x00, 0x20, 0x04, 0x10, 0x00,
+ 0x08, 0x50, 0xe9, 0xd7, 0xd4, 0xfb, 0xb5, 0xff, 0x9f, 0x24, 0x09, 0x01,
+ 0x42, 0x4a, 0xa2, 0x64, 0xd5, 0x55, 0x7b, 0x7f, 0xda, 0x7d, 0x4f, 0x00,
+ 0x20, 0x04, 0x00, 0x80, 0x00, 0xa0, 0x2a, 0x13, 0x84, 0x6a, 0x55, 0xff,
+ 0x1d, 0x48, 0x8a, 0x00, 0x94, 0x24, 0x8a, 0xc8, 0xaa, 0x42, 0x20, 0x5d,
+ 0xf5, 0xff, 0x5f, 0x01, 0x00, 0x02, 0x01, 0x00, 0x20, 0xa2, 0x4a, 0x1a,
+ 0x82, 0x56, 0xda, 0xbd, 0x3f, 0x92, 0x92, 0x00, 0x90, 0x92, 0x00, 0x40,
+ 0x95, 0x6a, 0xf4, 0x55, 0x6d, 0xff, 0xd6, 0x00, 0x00, 0x0a, 0x04, 0x20,
+ 0x14, 0x49, 0x4b, 0xaa, 0xaa, 0x56, 0xf5, 0xff, 0xbf, 0xab, 0xa4, 0x00,
+ 0x20, 0x89, 0x40, 0x80, 0xaa, 0xaa, 0xaa, 0xaa, 0xde, 0xbf, 0xeb, 0x03,
+ 0x00, 0x02, 0x04, 0x02, 0x0a, 0x10, 0x2b, 0x2a, 0x55, 0x5b, 0xf5, 0xff,
+ 0xd7, 0x2f, 0x92, 0x00, 0x10, 0x28, 0x21, 0x01, 0x56, 0x95, 0xa0, 0x56,
+ 0xdf, 0xef, 0xea, 0x87, 0x40, 0x0a, 0x42, 0x41, 0x00, 0x90, 0xaa, 0x52,
+ 0xb6, 0xad, 0xfa, 0xff, 0xd5, 0x2f, 0x14, 0x00, 0x00, 0x04, 0x95, 0x04,
+ 0xaa, 0xac, 0x55, 0x6b, 0xff, 0xb7, 0xea, 0x9f, 0x40, 0x02, 0x28, 0x51,
+ 0x00, 0x40, 0x58, 0xd5, 0xda, 0xd6, 0x6e, 0x7f, 0xf9, 0x3f, 0x12, 0x04,
+ 0x02, 0x04, 0x49, 0x25, 0x55, 0xaa, 0x77, 0xab, 0xff, 0x2b, 0xfd, 0x3f,
+ 0x48, 0x01, 0x20, 0x41, 0x00, 0x00, 0x58, 0xa9, 0xda, 0xea, 0xfd, 0xaf,
+ 0xfa, 0xff, 0x02, 0x04, 0x08, 0x14, 0x29, 0x49, 0x52, 0x55, 0x55, 0x55,
+ 0xff, 0x8d, 0xfe, 0x3f, 0xa8, 0x00, 0x02, 0x41, 0x00, 0x02, 0xa0, 0xa2,
+ 0xaa, 0xea, 0xff, 0x53, 0xfd, 0xff, 0x02, 0x04, 0x50, 0x04, 0x25, 0xa8,
+ 0x54, 0x49, 0x52, 0xb5, 0xbf, 0x8a, 0xfe, 0xff, 0xa9, 0x08, 0x04, 0x50,
+ 0x80, 0x02, 0xa1, 0x2a, 0x95, 0xea, 0xff, 0xa1, 0xff, 0xff, 0x03, 0x02,
+ 0x90, 0x02, 0x09, 0x08, 0x44, 0x49, 0x52, 0xbd, 0x7f, 0xca, 0xff, 0xff,
+ 0x2b, 0x09, 0x04, 0x48, 0x40, 0x82, 0x90, 0x56, 0xa9, 0xf6, 0xbf, 0xd0,
+ 0xff, 0xff, 0x47, 0x00, 0x50, 0x02, 0x15, 0x11, 0x40, 0x95, 0xaa, 0xfd,
+ 0x2f, 0xe9, 0xff, 0xff, 0x8f, 0x0a, 0x84, 0x50, 0x40, 0x84, 0x14, 0xaa,
+ 0x6a, 0xff, 0x5f, 0xf2, 0xff, 0xff, 0x7f, 0x00, 0x10, 0x02, 0x09, 0x10,
+ 0x40, 0x7d, 0xf7, 0xff, 0x0b, 0xfc, 0xff, 0xff, 0xaf, 0x02, 0x84, 0x50,
+ 0x42, 0x85, 0x12, 0xd0, 0xdd, 0xff, 0xa7, 0xf2, 0xff, 0xff, 0xff, 0x04,
+ 0x00, 0x0a, 0x08, 0x10, 0x48, 0xf8, 0xff, 0xff, 0x0a, 0xfe, 0xff, 0xff,
+ 0x7f, 0x03, 0xa4, 0x80, 0xa2, 0x8a, 0x02, 0x68, 0xff, 0xff, 0x52, 0xfd,
+ 0xff, 0xff, 0xff, 0x07, 0x00, 0x2a, 0x08, 0x20, 0x28, 0xdc, 0xff, 0x5f,
+ 0x05, 0xff, 0xff, 0xff, 0xff, 0x0d, 0x92, 0x40, 0x22, 0x09, 0x02, 0xea,
+ 0xfb, 0xaf, 0x48, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x12, 0x81, 0xa0,
+ 0x48, 0x9c, 0x6e, 0x93, 0xa2, 0xff, 0xff, 0xff, 0xff, 0x07, 0xa8, 0x40,
+ 0x28, 0x0a, 0x02, 0x74, 0xb5, 0x45, 0x81, 0xff, 0xff, 0xff, 0xff, 0x0f,
+ 0x02, 0x0a, 0x81, 0x20, 0x08, 0xae, 0xaa, 0x90, 0xe8, 0xff, 0xff, 0xff,
+ 0xff, 0x0f, 0x90, 0x40, 0x28, 0x88, 0x12, 0x58, 0x15, 0x50, 0xd0, 0xff,
+ 0xff, 0xff, 0xff, 0x0f, 0x44, 0x0a, 0x41, 0x21, 0x08, 0xae, 0x04, 0x14,
+ 0xf0, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x10, 0x40, 0x14, 0x88, 0x04, 0xba,
+ 0x02, 0x28, 0xe8, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x42, 0x15, 0x41, 0x21,
+ 0x05, 0xad, 0x00, 0x05, 0xf8, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x10, 0x40,
+ 0x24, 0x8a, 0x0e, 0x36, 0x00, 0x0a, 0xf4, 0xff, 0xff, 0xff, 0xff, 0x0f,
+ 0x42, 0x25, 0x90, 0xd0, 0x8b, 0xc2, 0x41, 0x05, 0xfc, 0xff, 0xff, 0xff,
+ 0xff, 0x0f, 0x10, 0x08, 0x05, 0xe8, 0x8e, 0x58, 0x80, 0x02, 0xfa, 0xff,
+ 0xff, 0xff, 0xff, 0x0f, 0x4a, 0x20, 0xa8, 0xba, 0x0b, 0x2b, 0x51, 0x01,
+ 0xfe, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x8a, 0x02, 0xe8, 0xaf, 0x84,
+ 0x90, 0x04, 0xfd, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x52, 0x21, 0x54, 0xbf,
+ 0x1f, 0x15, 0xa5, 0x02, 0xfe, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x08,
+ 0x01, 0xfa, 0xb6, 0xa4, 0x52, 0x40, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f,
+ 0x4a, 0xa2, 0x54, 0xef, 0x5f, 0x4b, 0xa4, 0x80, 0xff, 0xff, 0xff, 0xff,
+ 0xff, 0x0f, 0x80, 0x10, 0x82, 0xfe, 0xbf, 0x92, 0x52, 0x42, 0xff, 0xff,
+ 0xff, 0xff, 0xff, 0x0f, 0x12, 0x42, 0xa8, 0xbf, 0x1f, 0x24, 0x80, 0xa0,
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x84, 0x28, 0x8a, 0xf7, 0x37, 0x80,
+ 0x52, 0x80, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x10, 0x82, 0xe0, 0xff,
+ 0x1f, 0x00, 0x20, 0xe1, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x84, 0x28,
+ 0xca, 0xff, 0x1f, 0x00, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f,
+ 0x10, 0x42, 0xf0, 0xfd, 0x1b, 0x00, 0x50, 0xf0, 0xff, 0xff, 0xff, 0xff,
+ 0xff, 0x0f, 0xa4, 0x10, 0xc5, 0xff, 0x1f, 0x00, 0x00, 0xe0, 0xff, 0xff,
+ 0xff, 0xff, 0xff, 0x0f, 0x00, 0x22, 0xf8, 0xff, 0x0e, 0x00, 0x00, 0xf0,
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0xaa, 0x88, 0xe2, 0xff, 0x0f, 0x10,
+ 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x25, 0xfa, 0xff,
+ 0x0f, 0x01, 0x11, 0xfd, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0xff, 0xfb,
+ 0xfb, 0xff, 0x7f, 0x5d, 0xd5, 0xfa, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f};
demos/images/face.bmp
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/images/flagup.bmp
===================================================================
--- demos/images/flagup.bmp (nonexistent)
+++ demos/images/flagup.bmp (revision 1765)
@@ -0,0 +1,27 @@
+#define flagup_width 48
+#define flagup_height 48
+static char flagup_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x7f, 0x00,
+ 0x00, 0x00, 0x00, 0xe0, 0x7f, 0x00, 0x00, 0x00, 0x00, 0xef, 0x6a, 0x00,
+ 0x00, 0x00, 0xc0, 0x7b, 0x75, 0x00, 0x00, 0x00, 0xe0, 0xe0, 0x6a, 0x00,
+ 0x00, 0x00, 0x30, 0x60, 0x75, 0x00, 0x00, 0x00, 0x18, 0xe0, 0x7f, 0x00,
+ 0x00, 0x00, 0x0c, 0xe0, 0x7f, 0x00, 0x00, 0x00, 0x06, 0xe0, 0x04, 0x00,
+ 0x00, 0x00, 0x03, 0xe0, 0x04, 0x00, 0x00, 0x80, 0x01, 0xe0, 0x06, 0x00,
+ 0x00, 0xc0, 0x1f, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x7f, 0xe0, 0x07, 0x00,
+ 0x00, 0x70, 0xe0, 0xe0, 0x05, 0x00, 0x00, 0x38, 0x80, 0xe1, 0x04, 0x00,
+ 0x00, 0x18, 0x80, 0xf1, 0x04, 0x00, 0x00, 0x0c, 0x00, 0xfb, 0x04, 0x00,
+ 0x00, 0x0c, 0x00, 0xff, 0x04, 0x00, 0x00, 0x86, 0x1f, 0xee, 0x04, 0x00,
+ 0x00, 0x06, 0x06, 0xe6, 0x04, 0x00, 0x00, 0x06, 0x00, 0xe6, 0x04, 0x00,
+ 0x00, 0x06, 0x00, 0xe6, 0x04, 0x00, 0x00, 0x06, 0x00, 0x66, 0x04, 0x00,
+ 0x7f, 0x56, 0x52, 0x06, 0xe4, 0xff, 0x00, 0x76, 0x55, 0x06, 0x04, 0x00,
+ 0x00, 0x56, 0x57, 0x06, 0x04, 0x00, 0x00, 0x56, 0x55, 0x06, 0x06, 0x00,
+ 0x00, 0x56, 0xd5, 0x06, 0x03, 0x00, 0x00, 0x06, 0x00, 0x86, 0x01, 0x00,
+ 0x54, 0x06, 0x00, 0xc6, 0x54, 0x55, 0xaa, 0x06, 0x00, 0x66, 0xaa, 0x2a,
+ 0x54, 0x06, 0x00, 0x36, 0x55, 0x55, 0xaa, 0x06, 0x00, 0xbe, 0xaa, 0x2a,
+ 0x54, 0xfe, 0xff, 0x6f, 0x55, 0x55, 0xaa, 0xfc, 0xff, 0xa7, 0xaa, 0x2a,
+ 0x54, 0x01, 0x88, 0x60, 0x55, 0x55, 0xaa, 0xaa, 0x8a, 0xa0, 0xaa, 0x2a,
+ 0x54, 0x55, 0x8d, 0x60, 0x55, 0x55, 0xaa, 0xaa, 0x8a, 0xa0, 0xaa, 0x2a,
+ 0x54, 0x55, 0x8d, 0x60, 0x55, 0x55, 0xaa, 0xaa, 0x8a, 0xa0, 0xaa, 0x2a,
+ 0x54, 0x55, 0x8d, 0x50, 0x55, 0x55, 0xaa, 0xaa, 0x8a, 0xa8, 0xaa, 0x2a,
+ 0x54, 0x55, 0x95, 0x54, 0x55, 0x55, 0xaa, 0xaa, 0xaa, 0xaa, 0xaa, 0x2a,
+ 0x54, 0x55, 0x55, 0x55, 0x55, 0x15, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
demos/images/flagup.bmp
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/images/flagdown.bmp
===================================================================
--- demos/images/flagdown.bmp (nonexistent)
+++ demos/images/flagdown.bmp (revision 1765)
@@ -0,0 +1,27 @@
+#define flagdown_width 48
+#define flagdown_height 48
+static char flagdown_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1e, 0x00, 0x00,
+ 0x00, 0x00, 0x80, 0x7f, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xe1, 0x00, 0x00,
+ 0x00, 0x00, 0x70, 0x80, 0x01, 0x00, 0x00, 0x00, 0x18, 0x00, 0x03, 0x00,
+ 0x00, 0x00, 0x0c, 0x00, 0x03, 0x00, 0x00, 0x00, 0x06, 0x00, 0x06, 0x04,
+ 0x00, 0x00, 0x03, 0x00, 0x06, 0x06, 0x00, 0x80, 0x01, 0x00, 0x06, 0x07,
+ 0x00, 0xc0, 0x1f, 0x00, 0x87, 0x07, 0x00, 0xe0, 0x7f, 0x80, 0xc7, 0x07,
+ 0x00, 0x70, 0xe0, 0xc0, 0xe5, 0x07, 0x00, 0x38, 0x80, 0xe1, 0x74, 0x07,
+ 0x00, 0x18, 0x80, 0x71, 0x3c, 0x07, 0x00, 0x0c, 0x00, 0x3b, 0x1e, 0x03,
+ 0x00, 0x0c, 0x00, 0x1f, 0x0f, 0x00, 0x00, 0x86, 0x1f, 0x8e, 0x07, 0x00,
+ 0x00, 0x06, 0x06, 0xc6, 0x05, 0x00, 0x00, 0x06, 0x00, 0xc6, 0x05, 0x00,
+ 0x00, 0x06, 0x00, 0xc6, 0x04, 0x00, 0x00, 0x06, 0x00, 0x06, 0x04, 0x00,
+ 0x7f, 0x06, 0x00, 0x06, 0xe4, 0xff, 0x00, 0x06, 0x00, 0x06, 0x04, 0x00,
+ 0x00, 0x06, 0x00, 0x06, 0x04, 0x00, 0x00, 0x06, 0x00, 0x06, 0x06, 0x00,
+ 0x00, 0x06, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0x00, 0x86, 0x01, 0x00,
+ 0x00, 0x06, 0x00, 0xc6, 0x00, 0x00, 0x00, 0x06, 0x00, 0x66, 0x00, 0x00,
+ 0x00, 0x06, 0x00, 0x36, 0x00, 0x00, 0x00, 0x06, 0x00, 0x3e, 0x00, 0x00,
+ 0x00, 0xfe, 0xff, 0x2f, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x27, 0x00, 0x00,
+ 0x00, 0x00, 0x88, 0x20, 0x00, 0x00, 0x00, 0x00, 0x88, 0x20, 0x00, 0x00,
+ 0x00, 0x00, 0x88, 0x20, 0x00, 0x00, 0x00, 0x00, 0x88, 0x20, 0x00, 0x00,
+ 0x00, 0x00, 0x88, 0x20, 0x00, 0x00, 0x00, 0x00, 0x88, 0x20, 0x00, 0x00,
+ 0x00, 0x00, 0x88, 0x20, 0x00, 0x00, 0x00, 0x00, 0x88, 0x20, 0x00, 0x00,
+ 0xf7, 0xbf, 0x8e, 0xfc, 0xdf, 0xf8, 0x9d, 0xeb, 0x9b, 0x76, 0xd2, 0x7a,
+ 0x46, 0x30, 0xe2, 0x0f, 0xe1, 0x47, 0x55, 0x84, 0x48, 0x11, 0x84, 0x19};
demos/images/flagdown.bmp
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/text.tcl
===================================================================
--- demos/text.tcl (nonexistent)
+++ demos/text.tcl (revision 1765)
@@ -0,0 +1,76 @@
+# text.tcl --
+#
+# This demonstration script creates a text widget that describes
+# the basic editing functions.
+#
+# SCCS: @(#) text.tcl 1.6 97/03/02 16:28:12
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .text
+catch {destroy $w}
+toplevel $w
+wm title $w "Text Demonstration - Basic Facilities"
+wm iconname $w "text"
+positionWindow $w
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" -setgrid 1 \
+ -height 30
+scrollbar $w.scroll -command "$w.text yview"
+pack $w.scroll -side right -fill y
+pack $w.text -expand yes -fill both
+$w.text insert 0.0 \
+{This window is a text widget. It displays one or more lines of text
+and allows you to edit the text. Here is a summary of the things you
+can do to a text widget:
+
+1. Scrolling. Use the scrollbar to adjust the view in the text window.
+
+2. Scanning. Press mouse button 2 in the text window and drag up or down.
+This will drag the text at high speed to allow you to scan its contents.
+
+3. Insert text. Press mouse button 1 to set the insertion cursor, then
+type text. What you type will be added to the widget.
+
+4. Select. Press mouse button 1 and drag to select a range of characters.
+Once you've released the button, you can adjust the selection by pressing
+button 1 with the shift key down. This will reset the end of the
+selection nearest the mouse cursor and you can drag that end of the
+selection by dragging the mouse before releasing the mouse button.
+You can double-click to select whole words or triple-click to select
+whole lines.
+
+5. Delete and replace. To delete text, select the characters you'd like
+to delete and type Backspace or Delete. Alternatively, you can type new
+text, in which case it will replace the selected text.
+
+6. Copy the selection. To copy the selection into this window, select
+what you want to copy (either here or in another application), then
+click button 2 to copy the selection to the point of the mouse cursor.
+
+7. Edit. Text widgets support the standard Motif editing characters
+plus many Emacs editing characters. Backspace and Control-h erase the
+character to the left of the insertion cursor. Delete and Control-d
+erase the character to the right of the insertion cursor. Meta-backspace
+deletes the word to the left of the insertion cursor, and Meta-d deletes
+the word to the right of the insertion cursor. Control-k deletes from
+the insertion cursor to the end of the line, or it deletes the newline
+character if that is the only thing left on the line. Control-o opens
+a new line by inserting a newline character to the right of the insertion
+cursor. Control-t transposes the two characters on either side of the
+insertion cursor.
+
+7. Resize the window. This widget has been configured with the "setGrid"
+option on, so that if you resize the window it will always resize to an
+even number of characters high and wide. Also, if you make the window
+narrow you can see that long lines automatically wrap around onto
+additional lines so that all the information is always visible.}
+$w.text mark set insert 0.0
demos/text.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/twind.tcl
===================================================================
--- demos/twind.tcl (nonexistent)
+++ demos/twind.tcl (revision 1765)
@@ -0,0 +1,196 @@
+# twind.tcl --
+#
+# This demonstration script creates a text widget with a bunch of
+# embedded windows.
+#
+# SCCS: @(#) twind.tcl 1.7 97/03/02 16:28:22
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .twind
+catch {destroy $w}
+toplevel $w
+wm title $w "Text Demonstration - Embedded Windows"
+wm iconname $w "Embedded Windows"
+positionWindow $w
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.f -highlightthickness 2 -borderwidth 2 -relief sunken
+set t $w.f.text
+text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \
+ -height 35 -wrap word -highlightthickness 0 -borderwidth 0
+pack $t -expand yes -fill both
+scrollbar $w.scroll -command "$t yview"
+pack $w.scroll -side right -fill y
+pack $w.f -expand yes -fill both
+$t tag configure center -justify center -spacing1 5m -spacing3 5m
+$t tag configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c \
+ -spacing1 3m -spacing2 0 -spacing3 0
+
+button $t.on -text "Turn On" -command "textWindOn $w" \
+ -cursor top_left_arrow
+button $t.off -text "Turn Off" -command "textWindOff $w" \
+ -cursor top_left_arrow
+button $t.click -text "Click Here" -command "textWindPlot $t" \
+ -cursor top_left_arrow
+button $t.delete -text "Delete" -command "textWindDel $w" \
+ -cursor top_left_arrow
+
+$t insert end "A text widget can contain other widgets embedded "
+$t insert end "it. These are called \"embedded windows\", "
+$t insert end "and they can consist of arbitrary widgets. "
+$t insert end "For example, here are two embedded button "
+$t insert end "widgets. You can click on the first button to "
+$t window create end -window $t.on
+$t insert end " horizontal scrolling, which also turns off "
+$t insert end "word wrapping. Or, you can click on the second "
+$t insert end "button to\n"
+$t window create end -window $t.off
+$t insert end " horizontal scrolling and turn back on word wrapping.\n\n"
+
+$t insert end "Or, here is another example. If you "
+$t window create end -window $t.click
+$t insert end " a canvas displaying an x-y plot will appear right here."
+$t mark set plot insert
+$t mark gravity plot left
+$t insert end " You can drag the data points around with the mouse, "
+$t insert end "or you can click here to "
+$t window create end -window $t.delete
+$t insert end " the plot again.\n\n"
+
+$t insert end "You may also find it useful to put embedded windows in "
+$t insert end "a text without any actual text. In this case the "
+$t insert end "text widget acts like a geometry manager. For "
+$t insert end "example, here is a collection of buttons laid out "
+$t insert end "neatly into rows by the text widget. These buttons "
+$t insert end "can be used to change the background color of the "
+$t insert end "text widget (\"Default\" restores the color to "
+$t insert end "its default). If you click on the button labeled "
+$t insert end "\"Short\", it changes to a longer string so that "
+$t insert end "you can see how the text widget automatically "
+$t insert end "changes the layout. Click on the button again "
+$t insert end "to restore the short string.\n"
+
+button $t.default -text Default -command "embDefBg $t" \
+ -cursor top_left_arrow
+$t window create end -window $t.default -padx 3
+global embToggle
+set embToggle Short
+checkbutton $t.toggle -textvariable embToggle -indicatoron 0 \
+ -variable embToggle -onvalue "A much longer string" \
+ -offvalue "Short" -cursor top_left_arrow -pady 5 -padx 2
+$t window create end -window $t.toggle -padx 3 -pady 2
+set i 1
+foreach color {AntiqueWhite3 Bisque1 Bisque2 Bisque3 Bisque4
+ SlateBlue3 RoyalBlue1 SteelBlue2 DeepSkyBlue3 LightBlue1
+ DarkSlateGray1 Aquamarine2 DarkSeaGreen2 SeaGreen1
+ Yellow1 IndianRed1 IndianRed2 Tan1 Tan4} {
+ button $t.color$i -text $color -cursor top_left_arrow -command \
+ "$t configure -bg $color"
+ $t window create end -window $t.color$i -padx 3 -pady 2
+ incr i
+}
+$t tag add buttons $t.default end
+
+proc textWindOn w {
+ catch {destroy $w.scroll2}
+ set t $w.f.text
+ scrollbar $w.scroll2 -orient horizontal -command "$t xview"
+ pack $w.scroll2 -after $w.buttons -side bottom -fill x
+ $t configure -xscrollcommand "$w.scroll2 set" -wrap none
+}
+
+proc textWindOff w {
+ catch {destroy $w.scroll2}
+ set t $w.f.text
+ $t configure -xscrollcommand {} -wrap word
+}
+
+proc textWindPlot t {
+ set c $t.c
+ if [winfo exists $c] {
+ return
+ }
+ canvas $c -relief sunken -width 450 -height 300 -cursor top_left_arrow
+
+ set font {Helvetica 18}
+
+ $c create line 100 250 400 250 -width 2
+ $c create line 100 250 100 50 -width 2
+ $c create text 225 20 -text "A Simple Plot" -font $font -fill brown
+
+ for {set i 0} {$i <= 10} {incr i} {
+ set x [expr {100 + ($i*30)}]
+ $c create line $x 250 $x 245 -width 2
+ $c create text $x 254 -text [expr 10*$i] -anchor n -font $font
+ }
+ for {set i 0} {$i <= 5} {incr i} {
+ set y [expr {250 - ($i*40)}]
+ $c create line 100 $y 105 $y -width 2
+ $c create text 96 $y -text [expr $i*50].0 -anchor e -font $font
+ }
+
+ foreach point {{12 56} {20 94} {33 98} {32 120} {61 180}
+ {75 160} {98 223}} {
+ set x [expr {100 + (3*[lindex $point 0])}]
+ set y [expr {250 - (4*[lindex $point 1])/5}]
+ set item [$c create oval [expr $x-6] [expr $y-6] \
+ [expr $x+6] [expr $y+6] -width 1 -outline black \
+ -fill SkyBlue2]
+ $c addtag point withtag $item
+ }
+
+ $c bind point "$c itemconfig current -fill red"
+ $c bind point "$c itemconfig current -fill SkyBlue2"
+ $c bind point <1> "embPlotDown $c %x %y"
+ $c bind point "$c dtag selected"
+ bind $c "embPlotMove $c %x %y"
+ while {[string first [$t get plot] " \t\n"] >= 0} {
+ $t delete plot
+ }
+ $t insert plot "\n"
+ $t window create plot -window $c
+ $t tag add center plot
+ $t insert plot "\n"
+}
+
+set embPlot(lastX) 0
+set embPlot(lastY) 0
+
+proc embPlotDown {w x y} {
+ global embPlot
+ $w dtag selected
+ $w addtag selected withtag current
+ $w raise current
+ set embPlot(lastX) $x
+ set embPlot(lastY) $y
+}
+
+proc embPlotMove {w x y} {
+ global embPlot
+ $w move selected [expr $x-$embPlot(lastX)] [expr $y-$embPlot(lastY)]
+ set embPlot(lastX) $x
+ set embPlot(lastY) $y
+}
+
+proc textWindDel w {
+ set t $w.f.text
+ if [winfo exists $t.c] {
+ $t delete $t.c
+ while {[string first [$t get plot] " \t\n"] >= 0} {
+ $t delete plot
+ }
+ $t insert plot " "
+ }
+}
+
+proc embDefBg t {
+ $t configure -background [lindex [$t configure -background] 3]
+}
demos/twind.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/clrpick.tcl
===================================================================
--- demos/clrpick.tcl (nonexistent)
+++ demos/clrpick.tcl (revision 1765)
@@ -0,0 +1,56 @@
+# clrpick.tcl --
+#
+# This demonstration script prompts the user to select a color.
+#
+# SCCS: @(#) clrpick.tcl 1.3 97/03/02 16:20:12
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .clrpick
+catch {destroy $w}
+toplevel $w
+wm title $w "Color Selection Dialog"
+wm iconname $w "colors"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "Press the buttons below to choose the foreground and background colors for the widgets in this window."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+button $w.back -text "Set background color ..." \
+ -command \
+ "setColor $w $w.back background {-background -highlightbackground}"
+button $w.fore -text "Set foreground color ..." \
+ -command \
+ "setColor $w $w.back foreground -foreground"
+
+pack $w.back $w.fore -side top -anchor c -pady 2m
+
+proc setColor {w button name options} {
+ grab $w
+ set initialColor [$button cget -$name]
+ set color [tk_chooseColor -title "Choose a $name color" -parent $w \
+ -initialcolor $initialColor]
+ if [string compare $color ""] {
+ setColor_helper $w $options $color
+ }
+ grab release $w
+}
+
+proc setColor_helper {w options color} {
+ foreach option $options {
+ catch {
+ $w config $option $color
+ }
+ }
+ foreach child [winfo children $w] {
+ setColor_helper $child $options $color
+ }
+}
demos/clrpick.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/filebox.tcl
===================================================================
--- demos/filebox.tcl (nonexistent)
+++ demos/filebox.tcl (revision 1765)
@@ -0,0 +1,70 @@
+# filebox.tcl --
+#
+# This demonstration script prompts the user to select a file.
+#
+# SCCS: @(#) filebox.tcl 1.3 97/03/02 16:22:36
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .filebox
+catch {destroy $w}
+toplevel $w
+wm title $w "File Selection Dialogs"
+wm iconname $w "filebox"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "Enter a file name in the entry box or click on the \"Browse\" buttons to select a file name using the file selection dialog."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+foreach i {open save} {
+ set f [frame $w.$i]
+ label $f.lab -text "Select a file to $i: " -anchor e
+ entry $f.ent -width 20
+ button $f.but -text "Browse ..." -command "fileDialog $w $f.ent $i"
+ pack $f.lab -side left
+ pack $f.ent -side left -expand yes -fill x
+ pack $f.but -side left
+ pack $f -fill x -padx 1c -pady 3
+}
+
+if ![string compare $tcl_platform(platform) unix] {
+ checkbutton $w.strict -text "Use Motif Style Dialog" \
+ -variable tk_strictMotif -onvalue 1 -offvalue 0
+ pack $w.strict -anchor c
+}
+
+proc fileDialog {w ent operation} {
+ # Type names Extension(s) Mac File Type(s)
+ #
+ #---------------------------------------------------------
+ set types {
+ {"Text files" {.txt .doc} }
+ {"Text files" {} TEXT}
+ {"Tcl Scripts" {.tcl} TEXT}
+ {"C Source Files" {.c .h} }
+ {"All Source Files" {.tcl .c .h} }
+ {"Image Files" {.gif} }
+ {"Image Files" {.jpeg .jpg} }
+ {"Image Files" "" {GIFF JPEG}}
+ {"All files" *}
+ }
+ if {$operation == "open"} {
+ set file [tk_getOpenFile -filetypes $types -parent $w]
+ } else {
+ set file [tk_getSaveFile -filetypes $types -parent $w \
+ -initialfile Untitled -defaultextension .txt]
+ }
+ if [string compare $file ""] {
+ $ent delete 0 end
+ $ent insert 0 $file
+ $ent xview end
+ }
+}
demos/filebox.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/tclIndex
===================================================================
--- demos/tclIndex (nonexistent)
+++ demos/tclIndex (revision 1765)
@@ -0,0 +1,67 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(arrowSetup) [list source [file join $dir arrow.tcl]]
+set auto_index(arrowMove1) [list source [file join $dir arrow.tcl]]
+set auto_index(arrowMove2) [list source [file join $dir arrow.tcl]]
+set auto_index(arrowMove3) [list source [file join $dir arrow.tcl]]
+set auto_index(textLoadFile) [list source [file join $dir search.tcl]]
+set auto_index(textSearch) [list source [file join $dir search.tcl]]
+set auto_index(textToggle) [list source [file join $dir search.tcl]]
+set auto_index(itemEnter) [list source [file join $dir items.tcl]]
+set auto_index(itemLeave) [list source [file join $dir items.tcl]]
+set auto_index(itemMark) [list source [file join $dir items.tcl]]
+set auto_index(itemStroke) [list source [file join $dir items.tcl]]
+set auto_index(itemsUnderArea) [list source [file join $dir items.tcl]]
+set auto_index(itemStartDrag) [list source [file join $dir items.tcl]]
+set auto_index(itemDrag) [list source [file join $dir items.tcl]]
+set auto_index(butPress) [list source [file join $dir items.tcl]]
+set auto_index(loadDir) [list source [file join $dir image2.tcl]]
+set auto_index(loadImage) [list source [file join $dir image2.tcl]]
+set auto_index(rulerMkTab) [list source [file join $dir ruler.tcl]]
+set auto_index(rulerNewTab) [list source [file join $dir ruler.tcl]]
+set auto_index(rulerSelectTab) [list source [file join $dir ruler.tcl]]
+set auto_index(rulerMoveTab) [list source [file join $dir ruler.tcl]]
+set auto_index(rulerReleaseTab) [list source [file join $dir ruler.tcl]]
+set auto_index(mkTextConfig) [list source [file join $dir ctext.tcl]]
+set auto_index(textEnter) [list source [file join $dir ctext.tcl]]
+set auto_index(textInsert) [list source [file join $dir ctext.tcl]]
+set auto_index(textPaste) [list source [file join $dir ctext.tcl]]
+set auto_index(textB1Press) [list source [file join $dir ctext.tcl]]
+set auto_index(textB1Move) [list source [file join $dir ctext.tcl]]
+set auto_index(textBs) [list source [file join $dir ctext.tcl]]
+set auto_index(textDel) [list source [file join $dir ctext.tcl]]
+set auto_index(bitmapRow) [list source [file join $dir bitmap.tcl]]
+set auto_index(scrollEnter) [list source [file join $dir cscroll.tcl]]
+set auto_index(scrollLeave) [list source [file join $dir cscroll.tcl]]
+set auto_index(scrollButton) [list source [file join $dir cscroll.tcl]]
+set auto_index(textWindOn) [list source [file join $dir twind.tcl]]
+set auto_index(textWindOff) [list source [file join $dir twind.tcl]]
+set auto_index(textWindPlot) [list source [file join $dir twind.tcl]]
+set auto_index(embPlotDown) [list source [file join $dir twind.tcl]]
+set auto_index(embPlotMove) [list source [file join $dir twind.tcl]]
+set auto_index(textWindDel) [list source [file join $dir twind.tcl]]
+set auto_index(embDefBg) [list source [file join $dir twind.tcl]]
+set auto_index(floorDisplay) [list source [file join $dir floor.tcl]]
+set auto_index(newRoom) [list source [file join $dir floor.tcl]]
+set auto_index(roomChanged) [list source [file join $dir floor.tcl]]
+set auto_index(bg1) [list source [file join $dir floor.tcl]]
+set auto_index(bg2) [list source [file join $dir floor.tcl]]
+set auto_index(bg3) [list source [file join $dir floor.tcl]]
+set auto_index(fg1) [list source [file join $dir floor.tcl]]
+set auto_index(fg2) [list source [file join $dir floor.tcl]]
+set auto_index(fg3) [list source [file join $dir floor.tcl]]
+set auto_index(setWidth) [list source [file join $dir hscale.tcl]]
+set auto_index(plotDown) [list source [file join $dir plot.tcl]]
+set auto_index(plotMove) [list source [file join $dir plot.tcl]]
+set auto_index(puzzleSwitch) [list source [file join $dir puzzle.tcl]]
+set auto_index(setHeight) [list source [file join $dir vscale.tcl]]
+set auto_index(showMessageBox) [list source [file join $dir msgbox.tcl]]
+set auto_index(setColor) [list source [file join $dir clrpick.tcl]]
+set auto_index(setColor_helper) [list source [file join $dir clrpick.tcl]]
+set auto_index(fileDialog) [list source [file join $dir filebox.tcl]]
demos/tclIndex
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/license.terms
===================================================================
--- demos/license.terms (nonexistent)
+++ demos/license.terms (revision 1765)
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., and other parties. The following
+terms apply to all files associated with the software unless explicitly
+disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
demos/license.terms
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/arrow.tcl
===================================================================
--- demos/arrow.tcl (nonexistent)
+++ demos/arrow.tcl (revision 1765)
@@ -0,0 +1,238 @@
+# arrow.tcl --
+#
+# This demonstration script creates a canvas widget that displays a
+# large line with an arrowhead whose shape can be edited interactively.
+#
+# SCCS: @(#) arrow.tcl 1.8 97/03/02 16:18:20
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+# arrowSetup --
+# This procedure regenerates all the text and graphics in the canvas
+# window. It's called when the canvas is initially created, and also
+# whenever any of the parameters of the arrow head are changed
+# interactively.
+#
+# Arguments:
+# c - Name of the canvas widget.
+
+proc arrowSetup c {
+ upvar #0 demo_arrowInfo v
+
+ # Remember the current box, if there is one.
+
+ set tags [$c gettags current]
+ if {$tags != ""} {
+ set cur [lindex $tags [lsearch -glob $tags box?]]
+ } else {
+ set cur ""
+ }
+
+ # Create the arrow and outline.
+
+ $c delete all
+ eval "$c create line $v(x1) $v(y) $v(x2) $v(y) -width [expr 10*$v(width)] \
+ -arrowshape {[expr 10*$v(a)] [expr 10*$v(b)] [expr 10*$v(c)]} \
+ -arrow last $v(bigLineStyle)"
+ set xtip [expr $v(x2)-10*$v(b)]
+ set deltaY [expr 10*$v(c)+5*$v(width)]
+ $c create line $v(x2) $v(y) $xtip [expr $v(y)+$deltaY] \
+ [expr $v(x2)-10*$v(a)] $v(y) $xtip [expr $v(y)-$deltaY] \
+ $v(x2) $v(y) -width 2 -capstyle round -joinstyle round
+
+ # Create the boxes for reshaping the line and arrowhead.
+
+ eval "$c create rect [expr $v(x2)-10*$v(a)-5] [expr $v(y)-5] \
+ [expr $v(x2)-10*$v(a)+5] [expr $v(y)+5] $v(boxStyle) \
+ -tags {box1 box}"
+ eval "$c create rect [expr $xtip-5] [expr $v(y)-$deltaY-5] \
+ [expr $xtip+5] [expr $v(y)-$deltaY+5] $v(boxStyle) \
+ -tags {box2 box}"
+ eval "$c create rect [expr $v(x1)-5] [expr $v(y)-5*$v(width)-5] \
+ [expr $v(x1)+5] [expr $v(y)-5*$v(width)+5] $v(boxStyle) \
+ -tags {box3 box}"
+ if {$cur != ""} {
+ eval $c itemconfigure $cur $v(activeStyle)
+ }
+
+ # Create three arrows in actual size with the same parameters
+
+ $c create line [expr $v(x2)+50] 0 [expr $v(x2)+50] 1000 \
+ -width 2
+ set tmp [expr $v(x2)+100]
+ $c create line $tmp [expr $v(y)-125] $tmp [expr $v(y)-75] \
+ -width $v(width) \
+ -arrow both -arrowshape "$v(a) $v(b) $v(c)"
+ $c create line [expr $tmp-25] $v(y) [expr $tmp+25] $v(y) \
+ -width $v(width) \
+ -arrow both -arrowshape "$v(a) $v(b) $v(c)"
+ $c create line [expr $tmp-25] [expr $v(y)+75] [expr $tmp+25] \
+ [expr $v(y)+125] -width $v(width) \
+ -arrow both -arrowshape "$v(a) $v(b) $v(c)"
+
+ # Create a bunch of other arrows and text items showing the
+ # current dimensions.
+
+ set tmp [expr $v(x2)+10]
+ $c create line $tmp [expr $v(y)-5*$v(width)] \
+ $tmp [expr $v(y)-$deltaY] \
+ -arrow both -arrowshape $v(smallTips)
+ $c create text [expr $v(x2)+15] [expr $v(y)-$deltaY+5*$v(c)] \
+ -text $v(c) -anchor w
+ set tmp [expr $v(x1)-10]
+ $c create line $tmp [expr $v(y)-5*$v(width)] \
+ $tmp [expr $v(y)+5*$v(width)] \
+ -arrow both -arrowshape $v(smallTips)
+ $c create text [expr $v(x1)-15] $v(y) -text $v(width) -anchor e
+ set tmp [expr $v(y)+5*$v(width)+10*$v(c)+10]
+ $c create line [expr $v(x2)-10*$v(a)] $tmp $v(x2) $tmp \
+ -arrow both -arrowshape $v(smallTips)
+ $c create text [expr $v(x2)-5*$v(a)] [expr $tmp+5] \
+ -text $v(a) -anchor n
+ set tmp [expr $tmp+25]
+ $c create line [expr $v(x2)-10*$v(b)] $tmp $v(x2) $tmp \
+ -arrow both -arrowshape $v(smallTips)
+ $c create text [expr $v(x2)-5*$v(b)] [expr $tmp+5] \
+ -text $v(b) -anchor n
+
+ $c create text $v(x1) 310 -text "-width $v(width)" \
+ -anchor w -font {Helvetica 18}
+ $c create text $v(x1) 330 -text "-arrowshape {$v(a) $v(b) $v(c)}" \
+ -anchor w -font {Helvetica 18}
+
+ incr v(count)
+}
+
+set w .arrow
+global tk_library
+catch {destroy $w}
+toplevel $w
+wm title $w "Arrowhead Editor Demonstration"
+wm iconname $w "arrow"
+positionWindow $w
+set c $w.c
+
+label $w.msg -font $font -wraplength 5i -justify left -text "This widget allows you to experiment with different widths and arrowhead shapes for lines in canvases. To change the line width or the shape of the arrowhead, drag any of the three boxes attached to the oversized arrow. The arrows on the right give examples at normal scale. The text at the bottom shows the configuration options as you'd enter them for a canvas line item."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+canvas $c -width 500 -height 350 -relief sunken -borderwidth 2
+pack $c -expand yes -fill both
+
+set demo_arrowInfo(a) 8
+set demo_arrowInfo(b) 10
+set demo_arrowInfo(c) 3
+set demo_arrowInfo(width) 2
+set demo_arrowInfo(motionProc) arrowMoveNull
+set demo_arrowInfo(x1) 40
+set demo_arrowInfo(x2) 350
+set demo_arrowInfo(y) 150
+set demo_arrowInfo(smallTips) {5 5 2}
+set demo_arrowInfo(count) 0
+if {[winfo depth $c] > 1} {
+ set demo_arrowInfo(bigLineStyle) "-fill SkyBlue1"
+ set demo_arrowInfo(boxStyle) "-fill {} -outline black -width 1"
+ set demo_arrowInfo(activeStyle) "-fill red -outline black -width 1"
+} else {
+ set demo_arrowInfo(bigLineStyle) "-fill black \
+ -stipple @[file join $tk_library demos images grey.25]"
+ set demo_arrowInfo(boxStyle) "-fill {} -outline black -width 1"
+ set demo_arrowInfo(activeStyle) "-fill black -outline black -width 1"
+}
+arrowSetup $c
+$c bind box "$c itemconfigure current $demo_arrowInfo(activeStyle)"
+$c bind box "$c itemconfigure current $demo_arrowInfo(boxStyle)"
+$c bind box " "
+$c bind box " "
+$c bind box1 <1> {set demo_arrowInfo(motionProc) arrowMove1}
+$c bind box2 <1> {set demo_arrowInfo(motionProc) arrowMove2}
+$c bind box3 <1> {set demo_arrowInfo(motionProc) arrowMove3}
+$c bind box "\$demo_arrowInfo(motionProc) $c %x %y"
+bind $c "arrowSetup $c"
+
+# arrowMove1 --
+# This procedure is called for each mouse motion event on box1 (the
+# one at the vertex of the arrow). It updates the controlling parameters
+# for the line and arrowhead.
+#
+# Arguments:
+# c - The name of the canvas window.
+# x, y - The coordinates of the mouse.
+
+proc arrowMove1 {c x y} {
+ upvar #0 demo_arrowInfo v
+ set newA [expr ($v(x2)+5-round([$c canvasx $x]))/10]
+ if {$newA < 0} {
+ set newA 0
+ }
+ if {$newA > 25} {
+ set newA 25
+ }
+ if {$newA != $v(a)} {
+ $c move box1 [expr 10*($v(a)-$newA)] 0
+ set v(a) $newA
+ }
+}
+
+# arrowMove2 --
+# This procedure is called for each mouse motion event on box2 (the
+# one at the trailing tip of the arrowhead). It updates the controlling
+# parameters for the line and arrowhead.
+#
+# Arguments:
+# c - The name of the canvas window.
+# x, y - The coordinates of the mouse.
+
+proc arrowMove2 {c x y} {
+ upvar #0 demo_arrowInfo v
+ set newB [expr ($v(x2)+5-round([$c canvasx $x]))/10]
+ if {$newB < 0} {
+ set newB 0
+ }
+ if {$newB > 25} {
+ set newB 25
+ }
+ set newC [expr ($v(y)+5-round([$c canvasy $y])-5*$v(width))/10]
+ if {$newC < 0} {
+ set newC 0
+ }
+ if {$newC > 20} {
+ set newC 20
+ }
+ if {($newB != $v(b)) || ($newC != $v(c))} {
+ $c move box2 [expr 10*($v(b)-$newB)] [expr 10*($v(c)-$newC)]
+ set v(b) $newB
+ set v(c) $newC
+ }
+}
+
+# arrowMove3 --
+# This procedure is called for each mouse motion event on box3 (the
+# one that controls the thickness of the line). It updates the
+# controlling parameters for the line and arrowhead.
+#
+# Arguments:
+# c - The name of the canvas window.
+# x, y - The coordinates of the mouse.
+
+proc arrowMove3 {c x y} {
+ upvar #0 demo_arrowInfo v
+ set newWidth [expr ($v(y)+2-round([$c canvasy $y]))/5]
+ if {$newWidth < 0} {
+ set newWidth 0
+ }
+ if {$newWidth > 20} {
+ set newWidth 20
+ }
+ if {$newWidth != $v(width)} {
+ $c move box3 0 [expr 5*($v(width)-$newWidth)]
+ set v(width) $newWidth
+ }
+}
demos/arrow.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/rolodex
===================================================================
--- demos/rolodex (nonexistent)
+++ demos/rolodex (revision 1765)
@@ -0,0 +1,196 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+# rolodex --
+# This script was written as an entry in Tom LaStrange's rolodex
+# benchmark. It creates something that has some of the look and
+# feel of a rolodex program, although it's lifeless and doesn't
+# actually do the rolodex application.
+#
+# SCCS: @(#) rolodex 1.7 96/02/16 10:49:23
+
+foreach i [winfo child .] {
+ catch {destroy $i}
+}
+
+#------------------------------------------
+# Phase 0: create the front end.
+#------------------------------------------
+
+frame .frame -relief flat
+pack .frame -side top -fill y -anchor center
+
+set names {{} Name: Address: {} {} {Home Phone:} {Work Phone:} Fax:}
+foreach i {1 2 3 4 5 6 7} {
+ frame .frame.$i
+ pack .frame.$i -side top -pady 2 -anchor e
+
+ label .frame.$i.label -text [lindex $names $i] -anchor e
+ entry .frame.$i.entry -width 30 -relief sunken
+ pack .frame.$i.entry .frame.$i.label -side right
+}
+
+frame .buttons
+pack .buttons -side bottom -pady 2 -anchor center
+button .buttons.clear -text Clear
+button .buttons.add -text Add
+button .buttons.search -text Search
+button .buttons.delete -text "Delete ..."
+pack .buttons.clear .buttons.add .buttons.search .buttons.delete \
+ -side left -padx 2
+
+#------------------------------------------
+# Phase 1: Add menus, dialog boxes
+#------------------------------------------
+
+frame .menu -relief raised -borderwidth 1
+pack .menu -before .frame -side top -fill x
+
+menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
+menu .menu.file.m
+.menu.file.m add command -label "Load ..." -command fileAction -underline 0
+.menu.file.m add command -label "Exit" -command {destroy .} -underline 0
+pack .menu.file -side left
+
+menubutton .menu.help -text "Help" -menu .menu.help.m -underline 0
+menu .menu.help.m
+pack .menu.help -side right
+
+proc deleteAction {} {
+ if {[tk_dialog .delete {Confirm Action} {Are you sure?} {} 0 Cancel]
+ == 0} {
+ clearAction
+ }
+}
+.buttons.delete config -command deleteAction
+
+proc fileAction {} {
+ tk_dialog .fileSelection {File Selection} {This is a dummy file selection dialog box, which is used because there isn't a good file selection dialog built into Tk yet.} {} 0 OK
+ puts stderr {dummy file name}
+}
+
+#------------------------------------------
+# Phase 3: Print contents of card
+#------------------------------------------
+
+proc addAction {} {
+ global names
+ foreach i {1 2 3 4 5 6 7} {
+ puts stderr [format "%-12s %s" [lindex $names $i] [.frame.$i.entry get]]
+ }
+}
+.buttons.add config -command addAction
+
+#------------------------------------------
+# Phase 4: Miscellaneous other actions
+#------------------------------------------
+
+proc clearAction {} {
+ foreach i {1 2 3 4 5 6 7} {
+ .frame.$i.entry delete 0 end
+ }
+}
+.buttons.clear config -command clearAction
+
+proc fillCard {} {
+ clearAction
+ .frame.1.entry insert 0 "John Ousterhout"
+ .frame.2.entry insert 0 "CS Division, Department of EECS"
+ .frame.3.entry insert 0 "University of California"
+ .frame.4.entry insert 0 "Berkeley, CA 94720"
+ .frame.5.entry insert 0 "private"
+ .frame.6.entry insert 0 "510-642-0865"
+ .frame.7.entry insert 0 "510-642-5775"
+}
+.buttons.search config -command "addAction; fillCard"
+
+#----------------------------------------------------
+# Phase 5: Accelerators, mnemonics, command-line info
+#----------------------------------------------------
+
+.buttons.clear config -text "Clear Ctrl+C"
+bind . clearAction
+.buttons.add config -text "Add Ctrl+A"
+bind . addAction
+.buttons.search config -text "Search Ctrl+S"
+bind . "addAction; fillCard"
+.buttons.delete config -text "Delete... Ctrl+D"
+bind . deleteAction
+
+.menu.file.m entryconfig 1 -accel Ctrl+F
+bind . fileAction
+.menu.file.m entryconfig 2 -accel Ctrl+Q
+bind . {destroy .}
+
+focus .frame.1.entry
+
+#----------------------------------------------------
+# Phase 6: help
+#----------------------------------------------------
+
+proc Help {topic {x 0} {y 0}} {
+ global helpTopics helpCmds
+ if {$topic == ""} return
+ while {[info exists helpCmds($topic)]} {
+ set topic [eval $helpCmds($topic)]
+ }
+ if [info exists helpTopics($topic)] {
+ set msg $helpTopics($topic)
+ } else {
+ set msg "Sorry, but no help is available for this topic"
+ }
+ tk_dialog .help {Rolodex Help} "Information on $topic:\n\n$msg" \
+ {} 0 OK
+}
+
+proc getMenuTopic {w x y} {
+ return $w.[$w index @[expr $y-[winfo rooty $w]]]
+}
+
+bind . {Help [winfo containing %X %Y] %X %Y}
+bind . {Help [winfo containing %X %Y] %X %Y}
+
+# Help text and commands follow:
+
+set helpTopics(.menu.file) {This is the "file" menu. It can be used to invoke some overall operations on the rolodex applications, such as loading a file or exiting.}
+
+set helpCmds(.menu.file.m) {getMenuTopic $topic $x $y}
+set helpTopics(.menu.file.m.0) {The "Load" entry in the "File" menu posts a dialog box that you can use to select a rolodex file}
+set helpTopics(.menu.file.m.1) {The "Exit" entry in the "File" menu causes the rolodex application to terminate}
+set helpCmds(.menu.file.m.none) {set topic ".menu.file"}
+
+set helpTopics(.frame.1.entry) {In this field of the rolodex entry you should type the person's name}
+set helpTopics(.frame.2.entry) {In this field of the rolodex entry you should type the first line of the person's address}
+set helpTopics(.frame.3.entry) {In this field of the rolodex entry you should type the second line of the person's address}
+set helpTopics(.frame.4.entry) {In this field of the rolodex entry you should type the third line of the person's address}
+set helpTopics(.frame.5.entry) {In this field of the rolodex entry you should type the person's home phone number, or "private" if the person doesn't want his or her number publicized}
+set helpTopics(.frame.6.entry) {In this field of the rolodex entry you should type the person's work phone number}
+set helpTopics(.frame.7.entry) {In this field of the rolodex entry you should type the phone number for the person's FAX machine}
+
+set helpCmds(.frame.1.label) {set topic .frame.1.entry}
+set helpCmds(.frame.2.label) {set topic .frame.2.entry}
+set helpCmds(.frame.3.label) {set topic .frame.3.entry}
+set helpCmds(.frame.4.label) {set topic .frame.4.entry}
+set helpCmds(.frame.5.label) {set topic .frame.5.entry}
+set helpCmds(.frame.6.label) {set topic .frame.6.entry}
+set helpCmds(.frame.7.label) {set topic .frame.7.entry}
+
+set helpTopics(context) {Unfortunately, this application doesn't support context-sensitive help in the usual way, because when this demo was written Tk didn't have a grab mechanism and this is needed for context-sensitive help. Instead, you can achieve much the same effect by simply moving the mouse over the window you're curious about and pressing the Help or F1 keys. You can do this anytime.}
+set helpTopics(help) {This application provides only very crude help. Besides the entries in this menu, you can get help on individual windows by moving the mouse cursor over the window and pressing the Help or F1 keys.}
+set helpTopics(window) {This window is a dummy rolodex application created as part of Tom LaStrange's toolkit benchmark. It doesn't really do anything useful except to demonstrate a few features of the Tk toolkit.}
+set helpTopics(keys) "The following accelerator keys are defined for this application (in addition to those already available for the entry windows):\n\nCtrl+A:\t\tAdd\nCtrl+C:\t\tClear\nCtrl+D:\t\tDelete\nCtrl+F:\t\tEnter file name\nCtrl+Q:\t\tExit application (quit)\nCtrl+S:\t\tSearch (dummy operation)"
+set helpTopics(version) {This is version 1.0.}
+
+# Entries in "Help" menu
+
+.menu.help.m add command -label "On Context..." -command {Help context} \
+ -underline 3
+.menu.help.m add command -label "On Help..." -command {Help help} \
+ -underline 3
+.menu.help.m add command -label "On Window..." -command {Help window} \
+ -underline 3
+.menu.help.m add command -label "On Keys..." -command {Help keys} \
+ -underline 3
+.menu.help.m add command -label "On Version..." -command {Help version} \
+ -underline 3
demos/rolodex
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/radio.tcl
===================================================================
--- demos/radio.tcl (nonexistent)
+++ demos/radio.tcl (revision 1765)
@@ -0,0 +1,44 @@
+# radio.tcl --
+#
+# This demonstration script creates a toplevel window containing
+# several radiobutton widgets.
+#
+# SCCS: @(#) radio.tcl 1.5 97/03/02 16:26:57
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .radio
+catch {destroy $w}
+toplevel $w
+wm title $w "Radiobutton Demonstration"
+wm iconname $w "radio"
+positionWindow $w
+label $w.msg -font $font -wraplength 5i -justify left -text "Two groups of radiobuttons are displayed below. If you click on a button then the button will become selected exclusively among all the buttons in its group. A Tcl variable is associated with each group to indicate which of the group's buttons is selected. Click the \"See Variables\" button to see the current values of the variables."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+button $w.buttons.vars -text "See Variables" \
+ -command "showVars $w.dialog size color"
+pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1
+
+frame $w.left
+frame $w.right
+pack $w.left $w.right -side left -expand yes -pady .5c -padx .5c
+
+foreach i {10 12 18 24} {
+ radiobutton $w.left.b$i -text "Point Size $i" -variable size \
+ -relief flat -value $i
+ pack $w.left.b$i -side top -pady 2 -anchor w
+}
+
+foreach color {Red Green Blue Yellow Orange Purple} {
+ set lower [string tolower $color]
+ radiobutton $w.right.$lower -text $color -variable color \
+ -relief flat -value $lower
+ pack $w.right.$lower -side top -pady 2 -anchor w
+}
demos/radio.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/hscale.tcl
===================================================================
--- demos/hscale.tcl (nonexistent)
+++ demos/hscale.tcl (revision 1765)
@@ -0,0 +1,47 @@
+# hscale.tcl --
+#
+# This demonstration script shows an example with a horizontal scale.
+#
+# SCCS: @(#) hscale.tcl 1.4 97/03/02 16:24:01
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .hscale
+catch {destroy $w}
+toplevel $w
+wm title $w "Horizontal Scale Demonstration"
+wm iconname $w "hscale"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 3.5i -justify left -text "An arrow and a horizontal scale are displayed below. If you click or drag mouse button 1 in the scale, you can change the length of the arrow."
+pack $w.msg -side top -padx .5c
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.frame -borderwidth 10
+pack $w.frame -side top -fill x
+
+canvas $w.frame.canvas -width 50 -height 50 -bd 0 -highlightthickness 0
+$w.frame.canvas create polygon 0 0 1 1 2 2 -fill DeepSkyBlue3 -tags poly
+$w.frame.canvas create line 0 0 1 1 2 2 0 0 -fill black -tags line
+scale $w.frame.scale -orient horizontal -length 284 -from 0 -to 250 \
+ -command "setWidth $w.frame.canvas" -tickinterval 50
+pack $w.frame.canvas -side top -expand yes -anchor s -fill x -padx 15
+pack $w.frame.scale -side bottom -expand yes -anchor n
+$w.frame.scale set 75
+
+proc setWidth {w width} {
+ incr width 21
+ set x2 [expr $width - 30]
+ if {$x2 < 21} {
+ set x2 21
+ }
+ $w coords poly 20 15 20 35 $x2 35 $x2 45 $width 25 $x2 5 $x2 15 20 15
+ $w coords line 20 15 20 35 $x2 35 $x2 45 $width 25 $x2 5 $x2 15 20 15
+}
demos/hscale.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/timer
===================================================================
--- demos/timer (nonexistent)
+++ demos/timer (revision 1765)
@@ -0,0 +1,40 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+# timer --
+# This script generates a counter with start and stop buttons.
+#
+# SCCS: @(#) timer 1.6 96/02/16 10:49:20
+
+label .counter -text 0.00 -relief raised -width 10
+button .start -text Start -command {
+ if $stopped {
+ set stopped 0
+ tick
+ }
+}
+button .stop -text Stop -command {set stopped 1}
+pack .counter -side bottom -fill both
+pack .start -side left -fill both -expand yes
+pack .stop -side right -fill both -expand yes
+
+set seconds 0
+set hundredths 0
+set stopped 1
+
+proc tick {} {
+ global seconds hundredths stopped
+ if $stopped return
+ after 50 tick
+ set hundredths [expr $hundredths+5]
+ if {$hundredths >= 100} {
+ set hundredths 0
+ set seconds [expr $seconds+1]
+ }
+ .counter config -text [format "%d.%02d" $seconds $hundredths]
+}
+
+bind . {destroy .}
+bind . {destroy .}
+focus .
demos/timer
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/cscroll.tcl
===================================================================
--- demos/cscroll.tcl (nonexistent)
+++ demos/cscroll.tcl (revision 1765)
@@ -0,0 +1,96 @@
+# cscroll.tcl --
+#
+# This demonstration script creates a simple canvas that can be
+# scrolled in two dimensions.
+#
+# SCCS: @(#) cscroll.tcl 1.6 97/03/02 16:20:45
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .cscroll
+catch {destroy $w}
+toplevel $w
+wm title $w "Scrollable Canvas Demonstration"
+wm iconname $w "cscroll"
+positionWindow $w
+set c $w.c
+
+label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with button 2 in the canvas. If you click button 1 on one of the rectangles, its indices will be printed on stdout."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.grid
+scrollbar $w.hscroll -orient horiz -command "$c xview"
+scrollbar $w.vscroll -command "$c yview"
+canvas $c -relief sunken -borderwidth 2 -scrollregion {-11c -11c 50c 20c} \
+ -xscrollcommand "$w.hscroll set" \
+ -yscrollcommand "$w.vscroll set"
+pack $w.grid -expand yes -fill both -padx 1 -pady 1
+grid rowconfig $w.grid 0 -weight 1 -minsize 0
+grid columnconfig $w.grid 0 -weight 1 -minsize 0
+
+grid $c -padx 1 -in $w.grid -pady 1 \
+ -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
+grid $w.vscroll -in $w.grid -padx 1 -pady 1 \
+ -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
+grid $w.hscroll -in $w.grid -padx 1 -pady 1 \
+ -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
+
+
+set bg [lindex [$c config -bg] 4]
+for {set i 0} {$i < 20} {incr i} {
+ set x [expr {-10 + 3*$i}]
+ for {set j 0; set y -10} {$j < 10} {incr j; incr y 3} {
+ $c create rect ${x}c ${y}c [expr $x+2]c [expr $y+2]c \
+ -outline black -fill $bg -tags rect
+ $c create text [expr $x+1]c [expr $y+1]c -text "$i,$j" \
+ -anchor center -tags text
+ }
+}
+
+$c bind all "scrollEnter $c"
+$c bind all "scrollLeave $c"
+$c bind all <1> "scrollButton $c"
+bind $c <2> "$c scan mark %x %y"
+bind $c "$c scan dragto %x %y"
+
+proc scrollEnter canvas {
+ global oldFill
+ set id [$canvas find withtag current]
+ if {[lsearch [$canvas gettags current] text] >= 0} {
+ set id [expr $id-1]
+ }
+ set oldFill [lindex [$canvas itemconfig $id -fill] 4]
+ if {[winfo depth $canvas] > 1} {
+ $canvas itemconfigure $id -fill SeaGreen1
+ } else {
+ $canvas itemconfigure $id -fill black
+ $canvas itemconfigure [expr $id+1] -fill white
+ }
+}
+
+proc scrollLeave canvas {
+ global oldFill
+ set id [$canvas find withtag current]
+ if {[lsearch [$canvas gettags current] text] >= 0} {
+ set id [expr $id-1]
+ }
+ $canvas itemconfigure $id -fill $oldFill
+ $canvas itemconfigure [expr $id+1] -fill black
+}
+
+proc scrollButton canvas {
+ global oldFill
+ set id [$canvas find withtag current]
+ if {[lsearch [$canvas gettags current] text] < 0} {
+ set id [expr $id+1]
+ }
+ puts stdout "You buttoned at [lindex [$canvas itemconf $id -text] 4]"
+}
demos/cscroll.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/image1.tcl
===================================================================
--- demos/image1.tcl (nonexistent)
+++ demos/image1.tcl (revision 1765)
@@ -0,0 +1,36 @@
+# image1.tcl --
+#
+# This demonstration script displays two image widgets.
+#
+# SCCS: @(#) image1.tcl 1.6 97/03/02 16:24:35
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .image1
+catch {destroy $w}
+toplevel $w
+wm title $w "Image Demonstration #1"
+wm iconname $w "Image1"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration displays two images, each in a separate label widget."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+catch {image delete image1a}
+image create photo image1a -file [file join $tk_library demos images earth.gif]
+label $w.l1 -image image1a -bd 1 -relief sunken
+
+catch {image delete image1b}
+image create photo image1b \
+ -file [file join $tk_library demos images earthris.gif]
+label $w.l2 -image image1b -bd 1 -relief sunken
+
+pack $w.l1 $w.l2 -side top -padx .5m -pady .5m
demos/image1.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/menu.tcl
===================================================================
--- demos/menu.tcl (nonexistent)
+++ demos/menu.tcl (revision 1765)
@@ -0,0 +1,152 @@
+# menu.tcl --
+#
+# This demonstration script creates a window with a bunch of menus
+# and cascaded menus using menubars.
+#
+# SCCS: @(#) menu.tcl 1.17 97/06/26 15:45:04
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .menu
+catch {destroy $w}
+toplevel $w
+wm title $w "Menu Demonstration"
+wm iconname $w "menu"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left
+if {$tcl_platform(platform) == "macintosh"} {
+ $w.msg configure -text "This window contains a menubar with cascaded menus. You can invoke entries with an accelerator by typing Command+x, where \"x\" is the character next to the command key symbol. The rightmost menu can be torn off into a palette by dragging outside of its bounds and releasing the mouse."
+} else {
+ $w.msg configure -text "This window contains a menubar with cascaded menus. You can post a menu from the keyboard by typing Alt+x, where \"x\" is the character underlined on the menu. You can then traverse among the menus using the arrow keys. When a menu is posted, you can invoke the current entry by typing space, or you can invoke any entry by typing its underlined character. If a menu entry has an accelerator, you can invoke the entry without posting the menu just by typing the accelerator. The rightmost menu can be torn off into a palette by selecting the first item in the menu."
+}
+pack $w.msg -side top
+
+set menustatus " "
+frame $w.statusBar
+label $w.statusBar.label -textvariable menustatus -relief sunken -bd 1 -font "Helvetica 10" -anchor w
+pack $w.statusBar.label -side left -padx 2 -expand yes -fill both
+pack $w.statusBar -side bottom -fill x -pady 2
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+menu $w.menu -tearoff 0
+
+set m $w.menu.file
+menu $m -tearoff 0
+$w.menu add cascade -label "File" -menu $m -underline 0
+$m add command -label "Open..." -command {error "this is just a demo: no action has been defined for the \"Open...\" entry"}
+$m add command -label "New" -command {error "this is just a demo: no action has been defined for the \"New\" entry"}
+$m add command -label "Save" -command {error "this is just a demo: no action has been defined for the \"Save\" entry"}
+$m add command -label "Save As..." -command {error "this is just a demo: no action has been defined for the \"Save As...\" entry"}
+$m add separator
+$m add command -label "Print Setup..." -command {error "this is just a demo: no action has been defined for the \"Print Setup...\" entry"}
+$m add command -label "Print..." -command {error "this is just a demo: no action has been defined for the \"Print...\" entry"}
+$m add separator
+$m add command -label "Dismiss Menus Demo" -command "destroy $w"
+
+set m $w.menu.basic
+$w.menu add cascade -label "Basic" -menu $m -underline 0
+menu $m -tearoff 0
+$m add command -label "Long entry that does nothing"
+if {$tcl_platform(platform) == "macintosh"} {
+ set modifier Command
+} elseif {$tcl_platform(platform) == "windows"} {
+ set modifier Control
+} else {
+ set modifier Meta
+}
+foreach i {A B C D E F} {
+ $m add command -label "Print letter \"$i\"" -underline 14 \
+ -accelerator Meta+$i -command "puts $i" -accelerator $modifier+$i
+ bind $w <$modifier-[string tolower $i]> "puts $i"
+}
+
+set m $w.menu.cascade
+$w.menu add cascade -label "Cascades" -menu $m -underline 0
+menu $m -tearoff 0
+$m add command -label "Print hello" \
+ -command {puts stdout "Hello"} -accelerator $modifier+H -underline 6
+bind $w <$modifier-h> {puts stdout "Hello"}
+$m add command -label "Print goodbye" -command {\
+ puts stdout "Goodbye"} -accelerator $modifier+G -underline 6
+bind $w <$modifier-g> {puts stdout "Goodbye"}
+$m add cascade -label "Check buttons" \
+ -menu $w.menu.cascade.check -underline 0
+$m add cascade -label "Radio buttons" \
+ -menu $w.menu.cascade.radio -underline 0
+
+set m $w.menu.cascade.check
+menu $m -tearoff 0
+$m add check -label "Oil checked" -variable oil
+$m add check -label "Transmission checked" -variable trans
+$m add check -label "Brakes checked" -variable brakes
+$m add check -label "Lights checked" -variable lights
+$m add separator
+$m add command -label "Show current values" \
+ -command "showVars $w.menu.cascade.dialog oil trans brakes lights"
+$m invoke 1
+$m invoke 3
+
+set m $w.menu.cascade.radio
+menu $m -tearoff 0
+$m add radio -label "10 point" -variable pointSize -value 10
+$m add radio -label "14 point" -variable pointSize -value 14
+$m add radio -label "18 point" -variable pointSize -value 18
+$m add radio -label "24 point" -variable pointSize -value 24
+$m add radio -label "32 point" -variable pointSize -value 32
+$m add sep
+$m add radio -label "Roman" -variable style -value roman
+$m add radio -label "Bold" -variable style -value bold
+$m add radio -label "Italic" -variable style -value italic
+$m add sep
+$m add command -label "Show current values" \
+ -command "showVars $w.menu.cascade.dialog pointSize style"
+$m invoke 1
+$m invoke 7
+
+set m $w.menu.icon
+$w.menu add cascade -label "Icons" -menu $m -underline 0
+menu $m -tearoff 0
+$m add command \
+ -bitmap @[file join $tk_library demos images pattern.bmp] \
+ -hidemargin 1 \
+ -command {
+ tk_dialog .pattern {Bitmap Menu Entry} {The menu entry you invoked displays a bitmap rather than a text string. Other than this, it is just like any other menu entry.} {} 0 OK
+}
+foreach i {info questhead error} {
+ $m add command -bitmap $i -command "puts {You invoked the $i bitmap}" -hidemargin 1
+}
+$m entryconfigure 2 -columnbreak 1
+
+set m $w.menu.more
+$w.menu add cascade -label "More" -menu $m -underline 0
+menu $m -tearoff 0
+foreach i {{An entry} {Another entry} {Does nothing} {Does almost nothing} {Make life meaningful}} {
+ $m add command -label $i -command [list puts "You invoked \"$i\""]
+}
+
+set m $w.menu.colors
+$w.menu add cascade -label "Colors" -menu $m -underline 1
+menu $m
+foreach i {red orange yellow green blue} {
+ $m add command -label $i -background $i \
+ -command [list puts "You invoked \"$i\""]
+}
+
+$w configure -menu $w.menu
+
+bind Menu <> {
+ global $menustatus
+ if {[catch {%W entrycget active -label} label]} {
+ set label " "
+ }
+ set menustatus $label
+ update idletasks
+}
demos/menu.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/image2.tcl
===================================================================
--- demos/image2.tcl (nonexistent)
+++ demos/image2.tcl (revision 1765)
@@ -0,0 +1,80 @@
+# image2.tcl --
+#
+# This demonstration script creates a simple collection of widgets
+# that allow you to select and view images in a Tk label.
+#
+# SCCS: @(#) image2.tcl 1.9 97/03/02 16:24:48
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+# loadDir --
+# This procedure reloads the directory listbox from the directory
+# named in the demo's entry.
+#
+# Arguments:
+# w - Name of the toplevel window of the demo.
+
+proc loadDir w {
+ global dirName
+
+ $w.f.list delete 0 end
+ foreach i [lsort [glob [file join $dirName *]]] {
+ $w.f.list insert end [file tail $i]
+ }
+}
+
+# loadImage --
+# Given the name of the toplevel window of the demo and the mouse
+# position, extracts the directory entry under the mouse and loads
+# that file into a photo image for display.
+#
+# Arguments:
+# w - Name of the toplevel window of the demo.
+# x, y- Mouse position within the listbox.
+
+proc loadImage {w x y} {
+ global dirName
+
+ set file [file join $dirName [$w.f.list get @$x,$y]]
+ image2a configure -file $file
+}
+
+set w .image2
+catch {destroy $w}
+toplevel $w
+wm title $w "Image Demonstration #2"
+wm iconname $w "Image2"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration allows you to view images using a Tk \"photo\" image. First type a directory name in the listbox, then type Return to load the directory into the listbox. Then double-click on a file name in the listbox to see that image."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+label $w.dirLabel -text "Directory:"
+set dirName [file join $tk_library demos images]
+entry $w.dirName -width 30 -textvariable dirName
+bind $w.dirName "loadDir $w"
+frame $w.spacer1 -height 3m -width 20
+label $w.fileLabel -text "File:"
+frame $w.f
+pack $w.dirLabel $w.dirName $w.spacer1 $w.fileLabel $w.f -side top -anchor w
+
+listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set"
+scrollbar $w.f.scroll -command "$w.f.list yview"
+pack $w.f.list $w.f.scroll -side left -fill y -expand 1
+$w.f.list insert 0 earth.gif earthris.gif teapot.ppm
+bind $w.f.list "loadImage $w %x %y"
+
+catch {image delete image2a}
+image create photo image2a
+frame $w.spacer2 -height 3m -width 20
+label $w.imageLabel -text "Image:"
+label $w.image -image image2a
+pack $w.spacer2 $w.imageLabel $w.image -side top -anchor w
demos/image2.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/search.tcl
===================================================================
--- demos/search.tcl (nonexistent)
+++ demos/search.tcl (revision 1765)
@@ -0,0 +1,141 @@
+# search.tcl --
+#
+# This demonstration script creates a collection of widgets that
+# allow you to load a file into a text widget, then perform searches
+# on that file.
+#
+# SCCS: @(#) search.tcl 1.5 97/03/02 16:27:25
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+# textLoadFile --
+# This procedure below loads a file into a text widget, discarding
+# the previous contents of the widget. Tags for the old widget are
+# not affected, however.
+#
+# Arguments:
+# w - The window into which to load the file. Must be a
+# text widget.
+# file - The name of the file to load. Must be readable.
+
+proc textLoadFile {w file} {
+ set f [open $file]
+ $w delete 1.0 end
+ while {![eof $f]} {
+ $w insert end [read $f 10000]
+ }
+ close $f
+}
+
+# textSearch --
+# Search for all instances of a given string in a text widget and
+# apply a given tag to each instance found.
+#
+# Arguments:
+# w - The window in which to search. Must be a text widget.
+# string - The string to search for. The search is done using
+# exact matching only; no special characters.
+# tag - Tag to apply to each instance of a matching string.
+
+proc textSearch {w string tag} {
+ $w tag remove search 0.0 end
+ if {$string == ""} {
+ return
+ }
+ set cur 1.0
+ while 1 {
+ set cur [$w search -count length $string $cur end]
+ if {$cur == ""} {
+ break
+ }
+ $w tag add $tag $cur "$cur + $length char"
+ set cur [$w index "$cur + $length char"]
+ }
+}
+
+# textToggle --
+# This procedure is invoked repeatedly to invoke two commands at
+# periodic intervals. It normally reschedules itself after each
+# execution but if an error occurs (e.g. because the window was
+# deleted) then it doesn't reschedule itself.
+#
+# Arguments:
+# cmd1 - Command to execute when procedure is called.
+# sleep1 - Ms to sleep after executing cmd1 before executing cmd2.
+# cmd2 - Command to execute in the *next* invocation of this
+# procedure.
+# sleep2 - Ms to sleep after executing cmd2 before executing cmd1 again.
+
+proc textToggle {cmd1 sleep1 cmd2 sleep2} {
+ catch {
+ eval $cmd1
+ after $sleep1 [list textToggle $cmd2 $sleep2 $cmd1 $sleep1]
+ }
+}
+
+set w .search
+catch {destroy $w}
+toplevel $w
+wm title $w "Text Demonstration - Search and Highlight"
+wm iconname $w "search"
+positionWindow $w
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.file
+label $w.file.label -text "File name:" -width 13 -anchor w
+entry $w.file.entry -width 40 -textvariable fileName
+button $w.file.button -text "Load File" \
+ -command "textLoadFile $w.text \$fileName"
+pack $w.file.label $w.file.entry -side left
+pack $w.file.button -side left -pady 5 -padx 10
+bind $w.file.entry "
+ textLoadFile $w.text \$fileName
+ focus $w.string.entry
+"
+focus $w.file.entry
+
+frame $w.string
+label $w.string.label -text "Search string:" -width 13 -anchor w
+entry $w.string.entry -width 40 -textvariable searchString
+button $w.string.button -text "Highlight" \
+ -command "textSearch $w.text \$searchString search"
+pack $w.string.label $w.string.entry -side left
+pack $w.string.button -side left -pady 5 -padx 10
+bind $w.string.entry "textSearch $w.text \$searchString search"
+
+text $w.text -yscrollcommand "$w.scroll set" -setgrid true
+scrollbar $w.scroll -command "$w.text yview"
+pack $w.file $w.string -side top -fill x
+pack $w.scroll -side right -fill y
+pack $w.text -expand yes -fill both
+
+# Set up display styles for text highlighting.
+
+if {[winfo depth $w] > 1} {
+ textToggle "$w.text tag configure search -background \
+ #ce5555 -foreground white" 800 "$w.text tag configure \
+ search -background {} -foreground {}" 200
+} else {
+ textToggle "$w.text tag configure search -background \
+ black -foreground white" 800 "$w.text tag configure \
+ search -background {} -foreground {}" 200
+}
+$w.text insert 1.0 \
+{This window demonstrates how to use the tagging facilities in text
+widgets to implement a searching mechanism. First, type a file name
+in the top entry, then type or click on "Load File". Then
+type a string in the lower entry and type or click on
+"Load File". This will cause all of the instances of the string to
+be tagged with the tag "search", and it will arrange for the tag's
+display attributes to change to make all of the strings blink.}
+$w.text mark set insert 0.0
+
+set fileName ""
+set searchString ""
demos/search.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/README
===================================================================
--- demos/README (nonexistent)
+++ demos/README (revision 1765)
@@ -0,0 +1,46 @@
+This directory contains a collection of programs to demonstrate
+the features of the Tk toolkit. The programs are all scripts for
+"wish", a windowing shell. If wish has been installed in /usr/local
+then you can invoke any of the programs in this directory just
+by typing its file name to your command shell. Otherwise invoke
+wish with the file as its first argument, e.g., "wish hello".
+The rest of this file contains a brief description of each program.
+Files with names ending in ".tcl" are procedure packages used by one
+or more of the demo programs; they can't be used as programs by
+themselves so they aren't described below.
+
+hello - Creates a single button; if you click on it, a message
+ is typed and the application terminates.
+
+widget - Contains a collection of demonstrations of the widgets
+ currently available in the Tk library. Most of the .tcl
+ files are scripts for individual demos available through
+ the "widget" program.
+
+ixset - A simple Tk-based wrapper for the "xset" program, which
+ allows you to interactively query and set various X options
+ such as mouse acceleration and bell volume. Thanks to
+ Pierre David for contributing this example.
+
+rolodex - A mock-up of a simple rolodex application. It has much of
+ the user interface for such an application but no back-end
+ database. This program was written in response to Tom
+ LaStrange's toolkit benchmark challenge.
+
+tcolor - A color editor. Allows you to edit colors in several
+ different ways, and will also perform automatic updates
+ using "send".
+
+rmt - Allows you to "hook-up" remotely to any Tk application
+ on the display. Select an application with the menu,
+ then just type commands: they'll go to that application.
+
+timer - Displays a seconds timer with start and stop buttons.
+ Control-c and control-q cause it to exit.
+
+browse - A simple directory browser. Invoke it with and argument
+ giving the name of the directory you'd like to browse.
+ Double-click on files or subdirectories to browse them.
+ Control-c and control-q cause the program to exit.
+
+sccs id = SCCS: @(#) README 1.3 96/02/16 10:49:14
demos/README
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/bind.tcl
===================================================================
--- demos/bind.tcl (nonexistent)
+++ demos/bind.tcl (revision 1765)
@@ -0,0 +1,79 @@
+# bind.tcl --
+#
+# This demonstration script creates a text widget with bindings set
+# up for hypertext-like effects.
+#
+# SCCS: @(#) bind.tcl 1.6 97/03/02 16:19:01
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .bind
+catch {destroy $w}
+toplevel $w
+wm title $w "Text Demonstration - Tag Bindings"
+wm iconname $w "bind"
+positionWindow $w
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+text $w.text -yscrollcommand "$w.scroll set" -setgrid true \
+ -width 60 -height 24 -font $font -wrap word
+scrollbar $w.scroll -command "$w.text yview"
+pack $w.scroll -side right -fill y
+pack $w.text -expand yes -fill both
+
+# Set up display styles.
+
+if {[winfo depth $w] > 1} {
+ set bold "-background #43ce80 -relief raised -borderwidth 1"
+ set normal "-background {} -relief flat"
+} else {
+ set bold "-foreground white -background black"
+ set normal "-foreground {} -background {}"
+}
+
+# Add text to widget.
+
+$w.text insert 0.0 {\
+The same tag mechanism that controls display styles in text widgets can also be used to associate Tcl commands with regions of text, so that mouse or keyboard actions on the text cause particular Tcl commands to be invoked. For example, in the text below the descriptions of the canvas demonstrations have been tagged. When you move the mouse over a demo description the description lights up, and when you press button 1 over a description then that particular demonstration is invoked.
+
+}
+$w.text insert end \
+{1. Samples of all the different types of items that can be created in canvas widgets.} d1
+$w.text insert end \n\n
+$w.text insert end \
+{2. A simple two-dimensional plot that allows you to adjust the positions of the data points.} d2
+$w.text insert end \n\n
+$w.text insert end \
+{3. Anchoring and justification modes for text items.} d3
+$w.text insert end \n\n
+$w.text insert end \
+{4. An editor for arrow-head shapes for line items.} d4
+$w.text insert end \n\n
+$w.text insert end \
+{5. A ruler with facilities for editing tab stops.} d5
+$w.text insert end \n\n
+$w.text insert end \
+{6. A grid that demonstrates how canvases can be scrolled.} d6
+
+# Create bindings for tags.
+
+foreach tag {d1 d2 d3 d4 d5 d6} {
+ $w.text tag bind $tag "$w.text tag configure $tag $bold"
+ $w.text tag bind $tag "$w.text tag configure $tag $normal"
+}
+$w.text tag bind d1 <1> {source [file join $tk_library demos items.tcl]}
+$w.text tag bind d2 <1> {source [file join $tk_library demos plot.tcl]}
+$w.text tag bind d3 <1> {source [file join $tk_library demos ctext.tcl]}
+$w.text tag bind d4 <1> {source [file join $tk_library demos arrow.tcl]}
+$w.text tag bind d5 <1> {source [file join $tk_library demos ruler.tcl]}
+$w.text tag bind d6 <1> {source [file join $tk_library demos cscroll.tcl]}
+
+$w.text mark set insert 0.0
+$w.text configure -state disabled
demos/bind.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/bitmap.tcl
===================================================================
--- demos/bitmap.tcl (nonexistent)
+++ demos/bitmap.tcl (revision 1765)
@@ -0,0 +1,55 @@
+# bitmap.tcl --
+#
+# This demonstration script creates a toplevel window that displays
+# all of Tk's built-in bitmaps.
+#
+# SCCS: @(#) bitmap.tcl 1.6 97/03/02 16:19:20
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+# bitmapRow --
+# Create a row of bitmap items in a window.
+#
+# Arguments:
+# w - The window that is to contain the row.
+# args - The names of one or more bitmaps, which will be displayed
+# in a new row across the bottom of w along with their
+# names.
+
+proc bitmapRow {w args} {
+ frame $w
+ pack $w -side top -fill both
+ set i 0
+ foreach bitmap $args {
+ frame $w.$i
+ pack $w.$i -side left -fill both -pady .25c -padx .25c
+ label $w.$i.bitmap -bitmap $bitmap
+ label $w.$i.label -text $bitmap -width 9
+ pack $w.$i.label $w.$i.bitmap -side bottom
+ incr i
+ }
+}
+
+set w .bitmap
+global tk_library
+catch {destroy $w}
+toplevel $w
+wm title $w "Bitmap Demonstration"
+wm iconname $w "bitmap"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "This window displays all of Tk's built-in bitmaps, along with the names you can use for them in Tcl scripts."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.frame
+bitmapRow $w.frame.0 error gray12 gray25 gray50 gray75
+bitmapRow $w.frame.1 hourglass info question questhead warning
+pack $w.frame -side top -expand yes -fill both
demos/bitmap.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/check.tcl
===================================================================
--- demos/check.tcl (nonexistent)
+++ demos/check.tcl (revision 1765)
@@ -0,0 +1,33 @@
+# check.tcl --
+#
+# This demonstration script creates a toplevel window containing
+# several checkbuttons.
+#
+# SCCS: @(#) check.tcl 1.4 97/03/02 16:19:57
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .check
+catch {destroy $w}
+toplevel $w
+wm title $w "Checkbutton Demonstration"
+wm iconname $w "check"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "Three checkbuttons are displayed below. If you click on a button, it will toggle the button's selection state and set a Tcl variable to a value indicating the state of the checkbutton. Click the \"See Variables\" button to see the current values of the variables."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+button $w.buttons.vars -text "See Variables" \
+ -command "showVars $w.dialog wipers brakes sober"
+pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1
+
+checkbutton $w.b1 -text "Wipers OK" -variable wipers -relief flat
+checkbutton $w.b2 -text "Brakes OK" -variable brakes -relief flat
+checkbutton $w.b3 -text "Driver Sober" -variable sober -relief flat
+pack $w.b1 $w.b2 $w.b3 -side top -pady 2 -anchor w
demos/check.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/sayings.tcl
===================================================================
--- demos/sayings.tcl (nonexistent)
+++ demos/sayings.tcl (revision 1765)
@@ -0,0 +1,46 @@
+# sayings.tcl --
+#
+# This demonstration script creates a listbox that can be scrolled
+# both horizontally and vertically. It displays a collection of
+# well-known sayings.
+#
+# SCCS: @(#) sayings.tcl 1.7 97/03/02 16:27:10
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .sayings
+catch {destroy $w}
+toplevel $w
+wm title $w "Listbox Demonstration (well-known sayings)"
+wm iconname $w "sayings"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "The listbox below contains a collection of well-known sayings. You can scan the list using either of the scrollbars or by dragging in the listbox window with button 2 pressed."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.frame -borderwidth 10
+pack $w.frame -side top -expand yes -fill y
+
+
+scrollbar $w.frame.yscroll -command "$w.frame.list yview"
+scrollbar $w.frame.xscroll -orient horizontal \
+ -command "$w.frame.list xview"
+listbox $w.frame.list -width 20 -height 10 -setgrid 1 \
+ -yscroll "$w.frame.yscroll set" -xscroll "$w.frame.xscroll set"
+
+grid $w.frame.list -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
+grid $w.frame.yscroll -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
+grid $w.frame.xscroll -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
+grid rowconfig $w.frame 0 -weight 1 -minsize 0
+grid columnconfig $w.frame 0 -weight 1 -minsize 0
+
+
+$w.frame.list insert 0 "Waste not, want not" "Early to bed and early to rise makes a man healthy, wealthy, and wise" "Ask not what your country can do for you, ask what you can do for your country" "I shall return" "NOT" "A picture is worth a thousand words" "User interfaces are hard to build" "Thou shalt not steal" "A penny for your thoughts" "Fool me once, shame on you; fool me twice, shame on me" "Every cloud has a silver lining" "Where there's smoke there's fire" "It takes one to know one" "Curiosity killed the cat" "Take this job and shove it" "Up a creek without a paddle" "I'm mad as hell and I'm not going to take it any more" "An apple a day keeps the doctor away" "Don't look a gift horse in the mouth"
demos/sayings.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/vscale.tcl
===================================================================
--- demos/vscale.tcl (nonexistent)
+++ demos/vscale.tcl (revision 1765)
@@ -0,0 +1,48 @@
+# vscale.tcl --
+#
+# This demonstration script shows an example with a vertical scale.
+#
+# SCCS: @(#) vscale.tcl 1.4 97/03/02 16:28:34
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .vscale
+catch {destroy $w}
+toplevel $w
+wm title $w "Vertical Scale Demonstration"
+wm iconname $w "vscale"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 3.5i -justify left -text "An arrow and a vertical scale are displayed below. If you click or drag mouse button 1 in the scale, you can change the size of the arrow."
+pack $w.msg -side top -padx .5c
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.frame -borderwidth 10
+pack $w.frame
+
+scale $w.frame.scale -orient vertical -length 284 -from 0 -to 250 \
+ -command "setHeight $w.frame.canvas" -tickinterval 50
+canvas $w.frame.canvas -width 50 -height 50 -bd 0 -highlightthickness 0
+$w.frame.canvas create polygon 0 0 1 1 2 2 -fill SeaGreen3 -tags poly
+$w.frame.canvas create line 0 0 1 1 2 2 0 0 -fill black -tags line
+frame $w.frame.right -borderwidth 15
+pack $w.frame.scale -side left -anchor ne
+pack $w.frame.canvas -side left -anchor nw -fill y
+$w.frame.scale set 75
+
+proc setHeight {w height} {
+ incr height 21
+ set y2 [expr $height - 30]
+ if {$y2 < 21} {
+ set y2 21
+ }
+ $w coords poly 15 20 35 20 35 $y2 45 $y2 25 $height 5 $y2 15 $y2 15 20
+ $w coords line 15 20 35 20 35 $y2 45 $y2 25 $height 5 $y2 15 $y2 15 20
+}
demos/vscale.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/plot.tcl
===================================================================
--- demos/plot.tcl (nonexistent)
+++ demos/plot.tcl (revision 1765)
@@ -0,0 +1,98 @@
+# plot.tcl --
+#
+# This demonstration script creates a canvas widget showing a 2-D
+# plot with data points that can be dragged with the mouse.
+#
+# SCCS: @(#) plot.tcl 1.5 97/03/02 16:26:19
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .plot
+catch {destroy $w}
+toplevel $w
+wm title $w "Plot Demonstration"
+wm iconname $w "Plot"
+positionWindow $w
+set c $w.c
+
+label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget containing a simple 2-dimensional plot. You can doctor the data by dragging any of the points with mouse button 1."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+canvas $c -relief raised -width 450 -height 300
+pack $w.c -side top -fill x
+
+set plotFont {Helvetica 18}
+
+$c create line 100 250 400 250 -width 2
+$c create line 100 250 100 50 -width 2
+$c create text 225 20 -text "A Simple Plot" -font $plotFont -fill brown
+
+for {set i 0} {$i <= 10} {incr i} {
+ set x [expr {100 + ($i*30)}]
+ $c create line $x 250 $x 245 -width 2
+ $c create text $x 254 -text [expr 10*$i] -anchor n -font $plotFont
+}
+for {set i 0} {$i <= 5} {incr i} {
+ set y [expr {250 - ($i*40)}]
+ $c create line 100 $y 105 $y -width 2
+ $c create text 96 $y -text [expr $i*50].0 -anchor e -font $plotFont
+}
+
+foreach point {{12 56} {20 94} {33 98} {32 120} {61 180}
+ {75 160} {98 223}} {
+ set x [expr {100 + (3*[lindex $point 0])}]
+ set y [expr {250 - (4*[lindex $point 1])/5}]
+ set item [$c create oval [expr $x-6] [expr $y-6] \
+ [expr $x+6] [expr $y+6] -width 1 -outline black \
+ -fill SkyBlue2]
+ $c addtag point withtag $item
+}
+
+$c bind point "$c itemconfig current -fill red"
+$c bind point "$c itemconfig current -fill SkyBlue2"
+$c bind point <1> "plotDown $c %x %y"
+$c bind point "$c dtag selected"
+bind $c "plotMove $c %x %y"
+
+set plot(lastX) 0
+set plot(lastY) 0
+
+# plotDown --
+# This procedure is invoked when the mouse is pressed over one of the
+# data points. It sets up state to allow the point to be dragged.
+#
+# Arguments:
+# w - The canvas window.
+# x, y - The coordinates of the mouse press.
+
+proc plotDown {w x y} {
+ global plot
+ $w dtag selected
+ $w addtag selected withtag current
+ $w raise current
+ set plot(lastX) $x
+ set plot(lastY) $y
+}
+
+# plotMove --
+# This procedure is invoked during mouse motion events. It drags the
+# current item.
+#
+# Arguments:
+# w - The canvas window.
+# x, y - The coordinates of the mouse.
+
+proc plotMove {w x y} {
+ global plot
+ $w move selected [expr $x-$plot(lastX)] [expr $y-$plot(lastY)]
+ set plot(lastX) $x
+ set plot(lastY) $y
+}
demos/plot.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/dialog1.tcl
===================================================================
--- demos/dialog1.tcl (nonexistent)
+++ demos/dialog1.tcl (revision 1765)
@@ -0,0 +1,15 @@
+# dialog1.tcl --
+#
+# This demonstration script creates a dialog box with a local grab.
+#
+# SCCS: @(#) dialog1.tcl 1.2 96/02/16 10:49:52
+
+after idle {.dialog1.msg configure -wraplength 4i}
+set i [tk_dialog .dialog1 "Dialog with local grab" {This is a modal dialog box. It uses Tk's "grab" command to create a "local grab" on the dialog box. The grab prevents any pointer-related events from getting to any other windows in the application until you have answered the dialog by invoking one of the buttons below. However, you can still interact with other applications.} \
+info 0 OK Cancel {Show Code}]
+
+switch $i {
+ 0 {puts "You pressed OK"}
+ 1 {puts "You pressed Cancel"}
+ 2 {showCode .dialog1}
+}
demos/dialog1.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/dialog2.tcl
===================================================================
--- demos/dialog2.tcl (nonexistent)
+++ demos/dialog2.tcl (revision 1765)
@@ -0,0 +1,19 @@
+# dialog2.tcl --
+#
+# This demonstration script creates a dialog box with a global grab.
+#
+# SCCS: @(#) dialog2.tcl 1.2 96/02/16 10:49:53
+
+after idle {
+ .dialog2.msg configure -wraplength 4i
+}
+after 100 {
+ grab -global .dialog2
+}
+set i [tk_dialog .dialog2 "Dialog with local grab" {This dialog box uses a global grab, so it prevents you from interacting with anything on your display until you invoke one of the buttons below. Global grabs are almost always a bad idea; don't use them unless you're truly desperate.} warning 0 OK Cancel {Show Code}]
+
+switch $i {
+ 0 {puts "You pressed OK"}
+ 1 {puts "You pressed Cancel"}
+ 2 {showCode .dialog2}
+}
demos/dialog2.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/rmt
===================================================================
--- demos/rmt (nonexistent)
+++ demos/rmt (revision 1765)
@@ -0,0 +1,205 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+# rmt --
+# This script implements a simple remote-control mechanism for
+# Tk applications. It allows you to select an application and
+# then type commands to that application.
+#
+# SCCS: @(#) rmt 1.10 96/06/24 16:42:38
+
+wm title . "Tk Remote Controller"
+wm iconname . "Tk Remote"
+wm minsize . 1 1
+
+# The global variable below keeps track of the remote application
+# that we're sending to. If it's an empty string then we execute
+# the commands locally.
+
+set app "local"
+
+# The global variable below keeps track of whether we're in the
+# middle of executing a command entered via the text.
+
+set executing 0
+
+# The global variable below keeps track of the last command executed,
+# so it can be re-executed in response to !! commands.
+
+set lastCommand ""
+
+# Create menu bar. Arrange to recreate all the information in the
+# applications sub-menu whenever it is cascaded to.
+
+frame .menu -relief raised -bd 2
+pack .menu -side top -fill x
+menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
+menu .menu.file.m
+.menu.file.m add cascade -label "Select Application" \
+ -menu .menu.file.m.apps -underline 0
+.menu.file.m add command -label "Quit" -command "destroy ." -underline 0
+menu .menu.file.m.apps -postcommand fillAppsMenu
+pack .menu.file -side left
+
+# Create text window and scrollbar.
+
+text .t -relief sunken -bd 2 -yscrollcommand ".s set" -setgrid true
+scrollbar .s -command ".t yview"
+pack .s -side right -fill both
+pack .t -side left
+
+# Create a binding to forward commands to the target application,
+# plus modify many of the built-in bindings so that only information
+# in the current command can be deleted (can still set the cursor
+# earlier in the text and select and insert; just can't delete).
+
+bindtags .t {.t Text . all}
+bind .t {
+ .t mark set insert {end - 1c}
+ .t insert insert \n
+ invoke
+ break
+}
+bind .t {
+ catch {.t tag remove sel sel.first promptEnd}
+ if {[.t tag nextrange sel 1.0 end] == ""} {
+ if [.t compare insert < promptEnd] {
+ break
+ }
+ }
+}
+bind .t {
+ catch {.t tag remove sel sel.first promptEnd}
+ if {[.t tag nextrange sel 1.0 end] == ""} {
+ if [.t compare insert <= promptEnd] {
+ break
+ }
+ }
+}
+bind .t {
+ if [.t compare insert < promptEnd] {
+ break
+ }
+}
+bind .t {
+ if [.t compare insert < promptEnd] {
+ .t mark set insert promptEnd
+ }
+}
+bind .t {
+ if [.t compare insert < promptEnd] {
+ break
+ }
+}
+bind .t {
+ if [.t compare insert < promptEnd] {
+ break
+ }
+}
+bind .t {
+ if [.t compare insert <= promptEnd] {
+ break
+ }
+}
+bind .t {
+ if [.t compare insert <= promptEnd] {
+ break
+ }
+}
+auto_load tkTextInsert
+proc tkTextInsert {w s} {
+ if {$s == ""} {
+ return
+ }
+ catch {
+ if {[$w compare sel.first <= insert]
+ && [$w compare sel.last >= insert]} {
+ $w tag remove sel sel.first promptEnd
+ $w delete sel.first sel.last
+ }
+ }
+ $w insert insert $s
+ $w see insert
+}
+
+.t tag configure bold -font {Courier 12 bold}
+
+# The procedure below is used to print out a prompt at the
+# insertion point (which should be at the beginning of a line
+# right now).
+
+proc prompt {} {
+ global app
+ .t insert insert "$app: "
+ .t mark set promptEnd {insert}
+ .t mark gravity promptEnd left
+ .t tag add bold {promptEnd linestart} promptEnd
+}
+
+# The procedure below executes a command (it takes everything on the
+# current line after the prompt and either sends it to the remote
+# application or executes it locally, depending on "app".
+
+proc invoke {} {
+ global app executing lastCommand
+ set cmd [.t get promptEnd insert]
+ incr executing 1
+ if [info complete $cmd] {
+ if {$cmd == "!!\n"} {
+ set cmd $lastCommand
+ } else {
+ set lastCommand $cmd
+ }
+ if {$app == "local"} {
+ set result [catch [list uplevel #0 $cmd] msg]
+ } else {
+ set result [catch [list send $app $cmd] msg]
+ }
+ if {$result != 0} {
+ .t insert insert "Error: $msg\n"
+ } else {
+ if {$msg != ""} {
+ .t insert insert $msg\n
+ }
+ }
+ prompt
+ .t mark set promptEnd insert
+ }
+ incr executing -1
+ .t yview -pickplace insert
+}
+
+# The following procedure is invoked to change the application that
+# we're talking to. It also updates the prompt for the current
+# command, unless we're in the middle of executing a command from
+# the text item (in which case a new prompt is about to be output
+# so there's no need to change the old one).
+
+proc newApp appName {
+ global app executing
+ set app $appName
+ if !$executing {
+ .t mark gravity promptEnd right
+ .t delete "promptEnd linestart" promptEnd
+ .t insert promptEnd "$appName: "
+ .t tag add bold "promptEnd linestart" promptEnd
+ .t mark gravity promptEnd left
+ }
+ return {}
+}
+
+# The procedure below will fill in the applications sub-menu with a list
+# of all the applications that currently exist.
+
+proc fillAppsMenu {} {
+ catch {.menu.file.m.apps delete 0 last}
+ foreach i [lsort [winfo interps]] {
+ .menu.file.m.apps add command -label $i -command [list newApp $i]
+ }
+ .menu.file.m.apps add command -label local -command {newApp local}
+}
+
+set app [winfo name .]
+prompt
+focus .t
demos/rmt
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/hello
===================================================================
--- demos/hello (nonexistent)
+++ demos/hello (revision 1765)
@@ -0,0 +1,18 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+# hello --
+# Simple Tk script to create a button that prints "Hello, world".
+# Click on the button to terminate the program.
+#
+# SCCS: @(#) hello 1.6 96/02/16 10:49:18
+#
+# The first line below creates the button, and the second line
+# asks the packer to shrink-wrap the application's main window
+# around the button.
+
+button .hello -text "Hello, world" -command {
+ puts stdout "Hello, world"; destroy .
+}
+pack .hello
demos/hello
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/entry1.tcl
===================================================================
--- demos/entry1.tcl (nonexistent)
+++ demos/entry1.tcl (revision 1765)
@@ -0,0 +1,36 @@
+# entry1.tcl --
+#
+# This demonstration script creates several entry widgets without
+# scrollbars.
+#
+# SCCS: @(#) entry1.tcl 1.5 97/03/02 16:22:10
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .entry1
+catch {destroy $w}
+toplevel $w
+wm title $w "Entry Demonstration (no scrollbars)"
+wm iconname $w "entry1"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 5i -justify left -text "Three different entries are displayed below. You can add characters by pointing, clicking and typing. The normal Motif editing characters are supported, along with many Emacs bindings. For example, Backspace and Control-h delete the character to the left of the insertion cursor and Delete and Control-d delete the chararacter to the right of the insertion cursor. For entries that are too large to fit in the window all at once, you can scan through the entries by dragging with mouse button2 pressed."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+entry $w.e1
+entry $w.e2
+entry $w.e3
+pack $w.e1 $w.e2 $w.e3 -side top -pady 5 -padx 10 -fill x
+
+$w.e1 insert 0 "Initial value"
+$w.e2 insert end "This entry contains a long value, much too long "
+$w.e2 insert end "to fit in the window at one time, so long in fact "
+$w.e2 insert end "that you'll have to scan or scroll to see the end."
demos/entry1.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/entry2.tcl
===================================================================
--- demos/entry2.tcl (nonexistent)
+++ demos/entry2.tcl (revision 1765)
@@ -0,0 +1,48 @@
+# entry2.tcl --
+#
+# This demonstration script is the same as the entry1.tcl script
+# except that it creates scrollbars for the entries.
+#
+# SCCS: @(#) entry2.tcl 1.5 97/03/02 16:22:24
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .entry2
+catch {destroy $w}
+toplevel $w
+wm title $w "Entry Demonstration (with scrollbars)"
+wm iconname $w "entry2"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 5i -justify left -text "Three different entries are displayed below, with a scrollbar for each entry. You can add characters by pointing, clicking and typing. The normal Motif editing characters are supported, along with many Emacs bindings. For example, Backspace and Control-h delete the character to the left of the insertion cursor and Delete and Control-d delete the chararacter to the right of the insertion cursor. For entries that are too large to fit in the window all at once, you can scan through the entries with the scrollbars, or by dragging with mouse button2 pressed."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.frame -borderwidth 10
+pack $w.frame -side top -fill x -expand 1
+
+entry $w.frame.e1 -xscrollcommand "$w.frame.s1 set"
+scrollbar $w.frame.s1 -relief sunken -orient horiz -command \
+ "$w.frame.e1 xview"
+frame $w.frame.spacer1 -width 20 -height 10
+entry $w.frame.e2 -xscrollcommand "$w.frame.s2 set"
+scrollbar $w.frame.s2 -relief sunken -orient horiz -command \
+ "$w.frame.e2 xview"
+frame $w.frame.spacer2 -width 20 -height 10
+entry $w.frame.e3 -xscrollcommand "$w.frame.s3 set"
+scrollbar $w.frame.s3 -relief sunken -orient horiz -command \
+ "$w.frame.e3 xview"
+pack $w.frame.e1 $w.frame.s1 $w.frame.spacer1 $w.frame.e2 $w.frame.s2 \
+ $w.frame.spacer2 $w.frame.e3 $w.frame.s3 -side top -fill x
+
+$w.frame.e1 insert 0 "Initial value"
+$w.frame.e2 insert end "This entry contains a long value, much too long "
+$w.frame.e2 insert end "to fit in the window at one time, so long in fact "
+$w.frame.e2 insert end "that you'll have to scan or scroll to see the end."
demos/entry2.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/ctext.tcl
===================================================================
--- demos/ctext.tcl (nonexistent)
+++ demos/ctext.tcl (revision 1765)
@@ -0,0 +1,146 @@
+# ctext.tcl --
+#
+# This demonstration script creates a canvas widget with a text
+# item that can be edited and reconfigured in various ways.
+#
+# SCCS: @(#) ctext.tcl 1.6 97/03/02 16:21:02
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .ctext
+catch {destroy $w}
+toplevel $w
+wm title $w "Canvas Text Demonstration"
+wm iconname $w "Text"
+positionWindow $w
+set c $w.c
+
+label $w.msg -font $font -wraplength 5i -justify left -text "This window displays a string of text to demonstrate the text facilities of canvas widgets. You can click in the boxes to adjust the position of the text relative to its positioning point or change its justification. The text also supports the following simple bindings for editing:
+ 1. You can point, click, and type.
+ 2. You can also select with button 1.
+ 3. You can copy the selection to the mouse position with button 2.
+ 4. Backspace and Control+h delete the selection if there is one;
+ otherwise they delete the character just before the insertion cursor.
+ 5. Delete deletes the selection if there is one; otherwise it deletes
+ the character just after the insertion cursor."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+canvas $c -relief flat -borderwidth 0 -width 500 -height 350
+pack $w.c -side top -expand yes -fill both
+
+set textFont {Helvetica 24}
+
+$c create rectangle 245 195 255 205 -outline black -fill red
+
+# First, create the text item and give it bindings so it can be edited.
+
+$c addtag text withtag [$c create text 250 200 -text "This is just a string of text to demonstrate the text facilities of canvas widgets. Bindings have been been defined to support editing (see above)." -width 440 -anchor n -font {Helvetica 24} -justify left]
+$c bind text <1> "textB1Press $c %x %y"
+$c bind text "textB1Move $c %x %y"
+$c bind text "$c select adjust current @%x,%y"
+$c bind text "textB1Move $c %x %y"
+$c bind text "textInsert $c %A"
+$c bind text "textInsert $c \\n"
+$c bind text "textBs $c"
+$c bind text "textBs $c"
+$c bind text "textDel $c"
+$c bind text <2> "textPaste $c @%x,%y"
+
+# Next, create some items that allow the text's anchor position
+# to be edited.
+
+proc mkTextConfig {w x y option value color} {
+ set item [$w create rect [expr $x] [expr $y] [expr $x+30] [expr $y+30] \
+ -outline black -fill $color -width 1]
+ $w bind $item <1> "$w itemconf text $option $value"
+ $w addtag config withtag $item
+}
+
+set x 50
+set y 50
+set color LightSkyBlue1
+mkTextConfig $c $x $y -anchor se $color
+mkTextConfig $c [expr $x+30] [expr $y] -anchor s $color
+mkTextConfig $c [expr $x+60] [expr $y] -anchor sw $color
+mkTextConfig $c [expr $x] [expr $y+30] -anchor e $color
+mkTextConfig $c [expr $x+30] [expr $y+30] -anchor center $color
+mkTextConfig $c [expr $x+60] [expr $y+30] -anchor w $color
+mkTextConfig $c [expr $x] [expr $y+60] -anchor ne $color
+mkTextConfig $c [expr $x+30] [expr $y+60] -anchor n $color
+mkTextConfig $c [expr $x+60] [expr $y+60] -anchor nw $color
+set item [$c create rect [expr $x+40] [expr $y+40] [expr $x+50] [expr $y+50] \
+ -outline black -fill red]
+$c bind $item <1> "$c itemconf text -anchor center"
+$c create text [expr $x+45] [expr $y-5] -text {Text Position} -anchor s \
+ -font {Times 24} -fill brown
+
+# Lastly, create some items that allow the text's justification to be
+# changed.
+
+set x 350
+set y 50
+set color SeaGreen2
+mkTextConfig $c $x $y -justify left $color
+mkTextConfig $c [expr $x+30] [expr $y] -justify center $color
+mkTextConfig $c [expr $x+60] [expr $y] -justify right $color
+$c create text [expr $x+45] [expr $y-5] -text {Justification} -anchor s \
+ -font {Times 24} -fill brown
+
+$c bind config "textEnter $c"
+$c bind config "$c itemconf current -fill \$textConfigFill"
+
+set textConfigFill {}
+
+proc textEnter {w} {
+ global textConfigFill
+ set textConfigFill [lindex [$w itemconfig current -fill] 4]
+ $w itemconfig current -fill black
+}
+
+proc textInsert {w string} {
+ if {$string == ""} {
+ return
+ }
+ catch {$w dchars text sel.first sel.last}
+ $w insert text insert $string
+}
+
+proc textPaste {w pos} {
+ catch {
+ $w insert text $pos [selection get]
+ }
+}
+
+proc textB1Press {w x y} {
+ $w icursor current @$x,$y
+ $w focus current
+ focus $w
+ $w select from current @$x,$y
+}
+
+proc textB1Move {w x y} {
+ $w select to current @$x,$y
+}
+
+proc textBs {w} {
+ if ![catch {$w dchars text sel.first sel.last}] {
+ return
+ }
+ set char [expr {[$w index text insert] - 1}]
+ if {$char >= 0} {$w dchar text $char}
+}
+
+proc textDel {w} {
+ if ![catch {$w dchars text sel.first sel.last}] {
+ return
+ }
+ $w dchars text insert
+}
demos/ctext.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/icon.tcl
===================================================================
--- demos/icon.tcl (nonexistent)
+++ demos/icon.tcl (revision 1765)
@@ -0,0 +1,52 @@
+# icon.tcl --
+#
+# This demonstration script creates a toplevel window containing
+# buttons that display bitmaps instead of text.
+#
+# SCCS: @(#) icon.tcl 1.8 97/03/02 16:24:19
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .icon
+catch {destroy $w}
+toplevel $w
+wm title $w "Iconic Button Demonstration"
+wm iconname $w "icon"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 5i -justify left -text "This window shows three ways of using bitmaps or images in radiobuttons and checkbuttons. On the left are two radiobuttons, each of which displays a bitmap and an indicator. In the middle is a checkbutton that displays a different image depending on whether it is selected or not. On the right is a checkbutton that displays a single bitmap but changes its background color to indicate whether or not it is selected."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+image create bitmap flagup \
+ -file [file join $tk_library demos images flagup.bmp] \
+ -maskfile [file join $tk_library demos images flagup.bmp]
+image create bitmap flagdown \
+ -file [file join $tk_library demos images flagdown.bmp] \
+ -maskfile [file join $tk_library demos images flagdown.bmp]
+frame $w.frame -borderwidth 10
+pack $w.frame -side top
+
+checkbutton $w.frame.b1 -image flagdown -selectimage flagup \
+ -indicatoron 0
+$w.frame.b1 configure -selectcolor [$w.frame.b1 cget -background]
+checkbutton $w.frame.b2 \
+ -bitmap @[file join $tk_library demos images letters.bmp] \
+ -indicatoron 0 -selectcolor SeaGreen1
+frame $w.frame.left
+pack $w.frame.left $w.frame.b1 $w.frame.b2 -side left -expand yes -padx 5m
+
+radiobutton $w.frame.left.b3 \
+ -bitmap @[file join $tk_library demos images letters.bmp] \
+ -variable letters -value full
+radiobutton $w.frame.left.b4 \
+ -bitmap @[file join $tk_library demos images noletter.bmp] \
+ -variable letters -value empty
+pack $w.frame.left.b3 $w.frame.left.b4 -side top -expand yes
demos/icon.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/puzzle.tcl
===================================================================
--- demos/puzzle.tcl (nonexistent)
+++ demos/puzzle.tcl (revision 1765)
@@ -0,0 +1,73 @@
+# puzzle.tcl --
+#
+# This demonstration script creates a 15-puzzle game using a collection
+# of buttons.
+#
+# SCCS: @(#) puzzle.tcl 1.5 97/03/02 16:26:32
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+# puzzleSwitch --
+# This procedure is invoked when the user clicks on a particular button;
+# if the button is next to the empty space, it moves the button into th
+# empty space.
+
+proc puzzleSwitch {w num} {
+ global xpos ypos
+ if {(($ypos($num) >= ($ypos(space) - .01))
+ && ($ypos($num) <= ($ypos(space) + .01))
+ && ($xpos($num) >= ($xpos(space) - .26))
+ && ($xpos($num) <= ($xpos(space) + .26)))
+ || (($xpos($num) >= ($xpos(space) - .01))
+ && ($xpos($num) <= ($xpos(space) + .01))
+ && ($ypos($num) >= ($ypos(space) - .26))
+ && ($ypos($num) <= ($ypos(space) + .26)))} {
+ set tmp $xpos(space)
+ set xpos(space) $xpos($num)
+ set xpos($num) $tmp
+ set tmp $ypos(space)
+ set ypos(space) $ypos($num)
+ set ypos($num) $tmp
+ place $w.frame.$num -relx $xpos($num) -rely $ypos($num)
+ }
+}
+
+set w .puzzle
+catch {destroy $w}
+toplevel $w
+wm title $w "15-Puzzle Demonstration"
+wm iconname $w "15-Puzzle"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "A 15-puzzle appears below as a collection of buttons. Click on any of the pieces next to the space, and that piece will slide over the space. Continue this until the pieces are arranged in numerical order from upper-left to lower-right."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+# Special trick: select a darker color for the space by creating a
+# scrollbar widget and using its trough color.
+
+scrollbar $w.s
+frame $w.frame -width 120 -height 120 -borderwidth 2 -relief sunken \
+ -bg [$w.s cget -troughcolor]
+pack $w.frame -side top -pady 1c -padx 1c
+destroy $w.s
+
+set order {3 1 6 2 5 7 15 13 4 11 8 9 14 10 12}
+for {set i 0} {$i < 15} {set i [expr $i+1]} {
+ set num [lindex $order $i]
+ set xpos($num) [expr ($i%4)*.25]
+ set ypos($num) [expr ($i/4)*.25]
+ button $w.frame.$num -relief raised -text $num -highlightthickness 0 \
+ -command "puzzleSwitch $w $num"
+ place $w.frame.$num -relx $xpos($num) -rely $ypos($num) \
+ -relwidth .25 -relheight .25
+}
+set xpos(space) .75
+set ypos(space) .75
demos/puzzle.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/ruler.tcl
===================================================================
--- demos/ruler.tcl (nonexistent)
+++ demos/ruler.tcl (revision 1765)
@@ -0,0 +1,173 @@
+# ruler.tcl --
+#
+# This demonstration script creates a canvas widget that displays a ruler
+# with tab stops that can be set, moved, and deleted.
+#
+# SCCS: @(#) ruler.tcl 1.9 97/03/02 16:17:33
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+# rulerMkTab --
+# This procedure creates a new triangular polygon in a canvas to
+# represent a tab stop.
+#
+# Arguments:
+# c - The canvas window.
+# x, y - Coordinates at which to create the tab stop.
+
+proc rulerMkTab {c x y} {
+ upvar #0 demo_rulerInfo v
+ $c create polygon $x $y [expr $x+$v(size)] [expr $y+$v(size)] \
+ [expr $x-$v(size)] [expr $y+$v(size)]
+}
+
+set w .ruler
+global tk_library
+catch {destroy $w}
+toplevel $w
+wm title $w "Ruler Demonstration"
+wm iconname $w "ruler"
+positionWindow $w
+set c $w.c
+
+label $w.msg -font $font -wraplength 5i -justify left -text "This canvas widget shows a mock-up of a ruler. You can create tab stops by dragging them out of the well to the right of the ruler. You can also drag existing tab stops. If you drag a tab stop far enough up or down so that it turns dim, it will be deleted when you release the mouse button."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+canvas $c -width 14.8c -height 2.5c
+pack $w.c -side top -fill x
+
+set demo_rulerInfo(grid) .25c
+set demo_rulerInfo(left) [winfo fpixels $c 1c]
+set demo_rulerInfo(right) [winfo fpixels $c 13c]
+set demo_rulerInfo(top) [winfo fpixels $c 1c]
+set demo_rulerInfo(bottom) [winfo fpixels $c 1.5c]
+set demo_rulerInfo(size) [winfo fpixels $c .2c]
+set demo_rulerInfo(normalStyle) "-fill black"
+if {[winfo depth $c] > 1} {
+ set demo_rulerInfo(activeStyle) "-fill red -stipple {}"
+ set demo_rulerInfo(deleteStyle) [list -fill red \
+ -stipple @[file join $tk_library demos images gray25.bmp]]
+} else {
+ set demo_rulerInfo(activeStyle) "-fill black -stipple {}"
+ set demo_rulerInfo(deleteStyle) [list -fill black \
+ -stipple @[file join $tk_library demos images gray25.bmp]]
+}
+
+$c create line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1
+for {set i 0} {$i < 12} {incr i} {
+ set x [expr $i+1]
+ $c create line ${x}c 1c ${x}c 0.6c -width 1
+ $c create line $x.25c 1c $x.25c 0.8c -width 1
+ $c create line $x.5c 1c $x.5c 0.7c -width 1
+ $c create line $x.75c 1c $x.75c 0.8c -width 1
+ $c create text $x.15c .75c -text $i -anchor sw
+}
+$c addtag well withtag [$c create rect 13.2c 1c 13.8c 0.5c \
+ -outline black -fill [lindex [$c config -bg] 4]]
+$c addtag well withtag [rulerMkTab $c [winfo pixels $c 13.5c] \
+ [winfo pixels $c .65c]]
+
+$c bind well <1> "rulerNewTab $c %x %y"
+$c bind tab <1> "rulerSelectTab $c %x %y"
+bind $c "rulerMoveTab $c %x %y"
+bind $c "rulerReleaseTab $c"
+
+# rulerNewTab --
+# Does all the work of creating a tab stop, including creating the
+# triangle object and adding tags to it to give it tab behavior.
+#
+# Arguments:
+# c - The canvas window.
+# x, y - The coordinates of the tab stop.
+
+proc rulerNewTab {c x y} {
+ upvar #0 demo_rulerInfo v
+ $c addtag active withtag [rulerMkTab $c $x $y]
+ $c addtag tab withtag active
+ set v(x) $x
+ set v(y) $y
+ rulerMoveTab $c $x $y
+}
+
+# rulerSelectTab --
+# This procedure is invoked when mouse button 1 is pressed over
+# a tab. It remembers information about the tab so that it can
+# be dragged interactively.
+#
+# Arguments:
+# c - The canvas widget.
+# x, y - The coordinates of the mouse (identifies the point by
+# which the tab was picked up for dragging).
+
+proc rulerSelectTab {c x y} {
+ upvar #0 demo_rulerInfo v
+ set v(x) [$c canvasx $x $v(grid)]
+ set v(y) [expr $v(top)+2]
+ $c addtag active withtag current
+ eval "$c itemconf active $v(activeStyle)"
+ $c raise active
+}
+
+# rulerMoveTab --
+# This procedure is invoked during mouse motion events to drag a tab.
+# It adjusts the position of the tab, and changes its appearance if
+# it is about to be dragged out of the ruler.
+#
+# Arguments:
+# c - The canvas widget.
+# x, y - The coordinates of the mouse.
+
+proc rulerMoveTab {c x y} {
+ upvar #0 demo_rulerInfo v
+ if {[$c find withtag active] == ""} {
+ return
+ }
+ set cx [$c canvasx $x $v(grid)]
+ set cy [$c canvasy $y]
+ if {$cx < $v(left)} {
+ set cx $v(left)
+ }
+ if {$cx > $v(right)} {
+ set cx $v(right)
+ }
+ if {($cy >= $v(top)) && ($cy <= $v(bottom))} {
+ set cy [expr $v(top)+2]
+ eval "$c itemconf active $v(activeStyle)"
+ } else {
+ set cy [expr $cy-$v(size)-2]
+ eval "$c itemconf active $v(deleteStyle)"
+ }
+ $c move active [expr $cx-$v(x)] [expr $cy-$v(y)]
+ set v(x) $cx
+ set v(y) $cy
+}
+
+# rulerReleaseTab --
+# This procedure is invoked during button release events that end
+# a tab drag operation. It deselects the tab and deletes the tab if
+# it was dragged out of the ruler.
+#
+# Arguments:
+# c - The canvas widget.
+# x, y - The coordinates of the mouse.
+
+proc rulerReleaseTab c {
+ upvar #0 demo_rulerInfo v
+ if {[$c find withtag active] == {}} {
+ return
+ }
+ if {$v(y) != [expr $v(top)+2]} {
+ $c delete active
+ } else {
+ eval "$c itemconf active $v(normalStyle)"
+ $c dtag active
+ }
+}
demos/ruler.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: demos/menubu.tcl
===================================================================
--- demos/menubu.tcl (nonexistent)
+++ demos/menubu.tcl (revision 1765)
@@ -0,0 +1,93 @@
+# menubutton.tcl --
+#
+# This demonstration script creates a window with a bunch of menus
+# and cascaded menus using menubuttons.
+#
+# # SCCS: @(#) menubu.tcl 1.9 97/06/19 18:11:06
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+set w .menubutton
+catch {destroy $w}
+toplevel $w
+wm title $w "Menu Button Demonstration"
+wm iconname $w "menubutton"
+positionWindow $w
+
+
+frame $w.body
+pack $w.body -expand 1 -fill both
+
+menubutton $w.body.below -text "Below" -underline 0 -direction below -menu $w.body.below.m -relief raised
+menu $w.body.below.m -tearoff 0
+$w.body.below.m add command -label "Below menu: first item" -command "puts \"You have selected the first item from the Below menu.\""
+$w.body.below.m add command -label "Below menu: second item" -command "puts \"You have selected the second item from the Below menu.\""
+grid $w.body.below -row 0 -column 1 -sticky n
+menubutton $w.body.right -text "Right" -underline 0 -direction right -menu $w.body.right.m -relief raised
+menu $w.body.right.m -tearoff 0
+$w.body.right.m add command -label "Right menu: first item" -command "puts \"You have selected the first item from the Right menu.\""
+$w.body.right.m add command -label "Right menu: second item" -command "puts \"You have selected the second item from the Right menu.\""
+frame $w.body.center
+menubutton $w.body.left -text "Left" -underline 0 -direction left -menu $w.body.left.m -relief raised
+menu $w.body.left.m -tearoff 0
+$w.body.left.m add command -label "Left menu: first item" -command "puts \"You have selected the first item from the Left menu.\""
+$w.body.left.m add command -label "Left menu: second item" -command "puts \"You have selected the second item from the Left menu.\""
+grid $w.body.right -row 1 -column 0 -sticky w
+grid $w.body.center -row 1 -column 1 -sticky news
+grid $w.body.left -row 1 -column 2 -sticky e
+menubutton $w.body.above -text "Above" -underline 0 -direction above -menu $w.body.above.m -relief raised
+menu $w.body.above.m -tearoff 0
+$w.body.above.m add command -label "Above menu: first item" -command "puts \"You have selected the first item from the Above menu.\""
+$w.body.above.m add command -label "Above menu: second item" -command "puts \"You have selected the second item from the Above menu.\""
+grid $w.body.above -row 2 -column 1 -sticky s
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode .menubu"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+set body $w.body.center
+label $body.label -wraplength 300 -font "Helvetica 14" -justify left -text "This is a demonstration of menubuttons. The \"Below\" menubutton pops its menu below the button; the \"Right\" button pops to the right, etc. There are two option menus directly below this text; one is just a standard menu and the other is a 16-color palette."
+pack $body.label -side top -padx 25 -pady 25
+frame $body.buttons
+pack $body.buttons -padx 25 -pady 25
+tk_optionMenu $body.buttons.options menubuttonoptions one two three
+pack $body.buttons.options -side left -padx 25 -pady 25
+set m [tk_optionMenu $body.buttons.colors paletteColor Black red4 DarkGreen NavyBlue gray75 Red Green Blue gray50 Yellow Cyan Magenta White Brown DarkSeaGreen DarkViolet]
+if {$tcl_platform(platform) == "macintosh"} {
+ set topBorderColor Black
+ set bottomBorderColor Black
+} else {
+ set topBorderColor gray50
+ set bottomBorderColor gray75
+}
+for {set i 0} {$i <= [$m index last]} {incr i} {
+ set name [$m entrycget $i -label]
+ image create photo image_$name -height 16 -width 16
+ image_$name put $topBorderColor -to 0 0 16 1
+ image_$name put $topBorderColor -to 0 1 1 16
+ image_$name put $bottomBorderColor -to 0 15 16 16
+ image_$name put $bottomBorderColor -to 15 1 16 16
+ image_$name put $name -to 1 1 15 15
+
+ image create photo image_${name}_s -height 16 -width 16
+ image_${name}_s put Black -to 0 0 16 2
+ image_${name}_s put Black -to 0 2 2 16
+ image_${name}_s put Black -to 2 14 16 16
+ image_${name}_s put Black -to 14 2 16 14
+ image_${name}_s put $name -to 2 2 14 14
+
+ $m entryconfigure $i -image image_$name -selectimage image_${name}_s -hidemargin 1
+}
+$m configure -tearoff 1
+foreach i {Black gray75 gray50 White} {
+ $m entryconfigure $i -columnbreak 1
+}
+
+pack $body.buttons.colors -side left -padx 25 -pady 25
+
+
+
demos/menubu.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: scale.tcl
===================================================================
--- scale.tcl (nonexistent)
+++ scale.tcl (revision 1765)
@@ -0,0 +1,265 @@
+# scale.tcl --
+#
+# This file defines the default bindings for Tk scale widgets and provides
+# procedures that help in implementing the bindings.
+#
+# SCCS: @(#) scale.tcl 1.12 96/04/16 11:42:25
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for entries.
+#-------------------------------------------------------------------------
+
+# Standard Motif bindings:
+
+bind Scale {
+ if {$tk_strictMotif} {
+ set tkPriv(activeBg) [%W cget -activebackground]
+ %W config -activebackground [%W cget -background]
+ }
+ tkScaleActivate %W %x %y
+}
+bind Scale {
+ tkScaleActivate %W %x %y
+}
+bind Scale {
+ if {$tk_strictMotif} {
+ %W config -activebackground $tkPriv(activeBg)
+ }
+ if {[%W cget -state] == "active"} {
+ %W configure -state normal
+ }
+}
+bind Scale <1> {
+ tkScaleButtonDown %W %x %y
+}
+bind Scale {
+ tkScaleDrag %W %x %y
+}
+bind Scale { }
+bind Scale { }
+bind Scale {
+ tkCancelRepeat
+ tkScaleEndDrag %W
+ tkScaleActivate %W %x %y
+}
+bind Scale <2> {
+ tkScaleButton2Down %W %x %y
+}
+bind Scale {
+ tkScaleDrag %W %x %y
+}
+bind Scale { }
+bind Scale { }
+bind Scale {
+ tkCancelRepeat
+ tkScaleEndDrag %W
+ tkScaleActivate %W %x %y
+}
+bind Scale {
+ tkScaleControlPress %W %x %y
+}
+bind Scale {
+ tkScaleIncrement %W up little noRepeat
+}
+bind Scale {
+ tkScaleIncrement %W down little noRepeat
+}
+bind Scale {
+ tkScaleIncrement %W up little noRepeat
+}
+bind Scale {
+ tkScaleIncrement %W down little noRepeat
+}
+bind Scale {
+ tkScaleIncrement %W up big noRepeat
+}
+bind Scale {
+ tkScaleIncrement %W down big noRepeat
+}
+bind Scale {
+ tkScaleIncrement %W up big noRepeat
+}
+bind Scale {
+ tkScaleIncrement %W down big noRepeat
+}
+bind Scale {
+ %W set [%W cget -from]
+}
+bind Scale {
+ %W set [%W cget -to]
+}
+
+# tkScaleActivate --
+# This procedure is invoked to check a given x-y position in the
+# scale and activate the slider if the x-y position falls within
+# the slider.
+#
+# Arguments:
+# w - The scale widget.
+# x, y - Mouse coordinates.
+
+proc tkScaleActivate {w x y} {
+ global tkPriv
+ if {[$w cget -state] == "disabled"} {
+ return;
+ }
+ if {[$w identify $x $y] == "slider"} {
+ $w configure -state active
+ } else {
+ $w configure -state normal
+ }
+}
+
+# tkScaleButtonDown --
+# This procedure is invoked when a button is pressed in a scale. It
+# takes different actions depending on where the button was pressed.
+#
+# Arguments:
+# w - The scale widget.
+# x, y - Mouse coordinates of button press.
+
+proc tkScaleButtonDown {w x y} {
+ global tkPriv
+ set tkPriv(dragging) 0
+ set el [$w identify $x $y]
+ if {$el == "trough1"} {
+ tkScaleIncrement $w up little initial
+ } elseif {$el == "trough2"} {
+ tkScaleIncrement $w down little initial
+ } elseif {$el == "slider"} {
+ set tkPriv(dragging) 1
+ set tkPriv(initValue) [$w get]
+ set coords [$w coords]
+ set tkPriv(deltaX) [expr {$x - [lindex $coords 0]}]
+ set tkPriv(deltaY) [expr {$y - [lindex $coords 1]}]
+ $w configure -sliderrelief sunken
+ }
+}
+
+# tkScaleDrag --
+# This procedure is called when the mouse is dragged with
+# mouse button 1 down. If the drag started inside the slider
+# (i.e. the scale is active) then the scale's value is adjusted
+# to reflect the mouse's position.
+#
+# Arguments:
+# w - The scale widget.
+# x, y - Mouse coordinates.
+
+proc tkScaleDrag {w x y} {
+ global tkPriv
+ if {!$tkPriv(dragging)} {
+ return
+ }
+ $w set [$w get [expr {$x - $tkPriv(deltaX)}] \
+ [expr {$y - $tkPriv(deltaY)}]]
+}
+
+# tkScaleEndDrag --
+# This procedure is called to end an interactive drag of the
+# slider. It just marks the drag as over.
+#
+# Arguments:
+# w - The scale widget.
+
+proc tkScaleEndDrag {w} {
+ global tkPriv
+ set tkPriv(dragging) 0
+ $w configure -sliderrelief raised
+}
+
+# tkScaleIncrement --
+# This procedure is invoked to increment the value of a scale and
+# to set up auto-repeating of the action if that is desired. The
+# way the value is incremented depends on the "dir" and "big"
+# arguments.
+#
+# Arguments:
+# w - The scale widget.
+# dir - "up" means move value towards -from, "down" means
+# move towards -to.
+# big - Size of increments: "big" or "little".
+# repeat - Whether and how to auto-repeat the action: "noRepeat"
+# means don't auto-repeat, "initial" means this is the
+# first action in an auto-repeat sequence, and "again"
+# means this is the second repetition or later.
+
+proc tkScaleIncrement {w dir big repeat} {
+ global tkPriv
+ if {![winfo exists $w]} return
+ if {$big == "big"} {
+ set inc [$w cget -bigincrement]
+ if {$inc == 0} {
+ set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}]
+ }
+ if {$inc < [$w cget -resolution]} {
+ set inc [$w cget -resolution]
+ }
+ } else {
+ set inc [$w cget -resolution]
+ }
+ if {([$w cget -from] > [$w cget -to]) ^ ($dir == "up")} {
+ set inc [expr {-$inc}]
+ }
+ $w set [expr {[$w get] + $inc}]
+
+ if {$repeat == "again"} {
+ set tkPriv(afterId) [after [$w cget -repeatinterval] \
+ tkScaleIncrement $w $dir $big again]
+ } elseif {$repeat == "initial"} {
+ set delay [$w cget -repeatdelay]
+ if {$delay > 0} {
+ set tkPriv(afterId) [after $delay \
+ tkScaleIncrement $w $dir $big again]
+ }
+ }
+}
+
+# tkScaleControlPress --
+# This procedure handles button presses that are made with the Control
+# key down. Depending on the mouse position, it adjusts the scale
+# value to one end of the range or the other.
+#
+# Arguments:
+# w - The scale widget.
+# x, y - Mouse coordinates where the button was pressed.
+
+proc tkScaleControlPress {w x y} {
+ set el [$w identify $x $y]
+ if {$el == "trough1"} {
+ $w set [$w cget -from]
+ } elseif {$el == "trough2"} {
+ $w set [$w cget -to]
+ }
+}
+
+# tkScaleButton2Down
+# This procedure is invoked when button 2 is pressed over a scale.
+# It sets the value to correspond to the mouse position and starts
+# a slider drag.
+#
+# Arguments:
+# w - The scrollbar widget.
+# x, y - Mouse coordinates within the widget.
+
+proc tkScaleButton2Down {w x y} {
+ global tkPriv
+
+ if {[$w cget -state] == "disabled"} {
+ return;
+ }
+ $w configure -state active
+ $w set [$w get $x $y]
+ set tkPriv(dragging) 1
+ set tkPriv(initValue) [$w get]
+ set coords "$x $y"
+ set tkPriv(deltaX) 0
+ set tkPriv(deltaY) 0
+}
scale.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: clrpick.tcl
===================================================================
--- clrpick.tcl (nonexistent)
+++ clrpick.tcl (revision 1765)
@@ -0,0 +1,691 @@
+# clrpick.tcl --
+#
+# Color selection dialog for platforms that do not support a
+# standard color selection dialog.
+#
+# SCCS: @(#) clrpick.tcl 1.3 96/09/05 09:59:24
+#
+# Copyright (c) 1996 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# ToDo:
+#
+# (1): Find out how many free colors are left in the colormap and
+# don't allocate too many colors.
+# (2): Implement HSV color selection.
+#
+
+# tkColorDialog --
+#
+# Create a color dialog and let the user choose a color. This function
+# should not be called directly. It is called by the tk_chooseColor
+# function when a native color selector widget does not exist
+#
+proc tkColorDialog {args} {
+ global tkPriv
+ set w .__tk__color
+ upvar #0 $w data
+
+ # The lines variables track the start and end indices of the line
+ # elements in the colorbar canvases.
+ set data(lines,red,start) 0
+ set data(lines,red,last) -1
+ set data(lines,green,start) 0
+ set data(lines,green,last) -1
+ set data(lines,blue,start) 0
+ set data(lines,blue,last) -1
+
+ # This is the actual number of lines that are drawn in each color strip.
+ # Note that the bars may be of any width.
+ # However, NUM_COLORBARS must be a number that evenly divides 256.
+ # Such as 256, 128, 64, etc.
+ set data(NUM_COLORBARS) 8
+
+ # BARS_WIDTH is the number of pixels wide the color bar portion of the
+ # canvas is. This number must be a multiple of NUM_COLORBARS
+ set data(BARS_WIDTH) 128
+
+ # PLGN_WIDTH is the number of pixels wide of the triangular selection
+ # polygon. This also results in the definition of the padding on the
+ # left and right sides which is half of PLGN_WIDTH. Make this number even.
+ set data(PLGN_HEIGHT) 10
+
+ # PLGN_HEIGHT is the height of the selection polygon and the height of the
+ # selection rectangle at the bottom of the color bar. No restrictions.
+ set data(PLGN_WIDTH) 10
+
+ tkColorDialog_Config $w $args
+ tkColorDialog_InitValues $w
+
+ if {![winfo exists $w]} {
+ toplevel $w -class tkColorDialog
+ tkColorDialog_BuildDialog $w
+ }
+ wm transient $w $data(-parent)
+
+
+ # 5. Withdraw the window, then update all the geometry information
+ # so we know how big it wants to be, then center the window in the
+ # display and de-iconify it.
+
+ wm withdraw $w
+ update idletasks
+ set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
+ - [winfo vrootx [winfo parent $w]]}]
+ set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
+ - [winfo vrooty [winfo parent $w]]}]
+ wm geom $w +$x+$y
+ wm deiconify $w
+ wm title $w $data(-title)
+
+ # 6. Set a grab and claim the focus too.
+
+ set oldFocus [focus]
+ set oldGrab [grab current $w]
+ if {$oldGrab != ""} {
+ set grabStatus [grab status $oldGrab]
+ }
+ grab $w
+ focus $data(okBtn)
+
+ # 7. Wait for the user to respond, then restore the focus and
+ # return the index of the selected button. Restore the focus
+ # before deleting the window, since otherwise the window manager
+ # may take the focus away so we can't redirect it. Finally,
+ # restore any grab that was in effect.
+
+ tkwait variable tkPriv(selectColor)
+ catch {focus $oldFocus}
+ grab release $w
+ destroy $w
+ unset data
+ if {$oldGrab != ""} {
+ if {$grabStatus == "global"} {
+ grab -global $oldGrab
+ } else {
+ grab $oldGrab
+ }
+ }
+ return $tkPriv(selectColor)
+}
+
+# tkColorDialog_InitValues --
+#
+# Get called during initialization or when user resets NUM_COLORBARS
+#
+proc tkColorDialog_InitValues {w} {
+ upvar #0 $w data
+
+ # IntensityIncr is the difference in color intensity between a colorbar
+ # and its neighbors.
+ set data(intensityIncr) [expr {256 / $data(NUM_COLORBARS)}]
+
+ # ColorbarWidth is the width of each colorbar
+ set data(colorbarWidth) \
+ [expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}]
+
+ # Indent is the width of the space at the left and right side of the
+ # colorbar. It is always half the selector polygon width, because the
+ # polygon extends into the space.
+ set data(indent) [expr {$data(PLGN_WIDTH) / 2}]
+
+ set data(colorPad) 2
+ set data(selPad) [expr {$data(PLGN_WIDTH) / 2}]
+
+ #
+ # minX is the x coordinate of the first colorbar
+ #
+ set data(minX) $data(indent)
+
+ #
+ # maxX is the x coordinate of the last colorbar
+ #
+ set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent)-1}]
+
+ #
+ # canvasWidth is the width of the entire canvas, including the indents
+ #
+ set data(canvasWidth) [expr {$data(BARS_WIDTH) + \
+ $data(PLGN_WIDTH)}]
+
+ # Set the initial color, specified by -initialcolor, or the
+ # color chosen by the user the last time.
+ set data(selection) $data(-initialcolor)
+ set data(finalColor) $data(-initialcolor)
+ set rgb [winfo rgb . $data(selection)]
+
+ set data(red,intensity) [expr {[lindex $rgb 0]/0x100}]
+ set data(green,intensity) [expr {[lindex $rgb 1]/0x100}]
+ set data(blue,intensity) [expr {[lindex $rgb 2]/0x100}]
+}
+
+# tkColorDialog_Config --
+#
+# Parses the command line arguments to tk_chooseColor
+#
+proc tkColorDialog_Config {w argList} {
+ global tkPriv
+ upvar #0 $w data
+
+ # 1: the configuration specs
+ #
+ set specs {
+ {-initialcolor "" "" ""}
+ {-parent "" "" "."}
+ {-title "" "" "Color"}
+ }
+
+ # 2: parse the arguments
+ #
+ tclParseConfigSpec $w $specs "" $argList
+
+ if {![string compare $data(-title) ""]} {
+ set data(-title) " "
+ }
+ if {![string compare $data(-initialcolor) ""]} {
+ if {[info exists tkPriv(selectColor)] && \
+ [string compare $tkPriv(selectColor) ""]} {
+ set data(-initialcolor) $tkPriv(selectColor)
+ } else {
+ set data(-initialcolor) [. cget -background]
+ }
+ } else {
+ if {[catch {winfo rgb . $data(-initialcolor)} err]} {
+ error $err
+ }
+ }
+
+ if {![winfo exists $data(-parent)]} {
+ error "bad window path name \"$data(-parent)\""
+ }
+}
+
+# tkColorDialog_BuildDialog --
+#
+# Build the dialog.
+#
+proc tkColorDialog_BuildDialog {w} {
+ upvar #0 $w data
+
+ # TopFrame contains the color strips and the color selection
+ #
+ set topFrame [frame $w.top -relief raised -bd 1]
+
+ # StripsFrame contains the colorstrips and the individual RGB entries
+ set stripsFrame [frame $topFrame.colorStrip]
+
+ foreach c { Red Green Blue } {
+ set color [string tolower $c]
+
+ # each f frame contains an [R|G|B] entry and the equiv. color strip.
+ set f [frame $stripsFrame.$color]
+
+ # The box frame contains the label and entry widget for an [R|G|B]
+ set box [frame $f.box]
+
+ label $box.label -text $c: -width 6 -under 0 -anchor ne
+ entry $box.entry -textvariable [format %s $w]($color,intensity) \
+ -width 4
+ pack $box.label -side left -fill y -padx 2 -pady 3
+ pack $box.entry -side left -anchor n -pady 0
+ pack $box -side left -fill both
+
+ set height [expr \
+ {[winfo reqheight $box.entry] - \
+ 2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])}]
+
+ canvas $f.color -height $height\
+ -width $data(BARS_WIDTH) -relief sunken -bd 2
+ canvas $f.sel -height $data(PLGN_HEIGHT) \
+ -width $data(canvasWidth) -highlightthickness 0
+ pack $f.color -expand yes -fill both
+ pack $f.sel -expand yes -fill both
+
+ pack $f -side top -fill x -padx 0 -pady 2
+
+ set data($color,entry) $box.entry
+ set data($color,col) $f.color
+ set data($color,sel) $f.sel
+
+ bind $data($color,col) \
+ "tkColorDialog_DrawColorScale $w $color 1"
+ bind $data($color,col) \
+ "tkColorDialog_EnterColorBar $w $color"
+ bind $data($color,col) \
+ "tkColorDialog_LeaveColorBar $w $color"
+
+ bind $data($color,sel) \
+ "tkColorDialog_EnterColorBar $w $color"
+ bind $data($color,sel) \
+ "tkColorDialog_LeaveColorBar $w $color"
+
+ bind $box.entry "tkColorDialog_HandleRGBEntry $w"
+ }
+
+ pack $stripsFrame -side left -fill both -padx 4 -pady 10
+
+ # The selFrame contains a frame that demonstrates the currently
+ # selected color
+ #
+ set selFrame [frame $topFrame.sel]
+ set lab [label $selFrame.lab -text "Selection:" -under 0 -anchor sw]
+ set ent [entry $selFrame.ent -textvariable [format %s $w](selection) \
+ -width 16]
+ set f1 [frame $selFrame.f1 -relief sunken -bd 2]
+ set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70]
+
+ pack $lab $ent -side top -fill x -padx 4 -pady 2
+ pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10
+ pack $data(finalCanvas) -expand yes -fill both
+
+ bind $ent "tkColorDialog_HandleSelEntry $w"
+
+ pack $selFrame -side left -fill none -anchor nw
+ pack $topFrame -side top -expand yes -fill both -anchor nw
+
+ # the botFrame frame contains the buttons
+ #
+ set botFrame [frame $w.bot -relief raised -bd 1]
+ button $botFrame.ok -text OK -width 8 -under 0 \
+ -command "tkColorDialog_OkCmd $w"
+ button $botFrame.cancel -text Cancel -width 8 -under 0 \
+ -command "tkColorDialog_CancelCmd $w"
+
+ set data(okBtn) $botFrame.ok
+ set data(cancelBtn) $botFrame.cancel
+
+ pack $botFrame.ok $botFrame.cancel \
+ -padx 10 -pady 10 -expand yes -side left
+ pack $botFrame -side bottom -fill x
+
+
+ # Accelerator bindings
+
+ bind $w "focus $data(red,entry)"
+ bind $w "focus $data(green,entry)"
+ bind $w "focus $data(blue,entry)"
+ bind $w "focus $ent"
+ bind $w "tkButtonInvoke $data(cancelBtn)"
+ bind $w "tkButtonInvoke $data(cancelBtn)"
+ bind $w "tkButtonInvoke $data(okBtn)"
+
+ wm protocol $w WM_DELETE_WINDOW "tkColorDialog_CancelCmd $w"
+}
+
+# tkColorDialog_SetRGBValue --
+#
+# Sets the current selection of the dialog box
+#
+proc tkColorDialog_SetRGBValue {w color} {
+ upvar #0 $w data
+
+ set data(red,intensity) [lindex $color 0]
+ set data(green,intensity) [lindex $color 1]
+ set data(blue,intensity) [lindex $color 2]
+
+ tkColorDialog_RedrawColorBars $w all
+
+ # Now compute the new x value of each colorbars pointer polygon
+ foreach color { red green blue } {
+ set x [tkColorDialog_RgbToX $w $data($color,intensity)]
+ tkColorDialog_MoveSelector $w $data($color,sel) $color $x 0
+ }
+}
+
+# tkColorDialog_XToRgb --
+#
+# Converts a screen coordinate to intensity
+#
+proc tkColorDialog_XToRgb {w x} {
+ upvar #0 $w data
+
+ return [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}]
+}
+
+# tkColorDialog_RgbToX
+#
+# Converts an intensity to screen coordinate.
+#
+proc tkColorDialog_RgbToX {w color} {
+ upvar #0 $w data
+
+ return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}]
+}
+
+
+# tkColorDialog_DrawColorScale --
+#
+# Draw color scale is called whenever the size of one of the color
+# scale canvases is changed.
+#
+proc tkColorDialog_DrawColorScale {w c {create 0}} {
+ global lines
+ upvar #0 $w data
+
+ # col: color bar canvas
+ # sel: selector canvas
+ set col $data($c,col)
+ set sel $data($c,sel)
+
+ # First handle the case that we are creating everything for the first time.
+ if {$create} {
+ # First remove all the lines that already exist.
+ if { $data(lines,$c,last) > $data(lines,$c,start)} {
+ for {set i $data(lines,$c,start)} \
+ {$i <= $data(lines,$c,last)} { incr i} {
+ $sel delete $i
+ }
+ }
+ # Delete the selector if it exists
+ if {[info exists data($c,index)]} {
+ $sel delete $data($c,index)
+ }
+
+ # Draw the selection polygons
+ tkColorDialog_CreateSelector $w $sel $c
+ $sel bind $data($c,index) \
+ "tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1"
+ $sel bind $data($c,index) \
+ "tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)"
+ $sel bind $data($c,index) \
+ "tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)"
+
+ set height [winfo height $col]
+ # Create an invisible region under the colorstrip to catch mouse clicks
+ # that aren't on the selector.
+ set data($c,clickRegion) [$sel create rectangle 0 0 \
+ $data(canvasWidth) $height -fill {} -outline {}]
+
+ bind $col \
+ "tkColorDialog_StartMove $w $sel $c %x $data(colorPad)"
+ bind $col \
+ "tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)"
+ bind $col \
+ "tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)"
+
+ $sel bind $data($c,clickRegion) \
+ "tkColorDialog_StartMove $w $sel $c %x $data(selPad)"
+ $sel bind $data($c,clickRegion) \
+ "tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)"
+ $sel bind $data($c,clickRegion) \
+ "tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)"
+ } else {
+ # l is the canvas index of the first colorbar.
+ set l $data(lines,$c,start)
+ }
+
+ # Draw the color bars.
+ set highlightW [expr \
+ {[$col cget -highlightthickness] + [$col cget -bd]}]
+ for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {
+ set intensity [expr {$i * $data(intensityIncr)}]
+ set startx [expr {$i * $data(colorbarWidth) + $highlightW}]
+ if { $c == "red" } {
+ set color [format "#%02x%02x%02x" \
+ $intensity \
+ $data(green,intensity) \
+ $data(blue,intensity)]
+ } elseif { $c == "green" } {
+ set color [format "#%02x%02x%02x" \
+ $data(red,intensity) \
+ $intensity \
+ $data(blue,intensity)]
+ } else {
+ set color [format "#%02x%02x%02x" \
+ $data(red,intensity) \
+ $data(green,intensity) \
+ $intensity]
+ }
+
+ if {$create} {
+ set index [$col create rect $startx $highlightW \
+ [expr {$startx +$data(colorbarWidth)}] \
+ [expr {[winfo height $col] + $highlightW}]\
+ -fill $color -outline $color]
+ } else {
+ $col itemconf $l -fill $color -outline $color
+ incr l
+ }
+ }
+ $sel raise $data($c,index)
+
+ if {$create} {
+ set data(lines,$c,last) $index
+ set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}]
+ }
+
+ tkColorDialog_RedrawFinalColor $w
+}
+
+# tkColorDialog_CreateSelector --
+#
+# Creates and draws the selector polygon at the position
+# $data($c,intensity).
+#
+proc tkColorDialog_CreateSelector {w sel c } {
+ upvar #0 $w data
+ set data($c,index) [$sel create polygon \
+ 0 $data(PLGN_HEIGHT) \
+ $data(PLGN_WIDTH) $data(PLGN_HEIGHT) \
+ $data(indent) 0]
+ set data($c,x) [tkColorDialog_RgbToX $w $data($c,intensity)]
+ $sel move $data($c,index) $data($c,x) 0
+}
+
+# tkColorDialog_RedrawFinalColor
+#
+# Combines the intensities of the three colors into the final color
+#
+proc tkColorDialog_RedrawFinalColor {w} {
+ upvar #0 $w data
+
+ set color [format "#%02x%02x%02x" $data(red,intensity) \
+ $data(green,intensity) $data(blue,intensity)]
+
+ $data(finalCanvas) conf -bg $color
+ set data(finalColor) $color
+ set data(selection) $color
+ set data(finalRGB) [list \
+ $data(red,intensity) \
+ $data(green,intensity) \
+ $data(blue,intensity)]
+}
+
+# tkColorDialog_RedrawColorBars --
+#
+# Only redraws the colors on the color strips that were not manipulated.
+# Params: color of colorstrip that changed. If color is not [red|green|blue]
+# Then all colorstrips will be updated
+#
+proc tkColorDialog_RedrawColorBars {w colorChanged} {
+ upvar #0 $w data
+
+ switch $colorChanged {
+ red {
+ tkColorDialog_DrawColorScale $w green
+ tkColorDialog_DrawColorScale $w blue
+ }
+ green {
+ tkColorDialog_DrawColorScale $w red
+ tkColorDialog_DrawColorScale $w blue
+ }
+ blue {
+ tkColorDialog_DrawColorScale $w red
+ tkColorDialog_DrawColorScale $w green
+ }
+ default {
+ tkColorDialog_DrawColorScale $w red
+ tkColorDialog_DrawColorScale $w green
+ tkColorDialog_DrawColorScale $w blue
+ }
+ }
+ tkColorDialog_RedrawFinalColor $w
+}
+
+#----------------------------------------------------------------------
+# Event handlers
+#----------------------------------------------------------------------
+
+# tkColorDialog_StartMove --
+#
+# Handles a mousedown button event over the selector polygon.
+# Adds the bindings for moving the mouse while the button is
+# pressed. Sets the binding for the button-release event.
+#
+# Params: sel is the selector canvas window, color is the color of the strip.
+#
+proc tkColorDialog_StartMove {w sel color x delta {dontMove 0}} {
+ upvar #0 $w data
+
+ if {!$dontMove} {
+ tkColorDialog_MoveSelector $w $sel $color $x $delta
+ }
+}
+
+# tkColorDialog_MoveSelector --
+#
+# Moves the polygon selector so that its middle point has the same
+# x value as the specified x. If x is outside the bounds [0,255],
+# the selector is set to the closest endpoint.
+#
+# Params: sel is the selector canvas, c is [red|green|blue]
+# x is a x-coordinate.
+#
+proc tkColorDialog_MoveSelector {w sel color x delta} {
+ upvar #0 $w data
+
+ incr x -$delta
+
+ if { $x < 0 } {
+ set x 0
+ } elseif { $x >= $data(BARS_WIDTH)} {
+ set x [expr {$data(BARS_WIDTH) - 1}]
+ }
+ set diff [expr {$x - $data($color,x)}]
+ $sel move $data($color,index) $diff 0
+ set data($color,x) [expr {$data($color,x) + $diff}]
+
+ # Return the x value that it was actually set at
+ return $x
+}
+
+# tkColorDialog_ReleaseMouse
+#
+# Removes mouse tracking bindings, updates the colorbars.
+#
+# Params: sel is the selector canvas, color is the color of the strip,
+# x is the x-coord of the mouse.
+#
+proc tkColorDialog_ReleaseMouse {w sel color x delta} {
+ upvar #0 $w data
+
+ set x [tkColorDialog_MoveSelector $w $sel $color $x $delta]
+
+ # Determine exactly what color we are looking at.
+ set data($color,intensity) [tkColorDialog_XToRgb $w $x]
+
+ tkColorDialog_RedrawColorBars $w $color
+}
+
+# tkColorDialog_ResizeColorbars --
+#
+# Completely redraws the colorbars, including resizing the
+# colorstrips
+#
+proc tkColorDialog_ResizeColorBars {w} {
+ upvar #0 $w data
+
+ if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) ||
+ (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} {
+ set data(BARS_WIDTH) $data(NUM_COLORBARS)
+ }
+ tkColorDialog_InitValues $w
+ foreach color { red green blue } {
+ $data($color,col) conf -width $data(canvasWidth)
+ tkColorDialog_DrawColorScale $w $color 1
+ }
+}
+
+# tkColorDialog_HandleSelEntry --
+#
+# Handles the return keypress event in the "Selection:" entry
+#
+proc tkColorDialog_HandleSelEntry {w} {
+ upvar #0 $w data
+
+ set text [string trim $data(selection)]
+ # Check to make sure that the color is valid
+ if {[catch {set color [winfo rgb . $text]} ]} {
+ set data(selection) $data(finalColor)
+ return
+ }
+
+ set R [expr {[lindex $color 0]/0x100}]
+ set G [expr {[lindex $color 1]/0x100}]
+ set B [expr {[lindex $color 2]/0x100}]
+
+ tkColorDialog_SetRGBValue $w "$R $G $B"
+ set data(selection) $text
+}
+
+# tkColorDialog_HandleRGBEntry --
+#
+# Handles the return keypress event in the R, G or B entry
+#
+proc tkColorDialog_HandleRGBEntry {w} {
+ upvar #0 $w data
+
+ foreach c {red green blue} {
+ if {[catch {
+ set data($c,intensity) [expr {int($data($c,intensity))}]
+ }]} {
+ set data($c,intensity) 0
+ }
+
+ if {$data($c,intensity) < 0} {
+ set data($c,intensity) 0
+ }
+ if {$data($c,intensity) > 255} {
+ set data($c,intensity) 255
+ }
+ }
+
+ tkColorDialog_SetRGBValue $w "$data(red,intensity) $data(green,intensity) \
+ $data(blue,intensity)"
+}
+
+# mouse cursor enters a color bar
+#
+proc tkColorDialog_EnterColorBar {w color} {
+ upvar #0 $w data
+
+ $data($color,sel) itemconfig $data($color,index) -fill red
+}
+
+# mouse leaves enters a color bar
+#
+proc tkColorDialog_LeaveColorBar {w color} {
+ upvar #0 $w data
+
+ $data($color,sel) itemconfig $data($color,index) -fill black
+}
+
+# user hits OK button
+#
+proc tkColorDialog_OkCmd {w} {
+ global tkPriv
+ upvar #0 $w data
+
+ set tkPriv(selectColor) $data(finalColor)
+}
+
+# user hits Cancel button
+#
+proc tkColorDialog_CancelCmd {w} {
+ global tkPriv
+
+ set tkPriv(selectColor) ""
+}
+
clrpick.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: optMenu.tcl
===================================================================
--- optMenu.tcl (nonexistent)
+++ optMenu.tcl (revision 1765)
@@ -0,0 +1,45 @@
+# optMenu.tcl --
+#
+# This file defines the procedure tk_optionMenu, which creates
+# an option button and its associated menu.
+#
+# SCCS: @(#) optMenu.tcl 1.11 97/08/22 14:21:13
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+# tk_optionMenu --
+# This procedure creates an option button named $w and an associated
+# menu. Together they provide the functionality of Motif option menus:
+# they can be used to select one of many values, and the current value
+# appears in the global variable varName, as well as in the text of
+# the option menubutton. The name of the menu is returned as the
+# procedure's result, so that the caller can use it to change configuration
+# options on the menu or otherwise manipulate it.
+#
+# Arguments:
+# w - The name to use for the menubutton.
+# varName - Global variable to hold the currently selected value.
+# firstValue - First of legal values for option (must be >= 1).
+# args - Any number of additional values.
+
+proc tk_optionMenu {w varName firstValue args} {
+ upvar #0 $varName var
+
+ if {![info exists var]} {
+ set var $firstValue
+ }
+ menubutton $w -textvariable $varName -indicatoron 1 -menu $w.menu \
+ -relief raised -bd 2 -highlightthickness 2 -anchor c \
+ -direction flush
+ menu $w.menu -tearoff 0
+ $w.menu add radiobutton -label $firstValue -variable $varName
+ foreach i $args {
+ $w.menu add radiobutton -label $i -variable $varName
+ }
+ return $w.menu
+}
optMenu.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: scrlbar.tcl
===================================================================
--- scrlbar.tcl (nonexistent)
+++ scrlbar.tcl (revision 1765)
@@ -0,0 +1,417 @@
+# scrlbar.tcl --
+#
+# This file defines the default bindings for Tk scrollbar widgets.
+# It also provides procedures that help in implementing the bindings.
+#
+# SCCS: @(#) scrlbar.tcl 1.26 96/11/30 17:19:16
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for scrollbars.
+#-------------------------------------------------------------------------
+
+# Standard Motif bindings:
+if {($tcl_platform(platform) != "windows") &&
+ ($tcl_platform(platform) != "macintosh")} {
+bind Scrollbar {
+ if {$tk_strictMotif} {
+ set tkPriv(activeBg) [%W cget -activebackground]
+ %W config -activebackground [%W cget -background]
+ }
+ %W activate [%W identify %x %y]
+}
+bind Scrollbar {
+ %W activate [%W identify %x %y]
+}
+
+# The "info exists" command in the following binding handles the
+# situation where a Leave event occurs for a scrollbar without the Enter
+# event. This seems to happen on some systems (such as Solaris 2.4) for
+# unknown reasons.
+
+bind Scrollbar {
+ if {$tk_strictMotif && [info exists tkPriv(activeBg)]} {
+ %W config -activebackground $tkPriv(activeBg)
+ }
+ %W activate {}
+}
+bind Scrollbar <1> {
+ tkScrollButtonDown %W %x %y
+}
+bind Scrollbar {
+ tkScrollDrag %W %x %y
+}
+bind Scrollbar {
+ tkScrollDrag %W %x %y
+}
+bind Scrollbar {
+ tkScrollButtonUp %W %x %y
+}
+bind Scrollbar {
+ # Prevents binding from being invoked.
+}
+bind Scrollbar {
+ # Prevents binding from being invoked.
+}
+bind Scrollbar <2> {
+ tkScrollButton2Down %W %x %y
+}
+bind Scrollbar {
+ # Do nothing, since button 1 is already down.
+}
+bind Scrollbar {
+ # Do nothing, since button 2 is already down.
+}
+bind Scrollbar {
+ tkScrollDrag %W %x %y
+}
+bind Scrollbar {
+ tkScrollButtonUp %W %x %y
+}
+bind Scrollbar {
+ # Do nothing: B1 release will handle it.
+}
+bind Scrollbar {
+ # Do nothing: B2 release will handle it.
+}
+bind Scrollbar {
+ # Prevents binding from being invoked.
+}
+bind Scrollbar {
+ # Prevents binding from being invoked.
+}
+bind Scrollbar {
+ tkScrollTopBottom %W %x %y
+}
+bind Scrollbar {
+ tkScrollTopBottom %W %x %y
+}
+
+bind Scrollbar {
+ tkScrollByUnits %W v -1
+}
+bind Scrollbar {
+ tkScrollByUnits %W v 1
+}
+bind Scrollbar {
+ tkScrollByPages %W v -1
+}
+bind Scrollbar {
+ tkScrollByPages %W v 1
+}
+bind Scrollbar {
+ tkScrollByUnits %W h -1
+}
+bind Scrollbar {
+ tkScrollByUnits %W h 1
+}
+bind Scrollbar {
+ tkScrollByPages %W h -1
+}
+bind Scrollbar {
+ tkScrollByPages %W h 1
+}
+bind Scrollbar {
+ tkScrollByPages %W hv -1
+}
+bind Scrollbar {
+ tkScrollByPages %W hv 1
+}
+bind Scrollbar {
+ tkScrollToPos %W 0
+}
+bind Scrollbar {
+ tkScrollToPos %W 1
+}
+}
+# tkScrollButtonDown --
+# This procedure is invoked when a button is pressed in a scrollbar.
+# It changes the way the scrollbar is displayed and takes actions
+# depending on where the mouse is.
+#
+# Arguments:
+# w - The scrollbar widget.
+# x, y - Mouse coordinates.
+
+proc tkScrollButtonDown {w x y} {
+ global tkPriv
+ set tkPriv(relief) [$w cget -activerelief]
+ $w configure -activerelief sunken
+ set element [$w identify $x $y]
+ if {$element == "slider"} {
+ tkScrollStartDrag $w $x $y
+ } else {
+ tkScrollSelect $w $element initial
+ }
+}
+
+# tkScrollButtonUp --
+# This procedure is invoked when a button is released in a scrollbar.
+# It cancels scans and auto-repeats that were in progress, and restores
+# the way the active element is displayed.
+#
+# Arguments:
+# w - The scrollbar widget.
+# x, y - Mouse coordinates.
+
+proc tkScrollButtonUp {w x y} {
+ global tkPriv
+ tkCancelRepeat
+ $w configure -activerelief $tkPriv(relief)
+ tkScrollEndDrag $w $x $y
+ $w activate [$w identify $x $y]
+}
+
+# tkScrollSelect --
+# This procedure is invoked when a button is pressed over the scrollbar.
+# It invokes one of several scrolling actions depending on where in
+# the scrollbar the button was pressed.
+#
+# Arguments:
+# w - The scrollbar widget.
+# element - The element of the scrollbar that was selected, such
+# as "arrow1" or "trough2". Shouldn't be "slider".
+# repeat - Whether and how to auto-repeat the action: "noRepeat"
+# means don't auto-repeat, "initial" means this is the
+# first action in an auto-repeat sequence, and "again"
+# means this is the second repetition or later.
+
+proc tkScrollSelect {w element repeat} {
+ global tkPriv
+ if {![winfo exists $w]} return
+ if {$element == "arrow1"} {
+ tkScrollByUnits $w hv -1
+ } elseif {$element == "trough1"} {
+ tkScrollByPages $w hv -1
+ } elseif {$element == "trough2"} {
+ tkScrollByPages $w hv 1
+ } elseif {$element == "arrow2"} {
+ tkScrollByUnits $w hv 1
+ } else {
+ return
+ }
+ if {$repeat == "again"} {
+ set tkPriv(afterId) [after [$w cget -repeatinterval] \
+ tkScrollSelect $w $element again]
+ } elseif {$repeat == "initial"} {
+ set delay [$w cget -repeatdelay]
+ if {$delay > 0} {
+ set tkPriv(afterId) [after $delay tkScrollSelect $w $element again]
+ }
+ }
+}
+
+# tkScrollStartDrag --
+# This procedure is called to initiate a drag of the slider. It just
+# remembers the starting position of the mouse and slider.
+#
+# Arguments:
+# w - The scrollbar widget.
+# x, y - The mouse position at the start of the drag operation.
+
+proc tkScrollStartDrag {w x y} {
+ global tkPriv
+
+ if {[$w cget -command] == ""} {
+ return
+ }
+ set tkPriv(pressX) $x
+ set tkPriv(pressY) $y
+ set tkPriv(initValues) [$w get]
+ set iv0 [lindex $tkPriv(initValues) 0]
+ if {[llength $tkPriv(initValues)] == 2} {
+ set tkPriv(initPos) $iv0
+ } else {
+ if {$iv0 == 0} {
+ set tkPriv(initPos) 0.0
+ } else {
+ set tkPriv(initPos) [expr {(double([lindex $tkPriv(initValues) 2])) \
+ / [lindex $tkPriv(initValues) 0]}]
+ }
+ }
+}
+
+# tkScrollDrag --
+# This procedure is called for each mouse motion even when the slider
+# is being dragged. It notifies the associated widget if we're not
+# jump scrolling, and it just updates the scrollbar if we are jump
+# scrolling.
+#
+# Arguments:
+# w - The scrollbar widget.
+# x, y - The current mouse position.
+
+proc tkScrollDrag {w x y} {
+ global tkPriv
+
+ if {$tkPriv(initPos) == ""} {
+ return
+ }
+ set delta [$w delta [expr {$x - $tkPriv(pressX)}] [expr {$y - $tkPriv(pressY)}]]
+ if {[$w cget -jump]} {
+ if {[llength $tkPriv(initValues)] == 2} {
+ $w set [expr {[lindex $tkPriv(initValues) 0] + $delta}] \
+ [expr {[lindex $tkPriv(initValues) 1] + $delta}]
+ } else {
+ set delta [expr {round($delta * [lindex $tkPriv(initValues) 0])}]
+ eval $w set [lreplace $tkPriv(initValues) 2 3 \
+ [expr {[lindex $tkPriv(initValues) 2] + $delta}] \
+ [expr {[lindex $tkPriv(initValues) 3] + $delta}]]
+ }
+ } else {
+ tkScrollToPos $w [expr {$tkPriv(initPos) + $delta}]
+ }
+}
+
+# tkScrollEndDrag --
+# This procedure is called to end an interactive drag of the slider.
+# It scrolls the window if we're in jump mode, otherwise it does nothing.
+#
+# Arguments:
+# w - The scrollbar widget.
+# x, y - The mouse position at the end of the drag operation.
+
+proc tkScrollEndDrag {w x y} {
+ global tkPriv
+
+ if {$tkPriv(initPos) == ""} {
+ return
+ }
+ if {[$w cget -jump]} {
+ set delta [$w delta [expr {$x - $tkPriv(pressX)}] \
+ [expr {$y - $tkPriv(pressY)}]]
+ tkScrollToPos $w [expr {$tkPriv(initPos) + $delta}]
+ }
+ set tkPriv(initPos) ""
+}
+
+# tkScrollByUnits --
+# This procedure tells the scrollbar's associated widget to scroll up
+# or down by a given number of units. It notifies the associated widget
+# in different ways for old and new command syntaxes.
+#
+# Arguments:
+# w - The scrollbar widget.
+# orient - Which kinds of scrollbars this applies to: "h" for
+# horizontal, "v" for vertical, "hv" for both.
+# amount - How many units to scroll: typically 1 or -1.
+
+proc tkScrollByUnits {w orient amount} {
+ set cmd [$w cget -command]
+ if {($cmd == "") || ([string first \
+ [string index [$w cget -orient] 0] $orient] < 0)} {
+ return
+ }
+ set info [$w get]
+ if {[llength $info] == 2} {
+ uplevel #0 $cmd scroll $amount units
+ } else {
+ uplevel #0 $cmd [expr [lindex $info 2] + $amount]
+ }
+}
+
+# tkScrollByPages --
+# This procedure tells the scrollbar's associated widget to scroll up
+# or down by a given number of screenfuls. It notifies the associated
+# widget in different ways for old and new command syntaxes.
+#
+# Arguments:
+# w - The scrollbar widget.
+# orient - Which kinds of scrollbars this applies to: "h" for
+# horizontal, "v" for vertical, "hv" for both.
+# amount - How many screens to scroll: typically 1 or -1.
+
+proc tkScrollByPages {w orient amount} {
+ set cmd [$w cget -command]
+ if {($cmd == "") || ([string first \
+ [string index [$w cget -orient] 0] $orient] < 0)} {
+ return
+ }
+ set info [$w get]
+ if {[llength $info] == 2} {
+ uplevel #0 $cmd scroll $amount pages
+ } else {
+ uplevel #0 $cmd [expr [lindex $info 2] + $amount*([lindex $info 1] - 1)]
+ }
+}
+
+# tkScrollToPos --
+# This procedure tells the scrollbar's associated widget to scroll to
+# a particular location, given by a fraction between 0 and 1. It notifies
+# the associated widget in different ways for old and new command syntaxes.
+#
+# Arguments:
+# w - The scrollbar widget.
+# pos - A fraction between 0 and 1 indicating a desired position
+# in the document.
+
+proc tkScrollToPos {w pos} {
+ set cmd [$w cget -command]
+ if {($cmd == "")} {
+ return
+ }
+ set info [$w get]
+ if {[llength $info] == 2} {
+ uplevel #0 $cmd moveto $pos
+ } else {
+ uplevel #0 $cmd [expr round([lindex $info 0]*$pos)]
+ }
+}
+
+# tkScrollTopBottom
+# Scroll to the top or bottom of the document, depending on the mouse
+# position.
+#
+# Arguments:
+# w - The scrollbar widget.
+# x, y - Mouse coordinates within the widget.
+
+proc tkScrollTopBottom {w x y} {
+ global tkPriv
+ set element [$w identify $x $y]
+ if {[string match *1 $element]} {
+ tkScrollToPos $w 0
+ } elseif {[string match *2 $element]} {
+ tkScrollToPos $w 1
+ }
+
+ # Set tkPriv(relief), since it's needed by tkScrollButtonUp.
+
+ set tkPriv(relief) [$w cget -activerelief]
+}
+
+# tkScrollButton2Down
+# This procedure is invoked when button 2 is pressed over a scrollbar.
+# If the button is over the trough or slider, it sets the scrollbar to
+# the mouse position and starts a slider drag. Otherwise it just
+# behaves the same as button 1.
+#
+# Arguments:
+# w - The scrollbar widget.
+# x, y - Mouse coordinates within the widget.
+
+proc tkScrollButton2Down {w x y} {
+ global tkPriv
+ set element [$w identify $x $y]
+ if {($element == "arrow1") || ($element == "arrow2")} {
+ tkScrollButtonDown $w $x $y
+ return
+ }
+ tkScrollToPos $w [$w fraction $x $y]
+ set tkPriv(relief) [$w cget -activerelief]
+
+ # Need the "update idletasks" below so that the widget calls us
+ # back to reset the actual scrollbar position before we start the
+ # slider drag.
+
+ update idletasks
+ $w configure -activerelief sunken
+ $w activate slider
+ tkScrollStartDrag $w $x $y
+}
scrlbar.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: tclIndex
===================================================================
--- tclIndex (nonexistent)
+++ tclIndex (revision 1765)
@@ -0,0 +1,244 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]
+set auto_index(tkCheckRadioEnter) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]
+set auto_index(tkCheckRadioDown) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonInvoke) [list source [file join $dir button.tcl]]
+set auto_index(tkCheckRadioInvoke) [list source [file join $dir button.tcl]]
+set auto_index(tk_dialog) [list source [file join $dir dialog.tcl]]
+set auto_index(tkEntryClosestGap) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryButton1) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryMouseSelect) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryPaste) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryAutoScan) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryKeySelect) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryInsert) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryBackspace) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntrySeeInsert) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntrySetCursor) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryTranspose) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryPreviousWord) [list source [file join $dir entry.tcl]]
+set auto_index(tkListboxBeginSelect) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxMotion) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxBeginExtend) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxBeginToggle) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxAutoScan) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxUpDown) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxExtendUpDown) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxDataExtend) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxCancel) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxSelectAll) [list source [file join $dir listbox.tcl]]
+set auto_index(tkMbEnter) [list source [file join $dir menu.tcl]]
+set auto_index(tkMbLeave) [list source [file join $dir menu.tcl]]
+set auto_index(tkMbPost) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuUnpost) [list source [file join $dir menu.tcl]]
+set auto_index(tkMbMotion) [list source [file join $dir menu.tcl]]
+set auto_index(tkMbButtonUp) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuMotion) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuButtonDown) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuLeave) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuInvoke) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuEscape) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuUpArrow) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuDownArrow) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuLeftArrow) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuRightArrow) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuNextMenu) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuNextEntry) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuFind) [list source [file join $dir menu.tcl]]
+set auto_index(tkTraverseToMenu) [list source [file join $dir menu.tcl]]
+set auto_index(tkFirstMenu) [list source [file join $dir menu.tcl]]
+set auto_index(tkTraverseWithinMenu) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuFirstEntry) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuFindName) [list source [file join $dir menu.tcl]]
+set auto_index(tkPostOverPoint) [list source [file join $dir menu.tcl]]
+set auto_index(tkSaveGrabInfo) [list source [file join $dir menu.tcl]]
+set auto_index(tkRestoreOldGrab) [list source [file join $dir menu.tcl]]
+set auto_index(tk_menuSetFocus) [list source [file join $dir menu.tcl]]
+set auto_index(tkGenerateMenuSelect) [list source [file join $dir menu.tcl]]
+set auto_index(tk_popup) [list source [file join $dir menu.tcl]]
+set auto_index(tkScrollButtonDown) [list source [file join $dir scrlbar.tcl]]
+set auto_index(tkScrollButtonUp) [list source [file join $dir scrlbar.tcl]]
+set auto_index(tkScrollSelect) [list source [file join $dir scrlbar.tcl]]
+set auto_index(tkScrollStartDrag) [list source [file join $dir scrlbar.tcl]]
+set auto_index(tkScrollDrag) [list source [file join $dir scrlbar.tcl]]
+set auto_index(tkScrollEndDrag) [list source [file join $dir scrlbar.tcl]]
+set auto_index(tkScrollByUnits) [list source [file join $dir scrlbar.tcl]]
+set auto_index(tkScrollByPages) [list source [file join $dir scrlbar.tcl]]
+set auto_index(tkScrollToPos) [list source [file join $dir scrlbar.tcl]]
+set auto_index(tkScrollTopBottom) [list source [file join $dir scrlbar.tcl]]
+set auto_index(tkScrollButton2Down) [list source [file join $dir scrlbar.tcl]]
+set auto_index(tkTextClosestGap) [list source [file join $dir text.tcl]]
+set auto_index(tkTextButton1) [list source [file join $dir text.tcl]]
+set auto_index(tkTextSelectTo) [list source [file join $dir text.tcl]]
+set auto_index(tkTextKeyExtend) [list source [file join $dir text.tcl]]
+set auto_index(tkTextPaste) [list source [file join $dir text.tcl]]
+set auto_index(tkTextAutoScan) [list source [file join $dir text.tcl]]
+set auto_index(tkTextSetCursor) [list source [file join $dir text.tcl]]
+set auto_index(tkTextKeySelect) [list source [file join $dir text.tcl]]
+set auto_index(tkTextResetAnchor) [list source [file join $dir text.tcl]]
+set auto_index(tkTextInsert) [list source [file join $dir text.tcl]]
+set auto_index(tkTextUpDownLine) [list source [file join $dir text.tcl]]
+set auto_index(tkTextPrevPara) [list source [file join $dir text.tcl]]
+set auto_index(tkTextNextPara) [list source [file join $dir text.tcl]]
+set auto_index(tkTextScrollPages) [list source [file join $dir text.tcl]]
+set auto_index(tkTextTranspose) [list source [file join $dir text.tcl]]
+set auto_index(tk_textCopy) [list source [file join $dir text.tcl]]
+set auto_index(tk_textCut) [list source [file join $dir text.tcl]]
+set auto_index(tk_textPaste) [list source [file join $dir text.tcl]]
+set auto_index(tkTextNextPos) [list source [file join $dir text.tcl]]
+set auto_index(tkTextPrevPos) [list source [file join $dir text.tcl]]
+set auto_index(tkScreenChanged) [list source [file join $dir tk.tcl]]
+set auto_index(tkEventMotifBindings) [list source [file join $dir tk.tcl]]
+set auto_index(tkCancelRepeat) [list source [file join $dir tk.tcl]]
+set auto_index(tkTabToWindow) [list source [file join $dir tk.tcl]]
+set auto_index(bgerror) [list source [file join $dir bgerror.tcl]]
+set auto_index(tkScaleActivate) [list source [file join $dir scale.tcl]]
+set auto_index(tkScaleButtonDown) [list source [file join $dir scale.tcl]]
+set auto_index(tkScaleDrag) [list source [file join $dir scale.tcl]]
+set auto_index(tkScaleEndDrag) [list source [file join $dir scale.tcl]]
+set auto_index(tkScaleIncrement) [list source [file join $dir scale.tcl]]
+set auto_index(tkScaleControlPress) [list source [file join $dir scale.tcl]]
+set auto_index(tkScaleButton2Down) [list source [file join $dir scale.tcl]]
+set auto_index(tk_optionMenu) [list source [file join $dir optMenu.tcl]]
+set auto_index(tkTearOffMenu) [list source [file join $dir tearoff.tcl]]
+set auto_index(tkMenuDup) [list source [file join $dir tearoff.tcl]]
+set auto_index(tk_menuBar) [list source [file join $dir obsolete.tcl]]
+set auto_index(tk_bindForTraversal) [list source [file join $dir obsolete.tcl]]
+set auto_index(tk_focusNext) [list source [file join $dir focus.tcl]]
+set auto_index(tk_focusPrev) [list source [file join $dir focus.tcl]]
+set auto_index(tkFocusOK) [list source [file join $dir focus.tcl]]
+set auto_index(tk_focusFollowsMouse) [list source [file join $dir focus.tcl]]
+set auto_index(tkConsoleInit) [list source [file join $dir console.tcl]]
+set auto_index(tkConsoleSource) [list source [file join $dir console.tcl]]
+set auto_index(tkConsoleInvoke) [list source [file join $dir console.tcl]]
+set auto_index(tkConsoleHistory) [list source [file join $dir console.tcl]]
+set auto_index(tkConsolePrompt) [list source [file join $dir console.tcl]]
+set auto_index(tkConsoleBind) [list source [file join $dir console.tcl]]
+set auto_index(tkConsoleInsert) [list source [file join $dir console.tcl]]
+set auto_index(tkConsoleOutput) [list source [file join $dir console.tcl]]
+set auto_index(tkConsoleExit) [list source [file join $dir console.tcl]]
+set auto_index(tkConsoleAbout) [list source [file join $dir console.tcl]]
+set auto_index(tk_setPalette) [list source [file join $dir palette.tcl]]
+set auto_index(tkRecolorTree) [list source [file join $dir palette.tcl]]
+set auto_index(tkDarken) [list source [file join $dir palette.tcl]]
+set auto_index(tk_bisque) [list source [file join $dir palette.tcl]]
+set auto_index(tkColorDialog) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_InitValues) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_Config) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_BuildDialog) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_SetRGBValue) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_XToRgb) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_RgbToX) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_DrawColorScale) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_CreateSelector) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_RedrawFinalColor) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_RedrawColorBars) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_StartMove) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_MoveSelector) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_ReleaseMouse) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_ResizeColorBars) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_HandleSelEntry) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_HandleRGBEntry) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_EnterColorBar) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_LeaveColorBar) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_OkCmd) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_CancelCmd) [list source [file join $dir clrpick.tcl]]
+set auto_index(tclParseConfigSpec) [list source [file join $dir comdlg.tcl]]
+set auto_index(tclListValidFlags) [list source [file join $dir comdlg.tcl]]
+set auto_index(tclSortNoCase) [list source [file join $dir comdlg.tcl]]
+set auto_index(tclVerifyInteger) [list source [file join $dir comdlg.tcl]]
+set auto_index(tkFocusGroup_Create) [list source [file join $dir comdlg.tcl]]
+set auto_index(tkFocusGroup_BindIn) [list source [file join $dir comdlg.tcl]]
+set auto_index(tkFocusGroup_BindOut) [list source [file join $dir comdlg.tcl]]
+set auto_index(tkFocusGroup_Destroy) [list source [file join $dir comdlg.tcl]]
+set auto_index(tkFocusGroup_In) [list source [file join $dir comdlg.tcl]]
+set auto_index(tkFocusGroup_Out) [list source [file join $dir comdlg.tcl]]
+set auto_index(tkFDGetFileTypes) [list source [file join $dir comdlg.tcl]]
+set auto_index(::safe::loadTk) [list source [file join $dir safetk.tcl]]
+set auto_index(::safe::TkInit) [list source [file join $dir safetk.tcl]]
+set auto_index(::safe::allowTk) [list source [file join $dir safetk.tcl]]
+set auto_index(::safe::tkTopLevel) [list source [file join $dir safetk.tcl]]
+set auto_index(tkMessageBox) [list source [file join $dir msgbox.tcl]]
+set auto_index(tkIconList) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Config) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Create) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_AutoScan) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_DeleteAll) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Add) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Arrange) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Invoke) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_See) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_SelectAtXY) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Select) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Unselect) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Get) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Btn1) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Motion1) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Double1) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_ReturnKey) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Leave1) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_FocusIn) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_UpDown) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_LeftRight) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_KeyPress) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Goto) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Reset) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_Config) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_Create) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_UpdateWhenIdle) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_Update) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_SetPathSilently) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_SetPath) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_SetFilter) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialogResolveFile) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_EntFocusIn) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_EntFocusOut) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_ActivateEnt) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_InvokeBtn) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_UpDirCmd) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_JoinFile) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_OkCmd) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_CancelCmd) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_ListBrowse) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_ListInvoke) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_Done) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkMotifFDialog) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_Config) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_Create) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_MakeSList) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_BrowseDList) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_ActivateDList) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_BrowseFList) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_ActivateFList) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_ActivateFEnt) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_InterpFilter) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_ActivateSEnt) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_OkCmd) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_FilterCmd) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_CancelCmd) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_Update) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_LoadFiles) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkListBoxKeyAccel_Set) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkListBoxKeyAccel_Unset) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkListBoxKeyAccel_Key) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkListBoxKeyAccel_Goto) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkListBoxKeyAccel_Reset) [list source [file join $dir xmfbox.tcl]]
tclIndex
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: license.terms
===================================================================
--- license.terms (nonexistent)
+++ license.terms (revision 1765)
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., and other parties. The following
+terms apply to all files associated with the software unless explicitly
+disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
license.terms
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: tkfbox.tcl
===================================================================
--- tkfbox.tcl (nonexistent)
+++ tkfbox.tcl (revision 1765)
@@ -0,0 +1,1665 @@
+# tkfbox.tcl --
+#
+# Implements the "TK" standard file selection dialog box. This
+# dialog box is used on the Unix platforms whenever the tk_strictMotif
+# flag is not set.
+#
+# The "TK" standard file selection dialog box is similar to the
+# file selection dialog box on Win95(TM). The user can navigate
+# the directories by clicking on the folder icons or by
+# selectinf the "Directory" option menu. The user can select
+# files by clicking on the file icons or by entering a filename
+# in the "Filename:" entry.
+#
+# SCCS: @(#) tkfbox.tcl 1.13 97/10/01 14:51:01
+#
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#----------------------------------------------------------------------
+#
+# I C O N L I S T
+#
+# This is a pseudo-widget that implements the icon list inside the
+# tkFDialog dialog box.
+#
+#----------------------------------------------------------------------
+
+# tkIconList --
+#
+# Creates an IconList widget.
+#
+proc tkIconList {w args} {
+ upvar #0 $w data
+
+ tkIconList_Config $w $args
+ tkIconList_Create $w
+}
+
+# tkIconList_Config --
+#
+# Configure the widget variables of IconList, according to the command
+# line arguments.
+#
+proc tkIconList_Config {w argList} {
+ upvar #0 $w data
+
+ # 1: the configuration specs
+ #
+ set specs {
+ {-browsecmd "" "" ""}
+ {-command "" "" ""}
+ {-multiple "" "" "0"}
+ }
+
+ # 2: parse the arguments
+ #
+ tclParseConfigSpec $w $specs "" $argList
+}
+
+# tkIconList_Create --
+#
+# Creates an IconList widget by assembling a canvas widget and a
+# scrollbar widget. Sets all the bindings necessary for the IconList's
+# operations.
+#
+proc tkIconList_Create {w} {
+ upvar #0 $w data
+
+ frame $w
+ set data(sbar) [scrollbar $w.sbar -orient horizontal \
+ -highlightthickness 0 -takefocus 0]
+ set data(canvas) [canvas $w.canvas -bd 2 -relief sunken \
+ -width 400 -height 120 -takefocus 1]
+ pack $data(sbar) -side bottom -fill x -padx 2
+ pack $data(canvas) -expand yes -fill both
+
+ $data(sbar) config -command "$data(canvas) xview"
+ $data(canvas) config -xscrollcommand "$data(sbar) set"
+
+ # Initializes the max icon/text width and height and other variables
+ #
+ set data(maxIW) 1
+ set data(maxIH) 1
+ set data(maxTW) 1
+ set data(maxTH) 1
+ set data(numItems) 0
+ set data(curItem) {}
+ set data(noScroll) 1
+
+ # Creates the event bindings.
+ #
+ bind $data(canvas) "tkIconList_Arrange $w"
+
+ bind $data(canvas) <1> "tkIconList_Btn1 $w %x %y"
+ bind $data(canvas) "tkIconList_Motion1 $w %x %y"
+ bind $data(canvas) "tkIconList_ShiftBtn1 $w %x %y"
+ bind $data(canvas) "tkIconList_Double1 $w %x %y"
+ bind $data(canvas) "tkCancelRepeat"
+ bind $data(canvas) "tkIconList_Leave1 $w %x %y"
+ bind $data(canvas) "tkCancelRepeat"
+
+ bind $data(canvas) "tkIconList_UpDown $w -1"
+ bind $data(canvas) "tkIconList_UpDown $w 1"
+ bind $data(canvas) "tkIconList_LeftRight $w -1"
+ bind $data(canvas) "tkIconList_LeftRight $w 1"
+ bind $data(canvas) "tkIconList_ReturnKey $w"
+ bind $data(canvas) "tkIconList_KeyPress $w %A"
+ bind $data(canvas) ";"
+ bind $data(canvas) ";"
+
+ bind $data(canvas) "tkIconList_FocusIn $w"
+
+ return $w
+}
+
+# tkIconList_AutoScan --
+#
+# This procedure is invoked when the mouse leaves an entry window
+# with button 1 down. It scrolls the window up, down, left, or
+# right, depending on where the mouse left the window, and reschedules
+# itself as an "after" command so that the window continues to scroll until
+# the mouse moves back into the window or the mouse button is released.
+#
+# Arguments:
+# w - The IconList window.
+#
+proc tkIconList_AutoScan {w} {
+ upvar #0 $w data
+ global tkPriv
+
+ if {![winfo exists $w]} return
+ set x $tkPriv(x)
+ set y $tkPriv(y)
+
+ if {$data(noScroll)} {
+ return
+ }
+ if {$x >= [winfo width $data(canvas)]} {
+ $data(canvas) xview scroll 1 units
+ } elseif {$x < 0} {
+ $data(canvas) xview scroll -1 units
+ } elseif {$y >= [winfo height $data(canvas)]} {
+ # do nothing
+ } elseif {$y < 0} {
+ # do nothing
+ } else {
+ return
+ }
+
+ tkIconList_Motion1 $w $x $y
+ set tkPriv(afterId) [after 50 tkIconList_AutoScan $w]
+}
+
+# Deletes all the items inside the canvas subwidget and reset the IconList's
+# state.
+#
+proc tkIconList_DeleteAll {w} {
+ upvar #0 $w data
+ upvar #0 $w:itemList itemList
+
+ $data(canvas) delete all
+ catch {unset data(selected)}
+ catch {unset data(rect)}
+ catch {unset data(list)}
+ catch {unset itemList}
+ set data(maxIW) 1
+ set data(maxIH) 1
+ set data(maxTW) 1
+ set data(maxTH) 1
+ set data(numItems) 0
+ set data(curItem) {}
+ set data(noScroll) 1
+ $data(sbar) set 0.0 1.0
+ $data(canvas) xview moveto 0
+}
+
+# Adds an icon into the IconList with the designated image and text
+#
+proc tkIconList_Add {w image text} {
+ upvar #0 $w data
+ upvar #0 $w:itemList itemList
+ upvar #0 $w:textList textList
+
+ set iTag [$data(canvas) create image 0 0 -image $image -anchor nw]
+ set tTag [$data(canvas) create text 0 0 -text $text -anchor nw \
+ -font $data(font)]
+ set rTag [$data(canvas) create rect 0 0 0 0 -fill "" -outline ""]
+
+ set b [$data(canvas) bbox $iTag]
+ set iW [expr {[lindex $b 2]-[lindex $b 0]}]
+ set iH [expr {[lindex $b 3]-[lindex $b 1]}]
+ if {$data(maxIW) < $iW} {
+ set data(maxIW) $iW
+ }
+ if {$data(maxIH) < $iH} {
+ set data(maxIH) $iH
+ }
+
+ set b [$data(canvas) bbox $tTag]
+ set tW [expr {[lindex $b 2]-[lindex $b 0]}]
+ set tH [expr {[lindex $b 3]-[lindex $b 1]}]
+ if {$data(maxTW) < $tW} {
+ set data(maxTW) $tW
+ }
+ if {$data(maxTH) < $tH} {
+ set data(maxTH) $tH
+ }
+
+ lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW $tH $data(numItems)]
+ set itemList($rTag) [list $iTag $tTag $text $data(numItems)]
+ set textList($data(numItems)) [string tolower $text]
+ incr data(numItems)
+}
+
+# Places the icons in a column-major arrangement.
+#
+proc tkIconList_Arrange {w} {
+ upvar #0 $w data
+
+ if {![info exists data(list)]} {
+ if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {
+ set data(noScroll) 1
+ $data(sbar) config -command ""
+ }
+ return
+ }
+
+ set W [winfo width $data(canvas)]
+ set H [winfo height $data(canvas)]
+ set pad [expr {[$data(canvas) cget -highlightthickness] + \
+ [$data(canvas) cget -bd]}]
+ if {$pad < 2} {
+ set pad 2
+ }
+
+ incr W -[expr {$pad*2}]
+ incr H -[expr {$pad*2}]
+
+ set dx [expr {$data(maxIW) + $data(maxTW) + 8}]
+ if {$data(maxTH) > $data(maxIH)} {
+ set dy $data(maxTH)
+ } else {
+ set dy $data(maxIH)
+ }
+ incr dy 2
+ set shift [expr {$data(maxIW) + 4}]
+
+ set x [expr {$pad * 2}]
+ set y [expr {$pad * 1}] ; # Why * 1 ?
+ set usedColumn 0
+ foreach sublist $data(list) {
+ set usedColumn 1
+ set iTag [lindex $sublist 0]
+ set tTag [lindex $sublist 1]
+ set rTag [lindex $sublist 2]
+ set iW [lindex $sublist 3]
+ set iH [lindex $sublist 4]
+ set tW [lindex $sublist 5]
+ set tH [lindex $sublist 6]
+
+ set i_dy [expr {($dy - $iH)/2}]
+ set t_dy [expr {($dy - $tH)/2}]
+
+ $data(canvas) coords $iTag $x [expr {$y + $i_dy}]
+ $data(canvas) coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}]
+ $data(canvas) coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}]
+ $data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]
+
+ incr y $dy
+ if {($y + $dy) > $H} {
+ set y [expr {$pad * 1}] ; # *1 ?
+ incr x $dx
+ set usedColumn 0
+ }
+ }
+
+ if {$usedColumn} {
+ set sW [expr {$x + $dx}]
+ } else {
+ set sW $x
+ }
+
+ if {$sW < $W} {
+ $data(canvas) config -scrollregion "$pad $pad $sW $H"
+ $data(sbar) config -command ""
+ $data(canvas) xview moveto 0
+ set data(noScroll) 1
+ } else {
+ $data(canvas) config -scrollregion "$pad $pad $sW $H"
+ $data(sbar) config -command "$data(canvas) xview"
+ set data(noScroll) 0
+ }
+
+ set data(itemsPerColumn) [expr {($H-$pad)/$dy}]
+ if {$data(itemsPerColumn) < 1} {
+ set data(itemsPerColumn) 1
+ }
+
+ if {$data(curItem) != {}} {
+ tkIconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 0
+ }
+}
+
+# Gets called when the user invokes the IconList (usually by double-clicking
+# or pressing the Return key).
+#
+proc tkIconList_Invoke {w} {
+ upvar #0 $w data
+
+ if {[string compare $data(-command) ""] && [info exists data(selected)]} {
+ eval $data(-command) [list $data(selected)]
+ }
+}
+
+# tkIconList_See --
+#
+# If the item is not (completely) visible, scroll the canvas so that
+# it becomes visible.
+proc tkIconList_See {w rTag} {
+ upvar #0 $w data
+ upvar #0 $w:itemList itemList
+
+ if {$data(noScroll)} {
+ return
+ }
+ set sRegion [$data(canvas) cget -scrollregion]
+ if {![string compare $sRegion {}]} {
+ return
+ }
+
+ if {![info exists itemList($rTag)]} {
+ return
+ }
+
+
+ set bbox [$data(canvas) bbox $rTag]
+ set pad [expr {[$data(canvas) cget -highlightthickness] + \
+ [$data(canvas) cget -bd]}]
+
+ set x1 [lindex $bbox 0]
+ set x2 [lindex $bbox 2]
+ incr x1 -[expr {$pad * 2}]
+ incr x2 -[expr {$pad * 1}] ; # *1 ?
+
+ set cW [expr {[winfo width $data(canvas)] - $pad*2}]
+
+ set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]
+ set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}]
+ set oldDispX $dispX
+
+ # check if out of the right edge
+ #
+ if {($x2 - $dispX) >= $cW} {
+ set dispX [expr {$x2 - $cW}]
+ }
+ # check if out of the left edge
+ #
+ if {($x1 - $dispX) < 0} {
+ set dispX $x1
+ }
+
+ if {$oldDispX != $dispX} {
+ set fraction [expr {double($dispX)/double($scrollW)}]
+ $data(canvas) xview moveto $fraction
+ }
+}
+
+proc tkIconList_SelectAtXY {w x y} {
+ upvar #0 $w data
+
+ tkIconList_Select $w [$data(canvas) find closest \
+ [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
+}
+
+proc tkIconList_AddSelectAtXY {w x y {no_delete 0}} {
+ upvar #0 $w data
+
+ if {$data(-multiple) && [info exists data(selected)]} {
+ tkIconList_AddSelect $w [$data(canvas) find closest \
+ [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]] \
+ 1 $no_delete
+ return
+ }
+ tkIconList_SelectAtXY $w $x $y
+}
+
+proc tkIconList_Select {w rTag {callBrowse 1}} {
+ upvar #0 $w data
+ upvar #0 $w:itemList itemList
+
+ if {![info exists itemList($rTag)]} {
+ return
+ }
+ set iTag [lindex $itemList($rTag) 0]
+ set tTag [lindex $itemList($rTag) 1]
+ set text [lindex $itemList($rTag) 2]
+ set serial [lindex $itemList($rTag) 3]
+
+ if {$data(-multiple) && [info exists data(rect)]} {
+ foreach r $data(rect) {
+ $data(canvas) delete $r
+ }
+ unset data(rect)
+ }
+ if ![info exists data(rect)] {
+
+ set data(rect) [$data(canvas) create rect 0 0 0 0 \
+ -fill #a0a0ff -outline #a0a0ff]
+ }
+ $data(canvas) lower $data(rect)
+ set bbox [$data(canvas) bbox $tTag]
+ eval $data(canvas) coords $data(rect) $bbox
+
+ set data(curItem) $serial
+
+ #we can't set the text to data(selected) as text, this is bugy,
+ #when the path contains blanks
+ if {$data(-multiple)} {
+ catch {unset data(selected)}
+ lappend data(selected) $text
+ } else {
+ set data(selected) $text
+ }
+
+ if {$callBrowse} {
+ if [string compare $data(-browsecmd) ""] {
+ eval $data(-browsecmd) [list $data(selected)]
+ }
+ }
+}
+
+proc tkIconList_AddSelect {w rTag {callBrowse 1} {no_delete 0}} {
+ upvar #0 $w data
+ upvar #0 $w:itemList itemList
+
+ if ![info exists itemList($rTag)] {
+ return
+ }
+ set iTag [lindex $itemList($rTag) 0]
+ set tTag [lindex $itemList($rTag) 1]
+ set text [lindex $itemList($rTag) 2]
+ set serial [lindex $itemList($rTag) 3]
+
+ if {[lsearch -exact $data(selected) $text] != -1} {
+ if {$no_delete} {
+ return
+ }
+
+ # we've clicked on an existing item, so we need to remove it
+ set i [lsearch -exact $data(selected) $text]
+ set data(selected) [lreplace $data(selected) $i $i]
+
+ # find the appropriate coordinates and remove the
+ # corresponding rectangle.
+ set tmpbbox [$data(canvas) bbox $tTag]
+ for {set i 0} {$i<[llength $data(rect)]} {incr i} {
+ set rectTag [lindex $data(rect) $i]
+ set testbbox [$data(canvas) coords $rectTag]
+ # test first two coordinates; if they're the same the
+ # entire box should match
+ if {[lindex $testbbox 0]==[lindex $tmpbbox 0] && \
+ [lindex $testbbox 1]==[lindex $tmpbbox 1]} {
+ $data(canvas) delete $rectTag
+ set data(rect) [lreplace $data(rect) $i $i]
+ break
+ }
+ }
+
+ if {$callBrowse} {
+ if [string compare $data(-browsecmd) ""] {
+ eval $data(-browsecmd) [list $data(selected)]
+ }
+ }
+ return
+ }
+
+ set tmprect [$data(canvas) create rect 0 0 0 0 \
+ -fill #a0a0ff -outline #a0a0ff]
+ lappend data(rect) $tmprect
+
+ $data(canvas) lower $tmprect
+ set bbox [$data(canvas) bbox $tTag]
+ eval $data(canvas) coords $tmprect $bbox
+
+ set data(curItem) $serial
+ lappend data(selected) $text
+
+ if {$callBrowse} {
+ if [string compare $data(-browsecmd) ""] {
+ eval $data(-browsecmd) [list $data(selected)]
+ }
+ }
+}
+
+proc tkIconList_Unselect {w} {
+ upvar #0 $w data
+
+ if [info exists data(rect)] {
+ foreach r $data(rect) {
+ $data(canvas) delete $r
+ }
+ unset data(rect)
+ }
+ if {[info exists data(selected)]} {
+ unset data(selected)
+ }
+ set data(curItem) {}
+}
+
+# Returns the selected item
+#
+proc tkIconList_Get {w} {
+ upvar #0 $w data
+
+ if {[info exists data(selected)]} {
+ return $data(selected)
+ } else {
+ return ""
+ }
+}
+
+
+proc tkIconList_Btn1 {w x y} {
+ upvar #0 $w data
+
+ focus $data(canvas)
+ tkIconList_SelectAtXY $w $x $y
+}
+
+proc tkIconList_ShiftBtn1 {w x y} {
+ upvar #0 $w data
+
+ focus $data(canvas)
+ tkIconList_AddSelectAtXY $w $x $y
+}
+
+# Gets called on button-1 motions
+#
+proc tkIconList_Motion1 {w x y} {
+ global tkPriv
+ set tkPriv(x) $x
+ set tkPriv(y) $y
+
+ tkIconList_AddSelectAtXY $w $x $y 1
+}
+
+proc tkIconList_Double1 {w x y} {
+ upvar #0 $w data
+
+ if {$data(curItem) != {}} {
+ tkIconList_Invoke $w
+ }
+}
+
+proc tkIconList_ReturnKey {w} {
+ tkIconList_Invoke $w
+}
+
+proc tkIconList_Leave1 {w x y} {
+ global tkPriv
+
+ set tkPriv(x) $x
+ set tkPriv(y) $y
+ tkIconList_AutoScan $w
+}
+
+proc tkIconList_FocusIn {w} {
+ upvar #0 $w data
+
+ if {![info exists data(list)]} {
+ return
+ }
+
+ if {$data(curItem) == {}} {
+ set rTag [lindex [lindex $data(list) 0] 2]
+ tkIconList_Select $w $rTag
+ }
+}
+
+# tkIconList_UpDown --
+#
+# Moves the active element up or down by one element
+#
+# Arguments:
+# w - The IconList widget.
+# amount - +1 to move down one item, -1 to move back one item.
+#
+proc tkIconList_UpDown {w amount} {
+ upvar #0 $w data
+
+ if {![info exists data(list)]} {
+ return
+ }
+
+ if {$data(curItem) == {}} {
+ set rTag [lindex [lindex $data(list) 0] 2]
+ } else {
+ set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
+ set rTag [lindex [lindex $data(list) [expr {$data(curItem)+$amount}]] 2]
+ if {![string compare $rTag ""]} {
+ set rTag $oldRTag
+ }
+ }
+
+ if {[string compare $rTag ""]} {
+ tkIconList_Select $w $rTag
+ tkIconList_See $w $rTag
+ }
+}
+
+# tkIconList_LeftRight --
+#
+# Moves the active element left or right by one column
+#
+# Arguments:
+# w - The IconList widget.
+# amount - +1 to move right one column, -1 to move left one column.
+#
+proc tkIconList_LeftRight {w amount} {
+ upvar #0 $w data
+
+ if {![info exists data(list)]} {
+ return
+ }
+ if {$data(curItem) == {}} {
+ set rTag [lindex [lindex $data(list) 0] 2]
+ } else {
+ set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
+ set newItem [expr {$data(curItem)+($amount*$data(itemsPerColumn))}]
+ set rTag [lindex [lindex $data(list) $newItem] 2]
+ if {![string compare $rTag ""]} {
+ set rTag $oldRTag
+ }
+ }
+
+ if {[string compare $rTag ""]} {
+ tkIconList_Select $w $rTag
+ tkIconList_See $w $rTag
+ }
+}
+
+#----------------------------------------------------------------------
+# Accelerator key bindings
+#----------------------------------------------------------------------
+
+# tkIconList_KeyPress --
+#
+# Gets called when user enters an arbitrary key in the listbox.
+#
+proc tkIconList_KeyPress {w key} {
+ global tkPriv
+
+ append tkPriv(ILAccel,$w) $key
+ tkIconList_Goto $w $tkPriv(ILAccel,$w)
+ catch {
+ after cancel $tkPriv(ILAccel,$w,afterId)
+ }
+ set tkPriv(ILAccel,$w,afterId) [after 500 tkIconList_Reset $w]
+}
+
+proc tkIconList_Goto {w text} {
+ upvar #0 $w data
+ upvar #0 $w:textList textList
+ global tkPriv
+
+ if {![info exists data(list)]} {
+ return
+ }
+
+ if {[string length $text] == 0} {
+ return
+ }
+
+ if {$data(curItem) == {} || $data(curItem) == 0} {
+ set start 0
+ } else {
+ set start $data(curItem)
+ }
+
+ set text [string tolower $text]
+ set theIndex -1
+ set less 0
+ set len [string length $text]
+ set len0 [expr {$len-1}]
+ set i $start
+
+ # Search forward until we find a filename whose prefix is an exact match
+ # with $text
+ while 1 {
+ set sub [string range $textList($i) 0 $len0]
+ if {[string compare $text $sub] == 0} {
+ set theIndex $i
+ break
+ }
+ incr i
+ if {$i == $data(numItems)} {
+ set i 0
+ }
+ if {$i == $start} {
+ break
+ }
+ }
+
+ if {$theIndex > -1} {
+ set rTag [lindex [lindex $data(list) $theIndex] 2]
+ tkIconList_Select $w $rTag 0
+ tkIconList_See $w $rTag
+ }
+}
+
+proc tkIconList_Reset {w} {
+ global tkPriv
+
+ catch {unset tkPriv(ILAccel,$w)}
+}
+
+#----------------------------------------------------------------------
+#
+# F I L E D I A L O G
+#
+#----------------------------------------------------------------------
+
+# tkFDialog --
+#
+# Implements the TK file selection dialog. This dialog is used when
+# the tk_strictMotif flag is set to false. This procedure shouldn't
+# be called directly. Call tk_getOpenFile or tk_getSaveFile instead.
+#
+proc tkFDialog {args} {
+ global tkPriv
+ global __old_dialog
+ global __old_multiple
+ set w __tk_filedialog
+ upvar #0 $w data
+
+ if {![string compare [lindex [info level 0] 0] tk_getOpenFile]} {
+ set type open
+ } else {
+ set type save
+ }
+
+ tkFDialog_Config $w $type $args
+
+ if {![string compare $data(-parent) .]} {
+ set w .$w
+ } else {
+ set w $data(-parent).$w
+ }
+
+ #because tk doesn't use window-path dependent array, it is
+ #impossible to use more than one dialog box at the same time,
+ #so we have to recreate the dialog!
+ if {[info exists __old_dialog] \
+ && ($__old_dialog != $w || $__old_multiple != $data(-multiple))} {
+ catch {destroy $w}
+ catch {destroy $__old_dialog}
+ }
+ set __old_dialog $w
+ set __old_multiple $data(-multiple)
+
+ # (re)create the dialog box if necessary
+ #
+ set new_dialog 0
+ if {![winfo exists $w]} {
+ tkFDialog_Create $w
+ set new_dialog 1
+ } elseif {[string compare [winfo class $w] TkFDialog]} {
+ destroy $w
+ tkFDialog_Create $w
+ set new_dialog 1
+ } else {
+ set data(dirMenuBtn) $w.f1.menu
+ set data(dirMenu) $w.f1.menu.menu
+ set data(upBtn) $w.f1.up
+ set data(icons) $w.icons
+ set data(ent) $w.f2.ent
+ set data(typeMenuLab) $w.f3.lab
+ set data(typeMenuBtn) $w.f3.menu
+ set data(typeMenu) $data(typeMenuBtn).m
+ set data(okBtn) $w.f2.ok
+ set data(cancelBtn) $w.f3.cancel
+ }
+ wm transient $w $data(-parent)
+ #trace variable
+ trace variable data(selectPath) w "tkFDialog_SetPath $w"
+
+ # 5. Initialize the file types menu
+ #
+ if {$data(-filetypes) != {}} {
+ $data(typeMenu) delete 0 end
+ foreach type $data(-filetypes) {
+ set title [lindex $type 0]
+ set filter [lindex $type 1]
+ $data(typeMenu) add command -label $title \
+ -command [list tkFDialog_SetFilter $w $type]
+ }
+ tkFDialog_SetFilter $w [lindex $data(-filetypes) 0]
+ $data(typeMenuBtn) config -state normal
+ $data(typeMenuLab) config -state normal
+ } else {
+ set data(filter) "*"
+ $data(typeMenuBtn) config -state disabled -takefocus 0
+ $data(typeMenuLab) config -state disabled
+ }
+
+ tkFDialog_UpdateWhenIdle $w
+
+ # 6. Withdraw the window, then update all the geometry information
+ # so we know how big it wants to be, then center the window in the
+ # display and de-iconify it.
+
+ if {$new_dialog} {
+ #center dialog, when it has been new created
+ wm withdraw $w
+ update idletasks
+ set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
+ - [winfo vrootx [winfo parent $w]]}]
+ set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
+ - [winfo vrooty [winfo parent $w]]}]
+ wm geom $w [winfo reqwidth $w]x[winfo reqheight $w]+$x+$y
+ }
+ wm title $w $data(-title)
+ wm deiconify $w
+
+ # 7. Set a grab and claim the focus too.
+
+ set oldFocus [focus]
+ set oldGrab [grab current $w]
+ if {$oldGrab != ""} {
+ set grabStatus [grab status $oldGrab]
+ }
+ grab $w
+ focus $data(ent)
+ $data(ent) delete 0 end
+ $data(ent) insert 0 $data(selectFile)
+ $data(ent) select from 0
+ $data(ent) select to end
+ $data(ent) icursor end
+
+ # 8. Wait for the user to respond, then restore the focus and
+ # return the index of the selected button. Restore the focus
+ # before deleting the window, since otherwise the window manager
+ # may take the focus away so we can't redirect it. Finally,
+ # restore any grab that was in effect.
+
+ tkwait variable tkPriv(selectFilePath)
+ catch {focus $oldFocus}
+ grab release $w
+ wm withdraw $w
+ if {$oldGrab != ""} {
+ if {$grabStatus == "global"} {
+ grab -global $oldGrab
+ } else {
+ grab $oldGrab
+ }
+ }
+ #delete the tracer, because this conflicts with multiple
+ #used dialogs
+ trace vdelete data(selectPath) w "tkFDialog_SetPath $w"
+ return $tkPriv(selectFilePath)
+}
+
+# tkFDialog_Config --
+#
+# Configures the TK filedialog according to the argument list
+#
+proc tkFDialog_Config {w type argList} {
+ upvar #0 $w data
+
+ set data(type) $type
+
+ # 1: the configuration specs
+ #
+ set specs {
+ {-defaultextension "" "" ""}
+ {-filetypes "" "" ""}
+ {-initialdir "" "" ""}
+ {-initialfile "" "" ""}
+ {-parent "" "" "."}
+ {-title "" "" ""}
+ }
+ if ![string compare $type open] {
+ # CYGNUS LOCAL: Handle -choosedir.
+ # Note: the -choosedir option is a Cygnus extension. It is not
+ # documented since it only works on Unix -- it is an
+ # implementation detail of the directory-choosing code in
+ # in libgui.
+ lappend specs {-multiple "" "" "0"} {-choosedir "" "" "0"}
+ # END CYGNUS LOCAL
+ }
+
+ # 2: default values depending on the type of the dialog
+ #
+ if {![info exists data(selectPath)]} {
+ # first time the dialog has been popped up
+ set data(selectPath) [pwd]
+ set data(selectFile) ""
+ }
+
+ # 3: parse the arguments
+ #
+ tclParseConfigSpec $w $specs "" $argList
+
+ if {![string compare $data(-title) ""]} {
+ if {![string compare $type "open"]} {
+ set data(-title) "Open"
+ } else {
+ set data(-title) "Save As"
+ }
+ }
+
+ # 4: set the default directory and selection according to the -initial
+ # settings
+ #
+ # Khamis 16-04-98
+ # When the path contains blanks, glob returns an item in a list, but
+ # data(selectPath) must be an item and not a list of items, so we
+ # must extract the item from the returned list.
+ if {[string compare $data(-initialdir) ""]} {
+ if {[file isdirectory $data(-initialdir)]} {
+ #khamis: Join result of glob to an item
+ set data(selectPath) [lindex [glob $data(-initialdir)] 0]
+ } else {
+ set data(selectPath) [pwd]
+ }
+
+ # Convert the initialdir to an absolute path name.
+
+ set old [pwd]
+ cd $data(selectPath)
+ set data(selectPath) [pwd]
+ cd $old
+ }
+ set data(selectFile) $data(-initialfile)
+
+ # 5. Parse the -filetypes option
+ #
+ set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]
+
+ if {![winfo exists $data(-parent)]} {
+ error "bad window path name \"$data(-parent)\""
+ }
+
+ # Set -multiple to a one or zero value (not other boolean types
+ # like "yes") so we can use it in tests easier.
+ if {![string compare $type save]} {
+ set data(-multiple) 0
+ # CYGNUS LOCAL: choosedir
+ # Handle -choosedir here as well.
+ set data(-choosedir) 0
+ # END CYGNUS LOCAL
+ } else {
+ if {$data(-multiple)} {
+ set data(-multiple) 1
+ }
+ }
+}
+
+proc tkFDialog_Create {w} {
+ set dataName [lindex [split $w .] end]
+ upvar #0 $dataName data
+ global tk_library
+
+ toplevel $w -class TkFDialog
+
+ # f1: the frame with the directory option menu
+ #
+ set f1 [frame $w.f1]
+ label $f1.lab -text "Directory:" -under 0
+ set data(dirMenuBtn) $f1.menu
+ set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) $dataName] ""]
+ set data(upBtn) [button $f1.up]
+ if {![info exists tkPriv(updirImage)]} {
+ set tkPriv(updirImage) [image create bitmap -data {
+#define updir_width 28
+#define updir_height 16
+static char updir_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
+ 0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
+ 0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
+ 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
+ 0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
+ 0xf0, 0xff, 0xff, 0x01};}]
+ }
+ $data(upBtn) config -image $tkPriv(updirImage)
+
+ $f1.menu config -takefocus 1 -highlightthickness 2
+
+ pack $data(upBtn) -side right -padx 4 -fill both
+ pack $f1.lab -side left -padx 4 -fill both
+ pack $f1.menu -expand yes -fill both -padx 4
+
+ # data(icons): the IconList that list the files and directories.
+ #
+ set data(icons) [tkIconList $w.icons \
+ -browsecmd "tkFDialog_ListBrowse $w" \
+ -command "tkFDialog_ListInvoke $w" \
+ -multiple "$data(-multiple)"]
+
+ # f2: the frame with the OK button and the "file name" field
+ #
+ set f2 [frame $w.f2 -bd 0]
+ label $f2.lab -text "File name:" -anchor e -width 14 -under 5 -pady 0
+ if {$data(-multiple)} {
+ $f2.lab config -text "File names:"
+ }
+ set data(ent) [entry $f2.ent]
+
+ # The font to use for the icons. The default Canvas font on Unix
+ # is just deviant.
+ global $w.icons
+ set $w.icons(font) [$data(ent) cget -font]
+
+ # f3: the frame with the cancel button and the file types field
+ #
+ set f3 [frame $w.f3 -bd 0]
+
+ # The "File of types:" label needs to be grayed-out when
+ # -filetypes are not specified. The label widget does not support
+ # grayed-out text on monochrome displays. Therefore, we have to
+ # use a button widget to emulate a label widget (by setting its
+ # bindtags)
+
+ set data(typeMenuLab) [button $f3.lab -text "Files of type:" \
+ -anchor e -width 14 -under 9 \
+ -bd [$f2.lab cget -bd] \
+ -highlightthickness [$f2.lab cget -highlightthickness] \
+ -relief [$f2.lab cget -relief] \
+ -padx [$f2.lab cget -padx] \
+ -pady [$f2.lab cget -pady]]
+ bindtags $data(typeMenuLab) [list $data(typeMenuLab) Label \
+ [winfo toplevel $data(typeMenuLab)] all]
+
+ set data(typeMenuBtn) [menubutton $f3.menu -indicatoron 1 -menu $f3.menu.m]
+ set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
+ $data(typeMenuBtn) config -takefocus 1 -highlightthickness 2 \
+ -relief raised -bd 2 -anchor w
+
+ # the okBtn is created after the typeMenu so that the keyboard traversal
+ # is in the right order
+ set data(okBtn) [button $f2.ok -text OK -under 0 -width 6 \
+ -default active -pady 3]
+ set data(cancelBtn) [button $f3.cancel -text Cancel -under 0 -width 6\
+ -default normal -pady 3]
+
+ # pack the widgets in f2 and f3
+ #
+ pack $data(okBtn) -side right -padx 4 -anchor e
+ pack $f2.lab -side left -padx 4
+ pack $f2.ent -expand yes -fill x -padx 2 -pady 0
+
+ pack $data(cancelBtn) -side right -padx 4 -anchor w
+ pack $data(typeMenuLab) -side left -padx 4
+ pack $data(typeMenuBtn) -expand yes -fill x -side right
+
+ # Pack all the frames together. We are done with widget construction.
+ #
+ pack $f1 -side top -fill x -pady 4
+ pack $f3 -side bottom -fill x
+ pack $f2 -side bottom -fill x
+ pack $data(icons) -expand yes -fill both -padx 4 -pady 1
+
+ # Set up the event handlers
+ #
+ bind $data(ent) "tkFDialog_ActivateEnt $w"
+
+ $data(upBtn) config -command "tkFDialog_UpDirCmd $w"
+ $data(okBtn) config -command "tkFDialog_OkCmd $w"
+ $data(cancelBtn) config -command "tkFDialog_CancelCmd $w"
+
+ #trace variable data(selectPath) w "tkFDialog_SetPath $w"
+
+ bind $w "focus $data(dirMenuBtn)"
+ bind $w [format {
+ if {"[%s cget -state]" == "normal"} {
+ focus %s
+ }
+ } $data(typeMenuBtn) $data(typeMenuBtn)]
+ bind $w "focus $data(ent)"
+ bind $w "tkButtonInvoke $data(cancelBtn)"
+ bind $w "tkButtonInvoke $data(cancelBtn)"
+ bind $w "tkFDialog_InvokeBtn $w Open"
+ bind $w "tkFDialog_InvokeBtn $w Save"
+
+ wm protocol $w WM_DELETE_WINDOW "tkFDialog_CancelCmd $w"
+
+ # Build the focus group for all the entries
+ #
+ tkFocusGroup_Create $w
+ tkFocusGroup_BindIn $w $data(ent) "tkFDialog_EntFocusIn $w"
+ tkFocusGroup_BindOut $w $data(ent) "tkFDialog_EntFocusOut $w"
+}
+
+# tkFDialog_UpdateWhenIdle --
+#
+# Creates an idle event handler which updates the dialog in idle
+# time. This is important because loading the directory may take a long
+# time and we don't want to load the same directory for multiple times
+# due to multiple concurrent events.
+#
+proc tkFDialog_UpdateWhenIdle {w} {
+ upvar #0 [winfo name $w] data
+
+ if {[info exists data(updateId)]} {
+ return
+ } else {
+ set data(updateId) [after idle tkFDialog_Update $w]
+ }
+}
+
+# tkFDialog_Update --
+#
+# Loads the files and directories into the IconList widget. Also
+# sets up the directory option menu for quick access to parent
+# directories.
+#
+proc tkFDialog_Update {w} {
+
+ # This proc may be called within an idle handler. Make sure that the
+ # window has not been destroyed before this proc is called
+ if {![winfo exists $w] || [string compare [winfo class $w] TkFDialog]} {
+ return
+ }
+
+ set dataName [winfo name $w]
+ upvar #0 $dataName data
+ global tk_library tkPriv
+ catch {unset data(updateId)}
+
+ if {![info exists tkPriv(folderImage)]} {
+ set tkPriv(folderImage) [image create photo -data {
+R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
+QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
+ set tkPriv(fileImage) [image create photo -data {
+R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO
+rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
+ }
+ set folder $tkPriv(folderImage)
+ set file $tkPriv(fileImage)
+
+ set appPWD [pwd]
+ if {[catch {
+ cd $data(selectPath)
+ }]} {
+ # We cannot change directory to $data(selectPath). $data(selectPath)
+ # should have been checked before tkFDialog_Update is called, so
+ # we normally won't come to here. Anyways, give an error and abort
+ # action.
+ tk_messageBox -type ok -parent $data(-parent) -message \
+ "Cannot change to the directory \"$data(selectPath)\".\nPermission denied."\
+ -icon warning
+ cd $appPWD
+ return
+ }
+
+ # Turn on the busy cursor. BUG?? We haven't disabled X events, though,
+ # so the user may still click and cause havoc ...
+ #
+ set entCursor [$data(ent) cget -cursor]
+ set dlgCursor [$w cget -cursor]
+ $data(ent) config -cursor watch
+ $w config -cursor watch
+ update idletasks
+
+ tkIconList_DeleteAll $data(icons)
+
+ # Make the dir list
+ #
+ foreach f [lsort -dictionary [glob -nocomplain .* *]] {
+ if {![string compare $f .]} {
+ continue
+ }
+ if {![string compare $f ..]} {
+ continue
+ }
+ if {[file isdir ./$f]} {
+ if {![info exists hasDoneDir($f)]} {
+ tkIconList_Add $data(icons) $folder $f
+ set hasDoneDir($f) 1
+ }
+ }
+ }
+ # Make the file list
+ #
+ if {![string compare $data(filter) *]} {
+ set files [lsort -dictionary \
+ [glob -nocomplain .* *]]
+ } else {
+ set files [lsort -dictionary \
+ [eval glob -nocomplain $data(filter)]]
+ }
+
+ set top 0
+ foreach f $files {
+ if {![file isdir ./$f]} {
+ if {![info exists hasDoneFile($f)]} {
+ tkIconList_Add $data(icons) $file $f
+ set hasDoneFile($f) 1
+ }
+ }
+ }
+
+ tkIconList_Arrange $data(icons)
+
+ # Update the Directory: option menu
+ #
+ set list ""
+ set dir ""
+ foreach subdir [file split $data(selectPath)] {
+ set dir [file join $dir $subdir]
+ lappend list $dir
+ }
+
+ $data(dirMenu) delete 0 end
+ set var [format %s(selectPath) $dataName]
+ foreach path $list {
+ $data(dirMenu) add command -label $path -command [list set $var $path]
+ }
+
+ # Restore the PWD to the application's PWD
+ #
+ cd $appPWD
+
+ # turn off the busy cursor.
+ #
+ $data(ent) config -cursor $entCursor
+ $w config -cursor $dlgCursor
+}
+
+# tkFDialog_SetPathSilently --
+#
+# Sets data(selectPath) without invoking the trace procedure
+#
+proc tkFDialog_SetPathSilently {w path} {
+ upvar #0 [winfo name $w] data
+
+ trace vdelete data(selectPath) w "tkFDialog_SetPath $w"
+ set data(selectPath) $path
+ trace variable data(selectPath) w "tkFDialog_SetPath $w"
+}
+
+
+# This proc gets called whenever data(selectPath) is set
+#
+proc tkFDialog_SetPath {w name1 name2 op} {
+ if {[winfo exists $w]} {
+ upvar #0 [winfo name $w] data
+ tkFDialog_UpdateWhenIdle $w
+ }
+}
+
+# This proc gets called whenever data(filter) is set
+#
+proc tkFDialog_SetFilter {w type} {
+ upvar #0 [winfo name $w] data
+ upvar \#0 $data(icons) icons
+
+ set data(filter) [lindex $type 1]
+ $data(typeMenuBtn) config -text [lindex $type 0] -indicatoron 1
+
+ $icons(sbar) set 0.0 0.0
+
+ tkFDialog_UpdateWhenIdle $w
+}
+
+# tkFDialogResolveFile --
+#
+# Interpret the user's text input in a file selection dialog.
+# Performs:
+#
+# (1) ~ substitution
+# (2) resolve all instances of . and ..
+# (3) check for non-existent files/directories
+# (4) check for chdir permissions
+#
+# Arguments:
+# context: the current directory you are in
+# text: the text entered by the user
+# defaultext: the default extension to add to files with no extension
+#
+# Return vaue:
+# [list $flag $directory $file]
+#
+# flag = OK : valid input
+# = PATTERN : valid directory/pattern
+# = PATH : the directory does not exist
+# = FILE : the directory exists by the file doesn't
+# exist
+# = CHDIR : Cannot change to the directory
+# = ERROR : Invalid entry
+#
+# directory : valid only if flag = OK or PATTERN or FILE
+# file : valid only if flag = OK or PATTERN
+#
+# directory may not be the same as context, because text may contain
+# a subdirectory name
+#
+proc tkFDialogResolveFile {context text defaultext} {
+
+ set appPWD [pwd]
+
+ set path [tkFDialog_JoinFile $context $text]
+
+ if {[file ext $path] == ""} {
+ set path "$path$defaultext"
+ }
+
+
+ if {[catch {file exists $path}]} {
+ # This "if" block can be safely removed if the following code
+ # stop generating errors.
+ #
+ # file exists ~nonsuchuser
+ #
+ return [list ERROR $path ""]
+ }
+
+ if {[file exists $path]} {
+ if {[file isdirectory $path]} {
+ if {[catch {
+ cd $path
+ }]} {
+ return [list CHDIR $path ""]
+ }
+ set directory [pwd]
+ set file ""
+ set flag OK
+ cd $appPWD
+ } else {
+ if {[catch {
+ cd [file dirname $path]
+ }]} {
+ return [list CHDIR [file dirname $path] ""]
+ }
+ set directory [pwd]
+ set file [file tail $path]
+ set flag OK
+ cd $appPWD
+ }
+ } else {
+ set dirname [file dirname $path]
+ if {[file exists $dirname]} {
+ if {[catch {
+ cd $dirname
+ }]} {
+ return [list CHDIR $dirname ""]
+ }
+ set directory [pwd]
+ set file [file tail $path]
+ if {[regexp {[*]|[?]} $file]} {
+ set flag PATTERN
+ } else {
+ set flag FILE
+ }
+ cd $appPWD
+ } else {
+ set directory $dirname
+ set file [file tail $path]
+ set flag PATH
+ }
+ }
+
+ return [list $flag $directory $file]
+}
+
+
+# Gets called when the entry box gets keyboard focus. We clear the selection
+# from the icon list . This way the user can be certain that the input in the
+# entry box is the selection.
+#
+proc tkFDialog_EntFocusIn {w} {
+ upvar #0 [winfo name $w] data
+
+ if {[string compare [$data(ent) get] ""]} {
+ $data(ent) selection from 0
+ $data(ent) selection to end
+ $data(ent) icursor end
+ } else {
+ $data(ent) selection clear
+ }
+
+ tkIconList_Unselect $data(icons)
+
+ if {![string compare $data(type) open]} {
+ $data(okBtn) config -text "Open"
+ } else {
+ $data(okBtn) config -text "Save"
+ }
+}
+
+proc tkFDialog_EntFocusOut {w} {
+ upvar #0 [winfo name $w] data
+
+ $data(ent) selection clear
+}
+
+
+# Verification procedure
+proc tkFDialog_VerifyFileName { w fname } {
+ upvar #0 [winfo name $w] data
+
+ set list [tkFDialogResolveFile $data(selectPath) $fname \
+ $data(-defaultextension)]
+ set flag [lindex $list 0]
+ set path [lindex $list 1]
+ set file [lindex $list 2]
+
+ case $flag {
+ OK {
+ if {![string compare $file ""]} {
+ tkFDialog_SetPathSilently $w [file dirname $path]
+ # CYGNUS LOCAL: handle choosedir
+ if {$data(-choosedir)} {
+ if {$data(-multiple)} {
+ lappend data(selectFile) [file tail $path]
+ } else {
+ set data(selectFile) [file tail $path]
+ }
+ tkFDialog_Done $w
+ } else {
+ # user has entered an existing (sub)directory
+ set data(selectPath) $path
+ $data(ent) delete 0 end
+ }
+ } else {
+ tkFDialog_SetPathSilently $w $path
+ if {$data(-multiple)} {
+ lappend data(selectFile) $file
+ } else {
+ set data(selectFile) $file
+ }
+ tkFDialog_Done $w
+ }
+ }
+ PATTERN {
+ set data(selectPath) $path
+ set data(filter) $file
+ }
+ FILE {
+ if {![string compare $data(type) open]} {
+ tk_messageBox -icon warning -type ok -parent $data(-parent) \
+ -message "File \"[file join $path $file]\" does not exist."
+ $data(ent) select from 0
+ $data(ent) select to end
+ $data(ent) icursor end
+ } else {
+ tkFDialog_SetPathSilently $w $path
+ if {$data(-multiple)} {
+ lappend data(selectFile) $file
+ } else {
+ set data(selectFile) $file
+ }
+ tkFDialog_Done $w
+ }
+ }
+ PATH {
+ tk_messageBox -icon warning -type ok -parent $data(-parent) \
+ -message "Directory \"$path\" does not exist."
+ $data(ent) select from 0
+ $data(ent) select to end
+ $data(ent) icursor end
+ }
+ CHDIR {
+ tk_messageBox -type ok -parent $data(-parent) -message \
+ "Cannot change to the directory \"$path\".\nPermission denied."\
+ -icon warning
+ $data(ent) select from 0
+ $data(ent) select to end
+ $data(ent) icursor end
+ }
+ ERROR {
+ tk_messageBox -type ok -parent $data(-parent) -message \
+ "Invalid file name \"$path\"."\
+ -icon warning
+ $data(ent) select from 0
+ $data(ent) select to end
+ $data(ent) icursor end
+ }
+ }
+}
+
+# Gets called when user presses Return in the "File name" entry.
+#
+proc tkFDialog_ActivateEnt {w} {
+ upvar #0 [winfo name $w] data
+
+ #set text [string trim [$data(ent) get]]
+ set text [$data(ent) get]
+ if {$data(-multiple)} {
+ set data(selectFile) ""
+ foreach fname $text {
+ tkFDialog_VerifyFileName $w $fname
+ }
+ } else {
+ tkFDialog_VerifyFileName $w $text
+ }
+}
+
+# Gets called when user presses the Alt-s or Alt-o keys.
+#
+proc tkFDialog_InvokeBtn {w key} {
+ upvar #0 [winfo name $w] data
+
+ if {![string compare [$data(okBtn) cget -text] $key]} {
+ tkButtonInvoke $data(okBtn)
+ }
+}
+
+# Gets called when user presses the "parent directory" button
+#
+proc tkFDialog_UpDirCmd {w} {
+ upvar #0 [winfo name $w] data
+
+ if {[string compare $data(selectPath) "/"]} {
+ set data(selectPath) [file dirname $data(selectPath)]
+ }
+}
+
+# Join a file name to a path name. The "file join" command will break
+# if the filename begins with ~
+#
+proc tkFDialog_JoinFile {path file} {
+ if {[string match {~*} $file] && [file exists $path/$file]} {
+ return [file join $path ./$file]
+ } else {
+ return [file join $path $file]
+ }
+}
+
+
+
+# Gets called when user presses the "OK" button
+#
+proc tkFDialog_OkCmd {w} {
+ upvar #0 [winfo name $w] data
+
+ set text [tkIconList_Get $data(icons)]
+ if {[string compare $text ""]} {
+ if {!$data(-multiple)} {
+ set file [tkFDialog_JoinFile $data(selectPath) $text]
+ # CYGNUS LOCAL: handle choosedir
+ if {!$data(-choosedir) && [file isdirectory $file]} {
+ tkFDialog_ListInvoke $w $text
+ return
+ }
+ }
+ }
+
+ tkFDialog_ActivateEnt $w
+}
+
+# Gets called when user presses the "Cancel" button
+#
+proc tkFDialog_CancelCmd {w} {
+ upvar #0 [winfo name $w] data
+ global tkPriv
+
+ set tkPriv(selectFilePath) ""
+}
+
+# Gets called when user browses the IconList widget (dragging mouse, arrow
+# keys, etc)
+#
+proc tkFDialog_ListBrowse {w text} {
+ upvar #0 [winfo name $w] data
+
+ if {$text == ""} {
+ return
+ }
+
+ set file [tkFDialog_JoinFile $data(selectPath) $text]
+ # CYGNUS LOCAL: handle choosedir
+ if {$data(-choosedir) || ![file isdirectory $file]} {
+ $data(ent) delete 0 end
+ $data(ent) insert 0 $text
+
+ if {![string compare $data(type) open]} {
+ $data(okBtn) config -text "Open"
+ } else {
+ $data(okBtn) config -text "Save"
+ }
+ } else {
+ $data(okBtn) config -text "Open"
+ }
+}
+
+# Gets called when user invokes the IconList widget (double-click,
+# Return key, etc)
+#
+proc tkFDialog_ListInvoke {w text} {
+ upvar #0 [winfo name $w] data
+
+ if {$text == ""} {
+ return
+ }
+
+ if {$data(-multiple)} {
+ set file [tkFDialog_JoinFile $data(selectPath) [lindex $text 0]]
+ } else {
+ set file [tkFDialog_JoinFile $data(selectPath) $text]
+ }
+
+ if {[file isdirectory $file]} {
+ set appPWD [pwd]
+ if {[catch {cd $file}]} {
+ tk_messageBox -type ok -parent $data(-parent) -message \
+ "Cannot change to the directory \"$file\".\nPermission denied."\
+ -icon warning
+ } else {
+ cd $appPWD
+ set data(selectPath) $file
+ }
+ } else {
+ if {$data(-multiple)} {
+ set data(selectFile) [list $file]
+ } else {
+ set data(selectFile) $file
+ }
+ tkFDialog_Done $w
+ }
+}
+
+# tkFDialog_Done --
+#
+# Gets called when user has input a valid filename. Pops up a
+# dialog box to confirm selection when necessary. Sets the
+# tkPriv(selectFilePath) variable, which will break the "tkwait"
+# loop in tkFDialog and return the selected filename to the
+# script that calls tk_getOpenFile or tk_getSaveFile
+#
+proc tkFDialog_Done {w {selectFilePath ""}} {
+ upvar #0 [winfo name $w] data
+ global tkPriv
+
+ if {![string compare $selectFilePath ""]} {
+ if {$data(-multiple)} {
+ set selectFilePath {}
+ foreach f $data(selectFile) {
+ lappend selectFilePath [file join $data(selectPath) $f]
+ }
+ } else {
+ set selectFilePath [tkFDialog_JoinFile $data(selectPath) \
+ $data(selectFile)]
+ }
+ set tkPriv(selectFile) $data(selectFile)
+ set tkPriv(selectPath) $data(selectPath)
+
+ if {[file exists $selectFilePath] &&
+ ![string compare $data(type) save]} {
+
+ set reply [tk_messageBox -icon warning -type yesno\
+ -parent $data(-parent) -message "File\
+ \"$selectFilePath\" already exists.\nDo\
+ you want to overwrite it?"]
+ if {![string compare $reply "no"]} {
+ return
+ }
+ }
+ }
+ set tkPriv(selectFilePath) $selectFilePath
+}
+
tkfbox.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: tkfboxTest.tcl
===================================================================
--- tkfboxTest.tcl (nonexistent)
+++ tkfboxTest.tcl (revision 1765)
@@ -0,0 +1,1666 @@
+# tkfbox.tcl --
+#
+# Implements the "TK" standard file selection dialog box. This
+# dialog box is used on the Unix platforms whenever the tk_strictMotif
+# flag is not set.
+#
+# The "TK" standard file selection dialog box is similar to the
+# file selection dialog box on Win95(TM). The user can navigate
+# the directories by clicking on the folder icons or by
+# selectinf the "Directory" option menu. The user can select
+# files by clicking on the file icons or by entering a filename
+# in the "Filename:" entry.
+#
+# SCCS: @(#) tkfbox.tcl 1.13 97/10/01 14:51:01
+#
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#----------------------------------------------------------------------
+#
+# I C O N L I S T
+#
+# This is a pseudo-widget that implements the icon list inside the
+# tkFDialog dialog box.
+#
+#----------------------------------------------------------------------
+
+# tkIconList --
+#
+# Creates an IconList widget.
+#
+proc tkIconList {w args} {
+ upvar #0 $w data
+
+ tkIconList_Config $w $args
+ tkIconList_Create $w
+}
+
+# tkIconList_Config --
+#
+# Configure the widget variables of IconList, according to the command
+# line arguments.
+#
+proc tkIconList_Config {w argList} {
+ upvar #0 $w data
+
+ # 1: the configuration specs
+ #
+ set specs {
+ {-browsecmd "" "" ""}
+ {-command "" "" ""}
+ {-multiple "" "" "0"}
+ }
+
+ # 2: parse the arguments
+ #
+ tclParseConfigSpec $w $specs "" $argList
+}
+
+# tkIconList_Create --
+#
+# Creates an IconList widget by assembling a canvas widget and a
+# scrollbar widget. Sets all the bindings necessary for the IconList's
+# operations.
+#
+proc tkIconList_Create {w} {
+ upvar #0 $w data
+
+ frame $w
+ set data(sbar) [scrollbar $w.sbar -orient horizontal \
+ -highlightthickness 0 -takefocus 0]
+ set data(canvas) [canvas $w.canvas -bd 2 -relief sunken \
+ -width 400 -height 120 -takefocus 1]
+ pack $data(sbar) -side bottom -fill x -padx 2
+ pack $data(canvas) -expand yes -fill both
+
+ $data(sbar) config -command "$data(canvas) xview"
+ $data(canvas) config -xscrollcommand "$data(sbar) set"
+
+ # Initializes the max icon/text width and height and other variables
+ #
+ set data(maxIW) 1
+ set data(maxIH) 1
+ set data(maxTW) 1
+ set data(maxTH) 1
+ set data(numItems) 0
+ set data(curItem) {}
+ set data(noScroll) 1
+
+ # Creates the event bindings.
+ #
+ bind $data(canvas) "tkIconList_Arrange $w"
+
+ bind $data(canvas) <1> "tkIconList_Btn1 $w %x %y"
+ bind $data(canvas) "tkIconList_Motion1 $w %x %y"
+ bind $data(canvas) "tkIconList_ShiftBtn1 $w %x %y"
+ bind $data(canvas) "tkIconList_Double1 $w %x %y"
+ bind $data(canvas) "tkCancelRepeat"
+ bind $data(canvas) "tkIconList_Leave1 $w %x %y"
+ bind $data(canvas) "tkCancelRepeat"
+
+ bind $data(canvas) "tkIconList_UpDown $w -1"
+ bind $data(canvas) "tkIconList_UpDown $w 1"
+ bind $data(canvas) "tkIconList_LeftRight $w -1"
+ bind $data(canvas) "tkIconList_LeftRight $w 1"
+ bind $data(canvas) "tkIconList_ReturnKey $w"
+ bind $data(canvas) "tkIconList_KeyPress $w %A"
+ bind $data(canvas) ";"
+ bind $data(canvas) ";"
+
+ bind $data(canvas) "tkIconList_FocusIn $w"
+
+ return $w
+}
+
+# tkIconList_AutoScan --
+#
+# This procedure is invoked when the mouse leaves an entry window
+# with button 1 down. It scrolls the window up, down, left, or
+# right, depending on where the mouse left the window, and reschedules
+# itself as an "after" command so that the window continues to scroll until
+# the mouse moves back into the window or the mouse button is released.
+#
+# Arguments:
+# w - The IconList window.
+#
+proc tkIconList_AutoScan {w} {
+ upvar #0 $w data
+ global tkPriv
+
+ if {![winfo exists $w]} return
+ set x $tkPriv(x)
+ set y $tkPriv(y)
+
+ if {$data(noScroll)} {
+ return
+ }
+ if {$x >= [winfo width $data(canvas)]} {
+ $data(canvas) xview scroll 1 units
+ } elseif {$x < 0} {
+ $data(canvas) xview scroll -1 units
+ } elseif {$y >= [winfo height $data(canvas)]} {
+ # do nothing
+ } elseif {$y < 0} {
+ # do nothing
+ } else {
+ return
+ }
+
+ tkIconList_Motion1 $w $x $y
+ set tkPriv(afterId) [after 50 tkIconList_AutoScan $w]
+}
+
+# Deletes all the items inside the canvas subwidget and reset the IconList's
+# state.
+#
+proc tkIconList_DeleteAll {w} {
+ upvar #0 $w data
+ upvar #0 $w:itemList itemList
+
+ $data(canvas) delete all
+ catch {unset data(selected)}
+ catch {unset data(rect)}
+ catch {unset data(list)}
+ catch {unset itemList}
+ set data(maxIW) 1
+ set data(maxIH) 1
+ set data(maxTW) 1
+ set data(maxTH) 1
+ set data(numItems) 0
+ set data(curItem) {}
+ set data(noScroll) 1
+ $data(sbar) set 0.0 1.0
+ $data(canvas) xview moveto 0
+}
+
+# Adds an icon into the IconList with the designated image and text
+#
+proc tkIconList_Add {w image text} {
+ upvar #0 $w data
+ upvar #0 $w:itemList itemList
+ upvar #0 $w:textList textList
+
+ set iTag [$data(canvas) create image 0 0 -image $image -anchor nw]
+ set tTag [$data(canvas) create text 0 0 -text $text -anchor nw \
+ -font $data(font)]
+ set rTag [$data(canvas) create rect 0 0 0 0 -fill "" -outline ""]
+
+ set b [$data(canvas) bbox $iTag]
+ set iW [expr {[lindex $b 2]-[lindex $b 0]}]
+ set iH [expr {[lindex $b 3]-[lindex $b 1]}]
+ if {$data(maxIW) < $iW} {
+ set data(maxIW) $iW
+ }
+ if {$data(maxIH) < $iH} {
+ set data(maxIH) $iH
+ }
+
+ set b [$data(canvas) bbox $tTag]
+ set tW [expr {[lindex $b 2]-[lindex $b 0]}]
+ set tH [expr {[lindex $b 3]-[lindex $b 1]}]
+ if {$data(maxTW) < $tW} {
+ set data(maxTW) $tW
+ }
+ if {$data(maxTH) < $tH} {
+ set data(maxTH) $tH
+ }
+
+ lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW $tH $data(numItems)]
+ set itemList($rTag) [list $iTag $tTag $text $data(numItems)]
+ set textList($data(numItems)) [string tolower $text]
+ incr data(numItems)
+}
+
+# Places the icons in a column-major arrangement.
+#
+proc tkIconList_Arrange {w} {
+ upvar #0 $w data
+
+ if {![info exists data(list)]} {
+ if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {
+ set data(noScroll) 1
+ $data(sbar) config -command ""
+ }
+ return
+ }
+
+ set W [winfo width $data(canvas)]
+ set H [winfo height $data(canvas)]
+ set pad [expr {[$data(canvas) cget -highlightthickness] + \
+ [$data(canvas) cget -bd]}]
+ if {$pad < 2} {
+ set pad 2
+ }
+
+ incr W -[expr {$pad*2}]
+ incr H -[expr {$pad*2}]
+
+ set dx [expr {$data(maxIW) + $data(maxTW) + 8}]
+ if {$data(maxTH) > $data(maxIH)} {
+ set dy $data(maxTH)
+ } else {
+ set dy $data(maxIH)
+ }
+ incr dy 2
+ set shift [expr {$data(maxIW) + 4}]
+
+ set x [expr {$pad * 2}]
+ set y [expr {$pad * 1}] ; # Why * 1 ?
+ set usedColumn 0
+ foreach sublist $data(list) {
+ set usedColumn 1
+ set iTag [lindex $sublist 0]
+ set tTag [lindex $sublist 1]
+ set rTag [lindex $sublist 2]
+ set iW [lindex $sublist 3]
+ set iH [lindex $sublist 4]
+ set tW [lindex $sublist 5]
+ set tH [lindex $sublist 6]
+
+ set i_dy [expr {($dy - $iH)/2}]
+ set t_dy [expr {($dy - $tH)/2}]
+
+ $data(canvas) coords $iTag $x [expr {$y + $i_dy}]
+ $data(canvas) coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}]
+ $data(canvas) coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}]
+ $data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]
+
+ incr y $dy
+ if {($y + $dy) > $H} {
+ set y [expr {$pad * 1}] ; # *1 ?
+ incr x $dx
+ set usedColumn 0
+ }
+ }
+
+ if {$usedColumn} {
+ set sW [expr {$x + $dx}]
+ } else {
+ set sW $x
+ }
+
+ if {$sW < $W} {
+ $data(canvas) config -scrollregion "$pad $pad $sW $H"
+ $data(sbar) config -command ""
+ $data(canvas) xview moveto 0
+ set data(noScroll) 1
+ } else {
+ $data(canvas) config -scrollregion "$pad $pad $sW $H"
+ $data(sbar) config -command "$data(canvas) xview"
+ set data(noScroll) 0
+ }
+
+ set data(itemsPerColumn) [expr {($H-$pad)/$dy}]
+ if {$data(itemsPerColumn) < 1} {
+ set data(itemsPerColumn) 1
+ }
+
+ if {$data(curItem) != {}} {
+ tkIconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 0
+ }
+}
+
+# Gets called when the user invokes the IconList (usually by double-clicking
+# or pressing the Return key).
+#
+proc tkIconList_Invoke {w} {
+ upvar #0 $w data
+
+ if {[string compare $data(-command) ""] && [info exists data(selected)]} {
+ eval $data(-command)
+ }
+}
+
+# tkIconList_See --
+#
+# If the item is not (completely) visible, scroll the canvas so that
+# it becomes visible.
+proc tkIconList_See {w rTag} {
+ upvar #0 $w data
+ upvar #0 $w:itemList itemList
+
+ if {$data(noScroll)} {
+ return
+ }
+ set sRegion [$data(canvas) cget -scrollregion]
+ if {![string compare $sRegion {}]} {
+ return
+ }
+
+ if {![info exists itemList($rTag)]} {
+ return
+ }
+
+
+ set bbox [$data(canvas) bbox $rTag]
+ set pad [expr {[$data(canvas) cget -highlightthickness] + \
+ [$data(canvas) cget -bd]}]
+
+ set x1 [lindex $bbox 0]
+ set x2 [lindex $bbox 2]
+ incr x1 -[expr {$pad * 2}]
+ incr x2 -[expr {$pad * 1}] ; # *1 ?
+
+ set cW [expr {[winfo width $data(canvas)] - $pad*2}]
+
+ set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]
+ set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}]
+ set oldDispX $dispX
+
+ # check if out of the right edge
+ #
+ if {($x2 - $dispX) >= $cW} {
+ set dispX [expr {$x2 - $cW}]
+ }
+ # check if out of the left edge
+ #
+ if {($x1 - $dispX) < 0} {
+ set dispX $x1
+ }
+
+ if {$oldDispX != $dispX} {
+ set fraction [expr {double($dispX)/double($scrollW)}]
+ $data(canvas) xview moveto $fraction
+ }
+}
+
+proc tkIconList_SelectAtXY {w x y} {
+ upvar #0 $w data
+
+ tkIconList_Select $w [$data(canvas) find closest \
+ [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
+}
+
+proc tkIconList_AddSelectAtXY {w x y {no_delete 0}} {
+ upvar #0 $w data
+
+ if {$data(-multiple) && [info exists data(selected)]} {
+ tkIconList_AddSelect $w [$data(canvas) find closest \
+ [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]] \
+ 1 $no_delete
+ return
+ }
+ tkIconList_SelectAtXY $w $x $y
+}
+
+proc tkIconList_Select {w rTag {callBrowse 1}} {
+ upvar #0 $w data
+ upvar #0 $w:itemList itemList
+
+ if {![info exists itemList($rTag)]} {
+ return
+ }
+ set iTag [lindex $itemList($rTag) 0]
+ set tTag [lindex $itemList($rTag) 1]
+ set text [lindex $itemList($rTag) 2]
+ set serial [lindex $itemList($rTag) 3]
+
+ if {$data(-multiple) && [info exists data(rect)]} {
+ foreach r $data(rect) {
+ $data(canvas) delete $r
+ }
+ unset data(rect)
+ }
+ if ![info exists data(rect)] {
+
+ set data(rect) [$data(canvas) create rect 0 0 0 0 \
+ -fill #a0a0ff -outline #a0a0ff]
+ }
+ $data(canvas) lower $data(rect)
+ set bbox [$data(canvas) bbox $tTag]
+ eval $data(canvas) coords $data(rect) $bbox
+
+ set data(curItem) $serial
+
+ #we can't set the text to data(selected) as text, this is bugy,
+ #when the path contains blanks
+ if {$data(-multiple)} {
+ catch {unset data(selected)}
+ lappend data(selected) $text
+ } else {
+ set data(selected) $text
+ }
+
+ if {$callBrowse} {
+ if [string compare $data(-browsecmd) ""] {
+ eval $data(-browsecmd) [list $data(selected)]
+ }
+ }
+}
+
+proc tkIconList_AddSelect {w rTag {callBrowse 1} {no_delete 0}} {
+ upvar #0 $w data
+ upvar #0 $w:itemList itemList
+
+ if ![info exists itemList($rTag)] {
+ return
+ }
+ set iTag [lindex $itemList($rTag) 0]
+ set tTag [lindex $itemList($rTag) 1]
+ set text [lindex $itemList($rTag) 2]
+ set serial [lindex $itemList($rTag) 3]
+
+ if {[lsearch -exact $data(selected) $text] != -1} {
+ if {$no_delete} {
+ return
+ }
+
+ # we've clicked on an existing item, so we need to remove it
+ set i [lsearch -exact $data(selected) $text]
+ set data(selected) [lreplace $data(selected) $i $i]
+
+ # find the appropriate coordinates and remove the
+ # corresponding rectangle.
+ set tmpbbox [$data(canvas) bbox $tTag]
+ for {set i 0} {$i<[llength $data(rect)]} {incr i} {
+ set rectTag [lindex $data(rect) $i]
+ set testbbox [$data(canvas) coords $rectTag]
+ # test first two coordinates; if they're the same the
+ # entire box should match
+ if {[lindex $testbbox 0]==[lindex $tmpbbox 0] && \
+ [lindex $testbbox 1]==[lindex $tmpbbox 1]} {
+ $data(canvas) delete $rectTag
+ set data(rect) [lreplace $data(rect) $i $i]
+ break
+ }
+ }
+
+ if {$callBrowse} {
+ if [string compare $data(-browsecmd) ""] {
+ eval $data(-browsecmd) [list $data(selected)]
+ }
+ }
+ return
+ }
+
+ set tmprect [$data(canvas) create rect 0 0 0 0 \
+ -fill #a0a0ff -outline #a0a0ff]
+ lappend data(rect) $tmprect
+
+ $data(canvas) lower $tmprect
+ set bbox [$data(canvas) bbox $tTag]
+ eval $data(canvas) coords $tmprect $bbox
+
+ set data(curItem) $serial
+ lappend data(selected) $text
+
+ if {$callBrowse} {
+ if [string compare $data(-browsecmd) ""] {
+ eval $data(-browsecmd) [list $data(selected)]
+ }
+ }
+}
+
+proc tkIconList_Unselect {w} {
+ upvar #0 $w data
+
+ if [info exists data(rect)] {
+ foreach r $data(rect) {
+ $data(canvas) delete $r
+ }
+ unset data(rect)
+ }
+ if {[info exists data(selected)]} {
+ unset data(selected)
+ }
+ set data(curItem) {}
+}
+
+# Returns the selected item
+#
+proc tkIconList_Get {w} {
+ upvar #0 $w data
+
+ if {[info exists data(selected)]} {
+ return $data(selected)
+ } else {
+ return ""
+ }
+}
+
+
+proc tkIconList_Btn1 {w x y} {
+ upvar #0 $w data
+
+ focus $data(canvas)
+ tkIconList_SelectAtXY $w $x $y
+}
+
+proc tkIconList_ShiftBtn1 {w x y} {
+ upvar #0 $w data
+
+ focus $data(canvas)
+ tkIconList_AddSelectAtXY $w $x $y
+}
+
+# Gets called on button-1 motions
+#
+proc tkIconList_Motion1 {w x y} {
+ global tkPriv
+ set tkPriv(x) $x
+ set tkPriv(y) $y
+
+ tkIconList_AddSelectAtXY $w $x $y 1
+}
+
+proc tkIconList_Double1 {w x y} {
+ upvar #0 $w data
+
+ if {$data(curItem) != {}} {
+ tkIconList_Invoke $w
+ }
+}
+
+proc tkIconList_ReturnKey {w} {
+ tkIconList_Invoke $w
+}
+
+proc tkIconList_Leave1 {w x y} {
+ global tkPriv
+
+ set tkPriv(x) $x
+ set tkPriv(y) $y
+ tkIconList_AutoScan $w
+}
+
+proc tkIconList_FocusIn {w} {
+ upvar #0 $w data
+
+ if {![info exists data(list)]} {
+ return
+ }
+
+ if {$data(curItem) == {}} {
+ set rTag [lindex [lindex $data(list) 0] 2]
+ tkIconList_Select $w $rTag
+ }
+}
+
+# tkIconList_UpDown --
+#
+# Moves the active element up or down by one element
+#
+# Arguments:
+# w - The IconList widget.
+# amount - +1 to move down one item, -1 to move back one item.
+#
+proc tkIconList_UpDown {w amount} {
+ upvar #0 $w data
+
+ if {![info exists data(list)]} {
+ return
+ }
+
+ if {$data(curItem) == {}} {
+ set rTag [lindex [lindex $data(list) 0] 2]
+ } else {
+ set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
+ set rTag [lindex [lindex $data(list) [expr {$data(curItem)+$amount}]] 2]
+ if {![string compare $rTag ""]} {
+ set rTag $oldRTag
+ }
+ }
+
+ if {[string compare $rTag ""]} {
+ tkIconList_Select $w $rTag
+ tkIconList_See $w $rTag
+ }
+}
+
+# tkIconList_LeftRight --
+#
+# Moves the active element left or right by one column
+#
+# Arguments:
+# w - The IconList widget.
+# amount - +1 to move right one column, -1 to move left one column.
+#
+proc tkIconList_LeftRight {w amount} {
+ upvar #0 $w data
+
+ if {![info exists data(list)]} {
+ return
+ }
+ if {$data(curItem) == {}} {
+ set rTag [lindex [lindex $data(list) 0] 2]
+ } else {
+ set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
+ set newItem [expr {$data(curItem)+($amount*$data(itemsPerColumn))}]
+ set rTag [lindex [lindex $data(list) $newItem] 2]
+ if {![string compare $rTag ""]} {
+ set rTag $oldRTag
+ }
+ }
+
+ if {[string compare $rTag ""]} {
+ tkIconList_Select $w $rTag
+ tkIconList_See $w $rTag
+ }
+}
+
+#----------------------------------------------------------------------
+# Accelerator key bindings
+#----------------------------------------------------------------------
+
+# tkIconList_KeyPress --
+#
+# Gets called when user enters an arbitrary key in the listbox.
+#
+proc tkIconList_KeyPress {w key} {
+ global tkPriv
+
+ append tkPriv(ILAccel,$w) $key
+ tkIconList_Goto $w $tkPriv(ILAccel,$w)
+ catch {
+ after cancel $tkPriv(ILAccel,$w,afterId)
+ }
+ set tkPriv(ILAccel,$w,afterId) [after 500 tkIconList_Reset $w]
+}
+
+proc tkIconList_Goto {w text} {
+ upvar #0 $w data
+ upvar #0 $w:textList textList
+ global tkPriv
+
+ if {![info exists data(list)]} {
+ return
+ }
+
+ if {[string length $text] == 0} {
+ return
+ }
+
+ if {$data(curItem) == {} || $data(curItem) == 0} {
+ set start 0
+ } else {
+ set start $data(curItem)
+ }
+
+ set text [string tolower $text]
+ set theIndex -1
+ set less 0
+ set len [string length $text]
+ set len0 [expr {$len-1}]
+ set i $start
+
+ # Search forward until we find a filename whose prefix is an exact match
+ # with $text
+ while 1 {
+ set sub [string range $textList($i) 0 $len0]
+ if {[string compare $text $sub] == 0} {
+ set theIndex $i
+ break
+ }
+ incr i
+ if {$i == $data(numItems)} {
+ set i 0
+ }
+ if {$i == $start} {
+ break
+ }
+ }
+
+ if {$theIndex > -1} {
+ set rTag [lindex [lindex $data(list) $theIndex] 2]
+ tkIconList_Select $w $rTag 0
+ tkIconList_See $w $rTag
+ }
+}
+
+proc tkIconList_Reset {w} {
+ global tkPriv
+
+ catch {unset tkPriv(ILAccel,$w)}
+}
+
+#----------------------------------------------------------------------
+#
+# F I L E D I A L O G
+#
+#----------------------------------------------------------------------
+
+# tkFDialog --
+#
+# Implements the TK file selection dialog. This dialog is used when
+# the tk_strictMotif flag is set to false. This procedure shouldn't
+# be called directly. Call tk_getOpenFile or tk_getSaveFile instead.
+#
+proc tkFDialog {args} {
+ global tkPriv
+ global __old_dialog
+ global __old_multiple
+ set w __tk_filedialog
+ upvar #0 $w data
+
+ if {![string compare [lindex [info level 0] 0] tk_getOpenFile]} {
+ set type open
+ } else {
+ set type save
+ }
+
+ tkFDialog_Config $w $type $args
+
+ if {![string compare $data(-parent) .]} {
+ set w .$w
+ } else {
+ set w $data(-parent).$w
+ }
+
+ #because tk doesn't use window-path dependent array, it is
+ #impossible to use more than one dialog box at the same time,
+ #so we have to recreate the dialog!
+ if {[info exists __old_dialog] \
+ && ($__old_dialog != $w || $__old_multiple != $data(-multiple))} {
+ catch {destroy $w}
+ catch {destroy $__old_dialog}
+ }
+ set __old_dialog $w
+ set __old_multiple $data(-multiple)
+
+ # (re)create the dialog box if necessary
+ #
+ set new_dialog 0
+ if {![winfo exists $w]} {
+ tkFDialog_Create $w
+ set new_dialog 1
+ } elseif {[string compare [winfo class $w] TkFDialog]} {
+ destroy $w
+ tkFDialog_Create $w
+ set new_dialog 1
+ } else {
+ set data(dirMenuBtn) $w.f1.menu
+ set data(dirMenu) $w.f1.menu.menu
+ set data(upBtn) $w.f1.up
+ set data(icons) $w.icons
+ set data(ent) $w.f2.ent
+ set data(typeMenuLab) $w.f3.lab
+ set data(typeMenuBtn) $w.f3.menu
+ set data(typeMenu) $data(typeMenuBtn).m
+ set data(okBtn) $w.f2.ok
+ set data(cancelBtn) $w.f3.cancel
+ }
+ wm transient $w $data(-parent)
+ #trace variable
+ trace variable data(selectPath) w "tkFDialog_SetPath $w"
+
+ # 5. Initialize the file types menu
+ #
+ if {$data(-filetypes) != {}} {
+ $data(typeMenu) delete 0 end
+ foreach type $data(-filetypes) {
+ set title [lindex $type 0]
+ set filter [lindex $type 1]
+ $data(typeMenu) add command -label $title \
+ -command [list tkFDialog_SetFilter $w $type]
+ }
+ tkFDialog_SetFilter $w [lindex $data(-filetypes) 0]
+ $data(typeMenuBtn) config -state normal
+ $data(typeMenuLab) config -state normal
+ } else {
+ set data(filter) "*"
+ $data(typeMenuBtn) config -state disabled -takefocus 0
+ $data(typeMenuLab) config -state disabled
+ }
+
+ tkFDialog_UpdateWhenIdle $w
+
+ # 6. Withdraw the window, then update all the geometry information
+ # so we know how big it wants to be, then center the window in the
+ # display and de-iconify it.
+
+ if {$new_dialog} {
+ #center dialog, when it has been new created
+ wm withdraw $w
+ update idletasks
+ set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
+ - [winfo vrootx [winfo parent $w]]}]
+ set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
+ - [winfo vrooty [winfo parent $w]]}]
+ wm geom $w [winfo reqwidth $w]x[winfo reqheight $w]+$x+$y
+ }
+ wm title $w $data(-title)
+ wm deiconify $w
+
+ # 7. Set a grab and claim the focus too.
+
+ set oldFocus [focus]
+ set oldGrab [grab current $w]
+ if {$oldGrab != ""} {
+ set grabStatus [grab status $oldGrab]
+ }
+ grab $w
+ focus $data(ent)
+ $data(ent) delete 0 end
+ $data(ent) insert 0 $data(selectFile)
+ $data(ent) select from 0
+ $data(ent) select to end
+ $data(ent) icursor end
+
+ # 8. Wait for the user to respond, then restore the focus and
+ # return the index of the selected button. Restore the focus
+ # before deleting the window, since otherwise the window manager
+ # may take the focus away so we can't redirect it. Finally,
+ # restore any grab that was in effect.
+
+ tkwait variable tkPriv(selectFilePath)
+ catch {focus $oldFocus}
+ grab release $w
+ wm withdraw $w
+ if {$oldGrab != ""} {
+ if {$grabStatus == "global"} {
+ grab -global $oldGrab
+ } else {
+ grab $oldGrab
+ }
+ }
+ #delete the tracer, because this conflicts with multiple
+ #used dialogs
+ trace vdelete data(selectPath) w "tkFDialog_SetPath $w"
+ return $tkPriv(selectFilePath)
+}
+
+# tkFDialog_Config --
+#
+# Configures the TK filedialog according to the argument list
+#
+proc tkFDialog_Config {w type argList} {
+ upvar #0 $w data
+
+ set data(type) $type
+
+ # 1: the configuration specs
+ #
+ set specs {
+ {-defaultextension "" "" ""}
+ {-filetypes "" "" ""}
+ {-initialdir "" "" ""}
+ {-initialfile "" "" ""}
+ {-parent "" "" "."}
+ {-title "" "" ""}
+ }
+ if ![string compare $type open] {
+ # CYGNUS LOCAL: Handle -choosedir.
+ # Note: the -choosedir option is a Cygnus extension. It is not
+ # documented since it only works on Unix -- it is an
+ # implementation detail of the directory-choosing code in
+ # in libgui.
+ lappend specs {-multiple "" "" "0"} {-choosedir "" "" "0"}
+ # END CYGNUS LOCAL
+ }
+
+ # 2: default values depending on the type of the dialog
+ #
+ if {![info exists data(selectPath)]} {
+ # first time the dialog has been popped up
+ set data(selectPath) [pwd]
+ set data(selectFile) ""
+ }
+
+ # 3: parse the arguments
+ #
+ tclParseConfigSpec $w $specs "" $argList
+
+ if {![string compare $data(-title) ""]} {
+ if {![string compare $type "open"]} {
+ set data(-title) "Open"
+ } else {
+ set data(-title) "Save As"
+ }
+ }
+
+ # 4: set the default directory and selection according to the -initial
+ # settings
+ #
+ # Khamis 16-04-98
+ # When the path contains blanks, glob returns an item in a list, but
+ # data(selectPath) must be an item and not a list of items, so we
+ # must extract the item from the returned list.
+ if {[string compare $data(-initialdir) ""]} {
+ if {[file isdirectory $data(-initialdir)]} {
+ #khamis: Join result of glob to an item
+ set data(selectPath) [lindex [glob $data(-initialdir)] 0]
+ } else {
+ set data(selectPath) [pwd]
+ }
+
+ # Convert the initialdir to an absolute path name.
+
+ set old [pwd]
+ cd $data(selectPath)
+ set data(selectPath) [pwd]
+ cd $old
+ }
+ set data(selectFile) $data(-initialfile)
+
+ # 5. Parse the -filetypes option
+ #
+ set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]
+
+ if {![winfo exists $data(-parent)]} {
+ error "bad window path name \"$data(-parent)\""
+ }
+
+ # Set -multiple to a one or zero value (not other boolean types
+ # like "yes") so we can use it in tests easier.
+ if {![string compare $type save]} {
+ set data(-multiple) 0
+ # CYGNUS LOCAL: choosedir
+ # Handle -choosedir here as well.
+ set data(-choosedir) 0
+ # END CYGNUS LOCAL
+ } else {
+ if {$data(-multiple)} {
+ set data(-multiple) 1
+ }
+ }
+}
+
+proc tkFDialog_Create {w} {
+ set dataName [lindex [split $w .] end]
+ upvar #0 $dataName data
+ global tk_library
+
+ toplevel $w -class TkFDialog
+
+ # f1: the frame with the directory option menu
+ #
+ set f1 [frame $w.f1]
+ label $f1.lab -text "Directory:" -under 0
+ set data(dirMenuBtn) $f1.menu
+ set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) $dataName] ""]
+ set data(upBtn) [button $f1.up]
+ if {![info exists tkPriv(updirImage)]} {
+ set tkPriv(updirImage) [image create bitmap -data {
+#define updir_width 28
+#define updir_height 16
+static char updir_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
+ 0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
+ 0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
+ 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
+ 0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
+ 0xf0, 0xff, 0xff, 0x01};}]
+ }
+ $data(upBtn) config -image $tkPriv(updirImage)
+
+ $f1.menu config -takefocus 1 -highlightthickness 2
+
+ pack $data(upBtn) -side right -padx 4 -fill both
+ pack $f1.lab -side left -padx 4 -fill both
+ pack $f1.menu -expand yes -fill both -padx 4
+
+ # data(icons): the IconList that list the files and directories.
+ #
+ set data(icons) [tkIconList $w.icons \
+ -browsecmd "tkFDialog_ListBrowse $w" \
+ -command "tkFDialog_ListInvoke $w" \
+ -multiple "$data(-multiple)"]
+
+ # f2: the frame with the OK button and the "file name" field
+ #
+ set f2 [frame $w.f2 -bd 0]
+ label $f2.lab -text "File name:" -anchor e -width 14 -under 5 -pady 0
+ if {$data(-multiple)} {
+ $f2.lab config -text "File names:"
+ }
+ set data(ent) [entry $f2.ent]
+
+ # The font to use for the icons. The default Canvas font on Unix
+ # is just deviant.
+ global $w.icons
+ set $w.icons(font) [$data(ent) cget -font]
+
+ # f3: the frame with the cancel button and the file types field
+ #
+ set f3 [frame $w.f3 -bd 0]
+
+ # The "File of types:" label needs to be grayed-out when
+ # -filetypes are not specified. The label widget does not support
+ # grayed-out text on monochrome displays. Therefore, we have to
+ # use a button widget to emulate a label widget (by setting its
+ # bindtags)
+
+ set data(typeMenuLab) [button $f3.lab -text "Files of type:" \
+ -anchor e -width 14 -under 9 \
+ -bd [$f2.lab cget -bd] \
+ -highlightthickness [$f2.lab cget -highlightthickness] \
+ -relief [$f2.lab cget -relief] \
+ -padx [$f2.lab cget -padx] \
+ -pady [$f2.lab cget -pady]]
+ bindtags $data(typeMenuLab) [list $data(typeMenuLab) Label \
+ [winfo toplevel $data(typeMenuLab)] all]
+
+ set data(typeMenuBtn) [menubutton $f3.menu -indicatoron 1 -menu $f3.menu.m]
+ set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
+ $data(typeMenuBtn) config -takefocus 1 -highlightthickness 2 \
+ -relief raised -bd 2 -anchor w
+
+ # the okBtn is created after the typeMenu so that the keyboard traversal
+ # is in the right order
+ set data(okBtn) [button $f2.ok -text OK -under 0 -width 6 \
+ -default active -pady 3]
+ set data(cancelBtn) [button $f3.cancel -text Cancel -under 0 -width 6\
+ -default normal -pady 3]
+
+ # pack the widgets in f2 and f3
+ #
+ pack $data(okBtn) -side right -padx 4 -anchor e
+ pack $f2.lab -side left -padx 4
+ pack $f2.ent -expand yes -fill x -padx 2 -pady 0
+
+ pack $data(cancelBtn) -side right -padx 4 -anchor w
+ pack $data(typeMenuLab) -side left -padx 4
+ pack $data(typeMenuBtn) -expand yes -fill x -side right
+
+ # Pack all the frames together. We are done with widget construction.
+ #
+ pack $f1 -side top -fill x -pady 4
+ pack $f3 -side bottom -fill x
+ pack $f2 -side bottom -fill x
+ pack $data(icons) -expand yes -fill both -padx 4 -pady 1
+
+ # Set up the event handlers
+ #
+ bind $data(ent) "tkFDialog_ActivateEnt $w"
+
+ $data(upBtn) config -command "tkFDialog_UpDirCmd $w"
+ $data(okBtn) config -command "tkFDialog_OkCmd $w"
+ $data(cancelBtn) config -command "tkFDialog_CancelCmd $w"
+
+ #trace variable data(selectPath) w "tkFDialog_SetPath $w"
+
+ bind $w "focus $data(dirMenuBtn)"
+ bind $w [format {
+ if {"[%s cget -state]" == "normal"} {
+ focus %s
+ }
+ } $data(typeMenuBtn) $data(typeMenuBtn)]
+ bind $w "focus $data(ent)"
+ bind $w "tkButtonInvoke $data(cancelBtn)"
+ bind $w "tkButtonInvoke $data(cancelBtn)"
+ bind $w "tkFDialog_InvokeBtn $w Open"
+ bind $w "tkFDialog_InvokeBtn $w Save"
+
+ wm protocol $w WM_DELETE_WINDOW "tkFDialog_CancelCmd $w"
+
+ # Build the focus group for all the entries
+ #
+ tkFocusGroup_Create $w
+ tkFocusGroup_BindIn $w $data(ent) "tkFDialog_EntFocusIn $w"
+ tkFocusGroup_BindOut $w $data(ent) "tkFDialog_EntFocusOut $w"
+}
+
+# tkFDialog_UpdateWhenIdle --
+#
+# Creates an idle event handler which updates the dialog in idle
+# time. This is important because loading the directory may take a long
+# time and we don't want to load the same directory for multiple times
+# due to multiple concurrent events.
+#
+proc tkFDialog_UpdateWhenIdle {w} {
+ upvar #0 [winfo name $w] data
+
+ if {[info exists data(updateId)]} {
+ return
+ } else {
+ set data(updateId) [after idle tkFDialog_Update $w]
+ }
+}
+
+# tkFDialog_Update --
+#
+# Loads the files and directories into the IconList widget. Also
+# sets up the directory option menu for quick access to parent
+# directories.
+#
+proc tkFDialog_Update {w} {
+
+ # This proc may be called within an idle handler. Make sure that the
+ # window has not been destroyed before this proc is called
+ if {![winfo exists $w] || [string compare [winfo class $w] TkFDialog]} {
+ return
+ }
+
+ set dataName [winfo name $w]
+ upvar #0 $dataName data
+ global tk_library tkPriv
+ catch {unset data(updateId)}
+
+ set TRANSPARENT_GIF_COLOR [$w cget -bg]
+ if {![info exists tkPriv(folderImage)]} {
+ set tkPriv(folderImage) [image create photo -data {
+R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
+QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
+ set tkPriv(fileImage) [image create photo -data {
+R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO
+rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
+ }
+ set folder $tkPriv(folderImage)
+ set file $tkPriv(fileImage)
+
+ set appPWD [pwd]
+ if {[catch {
+ cd $data(selectPath)
+ }]} {
+ # We cannot change directory to $data(selectPath). $data(selectPath)
+ # should have been checked before tkFDialog_Update is called, so
+ # we normally won't come to here. Anyways, give an error and abort
+ # action.
+ tk_messageBox -type ok -parent $data(-parent) -message \
+ "Cannot change to the directory \"$data(selectPath)\".\nPermission denied."\
+ -icon warning
+ cd $appPWD
+ return
+ }
+
+ # Turn on the busy cursor. BUG?? We haven't disabled X events, though,
+ # so the user may still click and cause havoc ...
+ #
+ set entCursor [$data(ent) cget -cursor]
+ set dlgCursor [$w cget -cursor]
+ $data(ent) config -cursor watch
+ $w config -cursor watch
+ update idletasks
+
+ tkIconList_DeleteAll $data(icons)
+
+ # Make the dir list
+ #
+ foreach f [lsort -dictionary [glob -nocomplain .* *]] {
+ if {![string compare $f .]} {
+ continue
+ }
+ if {![string compare $f ..]} {
+ continue
+ }
+ if {[file isdir ./$f]} {
+ if {![info exists hasDoneDir($f)]} {
+ tkIconList_Add $data(icons) $folder $f
+ set hasDoneDir($f) 1
+ }
+ }
+ }
+ # Make the file list
+ #
+ if {![string compare $data(filter) *]} {
+ set files [lsort -dictionary \
+ [glob -nocomplain .* *]]
+ } else {
+ set files [lsort -dictionary \
+ [eval glob -nocomplain $data(filter)]]
+ }
+
+ set top 0
+ foreach f $files {
+ if {![file isdir ./$f]} {
+ if {![info exists hasDoneFile($f)]} {
+ tkIconList_Add $data(icons) $file $f
+ set hasDoneFile($f) 1
+ }
+ }
+ }
+
+ tkIconList_Arrange $data(icons)
+
+ # Update the Directory: option menu
+ #
+ set list ""
+ set dir ""
+ foreach subdir [file split $data(selectPath)] {
+ set dir [file join $dir $subdir]
+ lappend list $dir
+ }
+
+ $data(dirMenu) delete 0 end
+ set var [format %s(selectPath) $dataName]
+ foreach path $list {
+ $data(dirMenu) add command -label $path -command [list set $var $path]
+ }
+
+ # Restore the PWD to the application's PWD
+ #
+ cd $appPWD
+
+ # turn off the busy cursor.
+ #
+ $data(ent) config -cursor $entCursor
+ $w config -cursor $dlgCursor
+}
+
+# tkFDialog_SetPathSilently --
+#
+# Sets data(selectPath) without invoking the trace procedure
+#
+proc tkFDialog_SetPathSilently {w path} {
+ upvar #0 [winfo name $w] data
+
+ trace vdelete data(selectPath) w "tkFDialog_SetPath $w"
+ set data(selectPath) $path
+ trace variable data(selectPath) w "tkFDialog_SetPath $w"
+}
+
+
+# This proc gets called whenever data(selectPath) is set
+#
+proc tkFDialog_SetPath {w name1 name2 op} {
+ if {[winfo exists $w]} {
+ upvar #0 [winfo name $w] data
+ tkFDialog_UpdateWhenIdle $w
+ }
+}
+
+# This proc gets called whenever data(filter) is set
+#
+proc tkFDialog_SetFilter {w type} {
+ upvar #0 [winfo name $w] data
+ upvar \#0 $data(icons) icons
+
+ set data(filter) [lindex $type 1]
+ $data(typeMenuBtn) config -text [lindex $type 0] -indicatoron 1
+
+ $icons(sbar) set 0.0 0.0
+
+ tkFDialog_UpdateWhenIdle $w
+}
+
+# tkFDialogResolveFile --
+#
+# Interpret the user's text input in a file selection dialog.
+# Performs:
+#
+# (1) ~ substitution
+# (2) resolve all instances of . and ..
+# (3) check for non-existent files/directories
+# (4) check for chdir permissions
+#
+# Arguments:
+# context: the current directory you are in
+# text: the text entered by the user
+# defaultext: the default extension to add to files with no extension
+#
+# Return vaue:
+# [list $flag $directory $file]
+#
+# flag = OK : valid input
+# = PATTERN : valid directory/pattern
+# = PATH : the directory does not exist
+# = FILE : the directory exists by the file doesn't
+# exist
+# = CHDIR : Cannot change to the directory
+# = ERROR : Invalid entry
+#
+# directory : valid only if flag = OK or PATTERN or FILE
+# file : valid only if flag = OK or PATTERN
+#
+# directory may not be the same as context, because text may contain
+# a subdirectory name
+#
+proc tkFDialogResolveFile {context text defaultext} {
+
+ set appPWD [pwd]
+
+ set path [tkFDialog_JoinFile $context $text]
+
+ if {[file ext $path] == ""} {
+ set path "$path$defaultext"
+ }
+
+
+ if {[catch {file exists $path}]} {
+ # This "if" block can be safely removed if the following code
+ # stop generating errors.
+ #
+ # file exists ~nonsuchuser
+ #
+ return [list ERROR $path ""]
+ }
+
+ if {[file exists $path]} {
+ if {[file isdirectory $path]} {
+ if {[catch {
+ cd $path
+ }]} {
+ return [list CHDIR $path ""]
+ }
+ set directory [pwd]
+ set file ""
+ set flag OK
+ cd $appPWD
+ } else {
+ if {[catch {
+ cd [file dirname $path]
+ }]} {
+ return [list CHDIR [file dirname $path] ""]
+ }
+ set directory [pwd]
+ set file [file tail $path]
+ set flag OK
+ cd $appPWD
+ }
+ } else {
+ set dirname [file dirname $path]
+ if {[file exists $dirname]} {
+ if {[catch {
+ cd $dirname
+ }]} {
+ return [list CHDIR $dirname ""]
+ }
+ set directory [pwd]
+ set file [file tail $path]
+ if {[regexp {[*]|[?]} $file]} {
+ set flag PATTERN
+ } else {
+ set flag FILE
+ }
+ cd $appPWD
+ } else {
+ set directory $dirname
+ set file [file tail $path]
+ set flag PATH
+ }
+ }
+
+ return [list $flag $directory $file]
+}
+
+
+# Gets called when the entry box gets keyboard focus. We clear the selection
+# from the icon list . This way the user can be certain that the input in the
+# entry box is the selection.
+#
+proc tkFDialog_EntFocusIn {w} {
+ upvar #0 [winfo name $w] data
+
+ if {[string compare [$data(ent) get] ""]} {
+ $data(ent) selection from 0
+ $data(ent) selection to end
+ $data(ent) icursor end
+ } else {
+ $data(ent) selection clear
+ }
+
+ tkIconList_Unselect $data(icons)
+
+ if {![string compare $data(type) open]} {
+ $data(okBtn) config -text "Open"
+ } else {
+ $data(okBtn) config -text "Save"
+ }
+}
+
+proc tkFDialog_EntFocusOut {w} {
+ upvar #0 [winfo name $w] data
+
+ $data(ent) selection clear
+}
+
+
+# Verification procedure
+proc tkFDialog_VerifyFileName { w fname } {
+ upvar #0 [winfo name $w] data
+
+ set list [tkFDialogResolveFile $data(selectPath) $fname \
+ $data(-defaultextension)]
+ set flag [lindex $list 0]
+ set path [lindex $list 1]
+ set file [lindex $list 2]
+
+ case $flag {
+ OK {
+ if {![string compare $file ""]} {
+ tkFDialog_SetPathSilently $w [file dirname $path]
+ # CYGNUS LOCAL: handle choosedir
+ if {$data(-choosedir)} {
+ if {$data(-multiple)} {
+ lappend data(selectFile) [file tail $path]
+ } else {
+ set data(selectFile) [file tail $path]
+ }
+ tkFDialog_Done $w
+ } else {
+ # user has entered an existing (sub)directory
+ set data(selectPath) $path
+ $data(ent) delete 0 end
+ }
+ } else {
+ tkFDialog_SetPathSilently $w $path
+ if {$data(-multiple)} {
+ lappend data(selectFile) $file
+ } else {
+ set data(selectFile) $file
+ }
+ tkFDialog_Done $w
+ }
+ }
+ PATTERN {
+ set data(selectPath) $path
+ set data(filter) $file
+ }
+ FILE {
+ if {![string compare $data(type) open]} {
+ tk_messageBox -icon warning -type ok -parent $data(-parent) \
+ -message "File \"[file join $path $file]\" does not exist."
+ $data(ent) select from 0
+ $data(ent) select to end
+ $data(ent) icursor end
+ } else {
+ tkFDialog_SetPathSilently $w $path
+ if {$data(-multiple)} {
+ lappend data(selectFile) $file
+ } else {
+ set data(selectFile) $file
+ }
+ tkFDialog_Done $w
+ }
+ }
+ PATH {
+ tk_messageBox -icon warning -type ok -parent $data(-parent) \
+ -message "Directory \"$path\" does not exist."
+ $data(ent) select from 0
+ $data(ent) select to end
+ $data(ent) icursor end
+ }
+ CHDIR {
+ tk_messageBox -type ok -parent $data(-parent) -message \
+ "Cannot change to the directory \"$path\".\nPermission denied."\
+ -icon warning
+ $data(ent) select from 0
+ $data(ent) select to end
+ $data(ent) icursor end
+ }
+ ERROR {
+ tk_messageBox -type ok -parent $data(-parent) -message \
+ "Invalid file name \"$path\"."\
+ -icon warning
+ $data(ent) select from 0
+ $data(ent) select to end
+ $data(ent) icursor end
+ }
+ }
+}
+
+# Gets called when user presses Return in the "File name" entry.
+#
+proc tkFDialog_ActivateEnt {w} {
+ upvar #0 [winfo name $w] data
+
+ #set text [string trim [$data(ent) get]]
+ set text [$data(ent) get]
+ if {$data(-multiple)} {
+ set data(selectFile) ""
+ foreach fname $text {
+ tkFDialog_VerifyFileName $w $fname
+ }
+ } else {
+ tkFDialog_VerifyFileName $w $text
+ }
+}
+
+# Gets called when user presses the Alt-s or Alt-o keys.
+#
+proc tkFDialog_InvokeBtn {w key} {
+ upvar #0 [winfo name $w] data
+
+ if {![string compare [$data(okBtn) cget -text] $key]} {
+ tkButtonInvoke $data(okBtn)
+ }
+}
+
+# Gets called when user presses the "parent directory" button
+#
+proc tkFDialog_UpDirCmd {w} {
+ upvar #0 [winfo name $w] data
+
+ if {[string compare $data(selectPath) "/"]} {
+ set data(selectPath) [file dirname $data(selectPath)]
+ }
+}
+
+# Join a file name to a path name. The "file join" command will break
+# if the filename begins with ~
+#
+proc tkFDialog_JoinFile {path file} {
+ if {[string match {~*} $file] && [file exists $path/$file]} {
+ return [file join $path ./$file]
+ } else {
+ return [file join $path $file]
+ }
+}
+
+
+
+# Gets called when user presses the "OK" button
+#
+proc tkFDialog_OkCmd {w} {
+ upvar #0 [winfo name $w] data
+
+ set text [tkIconList_Get $data(icons)]
+ if {[string compare $text ""]} {
+ if {!$data(-multiple)} {
+ set file [tkFDialog_JoinFile $data(selectPath) $text]
+ # CYGNUS LOCAL: handle choosedir
+ if {!$data(-choosedir) && [file isdirectory $file]} {
+ tkFDialog_ListInvoke $w $text
+ return
+ }
+ }
+ }
+
+ tkFDialog_ActivateEnt $w
+}
+
+# Gets called when user presses the "Cancel" button
+#
+proc tkFDialog_CancelCmd {w} {
+ upvar #0 [winfo name $w] data
+ global tkPriv
+
+ set tkPriv(selectFilePath) ""
+}
+
+# Gets called when user browses the IconList widget (dragging mouse, arrow
+# keys, etc)
+#
+proc tkFDialog_ListBrowse {w text} {
+ upvar #0 [winfo name $w] data
+
+ if {$text == ""} {
+ return
+ }
+
+ set file [tkFDialog_JoinFile $data(selectPath) $text]
+ # CYGNUS LOCAL: handle choosedir
+ if {$data(-choosedir) || ![file isdirectory $file]} {
+ $data(ent) delete 0 end
+ $data(ent) insert 0 $text
+
+ if {![string compare $data(type) open]} {
+ $data(okBtn) config -text "Open"
+ } else {
+ $data(okBtn) config -text "Save"
+ }
+ } else {
+ $data(okBtn) config -text "Open"
+ }
+}
+
+# Gets called when user invokes the IconList widget (double-click,
+# Return key, etc)
+#
+proc tkFDialog_ListInvoke {w text} {
+ upvar #0 [winfo name $w] data
+
+ if {$text == ""} {
+ return
+ }
+
+ if {$data(-multiple)} {
+ set file [tkFDialog_JoinFile $data(selectPath) [lindex $text 0]]
+ } else {
+ set file [tkFDialog_JoinFile $data(selectPath) $text]
+ }
+
+ if {[file isdirectory $file]} {
+ set appPWD [pwd]
+ if {[catch {cd $file}]} {
+ tk_messageBox -type ok -parent $data(-parent) -message \
+ "Cannot change to the directory \"$file\".\nPermission denied."\
+ -icon warning
+ } else {
+ cd $appPWD
+ set data(selectPath) $file
+ }
+ } else {
+ if {$data(-multiple)} {
+ set data(selectFile) [list $file]
+ } else {
+ set data(selectFile) $file
+ }
+ tkFDialog_Done $w
+ }
+}
+
+# tkFDialog_Done --
+#
+# Gets called when user has input a valid filename. Pops up a
+# dialog box to confirm selection when necessary. Sets the
+# tkPriv(selectFilePath) variable, which will break the "tkwait"
+# loop in tkFDialog and return the selected filename to the
+# script that calls tk_getOpenFile or tk_getSaveFile
+#
+proc tkFDialog_Done {w {selectFilePath ""}} {
+ upvar #0 [winfo name $w] data
+ global tkPriv
+
+ if {![string compare $selectFilePath ""]} {
+ if {$data(-multiple)} {
+ set selectFilePath {}
+ foreach f $data(selectFile) {
+ lappend selectFilePath [file join $data(selectPath) $f]
+ }
+ } else {
+ set selectFilePath [tkFDialog_JoinFile $data(selectPath) \
+ $data(selectFile)]
+ }
+ set tkPriv(selectFile) $data(selectFile)
+ set tkPriv(selectPath) $data(selectPath)
+
+ if {[file exists $selectFilePath] &&
+ ![string compare $data(type) save]} {
+
+ set reply [tk_messageBox -icon warning -type yesno\
+ -parent $data(-parent) -message "File\
+ \"$selectFilePath\" already exists.\nDo\
+ you want to overwrite it?"]
+ if {![string compare $reply "no"]} {
+ return
+ }
+ }
+ }
+ set tkPriv(selectFilePath) $selectFilePath
+}
+
tkfboxTest.tcl
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property