Update Pier_v1 project
Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com>
This commit is contained in:
CopilotandCopilot committed
1 parent
f25e36c050
commit
ad73ddec2b
2476 files changed
+3423
-4902
No files matched your search
@@ -0,0 +1,44 @@
|
||||
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 on your path
|
||||
then you can invoke any of the programs in this directory just
|
||||
by typing its file name to your command shell under Unix. 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.
|
||||
@@ -0,0 +1,160 @@
|
||||
# anilabel.tcl --
|
||||
#
|
||||
# This demonstration script creates a toplevel window containing
|
||||
# several animated label widgets.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .anilabel
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Animated Label Demonstration"
|
||||
wm iconname $w "anilabel"
|
||||
positionWindow $w
|
||||
|
||||
label $w.msg -font $font -wraplength 4i -justify left -text "Four animated labels are displayed below; each of the labels on the left is animated by making the text message inside it appear to scroll, and the label on the right is animated by animating the image that it displays."
|
||||
pack $w.msg -side top
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
# Ensure that this this is an array
|
||||
array set animationCallbacks {}
|
||||
|
||||
## This callback is the core of how to do animation in Tcl/Tk; all
|
||||
## animations work in basically the same way, with a procedure that
|
||||
## uses the [after] command to reschedule itself at some point in the
|
||||
## future. Of course, the details of how to update the state will vary
|
||||
## according to what is being animated.
|
||||
proc RotateLabelText {w interval} {
|
||||
global animationCallbacks
|
||||
|
||||
# Schedule the calling of this procedure again in the future
|
||||
set animationCallbacks($w) [after $interval RotateLabelText $w $interval]
|
||||
|
||||
# We do marquee-like scrolling text by chopping characters off the
|
||||
# front of the text and sticking them on the end.
|
||||
set text [$w cget -text]
|
||||
set newText [string range $text 1 end][string index $text 0]
|
||||
$w configure -text $newText
|
||||
}
|
||||
|
||||
## A helper procedure to start the animation happening.
|
||||
proc animateLabelText {w text interval} {
|
||||
global animationCallbacks
|
||||
|
||||
# Install the text into the widget
|
||||
$w configure -text $text
|
||||
|
||||
# Schedule the start of the animation loop
|
||||
set animationCallbacks($w) [after $interval RotateLabelText $w $interval]
|
||||
|
||||
# Make sure that the animation stops and is cleaned up after itself
|
||||
# when the animated label is destroyed. Note that at this point we
|
||||
# cannot manipulate the widget itself, as that has already died.
|
||||
bind $w <Destroy> {
|
||||
after cancel $animationCallbacks(%W)
|
||||
unset animationCallbacks(%W)
|
||||
}
|
||||
}
|
||||
|
||||
## Next, a similar pair of procedures to animate a GIF loaded into a
|
||||
## photo image.
|
||||
proc SelectNextImageFrame {w interval} {
|
||||
global animationCallbacks
|
||||
set animationCallbacks($w) \
|
||||
[after $interval SelectNextImageFrame $w $interval]
|
||||
set image [$w cget -image]
|
||||
|
||||
# The easy way to animate a GIF!
|
||||
set idx -1
|
||||
scan [$image cget -format] "GIF -index %d" idx
|
||||
if {[catch {
|
||||
# Note that we get an error if the index is out of range
|
||||
$image configure -format "GIF -index [incr idx]"
|
||||
}]} then {
|
||||
$image configure -format "GIF -index 0"
|
||||
}
|
||||
}
|
||||
proc animateLabelImage {w imageData interval} {
|
||||
global animationCallbacks
|
||||
|
||||
# Create a multi-frame GIF from base-64-encoded data
|
||||
set image [image create photo -format GIF -data $imageData]
|
||||
|
||||
# Install the image into the widget
|
||||
$w configure -image $image
|
||||
|
||||
# Schedule the start of the animation loop
|
||||
set animationCallbacks($w) \
|
||||
[after $interval SelectNextImageFrame $w $interval]
|
||||
|
||||
# Make sure that the animation stops and is cleaned up after itself
|
||||
# when the animated label is destroyed. Note that at this point we
|
||||
# cannot manipulate the widget itself, as that has already died.
|
||||
# Also note that this script is in double-quotes; this is always OK
|
||||
# because image names are chosen automatically to be simple words.
|
||||
bind $w <Destroy> "
|
||||
after cancel \$animationCallbacks(%W)
|
||||
unset animationCallbacks(%W)
|
||||
rename $image {}
|
||||
"
|
||||
}
|
||||
|
||||
# Make some widgets to contain the animations
|
||||
labelframe $w.left -text "Scrolling Texts"
|
||||
labelframe $w.right -text "GIF Image"
|
||||
pack $w.left $w.right -side left -padx 10 -pady 10 -expand yes
|
||||
|
||||
# This method of scrolling text looks far better with a fixed-width font
|
||||
label $w.left.l1 -bd 4 -relief ridge -font fixedFont
|
||||
label $w.left.l2 -bd 4 -relief groove -font fixedFont
|
||||
label $w.left.l3 -bd 4 -relief flat -font fixedFont -width 18
|
||||
pack $w.left.l1 $w.left.l2 $w.left.l3 -side top -expand yes -padx 10 -pady 10 -anchor w
|
||||
# Don't need to do very much with this label except turn off the border
|
||||
label $w.right.l -bd 0
|
||||
pack $w.right.l -side top -expand yes -padx 10 -pady 10
|
||||
|
||||
# This is a base-64-encoded animated GIF file.
|
||||
set tclPoweredData {
|
||||
R0lGODlhKgBAAPQAAP//////zP//AP/MzP/Mmf/MAP+Zmf+ZZv+ZAMz//8zM
|
||||
zMyZmcyZZsxmZsxmAMwzAJnMzJmZzJmZmZlmmZlmZplmM5kzM2aZzGZmzGZm
|
||||
mWZmZmYzZmYzMzNmzDMzZgAzmSH+IE1hZGUgd2l0aCBHSU1QIGJ5IExARGVt
|
||||
YWlsbHkuY29tACH5BAVkAAEALAAAAAAqAEAAAAX+YCCOZEkyTKM2jOm66yPP
|
||||
dF03bx7YcuHIDkGBR7SZeIyhTID4FZ+4Es8nQyCe2EeUNJ0peY2s9mi7PhAM
|
||||
ngEAMGRbUpvzSxskLh1J+Hkg134OdDIDEB+GHxtYMEQMTjMGEYeGFoomezaC
|
||||
DZGSHFmLXTQKkh8eNQVpZ2afmDQGHaOYSoEyhhcklzVmMpuHnaZmDqiGJbg0
|
||||
qFqvh6UNAwB7VA+OwydEjgujkgrPNhbTI8dFvNgEYcHcHx0lB1kX2IYeA2G6
|
||||
NN0YfkXJ2BsAMuAzHB9cZMk3qoEbRzUACsRCUBK5JxsC3iMiKd8GN088SIyT
|
||||
0RAFSROyeEg38caDiB/+JEgqxsODrZJ1BkT0oHKSmI0ceQxo94HDpg0qsuDk
|
||||
UmRAMgu8OgwQ+uIJgUMVeGXA+IQkzEeHGvD8cIGlDXsLiRjQ+EHroQhea7xY
|
||||
8IQBSgYYDi1IS+OFBCgaDMGVS3fGi5BPJpBaENdQ0EomKGD56IHwO39EXiSC
|
||||
Ysgxor5+Xfgq0qByYUpiXmwuoredB2aYH4gWWda0B7SeNENpEJHC1ghi+pS4
|
||||
AJpIAwWvKPBi+8YEht5EriEqpFfMlhEdkBNpx0HUhwypx5T4IB1MBg/Ws2sn
|
||||
wV3MSQOkzI8fUd48Aw3dOZto71x85hHtHijYv18Gf/3GqCdDCXHNoICBobSo
|
||||
IqBqJLyCoH8JPrLgdh88CKCFD0CGmAiGYPgffwceZh6FC2ohIIklnkhehTNY
|
||||
4CIHHGzgwYw01ujBBhvAqKOLLq5AAk9kuSPkkKO40NB+h1gnypJIIvkBf09a
|
||||
N5QIRz5p5ZJXJpmlIVhOGQA2TmIJZZhKKmmll2BqyWSXWUrZpQtpatlmk1c2
|
||||
KaWRHeTZEJF8SqLDn/hhsOeQgBbqAh6DGqronxeARUIIACH5BAUeAAAALAUA
|
||||
LgAFAAUAAAUM4CeKz/OV5YmqaRkCACH5BAUeAAEALAUALgAKAAUAAAUUICCK
|
||||
z/OdJVCaa7p+7aOWcDvTZwgAIfkEBR4AAQAsCwAuAAkABQAABRPgA4zP95zA
|
||||
eZqoWqqpyqLkZ38hACH5BAUKAAEALAcALgANAA4AAAU7ICA+jwiUJEqeKau+
|
||||
r+vGaTmac63v/GP9HM7GQyx+jsgkkoRUHJ3Qx0cK/VQVTKtWwbVKn9suNunc
|
||||
WkMAIfkEBQoAAAAsBwA3AAcABQAABRGgIHzk842j+Yjlt5KuO8JmCAAh+QQF
|
||||
CgAAACwLADcABwAFAAAFEeAnfN9TjqP5oOWziq05lmUIACH5BAUKAAAALA8A
|
||||
NwAHAAUAAAUPoPCJTymS3yiQj4qOcPmEACH5BAUKAAAALBMANwAHAAUAAAUR
|
||||
oCB+z/MJX2o+I2miKimiawgAIfkEBQoAAAAsFwA3AAcABQAABRGgIHzfY47j
|
||||
Q4qk+aHl+pZmCAAh+QQFCgAAACwbADcABwAFAAAFEaAgfs/zCV9qPiNJouo7
|
||||
ll8IACH5BAUKAAAALB8ANwADAAUAAAUIoCB8o0iWZggAOw==
|
||||
}
|
||||
|
||||
# Finally, set up the text scrolling animation
|
||||
animateLabelText $w.left.l1 "* Slow Animation *" 300
|
||||
animateLabelText $w.left.l2 "* Fast Animation *" 80
|
||||
animateLabelText $w.left.l3 "This is a longer scrolling text in a widget that will not show the whole message at once. " 150
|
||||
animateLabelImage $w.right.l $tclPoweredData 100
|
||||
@@ -0,0 +1,104 @@
|
||||
# aniwave.tcl --
|
||||
#
|
||||
# This demonstration script illustrates how to adjust canvas item
|
||||
# coordinates in a way that does something fairly similar to waveform
|
||||
# display.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .aniwave
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Animated Wave Demonstration"
|
||||
wm iconname $w "aniwave"
|
||||
positionWindow $w
|
||||
|
||||
label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration contains a canvas widget with a line item inside it. The animation routines work by adjusting the coordinates list of the line; a trace on a variable is used so updates to the variable result in a change of position of the line."
|
||||
pack $w.msg -side top
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
# Create a canvas large enough to hold the wave. In fact, the wave
|
||||
# sticks off both sides of the canvas to prevent visual glitches.
|
||||
pack [canvas $w.c -width 300 -height 200 -background black] -padx 10 -pady 10 -expand yes
|
||||
|
||||
# Ensure that this this is an array
|
||||
array set animationCallbacks {}
|
||||
|
||||
# Creates a coordinates list of a wave. This code does a very sketchy
|
||||
# job and relies on Tk's line smoothing to make things look better.
|
||||
set waveCoords {}
|
||||
for {set x -10} {$x<=300} {incr x 5} {
|
||||
lappend waveCoords $x 100
|
||||
}
|
||||
lappend waveCoords $x 0 [incr x 5] 200
|
||||
|
||||
# Create a smoothed line and arrange for its coordinates to be the
|
||||
# contents of the variable waveCoords.
|
||||
$w.c create line $waveCoords -tags wave -width 1 -fill green -smooth 1
|
||||
proc waveCoordsTracer {w args} {
|
||||
global waveCoords
|
||||
# Actual visual update will wait until we have finished
|
||||
# processing; Tk does that for us automatically.
|
||||
$w.c coords wave $waveCoords
|
||||
}
|
||||
trace add variable waveCoords write [list waveCoordsTracer $w]
|
||||
|
||||
# Basic motion handler. Given what direction the wave is travelling
|
||||
# in, it advances the y coordinates in the coordinate-list one step in
|
||||
# that direction.
|
||||
proc basicMotion {} {
|
||||
global waveCoords direction
|
||||
set oc $waveCoords
|
||||
for {set i 1} {$i<[llength $oc]} {incr i 2} {
|
||||
if {$direction eq "left"} {
|
||||
lset waveCoords $i [lindex $oc \
|
||||
[expr {$i+2>[llength $oc] ? 1 : $i+2}]]
|
||||
} else {
|
||||
lset waveCoords $i \
|
||||
[lindex $oc [expr {$i-2<0 ? "end" : $i-2}]]
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Oscillation handler. This detects whether to reverse the direction
|
||||
# of the wave by checking to see if the peak of the wave has moved off
|
||||
# the screen (whose size we know already.)
|
||||
proc reverser {} {
|
||||
global waveCoords direction
|
||||
if {[lindex $waveCoords 1] < 10} {
|
||||
set direction "right"
|
||||
} elseif {[lindex $waveCoords end] < 10} {
|
||||
set direction "left"
|
||||
}
|
||||
}
|
||||
|
||||
# Main animation "loop". This calls the two procedures that handle the
|
||||
# movement repeatedly by scheduling asynchronous calls back to itself
|
||||
# using the [after] command. This procedure is the fundamental basis
|
||||
# for all animated effect handling in Tk.
|
||||
proc move {} {
|
||||
basicMotion
|
||||
reverser
|
||||
|
||||
# Theoretically 100 frames-per-second (==10ms between frames)
|
||||
global animationCallbacks
|
||||
set animationCallbacks(simpleWave) [after 10 move]
|
||||
}
|
||||
|
||||
# Initialise our remaining animation variables
|
||||
set direction "left"
|
||||
set animateAfterCallback {}
|
||||
# Arrange for the animation loop to stop when the canvas is deleted
|
||||
bind $w.c <Destroy> {
|
||||
after cancel $animationCallbacks(simpleWave)
|
||||
unset animationCallbacks(simpleWave)
|
||||
}
|
||||
# Start the animation processing
|
||||
move
|
||||
@@ -0,0 +1,241 @@
|
||||
# arrow.tcl --
|
||||
#
|
||||
# This demonstration script creates a canvas widget that displays a
|
||||
# large line with an arrowhead whose shape can be edited interactively.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
# 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) -arrow last \
|
||||
-width [expr {10*$v(width)}] -arrowshape [list \
|
||||
[expr {10*$v(a)}] [expr {10*$v(b)}] [expr {10*$v(c)}]]} \
|
||||
$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}] \
|
||||
-tags {box1 box}} $v(boxStyle)
|
||||
eval {$c create rect [expr {$xtip-5}] [expr {$v(y)-$deltaY-5}] \
|
||||
[expr {$xtip+5}] [expr {$v(y)-$deltaY+5}] \
|
||||
-tags {box2 box}} $v(boxStyle)
|
||||
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}] \
|
||||
-tags {box3 box}} $v(boxStyle)
|
||||
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
|
||||
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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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} {
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
set demo_arrowInfo(bigLineStyle) "-fill systemSelectedTextBackgroundColor"
|
||||
} else {
|
||||
set demo_arrowInfo(bigLineStyle) "-fill LightSeaGreen"
|
||||
}
|
||||
set demo_arrowInfo(boxStyle) "-fill {} -width 1"
|
||||
set demo_arrowInfo(activeStyle) "-fill red -width 1"
|
||||
} else {
|
||||
# Main widget program sets variable tk_demoDirectory
|
||||
set demo_arrowInfo(bigLineStyle) "-fill black \
|
||||
-stipple @[file join $tk_demoDirectory 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 <Enter> "$c itemconfigure current $demo_arrowInfo(activeStyle)"
|
||||
$c bind box <Leave> "$c itemconfigure current $demo_arrowInfo(boxStyle)"
|
||||
$c bind box <B1-Enter> " "
|
||||
$c bind box <B1-Leave> " "
|
||||
$c bind box1 <Button-1> {set demo_arrowInfo(motionProc) arrowMove1}
|
||||
$c bind box2 <Button-1> {set demo_arrowInfo(motionProc) arrowMove2}
|
||||
$c bind box3 <Button-1> {set demo_arrowInfo(motionProc) arrowMove3}
|
||||
$c bind box <B1-Motion> "\$demo_arrowInfo(motionProc) $c %x %y"
|
||||
bind $c <ButtonRelease-1> "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
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,78 @@
|
||||
# bind.tcl --
|
||||
#
|
||||
# This demonstration script creates a text widget with bindings set
|
||||
# up for hypertext-like effects.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .bind
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Text Demonstration - Tag Bindings"
|
||||
wm iconname $w "bind"
|
||||
positionWindow $w
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
text $w.text -yscrollcommand "$w.scroll set" -setgrid true \
|
||||
-width 60 -height 24 -font $font -wrap word
|
||||
ttk::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 <Enter> "$w.text tag configure $tag $bold"
|
||||
$w.text tag bind $tag <Leave> "$w.text tag configure $tag $normal"
|
||||
}
|
||||
# Main widget program sets variable tk_demoDirectory
|
||||
$w.text tag bind d1 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory items.tcl]}
|
||||
$w.text tag bind d2 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory plot.tcl]}
|
||||
$w.text tag bind d3 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory ctext.tcl]}
|
||||
$w.text tag bind d4 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory arrow.tcl]}
|
||||
$w.text tag bind d5 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory ruler.tcl]}
|
||||
$w.text tag bind d6 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory cscroll.tcl]}
|
||||
|
||||
$w.text mark set insert 0.0
|
||||
$w.text configure -state disabled
|
||||
@@ -0,0 +1,52 @@
|
||||
# bitmap.tcl --
|
||||
#
|
||||
# This demonstration script creates a toplevel window that displays
|
||||
# all of Tk's built-in bitmaps.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
# 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
|
||||
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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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
|
||||
@@ -0,0 +1,66 @@
|
||||
#!/bin/sh
|
||||
# the next line restarts using wish \
|
||||
exec wish "$0" ${1+"$@"}
|
||||
|
||||
# browse --
|
||||
# This script generates a directory browser, which lists the working
|
||||
# directory and allows you to open files or subdirectories by
|
||||
# double-clicking.
|
||||
|
||||
package require Tk
|
||||
|
||||
# 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.
|
||||
|
||||
set browseScript [file join [pwd] $argv0]
|
||||
proc browse {dir file} {
|
||||
global env browseScript
|
||||
if {[string compare $dir "."] != 0} {set file $dir/$file}
|
||||
switch [file type $file] {
|
||||
directory {
|
||||
exec [info nameofexecutable] $browseScript $file &
|
||||
}
|
||||
file {
|
||||
if {[info exists env(EDITOR)]} {
|
||||
eval exec $env(EDITOR) $file &
|
||||
} else {
|
||||
exec xedit $file &
|
||||
}
|
||||
}
|
||||
default {
|
||||
puts stdout "\"$file\" isn't a directory or regular file"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Fill the listbox with a list of all the files in the directory.
|
||||
|
||||
if {$argc>0} {set dir [lindex $argv 0]} else {set dir "."}
|
||||
foreach i [lsort [glob * .* *.*]] {
|
||||
if {[file type $i] eq "directory"} {
|
||||
# Safe to do since it is still a directory.
|
||||
append i /
|
||||
}
|
||||
.list insert end $i
|
||||
}
|
||||
|
||||
# Set up bindings for the browser.
|
||||
|
||||
bind all <Control-c> {destroy .}
|
||||
bind .list <Double-Button-1> {foreach i [selection get] {browse $dir $i}}
|
||||
|
||||
# Local Variables:
|
||||
# mode: tcl
|
||||
# End:
|
||||
@@ -0,0 +1,47 @@
|
||||
# button.tcl --
|
||||
#
|
||||
# This demonstration script creates a toplevel window containing
|
||||
# several button widgets.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
pack [addSeeDismiss $w.buttons $w] -side bottom -fill x
|
||||
|
||||
proc colorrefresh {w col} {
|
||||
$w configure -bg $col
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
# set highlightbackground of all buttons in $w
|
||||
set l [list $w]
|
||||
while {[llength $l]} {
|
||||
set l [concat [lassign $l b] [winfo children $b]]
|
||||
if {[winfo class $b] eq "Button"} {
|
||||
$b configure -highlightbackground $col
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
button $w.b1 -text "Peach Puff" -width 10 \
|
||||
-command [list colorrefresh $w PeachPuff1]
|
||||
button $w.b2 -text "Light Blue" -width 10 \
|
||||
-command [list colorrefresh $w LightBlue1]
|
||||
button $w.b3 -text "Sea Green" -width 10 \
|
||||
-command [list colorrefresh $w SeaGreen2]
|
||||
button $w.b4 -text "Yellow" -width 10 \
|
||||
-command [list colorrefresh $w Yellow1]
|
||||
pack $w.b1 $w.b2 $w.b3 $w.b4 -side top -expand yes -pady 2
|
||||
@@ -0,0 +1,71 @@
|
||||
# check.tcl --
|
||||
#
|
||||
# This demonstration script creates a toplevel window containing
|
||||
# several checkbuttons.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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 "Four 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. The first button also follows the state of the other three. If only some of the three are checked, the first button will display the tri-state mode. Click the \"See Variables\" button to see the current values of the variables."
|
||||
pack $w.msg -side top
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w [list safety wipers brakes sober]]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
checkbutton $w.b0 -text "Safety Check" -variable safety -relief flat \
|
||||
-onvalue "all" \
|
||||
-offvalue "none" \
|
||||
-tristatevalue "partial"
|
||||
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.b0 -side top -pady 2 -anchor w
|
||||
pack $w.b1 $w.b2 $w.b3 -side top -pady 2 -anchor w -padx 15
|
||||
|
||||
## This code makes $w.b0 function as a tri-state button; it's not
|
||||
## needed at all for just straight yes/no buttons.
|
||||
|
||||
set in_check 0
|
||||
proc tristate_check {n1 n2 op} {
|
||||
global safety wipers brakes sober in_check
|
||||
if {$in_check} {
|
||||
return
|
||||
}
|
||||
set in_check 1
|
||||
if {$n1 eq "safety"} {
|
||||
if {$safety eq "none"} {
|
||||
set wipers 0
|
||||
set brakes 0
|
||||
set sober 0
|
||||
} elseif {$safety eq "all"} {
|
||||
set wipers 1
|
||||
set brakes 1
|
||||
set sober 1
|
||||
}
|
||||
} else {
|
||||
if {$wipers == 1 && $brakes == 1 && $sober == 1} {
|
||||
set safety all
|
||||
} elseif {$wipers == 1 || $brakes == 1 || $sober == 1} {
|
||||
set safety partial
|
||||
} else {
|
||||
set safety none
|
||||
}
|
||||
}
|
||||
set in_check 0
|
||||
}
|
||||
|
||||
trace variable wipers w tristate_check
|
||||
trace variable brakes w tristate_check
|
||||
trace variable sober w tristate_check
|
||||
trace variable safety w tristate_check
|
||||
@@ -0,0 +1,54 @@
|
||||
# clrpick.tcl --
|
||||
#
|
||||
# This demonstration script prompts the user to select a color.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,99 @@
|
||||
# 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.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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 <Double-Button-1> {
|
||||
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
|
||||
@@ -0,0 +1,61 @@
|
||||
# combo.tcl --
|
||||
#
|
||||
# This demonstration script creates several combobox widgets.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .combo
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Combobox Demonstration"
|
||||
wm iconname $w "combo"
|
||||
positionWindow $w
|
||||
|
||||
ttk::label $w.msg -font $font -wraplength 5i -justify left -text "Three different\
|
||||
combo-boxes are displayed below. You can add characters to the first\
|
||||
one by pointing, clicking and typing, just as with an entry; pressing\
|
||||
Return will cause the current value to be added to the list that is\
|
||||
selectable from the drop-down list, and you can choose other values\
|
||||
by pressing the Down key, using the arrow keys to pick another one,\
|
||||
and pressing Return again. The second combo-box is fixed to a\
|
||||
particular value, and cannot be modified at all. The third one only\
|
||||
allows you to select values from its drop-down list of Australian\
|
||||
cities."
|
||||
pack $w.msg -side top -fill x
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w {firstValue secondValue ozCity}]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
ttk::frame $w.f
|
||||
pack $w.f -fill both -expand 1
|
||||
set w $w.f
|
||||
|
||||
set australianCities {
|
||||
Canberra Sydney Melbourne Perth Adelaide Brisbane
|
||||
Hobart Darwin "Alice Springs"
|
||||
}
|
||||
set secondValue unchangable
|
||||
set ozCity Sydney
|
||||
|
||||
ttk::labelframe $w.c1 -text "Fully Editable"
|
||||
ttk::combobox $w.c1.c -textvariable firstValue
|
||||
ttk::labelframe $w.c2 -text Disabled
|
||||
ttk::combobox $w.c2.c -textvariable secondValue -state disabled
|
||||
ttk::labelframe $w.c3 -text "Defined List Only"
|
||||
ttk::combobox $w.c3.c -textvariable ozCity -state readonly \
|
||||
-values $australianCities
|
||||
bind $w.c1.c <Return> {
|
||||
if {[%W get] ni [%W cget -values]} {
|
||||
%W configure -values [concat [%W cget -values] [list [%W get]]]
|
||||
}
|
||||
}
|
||||
|
||||
pack $w.c1 $w.c2 $w.c3 -side top -pady 5 -padx 10
|
||||
pack $w.c1.c -pady 5 -padx 10
|
||||
pack $w.c2.c -pady 5 -padx 10
|
||||
pack $w.c3.c -pady 5 -padx 10
|
||||
@@ -0,0 +1,172 @@
|
||||
# cscroll.tcl --
|
||||
#
|
||||
# This demonstration script creates a simple canvas that can be
|
||||
# scrolled in two dimensions.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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 \
|
||||
-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 <Enter> "scrollEnter $c"
|
||||
$c bind all <Leave> "scrollLeave $c"
|
||||
$c bind all <Button-1> "scrollButton $c"
|
||||
if {([tk windowingsystem] eq "aqua") && ![package vsatisfies [package provide Tk] 8.7-]} {
|
||||
bind $c <Button-3> "$c scan mark %x %y"
|
||||
bind $c <B3-Motion> "$c scan dragto %x %y"
|
||||
bind $c <MouseWheel> {
|
||||
%W yview scroll [expr {-%D}] units
|
||||
}
|
||||
bind $c <Option-MouseWheel> {
|
||||
%W yview scroll [expr {-10*%D}] units
|
||||
}
|
||||
bind $c <Shift-MouseWheel> {
|
||||
%W xview scroll [expr {-%D}] units
|
||||
}
|
||||
bind $c <Shift-Option-MouseWheel> {
|
||||
%W xview scroll [expr {-10*%D}] units
|
||||
}
|
||||
} else {
|
||||
bind $c <Button-2> "$c scan mark %x %y"
|
||||
bind $c <B2-Motion> "$c scan dragto %x %y"
|
||||
# We must make sure that positive and negative movements are rounded
|
||||
# equally to integers, avoiding the problem that
|
||||
# (int)1/-30 = -1,
|
||||
# but
|
||||
# (int)-1/-30 = 0
|
||||
# The following code ensure equal +/- behaviour.
|
||||
bind $c <MouseWheel> {
|
||||
if {%D >= 0} {
|
||||
%W yview scroll [expr {%D/-30}] units
|
||||
} else {
|
||||
%W yview scroll [expr {(%D-29)/-30}] units
|
||||
}
|
||||
}
|
||||
bind $c <Option-MouseWheel> {
|
||||
if {%D >= 0} {
|
||||
%W yview scroll [expr {%D/-3}] units
|
||||
} else {
|
||||
%W yview scroll [expr {(%D-2)/-3}] units
|
||||
}
|
||||
}
|
||||
bind $c <Shift-MouseWheel> {
|
||||
if {%D >= 0} {
|
||||
%W xview scroll [expr {%D/-30}] units
|
||||
} else {
|
||||
%W xview scroll [expr {(%D-29)/-30}] units
|
||||
}
|
||||
}
|
||||
bind $c <Shift-Option-MouseWheel> {
|
||||
if {%D >= 0} {
|
||||
%W xview scroll [expr {%D/-3}] units
|
||||
} else {
|
||||
%W xview scroll [expr {(%D-2)/-3}] units
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if {[tk windowingsystem] eq "x11" && ![package vsatisfies [package provide Tk] 8.7-]} {
|
||||
# Support for mousewheels on Linux/Unix commonly comes through mapping
|
||||
# the wheel to the extended buttons. If you have a mousewheel, find
|
||||
# Linux configuration info at:
|
||||
# https://linuxreviews.org/HOWTO_change_the_mouse_speed_in_X
|
||||
bind $c <Button-4> {
|
||||
if {!$tk_strictMotif} {
|
||||
%W yview scroll -5 units
|
||||
}
|
||||
}
|
||||
bind $c <Shift-Button-4> {
|
||||
if {!$tk_strictMotif} {
|
||||
%W xview scroll -5 units
|
||||
}
|
||||
}
|
||||
bind $c <Button-5> {
|
||||
if {!$tk_strictMotif} {
|
||||
%W yview scroll 5 units
|
||||
}
|
||||
}
|
||||
bind $c <Shift-Button-5> {
|
||||
if {!$tk_strictMotif} {
|
||||
%W xview scroll 5 units
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
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} {
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
$canvas itemconfigure $id -fill systemSelectedTextBackgroundColor
|
||||
} else {
|
||||
$canvas itemconfigure $id -fill LightSeaGreen
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
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
|
||||
}
|
||||
|
||||
proc scrollButton canvas {
|
||||
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]"
|
||||
}
|
||||
@@ -0,0 +1,176 @@
|
||||
# ctext.tcl --
|
||||
#
|
||||
# This demonstration script creates a canvas widget with a text
|
||||
# item that can be edited and reconfigured in various ways.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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, and on a pie slice to change its angle. 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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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 defined to support editing (see above)." -width 440 -anchor n -font $textFont -justify left]
|
||||
$c bind text <Button-1> "textB1Press $c %x %y"
|
||||
$c bind text <B1-Motion> "textB1Move $c %x %y"
|
||||
$c bind text <Shift-Button-1> "$c select adjust current @%x,%y"
|
||||
$c bind text <Shift-B1-Motion> "textB1Move $c %x %y"
|
||||
$c bind text <Key> "textInsert $c %A"
|
||||
$c bind text <Return> "textInsert $c \\n"
|
||||
$c bind text <Control-h> "textBs $c"
|
||||
$c bind text <BackSpace> "textBs $c"
|
||||
$c bind text <Delete> "textDel $c"
|
||||
if {[tk windowingsystem] eq "aqua" && ![package vsatisfies [package provide Tk] 8.7-]} {
|
||||
$c bind text <Button-3> "textPaste $c @%x,%y"
|
||||
} else {
|
||||
$c bind text <Button-2> "textPaste $c @%x,%y"
|
||||
}
|
||||
|
||||
# Next, create some items that allow the text's anchor position
|
||||
# to be edited.
|
||||
|
||||
proc mkTextConfigBox {w x y option value color} {
|
||||
set item [$w create rect $x $y [expr {$x+30}] [expr {$y+30}] \
|
||||
-outline black -fill $color -width 1]
|
||||
$w bind $item <Button-1> "$w itemconf text $option $value"
|
||||
$w addtag config withtag $item
|
||||
}
|
||||
proc mkTextConfigPie {w x y a option value color} {
|
||||
set item [$w create arc $x $y [expr {$x+90}] [expr {$y+90}] \
|
||||
-start [expr {$a-15}] -extent 30 -outline black -fill $color \
|
||||
-width 1]
|
||||
$w bind $item <Button-1> "$w itemconf text $option $value"
|
||||
$w addtag config withtag $item
|
||||
}
|
||||
|
||||
set x 50
|
||||
set y 50
|
||||
set color LightSkyBlue1
|
||||
mkTextConfigBox $c $x $y -anchor se $color
|
||||
mkTextConfigBox $c [expr {$x+30}] [expr {$y }] -anchor s $color
|
||||
mkTextConfigBox $c [expr {$x+60}] [expr {$y }] -anchor sw $color
|
||||
mkTextConfigBox $c [expr {$x }] [expr {$y+30}] -anchor e $color
|
||||
mkTextConfigBox $c [expr {$x+30}] [expr {$y+30}] -anchor center $color
|
||||
mkTextConfigBox $c [expr {$x+60}] [expr {$y+30}] -anchor w $color
|
||||
mkTextConfigBox $c [expr {$x }] [expr {$y+60}] -anchor ne $color
|
||||
mkTextConfigBox $c [expr {$x+30}] [expr {$y+60}] -anchor n $color
|
||||
mkTextConfigBox $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 <Button-1> "$c itemconf text -anchor center"
|
||||
$c create text [expr {$x+45}] [expr {$y-5}] \
|
||||
-text {Text Position} -anchor s -font {Times 20} -fill brown
|
||||
|
||||
# Now create some items that allow the text's angle to be changed.
|
||||
|
||||
set x 205
|
||||
set y 50
|
||||
set color Yellow
|
||||
mkTextConfigPie $c $x $y 0 -angle 90 $color
|
||||
mkTextConfigPie $c $x $y 30 -angle 120 $color
|
||||
mkTextConfigPie $c $x $y 60 -angle 150 $color
|
||||
mkTextConfigPie $c $x $y 90 -angle 180 $color
|
||||
mkTextConfigPie $c $x $y 120 -angle 210 $color
|
||||
mkTextConfigPie $c $x $y 150 -angle 240 $color
|
||||
mkTextConfigPie $c $x $y 180 -angle 270 $color
|
||||
mkTextConfigPie $c $x $y 210 -angle 300 $color
|
||||
mkTextConfigPie $c $x $y 240 -angle 330 $color
|
||||
mkTextConfigPie $c $x $y 270 -angle 0 $color
|
||||
mkTextConfigPie $c $x $y 300 -angle 30 $color
|
||||
mkTextConfigPie $c $x $y 330 -angle 60 $color
|
||||
$c create text [expr {$x+45}] [expr {$y-5}] \
|
||||
-text {Text Angle} -anchor s -font {Times 20} -fill brown
|
||||
|
||||
# Lastly, create some items that allow the text's justification to be
|
||||
# changed.
|
||||
|
||||
set x 350
|
||||
set y 50
|
||||
set color SeaGreen2
|
||||
mkTextConfigBox $c $x $y -justify left $color
|
||||
mkTextConfigBox $c [expr {$x+30}] $y -justify center $color
|
||||
mkTextConfigBox $c [expr {$x+60}] $y -justify right $color
|
||||
$c create text [expr {$x+45}] [expr {$y-5}] \
|
||||
-text {Justification} -anchor s -font {Times 20} -fill brown
|
||||
|
||||
$c bind config <Enter> "textEnter $c"
|
||||
$c bind config <Leave> "$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
|
||||
}
|
||||
@@ -0,0 +1,25 @@
|
||||
# dialog1.tcl --
|
||||
#
|
||||
# This demonstration script creates a dialog box with a local grab.
|
||||
|
||||
interp create child
|
||||
load {} Tk child
|
||||
child eval {
|
||||
wm title . child
|
||||
wm geometry . +700+30
|
||||
pack [text .t -width 30 -height 10]
|
||||
}
|
||||
|
||||
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 mouse or keyboard 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. For example, you should be able to edit text in the window named "child" which was created by a child interpreter.} \
|
||||
info 0 OK Cancel {Show Code}]
|
||||
|
||||
switch $i {
|
||||
0 {puts "You pressed OK"}
|
||||
1 {puts "You pressed Cancel"}
|
||||
2 {showCode .dialog1}
|
||||
}
|
||||
|
||||
if {[interp exists child]} {
|
||||
interp delete child
|
||||
}
|
||||
@@ -0,0 +1,18 @@
|
||||
# dialog2.tcl --
|
||||
#
|
||||
# This demonstration script creates a dialog box with a global grab.
|
||||
|
||||
after idle {
|
||||
.dialog2.msg configure -wraplength 4i
|
||||
}
|
||||
after 100 {
|
||||
grab -global .dialog2
|
||||
}
|
||||
set i [tk_dialog .dialog2 "Dialog with global grab" {This dialog box uses a global grab. If you are using an X11 window manager you will be prevented from interacting with anything on your display until you invoke one of the buttons below. This is almost always a bad idea; don't use global grabs with X11 unless you're truly desperate. On macOS systems you will not be able to interact with any window belonging to this process, but interaction with other macOS Applications will still be possible.}\
|
||||
warning 0 OK Cancel {Show Code}]
|
||||
|
||||
switch $i {
|
||||
0 {puts "You pressed OK"}
|
||||
1 {puts "You pressed Cancel"}
|
||||
2 {showCode .dialog2}
|
||||
}
|
||||
@@ -0,0 +1,97 @@
|
||||
::msgcat::mcset en "Widget Demonstration"
|
||||
::msgcat::mcset en "tkWidgetDemo"
|
||||
::msgcat::mcset en "&File"
|
||||
::msgcat::mcset en "About..."
|
||||
::msgcat::mcset en "&About..."
|
||||
::msgcat::mcset en "<F1>"
|
||||
::msgcat::mcset en "&Quit"
|
||||
::msgcat::mcset en "Meta+Q" ;# Displayed hotkey
|
||||
::msgcat::mcset en "Meta-q" ;# Actual binding sequence
|
||||
::msgcat::mcset en "Ctrl+Q" ;# Displayed hotkey
|
||||
::msgcat::mcset en "Control-q" ;# Actual binding sequence
|
||||
::msgcat::mcset en "Variable values"
|
||||
::msgcat::mcset en "Variable values:"
|
||||
::msgcat::mcset en "OK"
|
||||
::msgcat::mcset en "Run the \"%s\" sample program"
|
||||
::msgcat::mcset en "Dismiss"
|
||||
::msgcat::mcset en "Rerun Demo"
|
||||
::msgcat::mcset en "Demo code: %s"
|
||||
::msgcat::mcset en "About Widget Demo"
|
||||
::msgcat::mcset en "Tk widget demonstration application"
|
||||
::msgcat::mcset en "Copyright © %s"
|
||||
::msgcat::mcset en "
|
||||
@@title
|
||||
Tk Widget Demonstrations
|
||||
@@newline
|
||||
@@normal
|
||||
@@newline
|
||||
|
||||
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
|
||||
@@bold
|
||||
See Code
|
||||
@@normal
|
||||
button to see the Tcl/Tk code that created the demonstration. If
|
||||
you wish, you can edit the code and click the
|
||||
@@bold
|
||||
Rerun Demo
|
||||
@@normal
|
||||
button in the code window to reinvoke the demonstration with the
|
||||
modified code.
|
||||
@@newline
|
||||
"
|
||||
::msgcat::mcset en "Labels, buttons, checkbuttons, and radiobuttons"
|
||||
::msgcat::mcset en "Labels (text and bitmaps)"
|
||||
::msgcat::mcset en "Labels and UNICODE text"
|
||||
::msgcat::mcset en "Buttons"
|
||||
::msgcat::mcset en "Check-buttons (select any of a group)"
|
||||
::msgcat::mcset en "Radio-buttons (select one of a group)"
|
||||
::msgcat::mcset en "A 15-puzzle game made out of buttons"
|
||||
::msgcat::mcset en "Iconic buttons that use bitmaps"
|
||||
::msgcat::mcset en "Two labels displaying images"
|
||||
::msgcat::mcset en "A simple user interface for viewing images"
|
||||
::msgcat::mcset en "Labelled frames"
|
||||
::msgcat::mcset en "Listboxes"
|
||||
::msgcat::mcset en "The 50 states"
|
||||
::msgcat::mcset en "Colors: change the color scheme for the application"
|
||||
::msgcat::mcset en "A collection of famous and infamous sayings"
|
||||
::msgcat::mcset en "Entries and Spin-boxes"
|
||||
::msgcat::mcset en "Entries without scrollbars"
|
||||
::msgcat::mcset en "Entries with scrollbars"
|
||||
::msgcat::mcset en "Validated entries and password fields"
|
||||
::msgcat::mcset en "Spin-boxes"
|
||||
::msgcat::mcset en "Simple Rolodex-like form"
|
||||
::msgcat::mcset en "Text"
|
||||
::msgcat::mcset en "Basic editable text"
|
||||
::msgcat::mcset en "Text display styles"
|
||||
::msgcat::mcset en "Hypertext (tag bindings)"
|
||||
::msgcat::mcset en "A text widget with embedded windows"
|
||||
::msgcat::mcset en "A search tool built with a text widget"
|
||||
::msgcat::mcset en "Canvases"
|
||||
::msgcat::mcset en "The canvas item types"
|
||||
::msgcat::mcset en "A simple 2-D plot"
|
||||
::msgcat::mcset en "Text items in canvases"
|
||||
::msgcat::mcset en "An editor for arrowheads on canvas lines"
|
||||
::msgcat::mcset en "A ruler with adjustable tab stops"
|
||||
::msgcat::mcset en "A building floor plan"
|
||||
::msgcat::mcset en "A simple scrollable canvas"
|
||||
::msgcat::mcset en "Scales"
|
||||
::msgcat::mcset en "Horizontal scale"
|
||||
::msgcat::mcset en "Vertical scale"
|
||||
::msgcat::mcset en "Paned Windows"
|
||||
::msgcat::mcset en "Horizontal paned window"
|
||||
::msgcat::mcset en "Vertical paned window"
|
||||
::msgcat::mcset en "Menus"
|
||||
::msgcat::mcset en "Menus and cascades (sub-menus)"
|
||||
::msgcat::mcset en "Menu-buttons"
|
||||
::msgcat::mcset en "Common Dialogs"
|
||||
::msgcat::mcset en "Message boxes"
|
||||
::msgcat::mcset en "File selection dialog"
|
||||
::msgcat::mcset en "Color picker"
|
||||
::msgcat::mcset en "Miscellaneous"
|
||||
::msgcat::mcset en "The built-in bitmaps"
|
||||
::msgcat::mcset en "A dialog box with a local grab"
|
||||
::msgcat::mcset en "A dialog box with a global grab"
|
||||
@@ -0,0 +1,34 @@
|
||||
# entry1.tcl --
|
||||
#
|
||||
# This demonstration script creates several entry widgets without
|
||||
# scrollbars.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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 the middle mouse button pressed."
|
||||
pack $w.msg -side top
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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."
|
||||
@@ -0,0 +1,46 @@
|
||||
# entry2.tcl --
|
||||
#
|
||||
# This demonstration script is the same as the entry1.tcl script
|
||||
# except that it creates scrollbars for the entries.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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 the middle mouse button pressed."
|
||||
pack $w.msg -side top
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
frame $w.frame -borderwidth 10
|
||||
pack $w.frame -side top -fill x -expand 1
|
||||
|
||||
entry $w.frame.e1 -xscrollcommand "$w.frame.s1 set"
|
||||
ttk::scrollbar $w.frame.s1 -orient horiz -command \
|
||||
"$w.frame.e1 xview"
|
||||
frame $w.frame.spacer1 -width 20 -height 10
|
||||
entry $w.frame.e2 -xscrollcommand "$w.frame.s2 set"
|
||||
ttk::scrollbar $w.frame.s2 -orient horiz -command \
|
||||
"$w.frame.e2 xview"
|
||||
frame $w.frame.spacer2 -width 20 -height 10
|
||||
entry $w.frame.e3 -xscrollcommand "$w.frame.s3 set"
|
||||
ttk::scrollbar $w.frame.s3 -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."
|
||||
@@ -0,0 +1,185 @@
|
||||
# entry3.tcl --
|
||||
#
|
||||
# This demonstration script creates several entry widgets whose
|
||||
# permitted input is constrained in some way. It also shows off a
|
||||
# password entry.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .entry3
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Constrained Entry Demonstration"
|
||||
wm iconname $w "entry3"
|
||||
positionWindow $w
|
||||
|
||||
label $w.msg -font $font -wraplength 5i -justify left -text "Four different\
|
||||
entries are displayed below. You can add characters by pointing,\
|
||||
clicking and typing, though each is constrained in what it will\
|
||||
accept. The first only accepts 32-bit integers or the empty string\
|
||||
(checking when focus leaves it) and will flash to indicate any\
|
||||
problem. The second only accepts strings with fewer than ten\
|
||||
characters and sounds the bell when an attempt to go over the limit\
|
||||
is made. The third accepts US phone numbers, mapping letters to\
|
||||
their digit equivalent and sounding the bell on encountering an\
|
||||
illegal character or if trying to type over a character that is not\
|
||||
a digit. The fourth is a password field that accepts up to eight\
|
||||
characters (silently ignoring further ones), and displaying them as\
|
||||
asterisk characters."
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
# focusAndFlash --
|
||||
# Error handler for entry widgets that forces the focus onto the
|
||||
# widget and makes the widget flash by exchanging the foreground and
|
||||
# background colours at intervals of 200ms (i.e. at approximately
|
||||
# 2.5Hz).
|
||||
#
|
||||
# Arguments:
|
||||
# W - Name of entry widget to flash
|
||||
# fg - Initial foreground colour
|
||||
# bg - Initial background colour
|
||||
# count - Counter to control the number of times flashed
|
||||
|
||||
proc focusAndFlash {W fg bg {count 9}} {
|
||||
focus -force $W
|
||||
if {$count<1} {
|
||||
$W configure -foreground $fg -background $bg
|
||||
} else {
|
||||
if {$count%2} {
|
||||
$W configure -foreground $bg -background $fg
|
||||
} else {
|
||||
$W configure -foreground $fg -background $bg
|
||||
}
|
||||
after 200 [list focusAndFlash $W $fg $bg [expr {$count-1}]]
|
||||
}
|
||||
}
|
||||
|
||||
labelframe $w.l1 -text "Integer Entry"
|
||||
# Alternatively try using {string is digit} for arbitrary length numbers,
|
||||
# and not just 32-bit ones.
|
||||
entry $w.l1.e -validate focus -vcmd {string is integer %P}
|
||||
$w.l1.e configure -invalidcommand \
|
||||
"focusAndFlash %W [$w.l1.e cget -fg] [$w.l1.e cget -bg]"
|
||||
pack $w.l1.e -fill x -expand 1 -padx 1m -pady 1m
|
||||
|
||||
labelframe $w.l2 -text "Length-Constrained Entry"
|
||||
entry $w.l2.e -validate key -invcmd bell -vcmd {expr {[string length %P]<10}}
|
||||
pack $w.l2.e -fill x -expand 1 -padx 1m -pady 1m
|
||||
|
||||
### PHONE NUMBER ENTRY ###
|
||||
# Note that the source to this is quite a bit longer as the behaviour
|
||||
# demonstrated is a lot more ambitious than with the others.
|
||||
|
||||
# Initial content for the third entry widget
|
||||
set entry3content "1-(000)-000-0000"
|
||||
# Mapping from alphabetic characters to numbers. This is probably
|
||||
# wrong, but it is the only mapping I have; the UK doesn't really go
|
||||
# for associating letters with digits for some reason.
|
||||
set phoneNumberMap {}
|
||||
foreach {chars digit} {abc 2 def 3 ghi 4 jkl 5 mno 6 pqrs 7 tuv 8 wxyz 9} {
|
||||
foreach char [split $chars ""] {
|
||||
lappend phoneNumberMap $char $digit [string toupper $char] $digit
|
||||
}
|
||||
}
|
||||
|
||||
# validatePhoneChange --
|
||||
# Checks that the replacement (mapped to a digit) of the given
|
||||
# character in an entry widget at the given position will leave a
|
||||
# valid phone number in the widget.
|
||||
#
|
||||
# W - The entry widget to validate
|
||||
# vmode - The widget's validation mode
|
||||
# idx - The index where replacement is to occur
|
||||
# char - The character (or string, though that will always be
|
||||
# refused) to be overwritten at that point.
|
||||
|
||||
proc validatePhoneChange {W vmode idx char} {
|
||||
global phoneNumberMap entry3content
|
||||
if {$idx < 0} {return 1}
|
||||
after idle [list $W configure -validate $vmode -invcmd bell]
|
||||
if {
|
||||
!($idx<3 || $idx==6 || $idx==7 || $idx==11 || $idx>15) &&
|
||||
[string match {[0-9A-Za-z]} $char]
|
||||
} then {
|
||||
$W delete $idx
|
||||
$W insert $idx [string map $phoneNumberMap $char]
|
||||
after idle [list phoneSkipRight $W -1]
|
||||
return 1
|
||||
}
|
||||
return 0
|
||||
}
|
||||
|
||||
# phoneSkipLeft --
|
||||
# Skip over fixed characters in a phone-number string when moving left.
|
||||
#
|
||||
# Arguments:
|
||||
# W - The entry widget containing the phone-number.
|
||||
|
||||
proc phoneSkipLeft {W} {
|
||||
set idx [$W index insert]
|
||||
if {$idx == 8} {
|
||||
# Skip back two extra characters
|
||||
$W icursor [incr idx -2]
|
||||
} elseif {$idx == 7 || $idx == 12} {
|
||||
# Skip back one extra character
|
||||
$W icursor [incr idx -1]
|
||||
} elseif {$idx <= 3} {
|
||||
# Can't move any further
|
||||
bell
|
||||
return -code break
|
||||
}
|
||||
}
|
||||
|
||||
# phoneSkipRight --
|
||||
# Skip over fixed characters in a phone-number string when moving right.
|
||||
#
|
||||
# Arguments:
|
||||
# W - The entry widget containing the phone-number.
|
||||
# add - Offset to add to index before calculation (used by validation.)
|
||||
|
||||
proc phoneSkipRight {W {add 0}} {
|
||||
set idx [$W index insert]
|
||||
if {$idx+$add == 5} {
|
||||
# Skip forward two extra characters
|
||||
$W icursor [incr idx 2]
|
||||
} elseif {$idx+$add == 6 || $idx+$add == 10} {
|
||||
# Skip forward one extra character
|
||||
$W icursor [incr idx]
|
||||
} elseif {$idx+$add == 15 && !$add} {
|
||||
# Can't move any further
|
||||
bell
|
||||
return -code break
|
||||
}
|
||||
}
|
||||
|
||||
labelframe $w.l3 -text "US Phone-Number Entry"
|
||||
entry $w.l3.e -validate key -invcmd bell -textvariable entry3content \
|
||||
-vcmd {validatePhoneChange %W %v %i %S}
|
||||
# Click to focus goes to the first editable character...
|
||||
bind $w.l3.e <FocusIn> {
|
||||
if {"%d" ne "NotifyAncestor"} {
|
||||
%W icursor 3
|
||||
after idle {%W selection clear}
|
||||
}
|
||||
}
|
||||
bind $w.l3.e <<PrevChar>> {phoneSkipLeft %W}
|
||||
bind $w.l3.e <<NextChar>> {phoneSkipRight %W}
|
||||
pack $w.l3.e -fill x -expand 1 -padx 1m -pady 1m
|
||||
|
||||
labelframe $w.l4 -text "Password Entry"
|
||||
entry $w.l4.e -validate key -show "*" -vcmd {expr {[string length %P]<=8}}
|
||||
pack $w.l4.e -fill x -expand 1 -padx 1m -pady 1m
|
||||
|
||||
lower [frame $w.mid]
|
||||
grid $w.l1 $w.l2 -in $w.mid -padx 3m -pady 1m -sticky ew
|
||||
grid $w.l3 $w.l4 -in $w.mid -padx 3m -pady 1m -sticky ew
|
||||
grid columnconfigure $w.mid {0 1} -uniform 1
|
||||
pack $w.msg -side top
|
||||
pack $w.mid -fill both -expand 1
|
||||
@@ -0,0 +1,81 @@
|
||||
# filebox.tcl --
|
||||
#
|
||||
# This demonstration script prompts the user to select a file.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .filebox
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "File Selection Dialogs"
|
||||
wm iconname $w "filebox"
|
||||
positionWindow $w
|
||||
|
||||
ttk::frame $w._bg
|
||||
place $w._bg -x 0 -y 0 -relwidth 1 -relheight 1
|
||||
|
||||
ttk::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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
foreach i {open save} {
|
||||
set f [ttk::frame $w.$i]
|
||||
ttk::label $f.lab -text "Select a file to $i: " -anchor e
|
||||
ttk::entry $f.ent -width 20
|
||||
ttk::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 {[tk windowingsystem] eq "x11"} {
|
||||
ttk::checkbutton $w.strict -text "Use Motif Style Dialog" \
|
||||
-variable tk_strictMotif -onvalue 1 -offvalue 0
|
||||
pack $w.strict -anchor c
|
||||
|
||||
# This binding ensures that we don't run the rest of the demos
|
||||
# with motif style interactions
|
||||
bind $w.strict <Destroy> {set tk_strictMotif 0}
|
||||
}
|
||||
|
||||
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"} {
|
||||
global selected_type
|
||||
if {![info exists selected_type]} {
|
||||
set selected_type "Tcl Scripts"
|
||||
}
|
||||
set file [tk_getOpenFile -filetypes $types -parent $w \
|
||||
-typevariable selected_type]
|
||||
puts "You selected filetype \"$selected_type\""
|
||||
} 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
|
||||
}
|
||||
}
|
||||
File diff suppressed because it is too large.
Load diff
@@ -0,0 +1,67 @@
|
||||
# fontchoose.tcl --
|
||||
#
|
||||
# Show off the stock font selector dialog
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .fontchoose
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Font Selection Dialog"
|
||||
wm iconname $w "fontchooser"
|
||||
positionWindow $w
|
||||
|
||||
catch {font create FontchooseDemoFont {*}[font actual TkDefaultFont]}
|
||||
|
||||
# The font chooser needs to be configured and then shown.
|
||||
proc SelectFont {parent} {
|
||||
tk fontchooser configure -font FontchooseDemoFont \
|
||||
-command ApplyFont -parent $parent
|
||||
tk fontchooser show
|
||||
}
|
||||
|
||||
proc ApplyFont {font} {
|
||||
font configure FontchooseDemoFont {*}[font actual $font]
|
||||
}
|
||||
|
||||
# When the visibility of the fontchooser changes, the following event is fired
|
||||
# to the parent widget.
|
||||
#
|
||||
bind $w <<TkFontchooserVisibility>> {
|
||||
if {[tk fontchooser configure -visible]} {
|
||||
%W.f.font state disabled
|
||||
} else {
|
||||
%W.f.font state !disabled
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
set f [ttk::frame $w.f -relief sunken -padding 2]
|
||||
|
||||
text $f.msg -font FontchooseDemoFont -width 40 -height 6 -borderwidth 0 \
|
||||
-yscrollcommand [list $f.vs set]
|
||||
ttk::scrollbar $f.vs -command [list $f.msg yview]
|
||||
|
||||
$f.msg insert end "Press the buttons below to choose a new font for the\
|
||||
text shown in this window.\n" {}
|
||||
|
||||
ttk::button $f.font -text "Set font ..." -command [list SelectFont $w]
|
||||
|
||||
grid $f.msg $f.vs -sticky news
|
||||
grid $f.font - -sticky e
|
||||
grid columnconfigure $f 0 -weight 1
|
||||
grid rowconfigure $f 0 -weight 1
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
|
||||
grid $f -sticky news
|
||||
grid $btns -sticky ew
|
||||
grid columnconfigure $w 0 -weight 1
|
||||
grid rowconfigure $w 0 -weight 1
|
||||
update idletasks
|
||||
grid propagate $f 0
|
||||
@@ -0,0 +1,38 @@
|
||||
# form.tcl --
|
||||
#
|
||||
# This demonstration script creates a simple form with a bunch
|
||||
# of entry widgets.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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 <Return> "destroy $w"
|
||||
focus $w.f1.entry
|
||||
File diff suppressed because it is too large.
Load diff
@@ -0,0 +1,22 @@
|
||||
#!/bin/sh
|
||||
# the next line restarts using wish \
|
||||
exec wish "$0" ${1+"$@"}
|
||||
|
||||
# hello --
|
||||
# Simple Tk script to create a button that prints "Hello, world".
|
||||
# Click on the button to terminate the program.
|
||||
|
||||
package require Tk
|
||||
|
||||
# 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
|
||||
|
||||
# Local Variables:
|
||||
# mode: tcl
|
||||
# End:
|
||||
@@ -0,0 +1,45 @@
|
||||
# hscale.tcl --
|
||||
#
|
||||
# This demonstration script shows an example with a horizontal scale.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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
|
||||
}
|
||||
@@ -0,0 +1,51 @@
|
||||
# icon.tcl --
|
||||
#
|
||||
# This demonstration script creates a toplevel window containing
|
||||
# buttons that display bitmaps instead of text.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
# Main widget program sets variable tk_demoDirectory
|
||||
image create bitmap flagup \
|
||||
-file [file join $tk_demoDirectory images flagup.xbm] \
|
||||
-maskfile [file join $tk_demoDirectory images flagup.xbm]
|
||||
image create bitmap flagdown \
|
||||
-file [file join $tk_demoDirectory images flagdown.xbm] \
|
||||
-maskfile [file join $tk_demoDirectory images flagdown.xbm]
|
||||
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_demoDirectory images letters.xbm] \
|
||||
-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_demoDirectory images letters.xbm] \
|
||||
-variable letters -value full
|
||||
radiobutton $w.frame.left.b4 \
|
||||
-bitmap @[file join $tk_demoDirectory images noletter.xbm] \
|
||||
-variable letters -value empty
|
||||
pack $w.frame.left.b3 $w.frame.left.b4 -side top -expand yes
|
||||
@@ -0,0 +1,35 @@
|
||||
# image1.tcl --
|
||||
#
|
||||
# This demonstration script displays two image widgets.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
# Main widget program sets variable tk_demoDirectory
|
||||
catch {image delete image1a}
|
||||
image create photo image1a -file [file join $tk_demoDirectory images earth.gif]
|
||||
label $w.l1 -image image1a -bd 1 -relief sunken
|
||||
|
||||
catch {image delete image1b}
|
||||
image create photo image1b \
|
||||
-file [file join $tk_demoDirectory images earthris.gif]
|
||||
label $w.l2 -image image1b -bd 1 -relief sunken
|
||||
|
||||
pack $w.l1 $w.l2 -side top -padx .5m -pady .5m
|
||||
@@ -0,0 +1,108 @@
|
||||
# image2.tcl --
|
||||
#
|
||||
# This demonstration script creates a simple collection of widgets
|
||||
# that allow you to select and view images in a Tk label.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
# 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 -type f -directory $dirName *]] {
|
||||
$w.f.list insert end [file tail $i]
|
||||
}
|
||||
}
|
||||
|
||||
# selectAndLoadDir --
|
||||
# This procedure pops up a dialog to ask for a directory to load into
|
||||
# the listobx and (if the user presses OK) reloads the directory
|
||||
# listbox from the directory named in the demo's entry.
|
||||
#
|
||||
# Arguments:
|
||||
# w - Name of the toplevel window of the demo.
|
||||
|
||||
proc selectAndLoadDir w {
|
||||
global dirName
|
||||
set dir [tk_chooseDirectory -initialdir $dirName -parent $w -mustexist 1]
|
||||
if {$dir ne ""} {
|
||||
set dirName $dir
|
||||
loadDir $w
|
||||
}
|
||||
}
|
||||
|
||||
# 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]]
|
||||
if {[catch {
|
||||
image2a configure -file $file
|
||||
}]} then {
|
||||
# Mark the file as not loadable
|
||||
$w.f.list itemconfigure @$x,$y -bg \#c00000 -selectbackground \#ff0000
|
||||
}
|
||||
}
|
||||
|
||||
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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
frame $w.mid
|
||||
pack $w.mid -fill both -expand 1
|
||||
|
||||
labelframe $w.dir -text "Directory:"
|
||||
# Main widget program sets variable tk_demoDirectory
|
||||
set dirName [file join $tk_demoDirectory images]
|
||||
entry $w.dir.e -width 30 -textvariable dirName
|
||||
button $w.dir.b -pady 0 -padx 2m -text "Select Dir." \
|
||||
-command "selectAndLoadDir $w"
|
||||
bind $w.dir.e <Return> "loadDir $w"
|
||||
pack $w.dir.e -side left -fill both -padx 2m -pady 2m -expand true
|
||||
pack $w.dir.b -side left -fill y -padx {0 2m} -pady 2m
|
||||
labelframe $w.f -text "File:" -padx 2m -pady 2m
|
||||
|
||||
listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set"
|
||||
ttk::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 <Double-Button-1> "loadImage $w %x %y"
|
||||
|
||||
catch {image delete image2a}
|
||||
image create photo image2a
|
||||
labelframe $w.image -text "Image:"
|
||||
label $w.image.image -image image2a
|
||||
pack $w.image.image -padx 2m -pady 2m
|
||||
|
||||
grid $w.dir - -sticky ew -padx 1m -pady 1m -in $w.mid
|
||||
grid $w.f $w.image -sticky nw -padx 1m -pady 1m -in $w.mid
|
||||
grid columnconfigure $w.mid 1 -weight 1
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 51 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 8.0 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 6.2 KiB |
@@ -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};
|
||||
@@ -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};
|
||||
@@ -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};
|
||||
@@ -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};
|
||||
@@ -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};
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 53 KiB |
@@ -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};
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 2.3 KiB |
@@ -0,0 +1,31 @@
|
||||
P6
|
||||
256 256
|
||||
255
|
||||
\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\Line truncated
|
||||
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=%Y7"N1 F, ;' NCJNCJNDJODJODJODJh>!a: X/K% & 4$ +2F=;HPEJL&\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀŸlR¶xTsTµd)ŠO$w; m6
|
||||
g3
|
||||
a0 Z- \/ T*Q(ŠHµm8kRMmSMnTMoTMpTMpUM15G15G05G04G04GpUMpTM5^9 d<!yF#�O+€N,rC#qB"pB#k?"a: Z7 6ODJPDJPEJQEJQEJREJREJREJRFJSFJSFJSFJSFJe<!X/ - '0FªqS–gQ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À“fP¯tS mR�R%�Bf3
|
||||
^/ V+Q(L&I$r9 TlRMnSM46G47G47G46G46G46G46G46G36G36G25G25G15G04G/4F.3F oA"ˆN$‹O%�S)ŒR)”T&”T%‘R%ŠO$€J#xE# PDJQEJREJRFJSFJTFJTFJTGJUGJUGJUGJUGJVGJVGJVGJVGJVGJVGJY6 N' t;‹O$�dP¥oR�dP\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À¨pS�kQ“S%x=[- R)I$E"@ ”M¦]'pTM68G78G78G78G78G78G78G78G78G68G67G67G57G57G47G36G36G25Gp98 eOLpUMtVMn7 ·f+½i,¾i*¿i*¾h*…B␍ˆ`O~[NqUM[- ‰HUGJUGJVGJVGJVHJWHJWHJWHKWHKXHKXHKXHKXHKXHKXIKXIKXIKXIKXIKh>!Y0 W+]. s=‡M$�dPŸlR\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀoTM¥oR�dPvE"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?<H@<HA=HC>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 \À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\Àˆ`O�cPnA"M&@ 8 F# m6
|
||||
›W&rVMvWNyYNzYN|ZN}[N}[N><H?<H?<H?<H?<H?<H@<H@<H@<HA=HA=HB=HC>HE?IG@IIAIKBIODJSFJWHK—hQŸlR§pR°b(¾i*Én+Ù|7Û|6Ïr,Íq+Êp-Ãl+»g)±b(®sS§pS lRšiQ•gQ�eP�cPŠ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ŒcP�dP�eP’fP“fP“fQ“fQ”fQ‘eP�cP‰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ŒcP�dP’eP–gQšiQŸlR£nR¤\'´d)¿i*Æm+Îs/Ïs/Êo+Én+Ål*¾i*ºg)³c(ª_(ªqS¦oR¡mR�kQ™iQ•gQ“fP‘ePŽdP�cPŒ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ŒbP�cPŽ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‘eP�dP�dPŽdPŽcP�cPŒcPŒbP‹bP‹bP‹bPŠbPŠaP‰aP‰aO‰aOˆ`O‡`O†_O…_Oƒ^O�]Oª_(�@ B!I$B!N'w=‘eP`LKbNLeOL�kR 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ŒbP�cPŽcP�dP�dP’eP“fP•gQ—hQ™iQ›jQ�kR 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‘eP�dP�dP�dPŽcPŽcP�cP�cPŒ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ŒbP�cPŽcPŽdP�dP�dP‘eP’eP”fQ•gQ–gQ˜hQ™iQ›jQ�kQŸ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‘eP�dP�dP�dP�dPŽdPŽcP�cP�cPŒbP‹bPŠaPˆaO†`O�]O˜O G#7F#uWMƒ^OwXNxXNzYN{ZN|ZN¹yT¸yT·xT´wT±uTsS¨pS¡mRœjQ•gQ�dPŒbP‰aP‰aPŒbPŽcP‘eP�cP|ZN\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À[JKŠbP^/ 1 01|> wXN}[N�]Oƒ^O…_O‡`O‡`OˆaO‰aPŠaP‹bP‹bPŒbPŒcP�cPŽcPŽcP�dP�dP�dP‘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žkR�kQœjQšjQšiQ™iQ˜hQ—hQ–gQ•gQ•gQ”fQ”fQ“fP“fP’eP’eP‘eP‘eP�eP�dP�dP�dPŽcP�cPŒ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ŒcP�cPŽcPŽcP�dP�dP�dP‘eP‘eP’eP“fP“fQ”fQ•gQ–gQ—hQ˜hQ™iQ™iQ›jQœjQ�kRžlRŸlRœX&¢['¨^'¬`(´ZÂdÄf Èi Æg Âd¿c¿c¼a¸_©T¥\'£[' Z'ŸY&£nR¢mR¡mR lRŸlRžkR�kQœjQ›jQšjQšiQ™iQ˜hQ—hQ—hQ–hQ–gQ•gQ•gQ”gQ”fQ”fQ“fQ“fP’fP’eP‘eP‘eP�dP�dPŽcPŒbP‰aOƒ^Ox< : ŠaP�]Oj8sVMmSMfOL^KKUGJIAIQEJ?<H*1F(
|
||||
|
||||
|
||||
@%<-$G?@…pfdNLuWM\NdNL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀTFJvWN‰aP./01„E}[N�]O…_Oˆ`O‰aP‹bPŒbP�cP�cPŽcP�dP�dP�dP�eP‘eP’eP’eP“fP“fQ”fQ•gQ•gQ–gQ–hQ—hQ˜hQ™iQšiQ›jQœjQ�kQ�kRžlRŸlRžY&¤\'¨^'µ^½bÀcÃe Çi Äg Àc½b¼a¹`µ^´]¯X¢[' Z'žY&¢mR¡mR¡mR lRŸlRŸlRžkR�kQœkQœjQ›jQšjQšiQ™iQ™iQ˜iQ˜hQ—hQ—hQ—hQ–gQ–gQ•gQ•gQ•gQ”fQ”fQ“fQ“fP’eP‘eP�dP�cP‰aP—O ‡`O‡`OoTMQEJC>IeZY638* B\À\À\À\À\À, 4 .G1!\TU¡ƒrsVM{ZN`MK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À[JKyYNŒbP/0 ˆN$�]O…_Oˆ`O‹bPŒbP�cPŽcP�dP�dP�dP‘eP‘eP’eP’fP“fP“fQ”fQ”gQ•gQ–gQ–gQ—hQ—hQ˜hQ™iQ™iQšiQ›jQœjQœkQ�kRžkRŸlRœO¡Z'¥\'©^'V¼a¾bÁe Æi!Ãf ¾b»a¹`·_³]²\µZ¢[' Z'ŸY&œQ¡mR¡mR mR lRŸlRŸlRžkR�kR�kQœkQœjQ›jQ›jQšjQšiQšiQ™iQ™iQ˜iQ˜hQ˜hQ—hQ—hQ—hQ–hQ–gQ–gQ•gQ•gQ”fQ’fP�dP�cPšW& �dPŠaPrUM
|
||||
B\À\À\À\À\À\À\À\À\À\À%7!!C*F#P) {dYœze»�p€\OgPL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀSFJ`LKvWNŠaPm6
|
||||
X,uWM‚]O‡`OŠbP�cPŽdP�dP�dP‘eP’eP’fP“fP“fQ”fQ”gQ•gQ•gQ–gQ–gQ—hQ—hQ˜hQ˜iQ™iQ™iQšiQ›jQ›jQœjQœkQ�kQžkRžlRŸlR¢Z'¤\'§]'·_¹`¼a½bÁe Åi"Áe ¼aº`·_¶_²]²\±\«Y¡Z' Z'¡Z'¡mR¡mR mR lR lRŸlRŸlRžlRžkRžkR�kR�kQœkQœjQœjQ›jQ›jQ›jQšjQšiQšiQšiQ™iQ™iQ™iQ˜iQ˜hQ˜hQ—hQ–gQ•gQ“fQ�dP†_Oq8 –gQˆ`OuWM”T%\À\À\À\À\À\À\À\À\À\À B B!!T,c5ƒF‚T3È›~Æ“qƒ^OfOL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀXHK_LKsVM‡`O�cP ’S%�]OŠbP�cP�dP‘eP’eP“fP“fQ”fQ”gQ•gQ•gQ–gQ–gQ—hQ—hQ—hQ˜hQ˜iQ™iQ™iQšiQšiQ›jQ›jQœjQœjQ�kQ�kRž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žkR�kR�kR�kQ�kQœ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\O�cPƒ^O vE"‚]OŠaP�dP‘eP“fP”fQ•gQ•gQ–gQ–hQ—hQ—hQ˜hQ˜hQ˜iQ™iQ™iQ™iQšiQšjQ›jQ›jQœjQœjQœkQ�kQ�kRž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žkR�kR�kR�kR�kR�kQ�kQ�kQœjQœjQšiQ˜hQ’ePšW&M& oTMšiQ‘eP…_OtVMmSMdOL\À\À\À\À\À\À\À\À\À B B B ‘J Z'ª_(œkQ™iQ‡`OSFJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀTFJ\JKcNLlRMzYN‡`O’ePzZN \Nˆ`O�dP“fQ•gQ–gQ—hQ˜hQ˜hQ™iQ™iQ™iQšiQšiQšiQ›jQ›jQ›jQœjQœjQœjQœkQ�kQ�kRž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™iQ�ePt: �kQ˜hQ�cP€]OtVMlSMa2␍\À\À\À\À\À\À\À\À\À B B
|
||||
$ 5 ¬`(¶e)£nRœjQƒ^OJAI\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀXIK^KKdNLhPLuWM‚]OŒbP”fQ�eP␍m6
|
||||
†`OŽcP“fQ—hQ˜hQ™iQšiQšjQ›jQ›jQ›jQœjQœjQœjQœkQ�kQ�kQ�kRž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 mR�kR—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œjQ�kQ�kQ�kRž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™iQ�kQŸ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˜hQ�kQŸ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•gQ�cP„_O{ZNtVMpUMoTMmSMjQL_9 \À\À\À\À\À B "C(D#* A$[<)d<!QEJWHKXHKD>I\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀSFJ[JKaMKeOLhPLkRLmSMoTMuWM}[N…_O‹bP’eP˜hQžkR¢mR£nRžkR!-E�kR¡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–gQ�dPˆaO\OyYNuWMqUMoTMnSMkRLo8
\À\À\À\À\À B'D +E$ ( 1 J/ jH1NCJUGJYIKUGJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀXHK]KKbNLfOLiQLkRMmSMoTMqUMxXN\N†_OŒbP’fP˜hQ�kQ¡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¢mR�kQ—hQ‘ePŠaPƒ^O\N{ZNvXNqUMpTMnSMlRM�P%\À\À\À\À B#C*E$.E- .!G$Y:%d<"SFJYIKZIKNCJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀPDJZIK_LKdNLgPLjQLlRMnSMpTMqUMuWMyYN€\O†`O�cP’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¡mR�kQ˜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’eP�cPŠbP‡`O„_O�]O}[NyYNuWMpUMoTMmSMkRL}H#\À\À &D -E(1F/!2# 8 W7"iA&UGJ[JK\JKREJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\Line truncated
|
||||
!C +E'0F.4F7% 8% U/lG.SFJZIK]KKZIKB=H\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀREJZJK`LKdNLgPLjQLlRMnSMpTMqUMtWMxXN{ZN~[N�]O„^O†`O‰aO‹bP�dP•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‘eP�dPŒ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ŽcP�eP“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‘eP�dP�cPŠaP‡`O„^O�]O}[NyYNuWMpTMoTMmSMkRLgPL&D#.E,3F46G;' <( D"iB(VGJ]KK`LK[JKB>H\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀNCJYIK^LKcNLfOLiQLkRMmSMoTMqUMsVMvXNzYN}[N€\O‚^O…_Oˆ`OŠaPŒcP�dP‘eP“fQ•gQ—hQ™iQ�kR 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’eP�dP�cP‹bPˆ`O…_O‚]O~[NzYNvWNpTMoTMnSMkRMhQLo7 ,2F36G99HC+ @ ]8 nA"\JK`ML_LKSFJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀSFJ[JK`LKdNLgPLjQLlRMnSMpTMqUMtVMwXNzZN}[N€]Oƒ^O†_OˆaO‹bP�cP�dP‘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“fP�ePŽcP‹bPˆaO…_O‚^O\N{ZNwXNsVMoTMnSMlRMiQL~I#26G99G?<HA* E$ i@$ZIKaMLbML[JK;:H\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀWHJ]KKbMLeOLhPLjRLlSMnTMpTMrUMuWMxXN{ZN~\N�]O„^O†`O‰aO‹bPŽcP�dP’eP”fQ–gQ˜hQšiQœkRžlS mT£oU¦rWªuZ¯y]´~aºƒfŠlË’sÔšzÜ¡€ã§†è«‰ë®‹í¯Œí®‹ë¬ˆè¨„ã£~ßžyÚ™tÖ•oÒ�jÎŒfˈbÈ…_ƃ\Å�ZÄ€YÃXÂWÂ~WÂ~WÂ~WÃXÀXÄ€YÅ�Zƃ\Ç…^Ɇ`ˈbÌŠdÍ‹fÎ�gÎŽiÎŽjÎŽjÍŽjËŒiljgÆd¿ƒaº^¸}]¶|\´{[²yZ°xY®vX¬tWªsV¨qU¦pT¤oS¢nS mRžlR�kR›jQ™iQ—hQ•gQ“fP‘ePŽdPŒbP‰aO†_Oƒ^O€\O|ZNxXNtVMpTMnSMmSMjQLgPL99G?<HG- E&b;!YIK`MLdOM`LKNCJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀŸlRºyTÄ~UÊ‚XʃYÄXº{WtUšW'¢[(—hQ lR�cP€\OhQL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀNCJYIK^LKcNLfOLiQLkRLmSMoTMqUMrVMvWNyYN|ZN\N‚]O„_O‡`O‰aPŒbPŽcP�dP’fP”gQ–hQ˜iQšjRœkRžlS¡nT¤pU§sW«vZ°z]µb»„gŠlÉ‘sИyØžÞ¤…ã©Šè�ì±�ﳑﳑëŠç©…⣀ݞzؘtÒ“nÎ�iɉdÆ…`Â]Á€[¿~Y¾}X½|W½|V¼{V¼{V¼{V¼{V¼{V¼|W¼|W½}X½}Y½~Z½~Z¼~Z»}[º}[º}[º~\º~\º~]º~]¹~]¸~]·}]¶|\´z[²yZ°wY®vX¬tWªsV¨rU¦pT¤oS¢nS mRŸlR�kR›jQšiQ˜hQ–gQ“fQ‘eP�dPŒcPŠaP‡`O„^O�]O}[NyYNuWNpTMnTMmSMkRLhPL|H$D>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ŸlR�kRœjQšiQ˜hQ–gQ”fQ’eP�dP�cPŠ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ŠbP�cP�dP‘eP“fQ•gQ—hQ™iQ›jR�kRŸ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’eP�dPŽ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¤nR�kQ•gQˆ`OuWNY,\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀNCJYIK^KKbNLfOLhQLkRLmSMoTMpUMrUMuWMxXN{ZN~[N�]O„^O†_O‰aO‹bP�cP�dP‘eP“fQ•gQ—hQ™iQ›jR�kRŸ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’fP�dPŽcP‹bP‰aO†_Oƒ^O€\O|ZNxXNtVMoTMnSMlRMjQLgPLzG#\JKcOMoXUgPMZIK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À’fP”gQ•gQ—hQ™iQ�kQ lR¤nR§pRªqS¬sS¯tS :"r<zYNsS¹yT¾|UÁ~WÆ„^ËŠeË‹gƈe¾‚aµz[tV¦pS¢mR�kQ–gQŠbPzYNkRL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀRFJZJK`LKcNLfPLiQLkRMmSMoTMqUMrVMvWNyYN|ZN\N�]O„^O‡`O‰aO‹bP�cP�dP’eP”fQ–gQ—hQ™iQ›jR�lR 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ŽcP�dP’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‘eP�dPŒ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ŽcP�eP’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žlR�kR›jQ™iQ—hQ•gQ“fQ‘eP�dP�cPŠaP‡`O…_O‚]O\N{ZNwXNsVMnSMmSMkRMiQLfOL_LKhQMUGJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À (6BFP>=DKHMqjk€trwf`~kc„ndŠqe�se�te¯Ž{�w`¡v[\N†_O�cP“fP˜iQœjRŸlS£oT¦qV¥qV£oTžlR™iQº^‡`O�Q%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žlR�kR›jQ™iQ˜hQ–gQ”fQ‘eP�dP�cP‹bPˆ`O…_O‚]O\O|ZNxXNtVMoTMmSMlRMjQLgPLbML[JK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À%5 (6 $/79CEEKjgkrc_›…{‘uf±�{Ÿw_º�q�]Oˆ`OŽcP”fQ˜hQ›jRžlR¡nT¢oT¡nT�kR˜hQŽdP¦]'ŽQ%\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀUGJ[JK`MKdNLgPLiQLkRMmSMoTMqUMrUMuWNxXN{ZN~[N�]Oƒ^O†_Oˆ`OŠbP�cP�dP£['µ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žlR�kR›jQ™iQ˜hQ–gQ”fQ’eP�dP�cP‹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‹bP�cPž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³yLine truncated
|
||||
␍ & 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]O�cS{`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^P�qbpXMdH5R<,Q;, & % %#'-"'-&3DS_qP\nR_p>J\?K]<AG %%%DDDACF˜š�™Ÿ¨Ÿ¦®„�¢„�¢„�¢’™¡�•žŽ•�Ž”�Ž”��“œ�“œŒ’›Œ’›’˜¡š ©™ ¨™Ÿ¨Ž”�Ž”��“œ„‘¢„‘¢„‘¢„‘¢…‘£‰“£Ž–¤¬¥§º¬¨À¯©‹¯â‹¯â‹¯â‹°â‹°â‹°â‹°â‹°â‹°â‹°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âŒ°âLp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp¢Lp£Lp£Lp£Lp£Lp£Œ°âŒ°ãŒ°ãŒ°ãŒ°ãŒ°ãŒ°ãŒ°ãŒ°ãŒ°ãŒ°ãŒ°ãŒ°ãŒ°ãŒ°ãLq£Lq£Lq£Lq£Lq£Lq£Lq£Lq£Lq£Lq£Lq£Lq£Lq£Lq£Lq£Lq£…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Û…©Ü…©Ü…©Ü…©Ü…©Ü…ªÜ…ªÜ…ªÜ…ªÜGlžGlž†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÜ†ªÝ†ªÝ†ªÝ†ªÝ†ªÝ†«Ý†«Ý†«Ý†«ÝHlžHlžHlžHlžHlžHlžHlžHlžHlžHlžHlŸ‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«Ý‡«ÝDhšDhš=J[=J[=J[=J[=J[=J[=J[(/739B#)2(.7(/7(/7#*2$*3)/8)/8)/8)08*09+19(-5*.5/16437D>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£�²ä�²ä�²ä�²ä�²ä�²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽ²äŽLine truncated
|
||||
@@ -0,0 +1,302 @@
|
||||
# items.tcl --
|
||||
#
|
||||
# This demonstration script creates a canvas that displays the
|
||||
# canvas item types.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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 Left-Button drag:\tmoves item under pointer.\n Middle-Button drag:\trepositions view.\n Right-Button drag:\tstrokes out area.\n Ctrl+f:\t\tprints items under area."
|
||||
pack $w.msg -side top
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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"
|
||||
ttk::scrollbar $w.frame.vscroll -command "$c yview"
|
||||
ttk::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
|
||||
# Main widget program sets variable tk_demoDirectory
|
||||
$c create line 1c 5c 7c 5c 7c 7c 9c 7c -width .5c \
|
||||
-stipple @[file join $tk_demoDirectory images gray25.xbm] \
|
||||
-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_demoDirectory images gray25.xbm] \
|
||||
-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 {} -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 -outline {} -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_demoDirectory images gray25.xbm] \
|
||||
-fill $blue -outline {} -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_demoDirectory images gray25.xbm] \
|
||||
-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_demoDirectory images gray25.xbm] \
|
||||
-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
|
||||
catch {
|
||||
$c create text 25c 14c -font $font2 -anchor c -fill $red -angle 15 \
|
||||
-text "Angled 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_demoDirectory images gray25.xbm]
|
||||
$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 and Images" -anchor n
|
||||
catch {
|
||||
image create photo items.ousterhout \
|
||||
-file [file join $tk_demoDirectory images ouster.png]
|
||||
image create photo items.ousterhout.active -format "png -alpha 0.5" \
|
||||
-file [file join $tk_demoDirectory images ouster.png]
|
||||
$c create image 13c 20c -tags item -image items.ousterhout \
|
||||
-activeimage items.ousterhout.active
|
||||
}
|
||||
$c create bitmap 17c 18.5c -tags item \
|
||||
-bitmap @[file join $tk_demoDirectory images noletter.xbm]
|
||||
$c create bitmap 17c 21.5c -tags item \
|
||||
-bitmap @[file join $tk_demoDirectory images letters.xbm]
|
||||
|
||||
$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 <Enter> "itemEnter $c"
|
||||
$c bind item <Leave> "itemLeave $c"
|
||||
if {[tk windowingsystem] eq "aqua" && ![package vsatisfies [package provide Tk] 8.7-]} {
|
||||
bind $c <Button-2> "itemMark $c %x %y"
|
||||
bind $c <B2-Motion> "itemStroke $c %x %y"
|
||||
bind $c <Button-3> "$c scan mark %x %y"
|
||||
bind $c <B3-Motion> "$c scan dragto %x %y"
|
||||
} else {
|
||||
bind $c <Button-2> "$c scan mark %x %y"
|
||||
bind $c <B2-Motion> "$c scan dragto %x %y"
|
||||
bind $c <Button-3> "itemMark $c %x %y"
|
||||
bind $c <B3-Motion> "itemStroke $c %x %y"
|
||||
}
|
||||
bind $c <<NextChar>> "itemsUnderArea $c"
|
||||
bind $c <Button-1> "itemStartDrag $c %x %y"
|
||||
bind $c <B1-Motion> "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" || $type == "image"} {
|
||||
set restoreCmd {}
|
||||
return
|
||||
} elseif {$type == "bitmap"} {
|
||||
set bg [lindex [$c itemconf current -background] 4]
|
||||
set restoreCmd [list $c itemconfig current -background $bg]
|
||||
$c itemconfig current -background SteelBlue2
|
||||
return
|
||||
} elseif {$type == "image"} {
|
||||
set restoreCmd [list $c itemconfig current -state normal]
|
||||
$c itemconfig current -state active
|
||||
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] >= 0} {
|
||||
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] >= 0} {
|
||||
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 "Oooohhh!!" -fill $color -anchor n]
|
||||
after 500 "$w delete $i"
|
||||
}
|
||||
@@ -0,0 +1,328 @@
|
||||
#!/bin/sh
|
||||
# the next line restarts using wish \
|
||||
exec wish "$0" ${1+"$@"}
|
||||
|
||||
# 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
|
||||
|
||||
package require Tk
|
||||
|
||||
#
|
||||
# Button actions
|
||||
#
|
||||
|
||||
proc quit {} {
|
||||
destroy .
|
||||
}
|
||||
|
||||
proc ok {} {
|
||||
writesettings
|
||||
quit
|
||||
}
|
||||
|
||||
proc cancel {} {
|
||||
readsettings
|
||||
dispsettings
|
||||
.buttons.apply configure -state disabled
|
||||
.buttons.cancel configure -state disabled
|
||||
}
|
||||
|
||||
proc apply {} {
|
||||
writesettings
|
||||
.buttons.apply configure -state disabled
|
||||
.buttons.cancel configure -state disabled
|
||||
}
|
||||
|
||||
#
|
||||
# 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] >= 0} {
|
||||
switch -- [lindex $line 0] {
|
||||
auto {
|
||||
set rpt [lindex $line 1]
|
||||
if {$rpt eq "repeat:"} {
|
||||
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 eq "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 {$kbdrep eq "on"} {
|
||||
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.tim.entry get]
|
||||
set screencyc [.screen.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 eq "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.blank [expr {$screenbla eq "blank" ? "select" : "deselect"}]
|
||||
.screen.pat [expr {$screenbla ne "blank" ? "select" : "deselect"}]
|
||||
.screen.tim.entry delete 0 end
|
||||
.screen.tim.entry insert 0 $screentim
|
||||
.screen.cyc.entry delete 0 end
|
||||
.screen.cyc.entry insert 0 $screencyc
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Create all windows, and pack them
|
||||
#
|
||||
|
||||
proc labelentry {path text length {range {}}} {
|
||||
frame $path
|
||||
label $path.label -text $text
|
||||
if {[llength $range]} {
|
||||
spinbox $path.entry -width $length -relief sunken \
|
||||
-from [lindex $range 0] -to [lindex $range 1]
|
||||
} else {
|
||||
entry $path.entry -width $length -relief sunken
|
||||
}
|
||||
pack $path.label -side left
|
||||
pack $path.entry -side right -expand y -fill x
|
||||
}
|
||||
|
||||
proc createwindows {} {
|
||||
#
|
||||
# Buttons
|
||||
#
|
||||
|
||||
frame .buttons
|
||||
button .buttons.ok -default active -command ok -text "Ok"
|
||||
button .buttons.apply -default normal -command apply -text "Apply" \
|
||||
-state disabled
|
||||
button .buttons.cancel -default normal -command cancel -text "Cancel" \
|
||||
-state disabled
|
||||
button .buttons.quit -default normal -command quit -text "Quit"
|
||||
|
||||
pack .buttons.ok .buttons.apply .buttons.cancel .buttons.quit \
|
||||
-side left -expand yes -pady 5
|
||||
|
||||
bind . <Return> {.buttons.ok flash; .buttons.ok invoke}
|
||||
bind . <Escape> {.buttons.quit flash; .buttons.quit invoke}
|
||||
bind . <Button-1> {
|
||||
if {![string match .buttons* %W]} {
|
||||
.buttons.apply configure -state normal
|
||||
.buttons.cancel configure -state normal
|
||||
}
|
||||
}
|
||||
bind . <Key> {
|
||||
if {![string match .buttons* %W]} {
|
||||
switch -glob %K {
|
||||
Return - Escape - Tab - *Shift* {}
|
||||
default {
|
||||
.buttons.apply configure -state normal
|
||||
.buttons.cancel configure -state normal
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Bell settings
|
||||
#
|
||||
|
||||
labelframe .bell -text "Bell Settings" -padx 1.5m -pady 1.5m
|
||||
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 {25 20000}
|
||||
labelentry .bell.val.dur "Duration (ms)" 6 {1 10000}
|
||||
pack .bell.val.pit -side left -padx 5
|
||||
pack .bell.val.dur -side right -padx 5
|
||||
pack .bell.vol .bell.val -side top -expand yes
|
||||
|
||||
#
|
||||
# Keyboard settings
|
||||
#
|
||||
|
||||
labelframe .kbd -text "Keyboard Repeat Settings" -padx 1.5m -pady 1.5m
|
||||
|
||||
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 -fill x -expand yes -padx {0 1m}
|
||||
pack .kbd.val.cli -side left -expand yes -fill x -padx {1m 0}
|
||||
|
||||
pack .kbd.val -side top -expand yes -pady 2 -fill x
|
||||
|
||||
#
|
||||
# Mouse settings
|
||||
#
|
||||
|
||||
labelframe .mouse -text "Mouse Settings" -padx 1.5m -pady 1.5m
|
||||
|
||||
frame .mouse.hor
|
||||
labelentry .mouse.hor.acc "Acceleration" 5
|
||||
labelentry .mouse.hor.thr "Threshold (pixels)" 3 {1 2000}
|
||||
|
||||
pack .mouse.hor.acc -side left -padx {0 1m}
|
||||
pack .mouse.hor.thr -side right -padx {1m 0}
|
||||
|
||||
pack .mouse.hor -side top -expand yes
|
||||
|
||||
#
|
||||
# Screen Saver settings
|
||||
#
|
||||
|
||||
labelframe .screen -text "Screen-saver Settings" -padx 1.5m -pady 1.5m
|
||||
|
||||
radiobutton .screen.blank \
|
||||
-variable screenblank -text "Blank" -relief flat \
|
||||
-value "blank" -variable screenbla -anchor w
|
||||
radiobutton .screen.pat \
|
||||
-variable screenblank -text "Pattern" -relief flat \
|
||||
-value "noblank" -variable screenbla -anchor w
|
||||
labelentry .screen.tim "Timeout (s)" 5 {1 100000}
|
||||
labelentry .screen.cyc "Cycle (s)" 5 {1 100000}
|
||||
|
||||
grid .screen.blank .screen.tim -sticky e
|
||||
grid .screen.pat .screen.cyc -sticky e
|
||||
grid configure .screen.blank .screen.pat -sticky ew
|
||||
|
||||
#
|
||||
# Main window
|
||||
#
|
||||
|
||||
pack .buttons -side top -fill both
|
||||
pack .bell .kbd .mouse .screen -side top -fill both -expand yes \
|
||||
-padx 1m -pady 1m
|
||||
|
||||
#
|
||||
# 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...
|
||||
#
|
||||
|
||||
# Local Variables:
|
||||
# mode: tcl
|
||||
# End:
|
||||
@@ -0,0 +1,268 @@
|
||||
# Copyright (C) 2008 Pat Thoyts <patthoyts@users.sourceforge.net>
|
||||
#
|
||||
# Calculate a Knight's tour of a chessboard.
|
||||
#
|
||||
# This uses Warnsdorff's rule to calculate the next square each
|
||||
# time. This specifies that the next square should be the one that
|
||||
# has the least number of available moves.
|
||||
#
|
||||
# Using this rule it is possible to get to a position where
|
||||
# there are no squares available to move into. In this implementation
|
||||
# this occurs when the starting square is d6.
|
||||
#
|
||||
# To solve this fault an enhancement to the rule is that if we
|
||||
# have a choice of squares with an equal score, we should choose
|
||||
# the one nearest the edge of the board.
|
||||
#
|
||||
# If the call to the Edgemost function is commented out you can see
|
||||
# this occur.
|
||||
#
|
||||
# You can drag the knight to a specific square to start if you wish.
|
||||
# If you let it repeat then it will choose random start positions
|
||||
# for each new tour.
|
||||
|
||||
package require Tk
|
||||
|
||||
# Return a list of accessible squares from a given square
|
||||
proc ValidMoves {square} {
|
||||
set moves {}
|
||||
foreach pair {{-1 -2} {-2 -1} {-2 1} {-1 2} {1 2} {2 1} {2 -1} {1 -2}} {
|
||||
set col [expr {($square % 8) + [lindex $pair 0]}]
|
||||
set row [expr {($square / 8) + [lindex $pair 1]}]
|
||||
if {$row >= 0 && $row < 8 && $col >= 0 && $col < 8} {
|
||||
lappend moves [expr {$row * 8 + $col}]
|
||||
}
|
||||
}
|
||||
return $moves
|
||||
}
|
||||
|
||||
# Return the number of available moves for this square
|
||||
proc CheckSquare {square} {
|
||||
variable visited
|
||||
set moves 0
|
||||
foreach test [ValidMoves $square] {
|
||||
if {[lsearch -exact -integer $visited $test] < 0} {
|
||||
incr moves
|
||||
}
|
||||
}
|
||||
return $moves
|
||||
}
|
||||
|
||||
# Select the next square to move to. Returns -1 if there are no available
|
||||
# squares remaining that we can move to.
|
||||
proc Next {square} {
|
||||
variable visited
|
||||
set minimum 9
|
||||
set nextSquare -1
|
||||
foreach testSquare [ValidMoves $square] {
|
||||
if {[lsearch -exact -integer $visited $testSquare] < 0} {
|
||||
set count [CheckSquare $testSquare]
|
||||
if {$count < $minimum} {
|
||||
set minimum $count
|
||||
set nextSquare $testSquare
|
||||
} elseif {$count == $minimum} {
|
||||
# to remove the enhancement to Warnsdorff's rule
|
||||
# remove the next line:
|
||||
set nextSquare [Edgemost $nextSquare $testSquare]
|
||||
}
|
||||
}
|
||||
}
|
||||
return $nextSquare
|
||||
}
|
||||
|
||||
# Select the square nearest the edge of the board
|
||||
proc Edgemost {a b} {
|
||||
set colA [expr {3-int(abs(3.5-($a%8)))}]
|
||||
set colB [expr {3-int(abs(3.5-($b%8)))}]
|
||||
set rowA [expr {3-int(abs(3.5-($a/8)))}]
|
||||
set rowB [expr {3-int(abs(3.5-($b/8)))}]
|
||||
return [expr {($colA * $rowA) < ($colB * $rowB) ? $a : $b}]
|
||||
}
|
||||
|
||||
# Display a square number as a standard chess square notation.
|
||||
proc N {square} {
|
||||
return [format %c%d [expr {97 + $square % 8}] \
|
||||
[expr {$square / 8 + 1}]]
|
||||
}
|
||||
|
||||
# Perform a Knight's move and schedule the next move.
|
||||
proc MovePiece {dlg last square} {
|
||||
variable visited
|
||||
variable delay
|
||||
variable continuous
|
||||
$dlg.f.txt insert end "[llength $visited]. [N $last] .. [N $square]\n" {}
|
||||
$dlg.f.txt see end
|
||||
$dlg.f.c itemconfigure [expr {1+$last}] -state normal -outline black
|
||||
$dlg.f.c itemconfigure [expr {1+$square}] -state normal -outline red
|
||||
$dlg.f.c moveto knight {*}[lrange [$dlg.f.c coords [expr {1+$square}]] 0 1]
|
||||
lappend visited $square
|
||||
set next [Next $square]
|
||||
if {$next ne -1} {
|
||||
variable aid [after $delay [list MovePiece $dlg $square $next]]
|
||||
} else {
|
||||
$dlg.tf.b1 configure -state normal
|
||||
if {[llength $visited] == 64} {
|
||||
variable initial
|
||||
if {$initial == $square} {
|
||||
$dlg.f.txt insert end "Closed tour!"
|
||||
} else {
|
||||
$dlg.f.txt insert end "Success\n" {}
|
||||
if {$continuous} {
|
||||
after [expr {$delay * 2}] [namespace code \
|
||||
[list Tour $dlg [expr {int(rand() * 64)}]]]
|
||||
}
|
||||
}
|
||||
} else {
|
||||
$dlg.f.txt insert end "FAILED!\n" {}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Begin a new tour of the board given a random start position
|
||||
proc Tour {dlg {square {}}} {
|
||||
variable visited {}
|
||||
$dlg.f.txt delete 1.0 end
|
||||
$dlg.tf.b1 configure -state disabled
|
||||
for {set n 0} {$n < 64} {incr n} {
|
||||
$dlg.f.c itemconfigure $n -state disabled -outline black
|
||||
}
|
||||
if {$square eq {}} {
|
||||
set coords [lrange [$dlg.f.c coords knight] 0 1]
|
||||
set square [expr {[$dlg.f.c find closest {*}$coords 0 65]-1}]
|
||||
}
|
||||
variable initial $square
|
||||
after idle [list MovePiece $dlg $initial $initial]
|
||||
}
|
||||
|
||||
proc Stop {} {
|
||||
variable aid
|
||||
catch {after cancel $aid}
|
||||
}
|
||||
|
||||
proc Exit {dlg} {
|
||||
Stop
|
||||
destroy $dlg
|
||||
}
|
||||
|
||||
proc SetDelay {new} {
|
||||
variable delay [expr {int($new)}]
|
||||
}
|
||||
|
||||
proc DragStart {w x y} {
|
||||
$w dtag selected
|
||||
$w addtag selected withtag current
|
||||
variable dragging [list $x $y]
|
||||
}
|
||||
proc DragMotion {w x y} {
|
||||
variable dragging
|
||||
if {[info exists dragging]} {
|
||||
$w move selected [expr {$x - [lindex $dragging 0]}] \
|
||||
[expr {$y - [lindex $dragging 1]}]
|
||||
variable dragging [list $x $y]
|
||||
}
|
||||
}
|
||||
proc DragEnd {w x y} {
|
||||
set square [$w find closest $x $y 0 65]
|
||||
$w moveto selected {*}[lrange [$w coords $square] 0 1]
|
||||
$w dtag selected
|
||||
variable dragging ; unset dragging
|
||||
}
|
||||
|
||||
proc CreateGUI {} {
|
||||
catch {destroy .knightstour}
|
||||
set dlg [toplevel .knightstour]
|
||||
wm title $dlg "Knights tour"
|
||||
wm withdraw $dlg
|
||||
set f [ttk::frame $dlg.f]
|
||||
set c [canvas $f.c -width 240 -height 240]
|
||||
text $f.txt -width 10 -height 1 \
|
||||
-yscrollcommand [list $f.vs set] -font {Arial 8}
|
||||
ttk::scrollbar $f.vs -command [list $f.txt yview]
|
||||
|
||||
variable delay 600
|
||||
variable continuous 0
|
||||
ttk::frame $dlg.tf
|
||||
ttk::label $dlg.tf.ls -text Speed
|
||||
ttk::scale $dlg.tf.sc -from 8 -to 2000 -command [list SetDelay] \
|
||||
-variable [namespace which -variable delay]
|
||||
ttk::checkbutton $dlg.tf.cc -text Repeat \
|
||||
-variable [namespace which -variable continuous]
|
||||
ttk::button $dlg.tf.b1 -text Start -command [list Tour $dlg]
|
||||
ttk::button $dlg.tf.b2 -text Exit -command [list Exit $dlg]
|
||||
set square 0
|
||||
for {set row 7} {$row >= 0} {incr row -1} {
|
||||
for {set col 0} {$col < 8} {incr col} {
|
||||
if {(($col & 1) ^ ($row & 1))} {
|
||||
set fill tan3 ; set dfill tan4
|
||||
} else {
|
||||
set fill bisque ; set dfill bisque3
|
||||
}
|
||||
set coords [list [expr {$col * 30 + 4}] [expr {$row * 30 + 4}] \
|
||||
[expr {$col * 30 + 30}] [expr {$row * 30 + 30}]]
|
||||
$c create rectangle $coords -fill $fill -disabledfill $dfill \
|
||||
-width 2 -state disabled -outline black
|
||||
}
|
||||
}
|
||||
if {[tk windowingsystem] ne "x11"} {
|
||||
catch {eval font create KnightFont -size -24}
|
||||
$c create text 0 0 -font KnightFont -text "\u265e" \
|
||||
-anchor nw -tags knight -fill black -activefill "#600000"
|
||||
} else {
|
||||
# On X11 we cannot reliably tell if the \u265e glyph is available
|
||||
# so just use a polygon
|
||||
set pts {
|
||||
2 25 24 25 21 19 20 8 14 0 10 0 0 13 0 16
|
||||
2 17 4 14 5 15 3 17 5 17 9 14 10 15 5 21
|
||||
}
|
||||
$c create polygon $pts -tag knight -offset 8 \
|
||||
-fill black -activefill "#600000"
|
||||
}
|
||||
$c moveto knight {*}[lrange [$c coords [expr {1 + int(rand() * 64)}]] 0 1]
|
||||
$c bind knight <Button-1> [namespace code [list DragStart %W %x %y]]
|
||||
$c bind knight <Motion> [namespace code [list DragMotion %W %x %y]]
|
||||
$c bind knight <ButtonRelease-1> [namespace code [list DragEnd %W %x %y]]
|
||||
|
||||
grid $c $f.txt $f.vs -sticky news
|
||||
grid rowconfigure $f 0 -weight 1
|
||||
grid columnconfigure $f 1 -weight 1
|
||||
|
||||
grid $f - - - - - -sticky news
|
||||
set things [list $dlg.tf.ls $dlg.tf.sc $dlg.tf.cc $dlg.tf.b1]
|
||||
if {![info exists ::widgetDemo]} {
|
||||
lappend things $dlg.tf.b2
|
||||
if {[tk windowingsystem] ne "aqua"} {
|
||||
set things [linsert $things 0 [ttk::sizegrip $dlg.tf.sg]]
|
||||
}
|
||||
}
|
||||
pack {*}$things -side right
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
pack configure {*}$things -padx {4 4} -pady {12 12}
|
||||
pack configure [lindex $things 0] -padx {4 24}
|
||||
pack configure [lindex $things end] -padx {16 4}
|
||||
}
|
||||
grid $dlg.tf - - - - - -sticky ew
|
||||
if {[info exists ::widgetDemo]} {
|
||||
grid [addSeeDismiss $dlg.buttons $dlg] - - - - - -sticky ew
|
||||
}
|
||||
|
||||
grid rowconfigure $dlg 0 -weight 1
|
||||
grid columnconfigure $dlg 0 -weight 1
|
||||
|
||||
bind $dlg <Control-F2> {console show}
|
||||
bind $dlg <Return> [list $dlg.tf.b1 invoke]
|
||||
bind $dlg <Escape> [list $dlg.tf.b2 invoke]
|
||||
bind $dlg <Destroy> [namespace code [list Stop]]
|
||||
wm protocol $dlg WM_DELETE_WINDOW [namespace code [list Exit $dlg]]
|
||||
|
||||
wm deiconify $dlg
|
||||
tkwait window $dlg
|
||||
}
|
||||
|
||||
if {![winfo exists .knightstour]} {
|
||||
if {![info exists widgetDemo]} { wm withdraw . }
|
||||
set r [catch [linsert $argv 0 CreateGUI] err]
|
||||
if {$r} {
|
||||
tk_messageBox -icon error -title "Error" -message $err
|
||||
}
|
||||
if {![info exists widgetDemo]} { exit $r }
|
||||
}
|
||||
@@ -0,0 +1,40 @@
|
||||
# label.tcl --
|
||||
#
|
||||
# This demonstration script creates a toplevel window containing
|
||||
# several label widgets.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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 an image 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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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
|
||||
|
||||
# Main widget program sets variable tk_demoDirectory
|
||||
image create photo label.ousterhout \
|
||||
-file [file join $tk_demoDirectory images ouster.png]
|
||||
label $w.right.picture -borderwidth 2 -relief sunken -image label.ousterhout
|
||||
label $w.right.caption -text "Tcl/Tk Creator"
|
||||
pack $w.right.picture $w.right.caption -side top
|
||||
@@ -0,0 +1,76 @@
|
||||
# labelframe.tcl --
|
||||
#
|
||||
# This demonstration script creates a toplevel window containing
|
||||
# several labelframe widgets.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .labelframe
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Labelframe Demonstration"
|
||||
wm iconname $w "labelframe"
|
||||
positionWindow $w
|
||||
|
||||
# Some information
|
||||
|
||||
label $w.msg -font $font -wraplength 4i -justify left -text "Labelframes are\
|
||||
used to group related widgets together. The label may be either \
|
||||
plain text or another widget."
|
||||
pack $w.msg -side top
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
# Demo area
|
||||
|
||||
frame $w.f
|
||||
pack $w.f -side bottom -fill both -expand 1
|
||||
set w $w.f
|
||||
|
||||
# A group of radiobuttons in a labelframe
|
||||
|
||||
labelframe $w.f -text "Value" -padx 2 -pady 2
|
||||
grid $w.f -row 0 -column 0 -pady 2m -padx 2m
|
||||
|
||||
foreach value {1 2 3 4} {
|
||||
radiobutton $w.f.b$value -text "This is value $value" \
|
||||
-variable lfdummy -value $value
|
||||
pack $w.f.b$value -side top -fill x -pady 2
|
||||
}
|
||||
|
||||
|
||||
# Using a label window to control a group of options.
|
||||
|
||||
proc lfEnableButtons {w} {
|
||||
foreach child [winfo children $w] {
|
||||
if {$child == "$w.cb"} continue
|
||||
if {$::lfdummy2} {
|
||||
$child configure -state normal
|
||||
} else {
|
||||
$child configure -state disabled
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
labelframe $w.f2 -pady 2 -padx 2
|
||||
checkbutton $w.f2.cb -text "Use this option." -variable lfdummy2 \
|
||||
-command "lfEnableButtons $w.f2" -padx 0
|
||||
$w.f2 configure -labelwidget $w.f2.cb
|
||||
grid $w.f2 -row 0 -column 1 -pady 2m -padx 2m
|
||||
|
||||
set t 0
|
||||
foreach str {Option1 Option2 Option3} {
|
||||
checkbutton $w.f2.b$t -text $str
|
||||
pack $w.f2.b$t -side top -fill x -pady 2
|
||||
incr t
|
||||
}
|
||||
lfEnableButtons $w.f2
|
||||
|
||||
|
||||
grid columnconfigure $w {0 1} -weight 1
|
||||
@@ -0,0 +1,40 @@
|
||||
This software is copyrighted by the Regents of the University of
|
||||
California, Sun Microsystems, Inc., Scriptics Corporation, ActiveState
|
||||
Corporation, Apple 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 (b) (3) 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.
|
||||
@@ -0,0 +1,119 @@
|
||||
# mclist.tcl --
|
||||
#
|
||||
# This demonstration script creates a toplevel window containing a Ttk
|
||||
# tree widget configured as a multi-column listbox.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .mclist
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Multi-Column List"
|
||||
wm iconname $w "mclist"
|
||||
positionWindow $w
|
||||
|
||||
## Explanatory text
|
||||
ttk::label $w.msg -font $font -wraplength 4i -justify left -anchor n -padding {10 2 10 6} -text "Ttk is the new Tk themed widget set. One of the widgets it includes is a tree widget, which can be configured to display multiple columns of informational data without displaying the tree itself. This is a simple way to build a listbox that has multiple columns. Clicking on the heading for a column will sort the data by that column. You can also change the width of the columns by dragging the boundary between them."
|
||||
pack $w.msg -fill x
|
||||
|
||||
## See Code / Dismiss
|
||||
pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x
|
||||
|
||||
ttk::frame $w.container
|
||||
ttk::treeview $w.tree -columns {country capital currency} -show headings \
|
||||
-yscroll "$w.vsb set" -xscroll "$w.hsb set"
|
||||
ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview"
|
||||
ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview"
|
||||
pack $w.container -fill both -expand 1
|
||||
grid $w.tree $w.vsb -in $w.container -sticky nsew
|
||||
grid $w.hsb -in $w.container -sticky nsew
|
||||
grid column $w.container 0 -weight 1
|
||||
grid row $w.container 0 -weight 1
|
||||
|
||||
image create photo upArrow -data {
|
||||
R0lGODlhDgAOAJEAANnZ2YCAgPz8/P///yH5BAEAAAAALAAAAAAOAA4AAAImhI+
|
||||
py+1LIsJHiBAh+BgmiEAJQITgW6DgUQIAECH4JN8IPqYuNxUAOw==}
|
||||
image create photo downArrow -data {
|
||||
R0lGODlhDgAOAJEAANnZ2YCAgPz8/P///yH5BAEAAAAALAAAAAAOAA4AAAInhI+
|
||||
py+1I4ocQ/IgDEYIPgYJICUCE4F+YIBolEoKPEJKZmVJK6ZACADs=}
|
||||
image create photo noArrow -height 14 -width 14
|
||||
|
||||
## The data we're going to insert
|
||||
set data {
|
||||
Argentina {Buenos Aires} ARS
|
||||
Australia Canberra AUD
|
||||
Brazil Brazilia BRL
|
||||
Canada Ottawa CAD
|
||||
China Beijing CNY
|
||||
France Paris EUR
|
||||
Germany Berlin EUR
|
||||
India {New Delhi} INR
|
||||
Italy Rome EUR
|
||||
Japan Tokyo JPY
|
||||
Mexico {Mexico City} MXN
|
||||
Russia Moscow RUB
|
||||
{South Africa} Pretoria ZAR
|
||||
{United Kingdom} London GBP
|
||||
{United States} {Washington, D.C.} USD
|
||||
}
|
||||
|
||||
## Code to insert the data nicely
|
||||
set font [ttk::style lookup Heading -font]
|
||||
foreach col {country capital currency} name {Country Capital Currency} {
|
||||
$w.tree heading $col -text $name -image noArrow -anchor w \
|
||||
-command [list SortBy $w.tree $col 0]
|
||||
$w.tree column $col -width [expr {
|
||||
[font measure $font $name] + [image width noArrow] + 5
|
||||
}]
|
||||
}
|
||||
set font [ttk::style lookup Treeview -font]
|
||||
foreach {country capital currency} $data {
|
||||
$w.tree insert {} end -values [list $country $capital $currency]
|
||||
foreach col {country capital currency} {
|
||||
set len [font measure $font "[set $col] "]
|
||||
if {[$w.tree column $col -width] < $len} {
|
||||
$w.tree column $col -width $len
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
## Code to do the sorting of the tree contents when clicked on
|
||||
proc SortBy {tree col direction} {
|
||||
# Determine currently sorted column and its sort direction
|
||||
foreach c {country capital currency} {
|
||||
set s [$tree heading $c state]
|
||||
if {("selected" in $s || "alternate" in $s) && $col ne $c} {
|
||||
# Sorted column has changed
|
||||
$tree heading $c -image noArrow state {!selected !alternate !user1}
|
||||
set direction [expr {"alternate" in $s}]
|
||||
}
|
||||
}
|
||||
|
||||
# Build something we can sort
|
||||
set data {}
|
||||
foreach row [$tree children {}] {
|
||||
lappend data [list [$tree set $row $col] $row]
|
||||
}
|
||||
|
||||
set dir [expr {$direction ? "-decreasing" : "-increasing"}]
|
||||
set r -1
|
||||
|
||||
# Now reshuffle the rows into the sorted order
|
||||
foreach info [lsort -dictionary -index 0 $dir $data] {
|
||||
$tree move [lindex $info 1] {} [incr r]
|
||||
}
|
||||
|
||||
# Switch the heading so that it will sort in the opposite direction
|
||||
$tree heading $col -command [list SortBy $tree $col [expr {!$direction}]] \
|
||||
state [expr {$direction?"!selected alternate":"selected !alternate"}]
|
||||
if {[ttk::style theme use] eq "aqua"} {
|
||||
# Aqua theme displays native sort arrows when user1 state is set
|
||||
$tree heading $col state "user1"
|
||||
} else {
|
||||
$tree heading $col -image [expr {$direction?"upArrow":"downArrow"}]
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,180 @@
|
||||
# menu.tcl --
|
||||
#
|
||||
# This demonstration script creates a window with a bunch of menus
|
||||
# and cascaded menus using menubars.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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 {[tk windowingsystem] eq "aqua"} {
|
||||
catch {set origUseCustomMDEF $::tk::mac::useCustomMDEF; set ::tk::mac::useCustomMDEF 1}
|
||||
$w.msg configure -text "This window has 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 selecting the first item in the menu."
|
||||
} 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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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 {[tk windowingsystem] eq "aqua"} {
|
||||
set modifier Command
|
||||
} elseif {[tk windowingsystem] == "win32"} {
|
||||
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 $modifier+$i -command "puts $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
|
||||
# Main widget program sets variable tk_demoDirectory
|
||||
image create photo lilearth -file [file join $tk_demoDirectory \
|
||||
images earthmenu.png]
|
||||
$m add command -image lilearth \
|
||||
-hidemargin 1 -command [list \
|
||||
tk_dialog $w.pattern {Bitmap Menu Entry} \
|
||||
"The menu entry you invoked displays a photoimage 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 -hidemargin 1 -command [list \
|
||||
puts "You invoked the $i bitmap" ]
|
||||
}
|
||||
$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 emojiLabel [encoding convertfrom utf-8 "\xF0\x9F\x98\x8D Make friends"]
|
||||
$m add command -label $emojiLabel -command [list puts "Menu labels can include non-BMP characters."]
|
||||
$m entryconfigure "Does almost nothing" -bitmap questhead -compound left \
|
||||
-command [list \
|
||||
tk_dialog $w.compound {Compound Menu Entry} \
|
||||
"The menu entry you invoked displays both a bitmap and a\
|
||||
text string. Other than this, it is just like any other\
|
||||
menu entry." {} 0 OK ]
|
||||
|
||||
set m $w.menu.colors
|
||||
$w.menu add cascade -label "Colors" -menu $m -underline 1
|
||||
menu $m -tearoff 1
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
# Aqua ignores the -background and -foreground options, but a compound
|
||||
# button can be used for selecting colors.
|
||||
foreach i {red orange yellow green blue} {
|
||||
image create photo image_$i -height 16 -width 16
|
||||
image_$i put black -to 0 0 16 1
|
||||
image_$i put black -to 0 1 1 16
|
||||
image_$i put black -to 0 15 16 16
|
||||
image_$i put black -to 15 1 16 16
|
||||
image_$i put $i -to 1 1 15 15
|
||||
$m add command -label $i -image image_$i -compound left -command [list \
|
||||
puts "You invoked \"$i\"" ]
|
||||
}
|
||||
} else {
|
||||
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 <<MenuSelect>> {
|
||||
global $menustatus
|
||||
if {[catch {%W entrycget active -label} label]} {
|
||||
set label " "
|
||||
}
|
||||
set menustatus $label
|
||||
update idletasks
|
||||
}
|
||||
|
||||
if {[tk windowingsystem] eq "aqua"} {catch {set ::tk::mac::useCustomMDEF $origUseCustomMDEF}}
|
||||
@@ -0,0 +1,90 @@
|
||||
# menubu.tcl --
|
||||
#
|
||||
# This demonstration script creates a window with a bunch of menus
|
||||
# and cascaded menus using menubuttons.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .menubu
|
||||
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
|
||||
if {[tk windowingsystem] eq "aqua"} {catch {set origUseCustomMDEF $::tk::mac::useCustomMDEF; set ::tk::mac::useCustomMDEF 1}}
|
||||
|
||||
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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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 {[tk windowingsystem] eq "aqua"} {
|
||||
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
|
||||
|
||||
if {[tk windowingsystem] eq "aqua"} {catch {set ::tk::mac::useCustomMDEF $origUseCustomMDEF}}
|
||||
@@ -0,0 +1,62 @@
|
||||
# msgbox.tcl --
|
||||
#
|
||||
# This demonstration script creates message boxes of various type
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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
|
||||
|
||||
pack [addSeeDismiss $w.buttons $w {} {
|
||||
ttk::button $w.buttons.vars -text "Message Box" -command "showMessageBox $w"
|
||||
}] -side bottom -fill x
|
||||
#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
|
||||
}
|
||||
@@ -0,0 +1,125 @@
|
||||
::msgcat::mcset nl "Widget Demonstration" "Demonstratie van widgets"
|
||||
::msgcat::mcset nl "tkWidgetDemo" "tkWidgetDemo"
|
||||
::msgcat::mcset nl "&File" "&Bestand"
|
||||
::msgcat::mcset nl "About..." "Info..."
|
||||
::msgcat::mcset nl "&About..." "&Info..."
|
||||
::msgcat::mcset nl "<F1>" "<F1>"
|
||||
::msgcat::mcset nl "&Quit" "&Einde"
|
||||
::msgcat::mcset nl "Meta+Q" "Meta+E" ;# Displayed hotkey
|
||||
::msgcat::mcset nl "Meta-q" "Meta-e" ;# Actual binding sequence
|
||||
::msgcat::mcset nl "Ctrl+Q" "Ctrl+E" ;# Displayed hotkey
|
||||
::msgcat::mcset nl "Control-q" "Control-e" ;# Actual binding sequence
|
||||
::msgcat::mcset nl "Dismiss" "Sluiten"
|
||||
::msgcat::mcset nl "See Variables" "Bekijk Variabelen"
|
||||
::msgcat::mcset nl "Variable Values" "Waarden Variabelen"
|
||||
::msgcat::mcset nl "OK" "OK"
|
||||
::msgcat::mcset nl "Run the \"%s\" sample program" "Start voorbeeld \"%s\""
|
||||
::msgcat::mcset nl "Print Code" "Code Afdrukken"
|
||||
::msgcat::mcset nl "Demo code: %s" "Code van Demo %s"
|
||||
::msgcat::mcset nl "About Widget Demo" "Over deze demonstratie"
|
||||
::msgcat::mcset nl "Tk widget demonstration" "Demonstratie van Tk widgets"
|
||||
::msgcat::mcset nl "Copyright © %s"
|
||||
|
||||
::msgcat::mcset nl "Tk Widget Demonstrations" "Demonstratie van Tk widgets"
|
||||
::msgcat::mcset nl "This application provides a front end for several short scripts" \
|
||||
"Dit programma is een schil rond enkele korte scripts waarmee"
|
||||
::msgcat::mcset nl "that demonstrate what you can do with Tk widgets. Each of the" \
|
||||
"gedemonstreerd wordt wat je kunt doen met Tk widgets. Elk van de"
|
||||
::msgcat::mcset nl "numbered lines below describes a demonstration; you can click on" \
|
||||
"genummerde regels hieronder omschrijft een demonstratie; je kunt de"
|
||||
::msgcat::mcset nl "it to invoke the demonstration. Once the demonstration window" \
|
||||
"demonstratie starten door op de regel te klikken."
|
||||
::msgcat::mcset nl "appears, you can click the" \
|
||||
"Zodra het nieuwe venster verschijnt, kun je op de knop"
|
||||
::msgcat::mcset nl "See Code" "Bekijk Code" ;# This is also button text!
|
||||
::msgcat::mcset nl "button to see the Tcl/Tk code that created the demonstration. If" \
|
||||
"drukken om de achterliggende Tcl/Tk code te zien. Als je dat wilt,"
|
||||
::msgcat::mcset nl "you wish, you can edit the code and click the" \
|
||||
"kun je de code wijzigen en op de knop"
|
||||
::msgcat::mcset nl "Rerun Demo" "Herstart Demo" ;# This is also button text!
|
||||
::msgcat::mcset nl "button in the code window to reinvoke the demonstration with the" \
|
||||
"drukken in het codevenster om de demonstratie uit te voeren met de"
|
||||
::msgcat::mcset nl "modified code." \
|
||||
"nieuwe code."
|
||||
|
||||
::msgcat::mcset nl "Labels, buttons, checkbuttons, and radiobuttons" \
|
||||
"Labels, knoppen, vinkjes/aankruishokjes en radioknoppen"
|
||||
|
||||
::msgcat::mcset nl "Labels (text and bitmaps)" "Labels (tekst en plaatjes)"
|
||||
::msgcat::mcset nl "Labels and UNICODE text" "Labels en tekst in UNICODE"
|
||||
::msgcat::mcset nl "Buttons" "Buttons (drukknoppen)"
|
||||
::msgcat::mcset nl "Check-buttons (select any of a group)" \
|
||||
"Check-buttons (een of meer uit een groep)"
|
||||
::msgcat::mcset nl "Radio-buttons (select one of a group)" \
|
||||
"Radio-buttons (een van een groep)"
|
||||
::msgcat::mcset nl "A 15-puzzle game made out of buttons" \
|
||||
"Een schuifpuzzel van buttons"
|
||||
::msgcat::mcset nl "Iconic buttons that use bitmaps" \
|
||||
"Buttons met pictogrammen"
|
||||
::msgcat::mcset nl "Two labels displaying images" \
|
||||
"Twee labels met plaatjes in plaats van tekst"
|
||||
::msgcat::mcset nl "A simple user interface for viewing images" \
|
||||
"Een eenvoudige user-interface voor het bekijken van plaatjes"
|
||||
::msgcat::mcset nl "Labelled frames" \
|
||||
"Kaders met bijschrift"
|
||||
|
||||
::msgcat::mcset nl "Listboxes" "Keuzelijsten"
|
||||
::msgcat::mcset nl "The 50 states" "De 50 staten van de VS"
|
||||
::msgcat::mcset nl "Colors: change the color scheme for the application" \
|
||||
"Kleuren: verander het kleurenschema voor het programma"
|
||||
::msgcat::mcset nl "A collection of famous and infamous sayings" \
|
||||
"Beroemde en beruchte citaten en gezegden"
|
||||
|
||||
::msgcat::mcset nl "Entries and Spin-boxes" "Invulvelden en Spinboxen"
|
||||
::msgcat::mcset nl "Entries without scrollbars" "Invulvelden zonder schuifbalk"
|
||||
::msgcat::mcset nl "Entries with scrollbars" "Invulvelden met schuifbalk"
|
||||
::msgcat::mcset nl "Validated entries and password fields" \
|
||||
"Invulvelden met controle of wachtwoorden"
|
||||
::msgcat::mcset nl "Spin-boxes" "Spinboxen"
|
||||
::msgcat::mcset nl "Simple Rolodex-like form" "Simpel kaartsysteem"
|
||||
|
||||
::msgcat::mcset nl "Text" "Tekst"
|
||||
::msgcat::mcset nl "Basic editable text" "Voorbeeld met te wijzigen tekst"
|
||||
::msgcat::mcset nl "Text display styles" "Tekst met verschillende stijlen"
|
||||
::msgcat::mcset nl "Hypertext (tag bindings)" \
|
||||
"Hypertext (verwijzingen via \"tags\")"
|
||||
::msgcat::mcset nl "A text widget with embedded windows" \
|
||||
"Tekstwidget met windows erin"
|
||||
::msgcat::mcset nl "A search tool built with a text widget" \
|
||||
"Zoeken in tekst met behulp van een tekstwidget"
|
||||
|
||||
::msgcat::mcset nl "Canvases" "Canvaswidgets"
|
||||
::msgcat::mcset nl "The canvas item types" "Objecten in een canvas"
|
||||
::msgcat::mcset nl "A simple 2-D plot" "Eenvoudige 2D-grafiek"
|
||||
::msgcat::mcset nl "Text items in canvases" "Tekstobjecten in een canvas"
|
||||
::msgcat::mcset nl "An editor for arrowheads on canvas lines" \
|
||||
"Editor voor de vorm van de pijl (begin/eind van een lijn)"
|
||||
::msgcat::mcset nl "A ruler with adjustable tab stops" \
|
||||
"Een meetlat met aanpasbare ruiters"
|
||||
::msgcat::mcset nl "A building floor plan" "Plattegrond van een gebouw"
|
||||
::msgcat::mcset nl "A simple scrollable canvas" "Een schuifbaar canvas"
|
||||
|
||||
::msgcat::mcset nl "Scales" "Schaalverdelingen"
|
||||
::msgcat::mcset nl "Horizontal scale" "Horizontale schaal"
|
||||
::msgcat::mcset nl "Vertical scale" "Verticale schaal"
|
||||
|
||||
::msgcat::mcset nl "Paned Windows" "Vensters opgedeeld in stukken"
|
||||
::msgcat::mcset nl "Horizontal paned window" "Horizontaal gedeeld venster"
|
||||
::msgcat::mcset nl "Vertical paned window" "Verticaal gedeeld venster"
|
||||
|
||||
::msgcat::mcset nl "Menus" "Menu's"
|
||||
::msgcat::mcset nl "Menus and cascades (sub-menus)" \
|
||||
"Menu's en cascades (submenu's)"
|
||||
::msgcat::mcset nl "Menu-buttons" "Menu-buttons"
|
||||
|
||||
::msgcat::mcset nl "Common Dialogs" "Veel voorkomende dialoogvensters"
|
||||
::msgcat::mcset nl "Message boxes" "Mededeling (message box)"
|
||||
::msgcat::mcset nl "File selection dialog" "Selectie van bestanden"
|
||||
::msgcat::mcset nl "Color picker" "Kleurenpalet"
|
||||
|
||||
::msgcat::mcset nl "Miscellaneous" "Diversen"
|
||||
::msgcat::mcset nl "The built-in bitmaps" "Ingebouwde plaatjes"
|
||||
::msgcat::mcset nl "A dialog box with a local grab" \
|
||||
"Een dialoogvenster met een locale \"grab\""
|
||||
::msgcat::mcset nl "A dialog box with a global grab" \
|
||||
"Een dialoogvenster met een globale \"grab\""
|
||||
@@ -0,0 +1,32 @@
|
||||
# paned1.tcl --
|
||||
#
|
||||
# This demonstration script creates a toplevel window containing
|
||||
# a paned window that separates two windows horizontally.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .paned1
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Horizontal Paned Window Demonstration"
|
||||
wm iconname $w "paned1"
|
||||
positionWindow $w
|
||||
|
||||
label $w.msg -font $font -wraplength 4i -justify left -text "The sash between the two coloured windows below can be used to divide the area between them. Use the left mouse button to resize without redrawing by just moving the sash, and use the middle mouse button to resize opaquely (always redrawing the windows in each position.)"
|
||||
pack $w.msg -side top
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
panedwindow $w.pane
|
||||
pack $w.pane -side top -expand yes -fill both -pady 2 -padx 2m
|
||||
|
||||
label $w.pane.left -text "This is the\nleft side" -fg black -bg yellow
|
||||
label $w.pane.right -text "This is the\nright side" -fg black -bg cyan
|
||||
|
||||
$w.pane add $w.pane.left $w.pane.right
|
||||
@@ -0,0 +1,74 @@
|
||||
# paned2.tcl --
|
||||
#
|
||||
# This demonstration script creates a toplevel window containing
|
||||
# a paned window that separates two windows vertically.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .paned2
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Vertical Paned Window Demonstration"
|
||||
wm iconname $w "paned2"
|
||||
positionWindow $w
|
||||
|
||||
label $w.msg -font $font -wraplength 4i -justify left -text "The sash between the two scrolled windows below can be used to divide the area between them. Use the left mouse button to resize without redrawing by just moving the sash, and use the middle mouse button to resize opaquely (always redrawing the windows in each position.)"
|
||||
pack $w.msg -side top
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
# Create the pane itself
|
||||
panedwindow $w.pane -orient vertical
|
||||
pack $w.pane -side top -expand yes -fill both -pady 2 -padx 2m
|
||||
|
||||
# The top window is a listbox with scrollbar
|
||||
set paneList {
|
||||
{List of Tk Widgets}
|
||||
button
|
||||
canvas
|
||||
checkbutton
|
||||
entry
|
||||
frame
|
||||
label
|
||||
labelframe
|
||||
listbox
|
||||
menu
|
||||
menubutton
|
||||
message
|
||||
panedwindow
|
||||
radiobutton
|
||||
scale
|
||||
scrollbar
|
||||
spinbox
|
||||
text
|
||||
toplevel
|
||||
}
|
||||
set f [frame $w.pane.top]
|
||||
listbox $f.list -listvariable paneList -yscrollcommand "$f.scr set"
|
||||
# Invert the first item to highlight it
|
||||
$f.list itemconfigure 0 \
|
||||
-background [$f.list cget -fg] -foreground [$f.list cget -bg]
|
||||
ttk::scrollbar $f.scr -orient vertical -command "$f.list yview"
|
||||
pack $f.scr -side right -fill y
|
||||
pack $f.list -fill both -expand 1
|
||||
|
||||
# The bottom window is a text widget with scrollbar
|
||||
set f [frame $w.pane.bottom]
|
||||
text $f.text -xscrollcommand "$f.xscr set" -yscrollcommand "$f.yscr set" \
|
||||
-width 30 -height 8 -wrap none
|
||||
ttk::scrollbar $f.xscr -orient horizontal -command "$f.text xview"
|
||||
ttk::scrollbar $f.yscr -orient vertical -command "$f.text yview"
|
||||
grid $f.text $f.yscr -sticky nsew
|
||||
grid $f.xscr -sticky nsew
|
||||
grid columnconfigure $f 0 -weight 1
|
||||
grid rowconfigure $f 0 -weight 1
|
||||
$f.text insert 1.0 "This is just a normal text widget"
|
||||
|
||||
# Now add our contents to the paned window
|
||||
$w.pane add $w.pane.top $w.pane.bottom
|
||||
@@ -0,0 +1,197 @@
|
||||
# pendulum.tcl --
|
||||
#
|
||||
# This demonstration illustrates how Tcl/Tk can be used to construct
|
||||
# simulations of physical systems.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .pendulum
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Pendulum Animation Demonstration"
|
||||
wm iconname $w "pendulum"
|
||||
positionWindow $w
|
||||
|
||||
label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration shows how Tcl/Tk can be used to carry out animations that are linked to simulations of physical systems. In the left canvas is a graphical representation of the physical system itself, a simple pendulum, and in the right canvas is a graph of the phase space of the system, which is a plot of the angle (relative to the vertical) against the angular velocity. The pendulum bob may be repositioned by clicking and dragging anywhere on the left canvas."
|
||||
pack $w.msg
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
# Create some structural widgets
|
||||
pack [panedwindow $w.p] -fill both -expand 1
|
||||
$w.p add [labelframe $w.p.l1 -text "Pendulum Simulation"]
|
||||
$w.p add [labelframe $w.p.l2 -text "Phase Space"]
|
||||
|
||||
# Create the canvas containing the graphical representation of the
|
||||
# simulated system.
|
||||
canvas $w.c -width 320 -height 200 -background white -bd 2 -relief sunken
|
||||
$w.c create text 5 5 -anchor nw -text "Click to Adjust Bob Start Position"
|
||||
# Coordinates of these items don't matter; they will be set properly below
|
||||
$w.c create line 0 25 320 25 -tags plate -fill grey50 -width 2
|
||||
$w.c create oval 155 20 165 30 -tags pivot -fill grey50 -outline {}
|
||||
$w.c create line 1 1 1 1 -tags rod -fill black -width 3
|
||||
$w.c create oval 1 1 2 2 -tags bob -fill yellow -outline black
|
||||
pack $w.c -in $w.p.l1 -fill both -expand true
|
||||
|
||||
# Create the canvas containing the phase space graph; this consists of
|
||||
# a line that gets gradually paler as it ages, which is an extremely
|
||||
# effective visual trick.
|
||||
canvas $w.k -width 320 -height 200 -background white -bd 2 -relief sunken
|
||||
$w.k create line 160 200 160 0 -fill grey75 -arrow last -tags y_axis
|
||||
$w.k create line 0 100 320 100 -fill grey75 -arrow last -tags x_axis
|
||||
for {set i 90} {$i>=0} {incr i -10} {
|
||||
# Coordinates of these items don't matter; they will be set properly below
|
||||
$w.k create line 0 0 1 1 -smooth true -tags graph$i -fill grey$i
|
||||
}
|
||||
|
||||
$w.k create text 0 0 -anchor ne -text "\u03b8" -tags label_theta
|
||||
$w.k create text 0 0 -anchor ne -text "\u03b4\u03b8" -tags label_dtheta
|
||||
pack $w.k -in $w.p.l2 -fill both -expand true
|
||||
|
||||
# Initialize some variables
|
||||
set points {}
|
||||
set Theta 45.0
|
||||
set dTheta 0.0
|
||||
set pi 3.1415926535897933
|
||||
set length 150
|
||||
set home 160
|
||||
|
||||
# This procedure makes the pendulum appear at the correct place on the
|
||||
# canvas. If the additional arguments "at $x $y" are passed (the 'at'
|
||||
# is really just syntactic sugar) instead of computing the position of
|
||||
# the pendulum from the length of the pendulum rod and its angle, the
|
||||
# length and angle are computed in reverse from the given location
|
||||
# (which is taken to be the centre of the pendulum bob.)
|
||||
proc showPendulum {canvas {at {}} {x {}} {y {}}} {
|
||||
global Theta dTheta pi length home
|
||||
if {$at eq "at" && ($x!=$home || $y!=25)} {
|
||||
set dTheta 0.0
|
||||
set x2 [expr {$x - $home}]
|
||||
set y2 [expr {$y - 25}]
|
||||
set length [expr {hypot($x2, $y2)}]
|
||||
set Theta [expr {atan2($x2, $y2) * 180/$pi}]
|
||||
} else {
|
||||
set angle [expr {$Theta * $pi/180}]
|
||||
set x [expr {$home + $length*sin($angle)}]
|
||||
set y [expr {25 + $length*cos($angle)}]
|
||||
}
|
||||
$canvas coords rod $home 25 $x $y
|
||||
$canvas coords bob \
|
||||
[expr {$x-15}] [expr {$y-15}] [expr {$x+15}] [expr {$y+15}]
|
||||
}
|
||||
showPendulum $w.c
|
||||
|
||||
# Update the phase-space graph according to the current angle and the
|
||||
# rate at which the angle is changing (the first derivative with
|
||||
# respect to time.)
|
||||
proc showPhase {canvas} {
|
||||
global Theta dTheta points psw psh
|
||||
lappend points [expr {$Theta+$psw}] [expr {-20*$dTheta+$psh}]
|
||||
if {[llength $points] > 100} {
|
||||
set points [lrange $points end-99 end]
|
||||
}
|
||||
for {set i 0} {$i<100} {incr i 10} {
|
||||
set list [lrange $points end-[expr {$i-1}] end-[expr {$i-12}]]
|
||||
if {[llength $list] >= 4} {
|
||||
$canvas coords graph$i $list
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Set up some bindings on the canvases. Note that when the user
|
||||
# clicks we stop the animation until they release the mouse
|
||||
# button. Also note that both canvases are sensitive to <Configure>
|
||||
# events, which allows them to find out when they have been resized by
|
||||
# the user.
|
||||
bind $w.c <Destroy> {
|
||||
after cancel $animationCallbacks(pendulum)
|
||||
unset animationCallbacks(pendulum)
|
||||
}
|
||||
bind $w.c <Button-1> {
|
||||
after cancel $animationCallbacks(pendulum)
|
||||
showPendulum %W at %x %y
|
||||
}
|
||||
bind $w.c <B1-Motion> {
|
||||
showPendulum %W at %x %y
|
||||
}
|
||||
bind $w.c <ButtonRelease-1> {
|
||||
showPendulum %W at %x %y
|
||||
set animationCallbacks(pendulum) [after 15 repeat [winfo toplevel %W]]
|
||||
}
|
||||
bind $w.c <Configure> {
|
||||
%W coords plate 0 25 %w 25
|
||||
set home [expr {%w/2}]
|
||||
%W coords pivot [expr {$home-5}] 20 [expr {$home+5}] 30
|
||||
}
|
||||
bind $w.k <Configure> {
|
||||
set psh [expr {%h/2}]
|
||||
set psw [expr {%w/2}]
|
||||
%W coords x_axis 2 $psh [expr {%w-2}] $psh
|
||||
%W coords y_axis $psw [expr {%h-2}] $psw 2
|
||||
%W coords label_dtheta [expr {$psw-4}] 6
|
||||
%W coords label_theta [expr {%w-6}] [expr {$psh+4}]
|
||||
}
|
||||
|
||||
# This procedure is the "business" part of the simulation that does
|
||||
# simple numerical integration of the formula for a simple rotational
|
||||
# pendulum.
|
||||
proc recomputeAngle {} {
|
||||
global Theta dTheta pi length
|
||||
set scaling [expr {3000.0/$length/$length}]
|
||||
|
||||
# To estimate the integration accurately, we really need to
|
||||
# compute the end-point of our time-step. But to do *that*, we
|
||||
# need to estimate the integration accurately! So we try this
|
||||
# technique, which is inaccurate, but better than doing it in a
|
||||
# single step. What we really want is bound up in the
|
||||
# differential equation:
|
||||
# .. - sin theta
|
||||
# theta + theta = -----------
|
||||
# length
|
||||
# But my math skills are not good enough to solve this!
|
||||
|
||||
# first estimate
|
||||
set firstDDTheta [expr {-sin($Theta * $pi/180)*$scaling}]
|
||||
set midDTheta [expr {$dTheta + $firstDDTheta}]
|
||||
set midTheta [expr {$Theta + ($dTheta + $midDTheta)/2}]
|
||||
# second estimate
|
||||
set midDDTheta [expr {-sin($midTheta * $pi/180)*$scaling}]
|
||||
set midDTheta [expr {$dTheta + ($firstDDTheta + $midDDTheta)/2}]
|
||||
set midTheta [expr {$Theta + ($dTheta + $midDTheta)/2}]
|
||||
# Now we do a double-estimate approach for getting the final value
|
||||
# first estimate
|
||||
set midDDTheta [expr {-sin($midTheta * $pi/180)*$scaling}]
|
||||
set lastDTheta [expr {$midDTheta + $midDDTheta}]
|
||||
set lastTheta [expr {$midTheta + ($midDTheta + $lastDTheta)/2}]
|
||||
# second estimate
|
||||
set lastDDTheta [expr {-sin($lastTheta * $pi/180)*$scaling}]
|
||||
set lastDTheta [expr {$midDTheta + ($midDDTheta + $lastDDTheta)/2}]
|
||||
set lastTheta [expr {$midTheta + ($midDTheta + $lastDTheta)/2}]
|
||||
# Now put the values back in our globals
|
||||
set dTheta $lastDTheta
|
||||
set Theta $lastTheta
|
||||
}
|
||||
|
||||
# This method ties together the simulation engine and the graphical
|
||||
# display code that visualizes it.
|
||||
proc repeat w {
|
||||
global animationCallbacks
|
||||
|
||||
# Simulate
|
||||
recomputeAngle
|
||||
|
||||
# Update the display
|
||||
showPendulum $w.c
|
||||
showPhase $w.k
|
||||
|
||||
# Reschedule ourselves
|
||||
set animationCallbacks(pendulum) [after 15 [list repeat $w]]
|
||||
}
|
||||
# Start the simulation after a short pause
|
||||
set animationCallbacks(pendulum) [after 500 [list repeat $w]]
|
||||
@@ -0,0 +1,97 @@
|
||||
# plot.tcl --
|
||||
#
|
||||
# This demonstration script creates a canvas widget showing a 2-D
|
||||
# plot with data points that can be dragged with the mouse.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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 <Enter> "$c itemconfig current -fill red"
|
||||
$c bind point <Leave> "$c itemconfig current -fill SkyBlue2"
|
||||
$c bind point <Button-1> "plotDown $c %x %y"
|
||||
$c bind point <ButtonRelease-1> "$c dtag selected"
|
||||
bind $c <B1-Motion> "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
|
||||
}
|
||||
@@ -0,0 +1,82 @@
|
||||
# puzzle.tcl --
|
||||
#
|
||||
# This demonstration script creates a 15-puzzle game using a collection
|
||||
# of buttons.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
# 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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
# Special trick: select a darker color for the space by creating a
|
||||
# scrollbar widget and using its trough color.
|
||||
|
||||
scrollbar $w.s
|
||||
|
||||
# The button metrics are a bit bigger in Aqua, and since we are
|
||||
# using place which doesn't autosize, then we need to have a
|
||||
# slightly larger frame here...
|
||||
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
set frameSize 168
|
||||
} else {
|
||||
set frameSize 120
|
||||
}
|
||||
|
||||
frame $w.frame -width $frameSize -height $frameSize -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 -bd 0 -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
|
||||
@@ -0,0 +1,66 @@
|
||||
# radio.tcl --
|
||||
#
|
||||
# This demonstration script creates a toplevel window containing
|
||||
# several radiobutton widgets.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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 "Three 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. When the 'Tristate' button is pressed, the radio buttons will display the tri-state mode. Selecting any radio button will return the buttons to their respective on/off state. Click the \"See Variables\" button to see the current values of the variables."
|
||||
grid $w.msg -row 0 -column 0 -columnspan 3 -sticky nsew
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w [list size color align]]
|
||||
grid $btns -row 3 -column 0 -columnspan 3 -sticky ew
|
||||
|
||||
labelframe $w.left -pady 2 -text "Point Size" -padx 2
|
||||
labelframe $w.mid -pady 2 -text "Color" -padx 2
|
||||
labelframe $w.right -pady 2 -text "Alignment" -padx 2
|
||||
button $w.tristate -text Tristate -command "set size multi; set color multi" \
|
||||
-pady 2 -padx 2
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
$w.tristate configure -padx 10
|
||||
}
|
||||
grid $w.left -column 0 -row 1 -pady .5c -padx .5c -rowspan 2
|
||||
grid $w.mid -column 1 -row 1 -pady .5c -padx .5c -rowspan 2
|
||||
grid $w.right -column 2 -row 1 -pady .5c -padx .5c
|
||||
grid $w.tristate -column 2 -row 2 -pady .5c -padx .5c
|
||||
|
||||
foreach i {10 12 14 18 24} {
|
||||
radiobutton $w.left.b$i -text "Point Size $i" -variable size \
|
||||
-relief flat -value $i -tristatevalue "multi"
|
||||
pack $w.left.b$i -side top -pady 2 -anchor w -fill x
|
||||
}
|
||||
|
||||
foreach c {Red Green Blue Yellow Orange Purple} {
|
||||
set lower [string tolower $c]
|
||||
radiobutton $w.mid.$lower -text $c -variable color \
|
||||
-relief flat -value $lower -anchor w \
|
||||
-command "$w.mid configure -fg \$color" \
|
||||
-tristatevalue "multi"
|
||||
pack $w.mid.$lower -side top -pady 2 -fill x
|
||||
}
|
||||
|
||||
|
||||
label $w.right.l -text "Label" -bitmap questhead -compound left
|
||||
$w.right.l configure -width [winfo reqwidth $w.right.l] -compound top
|
||||
$w.right.l configure -height [winfo reqheight $w.right.l]
|
||||
foreach a {Top Left Right Bottom} {
|
||||
set lower [string tolower $a]
|
||||
radiobutton $w.right.$lower -text $a -variable align \
|
||||
-relief flat -value $lower -indicatoron 0 -width 7 \
|
||||
-command "$w.right.l configure -compound \$align"
|
||||
}
|
||||
|
||||
grid x $w.right.top
|
||||
grid $w.right.left $w.right.l $w.right.right
|
||||
grid x $w.right.bottom
|
||||
@@ -0,0 +1,210 @@
|
||||
#!/bin/sh
|
||||
# the next line restarts using wish \
|
||||
exec wish "$0" ${1+"$@"}
|
||||
|
||||
# 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.
|
||||
|
||||
package require Tk
|
||||
|
||||
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.
|
||||
|
||||
. configure -menu [menu .menu]
|
||||
menu .menu.file
|
||||
menu .menu.file.apps -postcommand fillAppsMenu
|
||||
.menu add cascade -label "File" -underline 0 -menu .menu.file
|
||||
.menu.file add cascade -label "Select Application" -underline 0 \
|
||||
-menu .menu.file.apps
|
||||
.menu.file add command -label "Quit" -command "destroy ." -underline 0
|
||||
|
||||
# Create text window and scrollbar.
|
||||
|
||||
text .t -yscrollcommand ".s set" -setgrid true
|
||||
scrollbar .s -command ".t yview"
|
||||
grid .t .s -sticky nsew
|
||||
grid rowconfigure . 0 -weight 1
|
||||
grid columnconfigure . 0 -weight 1
|
||||
|
||||
# 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 <Return> {
|
||||
.t mark set insert {end - 1c}
|
||||
.t insert insert \n
|
||||
invoke
|
||||
break
|
||||
}
|
||||
bind .t <Delete> {
|
||||
catch {.t tag remove sel sel.first promptEnd}
|
||||
if {[.t tag nextrange sel 1.0 end] eq ""} {
|
||||
if {[.t compare insert < promptEnd]} {
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
bind .t <BackSpace> {
|
||||
catch {.t tag remove sel sel.first promptEnd}
|
||||
if {[.t tag nextrange sel 1.0 end] eq ""} {
|
||||
if {[.t compare insert <= promptEnd]} {
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
bind .t <Control-d> {
|
||||
if {[.t compare insert < promptEnd]} {
|
||||
break
|
||||
}
|
||||
}
|
||||
bind .t <Control-k> {
|
||||
if {[.t compare insert < promptEnd]} {
|
||||
.t mark set insert promptEnd
|
||||
}
|
||||
}
|
||||
bind .t <Control-t> {
|
||||
if {[.t compare insert < promptEnd]} {
|
||||
break
|
||||
}
|
||||
}
|
||||
bind .t <Meta-d> {
|
||||
if {[.t compare insert < promptEnd]} {
|
||||
break
|
||||
}
|
||||
}
|
||||
bind .t <Meta-BackSpace> {
|
||||
if {[.t compare insert <= promptEnd]} {
|
||||
break
|
||||
}
|
||||
}
|
||||
bind .t <Control-h> {
|
||||
if {[.t compare insert <= promptEnd]} {
|
||||
break
|
||||
}
|
||||
}
|
||||
### This next bit *isn't* nice - DKF ###
|
||||
auto_load tk::TextInsert
|
||||
proc tk::TextInsert {w s} {
|
||||
if {$s eq ""} {
|
||||
return
|
||||
}
|
||||
catch {
|
||||
if {
|
||||
[$w compare sel.first <= insert] && [$w compare sel.last >= insert]
|
||||
} then {
|
||||
$w tag remove sel sel.first promptEnd
|
||||
$w delete sel.first sel.last
|
||||
}
|
||||
}
|
||||
$w insert insert $s
|
||||
$w see insert
|
||||
}
|
||||
|
||||
.t configure -font {Courier 12}
|
||||
.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 eq "!!\n"} {
|
||||
set cmd $lastCommand
|
||||
} else {
|
||||
set lastCommand $cmd
|
||||
}
|
||||
if {$app eq "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"
|
||||
} elseif {$msg ne ""} {
|
||||
.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 {} {
|
||||
set m .menu.file.apps
|
||||
catch {$m delete 0 last}
|
||||
foreach i [lsort [winfo interps]] {
|
||||
$m add command -label $i -command [list newApp $i]
|
||||
}
|
||||
$m add command -label local -command {newApp local}
|
||||
}
|
||||
|
||||
set app [winfo name .]
|
||||
prompt
|
||||
focus .t
|
||||
|
||||
# Local Variables:
|
||||
# mode: tcl
|
||||
# End:
|
||||
@@ -0,0 +1,204 @@
|
||||
#!/bin/sh
|
||||
# the next line restarts using wish \
|
||||
exec wish "$0" ${1+"$@"}
|
||||
|
||||
# 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.
|
||||
|
||||
package require Tk
|
||||
|
||||
foreach i [winfo child .] {
|
||||
catch {destroy $i}
|
||||
}
|
||||
|
||||
set version 1.2
|
||||
|
||||
#------------------------------------------
|
||||
# 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} {
|
||||
label .frame.label$i -text [lindex $names $i] -anchor e
|
||||
entry .frame.entry$i -width 35
|
||||
grid .frame.label$i .frame.entry$i -sticky ew -pady 2 -padx 1
|
||||
}
|
||||
|
||||
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
|
||||
#------------------------------------------
|
||||
|
||||
# DKF - note that this is an old-style menu bar; I just have not yet
|
||||
# got around to converting the context help code to work with the new
|
||||
# menu system and its <<MenuSelect>> virtual event.
|
||||
|
||||
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.entry$i get]]
|
||||
}
|
||||
}
|
||||
.buttons.add config -command addAction
|
||||
|
||||
#------------------------------------------
|
||||
# Phase 4: Miscellaneous other actions
|
||||
#------------------------------------------
|
||||
|
||||
proc clearAction {} {
|
||||
foreach i {1 2 3 4 5 6 7} {
|
||||
.frame.entry$i delete 0 end
|
||||
}
|
||||
}
|
||||
.buttons.clear config -command clearAction
|
||||
|
||||
proc fillCard {} {
|
||||
clearAction
|
||||
.frame.entry1 insert 0 "John Ousterhout"
|
||||
.frame.entry2 insert 0 "CS Division, Department of EECS"
|
||||
.frame.entry3 insert 0 "University of California"
|
||||
.frame.entry4 insert 0 "Berkeley, CA 94720"
|
||||
.frame.entry5 insert 0 "private"
|
||||
.frame.entry6 insert 0 "510-642-0865"
|
||||
.frame.entry7 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 . <Control-c> clearAction
|
||||
.buttons.add config -text "Add Ctrl+A"
|
||||
bind . <Control-a> addAction
|
||||
.buttons.search config -text "Search Ctrl+S"
|
||||
bind . <Control-s> "addAction; fillCard"
|
||||
.buttons.delete config -text "Delete... Ctrl+D"
|
||||
bind . <Control-d> deleteAction
|
||||
|
||||
.menu.file.m entryconfig 1 -accel Ctrl+F
|
||||
bind . <Control-f> fileAction
|
||||
.menu.file.m entryconfig 2 -accel Ctrl+Q
|
||||
bind . <Control-q> {destroy .}
|
||||
|
||||
focus .frame.entry1
|
||||
|
||||
#----------------------------------------------------
|
||||
# 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]}]]
|
||||
}
|
||||
|
||||
event add <<Help>> <F1> <Help>
|
||||
bind . <<Help>> {Help [winfo containing %X %Y] %X %Y}
|
||||
bind Menu <<Help>> {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.1) {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.2) {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.entry1) {In this field of the rolodex entry you should type the person's name}
|
||||
set helpTopics(.frame.entry2) {In this field of the rolodex entry you should type the first line of the person's address}
|
||||
set helpTopics(.frame.entry3) {In this field of the rolodex entry you should type the second line of the person's address}
|
||||
set helpTopics(.frame.entry4) {In this field of the rolodex entry you should type the third line of the person's address}
|
||||
set helpTopics(.frame.entry5) {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.entry6) {In this field of the rolodex entry you should type the person's work phone number}
|
||||
set helpTopics(.frame.entry7) {In this field of the rolodex entry you should type the phone number for the person's FAX machine}
|
||||
|
||||
set helpCmds(.frame.label1) {set topic .frame.entry1}
|
||||
set helpCmds(.frame.label2) {set topic .frame.entry2}
|
||||
set helpCmds(.frame.label3) {set topic .frame.entry3}
|
||||
set helpCmds(.frame.label4) {set topic .frame.entry4}
|
||||
set helpCmds(.frame.label5) {set topic .frame.entry5}
|
||||
set helpCmds(.frame.label6) {set topic .frame.entry6}
|
||||
set helpCmds(.frame.label7) {set topic .frame.entry7}
|
||||
|
||||
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 $version."
|
||||
|
||||
# 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
|
||||
|
||||
# Local Variables:
|
||||
# mode: tcl
|
||||
# End:
|
||||
@@ -0,0 +1,175 @@
|
||||
# ruler.tcl --
|
||||
#
|
||||
# This demonstration script creates a canvas widget that displays a ruler
|
||||
# with tab stops that can be set, moved, and deleted.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
# 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
|
||||
set newTab [$c create polygon $x $y \
|
||||
[expr {$x+$v(size)}] [expr {$y+$v(size)}] \
|
||||
[expr {$x-$v(size)}] [expr {$y+$v(size)}]]
|
||||
set fill [$c itemcget $newTab -outline]
|
||||
$c itemconfigure $newTab -fill $fill -outline {}
|
||||
set v(normalStyle) "-fill $fill"
|
||||
return $newTab
|
||||
}
|
||||
|
||||
set w .ruler
|
||||
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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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]
|
||||
# Main widget program sets variable tk_demoDirectory
|
||||
if {[winfo depth $c] > 1} {
|
||||
set demo_rulerInfo(activeStyle) "-fill red -stipple {}"
|
||||
set demo_rulerInfo(deleteStyle) [list -fill red \
|
||||
-stipple @[file join $tk_demoDirectory images gray25.xbm]]
|
||||
} else {
|
||||
set demo_rulerInfo(activeStyle) "-fill black -stipple {}"
|
||||
set demo_rulerInfo(deleteStyle) [list -fill black \
|
||||
-stipple @[file join $tk_demoDirectory images gray25.xbm]]
|
||||
}
|
||||
|
||||
$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 \
|
||||
-fill [lindex [$c config -bg] 4]]
|
||||
$c addtag well withtag [rulerMkTab $c [winfo pixels $c 13.5c] \
|
||||
[winfo pixels $c .65c]]
|
||||
|
||||
$c bind well <Button-1> "rulerNewTab $c %x %y"
|
||||
$c bind tab <Button-1> "rulerSelectTab $c %x %y"
|
||||
bind $c <B1-Motion> "rulerMoveTab $c %x %y"
|
||||
bind $c <ButtonRelease-1> "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) != $v(top)+2} {
|
||||
$c delete active
|
||||
} else {
|
||||
eval "$c itemconf active $v(normalStyle)"
|
||||
$c dtag active
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,44 @@
|
||||
# sayings.tcl --
|
||||
#
|
||||
# This demonstration script creates a listbox that can be scrolled
|
||||
# both horizontally and vertically. It displays a collection of
|
||||
# well-known sayings.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
frame $w.frame -borderwidth 10
|
||||
pack $w.frame -side top -expand yes -fill both -padx 1c
|
||||
|
||||
|
||||
ttk::scrollbar $w.frame.yscroll -command "$w.frame.list yview"
|
||||
ttk::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 "Don't speculate, measure" "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" "Measure twice, cut once"
|
||||
@@ -0,0 +1,139 @@
|
||||
# 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.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
# 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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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 <Return> "
|
||||
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 <Return> "textSearch $w.text \$searchString search"
|
||||
|
||||
text $w.text -yscrollcommand "$w.scroll set" -setgrid true
|
||||
ttk::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 <Return> or click on "Load File". Then
|
||||
type a string in the lower entry and type <Return> 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 ""
|
||||
@@ -0,0 +1,53 @@
|
||||
# spin.tcl --
|
||||
#
|
||||
# This demonstration script creates several spinbox widgets.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .spin
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Spinbox Demonstration"
|
||||
wm iconname $w "spin"
|
||||
positionWindow $w
|
||||
|
||||
label $w.msg -font $font -wraplength 5i -justify left -text "Three different\
|
||||
spin-boxes 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 values that are too large to fit in the\
|
||||
window all at once, you can scan through the value by dragging with\
|
||||
mouse button2 pressed. Note that the first spin-box will only permit\
|
||||
you to type in integers, and the third selects from a list of\
|
||||
Australian cities."
|
||||
pack $w.msg -side top
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
set australianCities {
|
||||
Canberra Sydney Melbourne Perth Adelaide Brisbane
|
||||
Hobart Darwin "Alice Springs"
|
||||
}
|
||||
|
||||
spinbox $w.s1 -from 1 -to 10 -width 10 -validate key \
|
||||
-vcmd {string is integer %P}
|
||||
spinbox $w.s2 -from 0 -to 3 -increment .5 -format %05.2f -width 10
|
||||
spinbox $w.s3 -values $australianCities -width 10
|
||||
|
||||
#entry $w.e1
|
||||
#entry $w.e2
|
||||
#entry $w.e3
|
||||
pack $w.s1 $w.s2 $w.s3 -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."
|
||||
@@ -0,0 +1,60 @@
|
||||
#!/bin/sh
|
||||
# the next line restarts using wish \
|
||||
exec wish "$0" ${1+"$@"}
|
||||
|
||||
# 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
|
||||
|
||||
package require Tk ;# We use Tk generally, and...
|
||||
package require Tktest ;# ... we use the square widget too.
|
||||
|
||||
square .s
|
||||
pack .s -expand yes -fill both
|
||||
wm minsize . 1 1
|
||||
|
||||
bind .s <Button-1> {center %x %y}
|
||||
bind .s <B1-Motion> {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
|
||||
}
|
||||
|
||||
# Local Variables:
|
||||
# mode: tcl
|
||||
# End:
|
||||
@@ -0,0 +1,54 @@
|
||||
# states.tcl --
|
||||
#
|
||||
# This demonstration script creates a listbox widget that displays
|
||||
# the names of the 50 states in the United States of America.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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
|
||||
|
||||
labelframe $w.justif -text Justification
|
||||
foreach c {Left Center Right} {
|
||||
set lower [string tolower $c]
|
||||
radiobutton $w.justif.$lower -text $c -variable just \
|
||||
-relief flat -value $lower -anchor w \
|
||||
-command "$w.frame.list configure -justify \$just" \
|
||||
-tristatevalue "multi"
|
||||
pack $w.justif.$lower -side left -pady 2 -fill x
|
||||
}
|
||||
pack $w.justif
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
frame $w.frame -borderwidth .5c
|
||||
pack $w.frame -side top -expand yes -fill y
|
||||
|
||||
ttk::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
|
||||
@@ -0,0 +1,155 @@
|
||||
# style.tcl --
|
||||
#
|
||||
# This demonstration script creates a text widget that illustrates the
|
||||
# various display styles that may be set for tags.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .style
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Text Demonstration - Display Styles"
|
||||
wm iconname $w "style"
|
||||
positionWindow $w
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
# Only set the font family in one place for simplicity and consistency
|
||||
|
||||
set family Courier
|
||||
|
||||
text $w.text -yscrollcommand "$w.scroll set" -setgrid true \
|
||||
-width 70 -height 32 -wrap word -font "$family 12"
|
||||
ttk::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 "$family 12 bold italic"
|
||||
$w.text tag configure big -font "$family 14 bold"
|
||||
$w.text tag configure verybig -font "Helvetica 24 bold"
|
||||
$w.text tag configure tiny -font "Times 8 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 "$family 10"
|
||||
$w.text tag configure sub -offset -2p -font "$family 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 system font, "
|
||||
$w.text insert end large verybig
|
||||
$w.text insert end " or "
|
||||
$w.text insert end "small" tiny ".\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
|
||||
@@ -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 -encoding utf-8 [file join $dir arrow.tcl]]
|
||||
set auto_index(arrowMove1) [list source -encoding utf-8 [file join $dir arrow.tcl]]
|
||||
set auto_index(arrowMove2) [list source -encoding utf-8 [file join $dir arrow.tcl]]
|
||||
set auto_index(arrowMove3) [list source -encoding utf-8 [file join $dir arrow.tcl]]
|
||||
set auto_index(textLoadFile) [list source -encoding utf-8 [file join $dir search.tcl]]
|
||||
set auto_index(textSearch) [list source -encoding utf-8 [file join $dir search.tcl]]
|
||||
set auto_index(textToggle) [list source -encoding utf-8 [file join $dir search.tcl]]
|
||||
set auto_index(itemEnter) [list source -encoding utf-8 [file join $dir items.tcl]]
|
||||
set auto_index(itemLeave) [list source -encoding utf-8 [file join $dir items.tcl]]
|
||||
set auto_index(itemMark) [list source -encoding utf-8 [file join $dir items.tcl]]
|
||||
set auto_index(itemStroke) [list source -encoding utf-8 [file join $dir items.tcl]]
|
||||
set auto_index(itemsUnderArea) [list source -encoding utf-8 [file join $dir items.tcl]]
|
||||
set auto_index(itemStartDrag) [list source -encoding utf-8 [file join $dir items.tcl]]
|
||||
set auto_index(itemDrag) [list source -encoding utf-8 [file join $dir items.tcl]]
|
||||
set auto_index(butPress) [list source -encoding utf-8 [file join $dir items.tcl]]
|
||||
set auto_index(loadDir) [list source -encoding utf-8 [file join $dir image2.tcl]]
|
||||
set auto_index(loadImage) [list source -encoding utf-8 [file join $dir image2.tcl]]
|
||||
set auto_index(rulerMkTab) [list source -encoding utf-8 [file join $dir ruler.tcl]]
|
||||
set auto_index(rulerNewTab) [list source -encoding utf-8 [file join $dir ruler.tcl]]
|
||||
set auto_index(rulerSelectTab) [list source -encoding utf-8 [file join $dir ruler.tcl]]
|
||||
set auto_index(rulerMoveTab) [list source -encoding utf-8 [file join $dir ruler.tcl]]
|
||||
set auto_index(rulerReleaseTab) [list source -encoding utf-8 [file join $dir ruler.tcl]]
|
||||
set auto_index(mkTextConfig) [list source -encoding utf-8 [file join $dir ctext.tcl]]
|
||||
set auto_index(textEnter) [list source -encoding utf-8 [file join $dir ctext.tcl]]
|
||||
set auto_index(textInsert) [list source -encoding utf-8 [file join $dir ctext.tcl]]
|
||||
set auto_index(textPaste) [list source -encoding utf-8 [file join $dir ctext.tcl]]
|
||||
set auto_index(textB1Press) [list source -encoding utf-8 [file join $dir ctext.tcl]]
|
||||
set auto_index(textB1Move) [list source -encoding utf-8 [file join $dir ctext.tcl]]
|
||||
set auto_index(textBs) [list source -encoding utf-8 [file join $dir ctext.tcl]]
|
||||
set auto_index(textDel) [list source -encoding utf-8 [file join $dir ctext.tcl]]
|
||||
set auto_index(bitmapRow) [list source -encoding utf-8 [file join $dir bitmap.tcl]]
|
||||
set auto_index(scrollEnter) [list source -encoding utf-8 [file join $dir cscroll.tcl]]
|
||||
set auto_index(scrollLeave) [list source -encoding utf-8 [file join $dir cscroll.tcl]]
|
||||
set auto_index(scrollButton) [list source -encoding utf-8 [file join $dir cscroll.tcl]]
|
||||
set auto_index(textWindOn) [list source -encoding utf-8 [file join $dir twind.tcl]]
|
||||
set auto_index(textWindOff) [list source -encoding utf-8 [file join $dir twind.tcl]]
|
||||
set auto_index(textWindPlot) [list source -encoding utf-8 [file join $dir twind.tcl]]
|
||||
set auto_index(embPlotDown) [list source -encoding utf-8 [file join $dir twind.tcl]]
|
||||
set auto_index(embPlotMove) [list source -encoding utf-8 [file join $dir twind.tcl]]
|
||||
set auto_index(textWindDel) [list source -encoding utf-8 [file join $dir twind.tcl]]
|
||||
set auto_index(embDefBg) [list source -encoding utf-8 [file join $dir twind.tcl]]
|
||||
set auto_index(floorDisplay) [list source -encoding utf-8 [file join $dir floor.tcl]]
|
||||
set auto_index(newRoom) [list source -encoding utf-8 [file join $dir floor.tcl]]
|
||||
set auto_index(roomChanged) [list source -encoding utf-8 [file join $dir floor.tcl]]
|
||||
set auto_index(bg1) [list source -encoding utf-8 [file join $dir floor.tcl]]
|
||||
set auto_index(bg2) [list source -encoding utf-8 [file join $dir floor.tcl]]
|
||||
set auto_index(bg3) [list source -encoding utf-8 [file join $dir floor.tcl]]
|
||||
set auto_index(fg1) [list source -encoding utf-8 [file join $dir floor.tcl]]
|
||||
set auto_index(fg2) [list source -encoding utf-8 [file join $dir floor.tcl]]
|
||||
set auto_index(fg3) [list source -encoding utf-8 [file join $dir floor.tcl]]
|
||||
set auto_index(setWidth) [list source -encoding utf-8 [file join $dir hscale.tcl]]
|
||||
set auto_index(plotDown) [list source -encoding utf-8 [file join $dir plot.tcl]]
|
||||
set auto_index(plotMove) [list source -encoding utf-8 [file join $dir plot.tcl]]
|
||||
set auto_index(puzzleSwitch) [list source -encoding utf-8 [file join $dir puzzle.tcl]]
|
||||
set auto_index(setHeight) [list source -encoding utf-8 [file join $dir vscale.tcl]]
|
||||
set auto_index(showMessageBox) [list source -encoding utf-8 [file join $dir msgbox.tcl]]
|
||||
set auto_index(setColor) [list source -encoding utf-8 [file join $dir clrpick.tcl]]
|
||||
set auto_index(setColor_helper) [list source -encoding utf-8 [file join $dir clrpick.tcl]]
|
||||
set auto_index(fileDialog) [list source -encoding utf-8 [file join $dir filebox.tcl]]
|
||||
@@ -0,0 +1,358 @@
|
||||
#!/bin/sh
|
||||
# the next line restarts using wish \
|
||||
exec wish "$0" ${1+"$@"}
|
||||
|
||||
# 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.
|
||||
|
||||
package require Tk
|
||||
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.
|
||||
|
||||
. configure -menu [menu .menu]
|
||||
menu .menu.file
|
||||
.menu add cascade -menu .menu.file -label File -underline 0
|
||||
.menu.file add radio -label "RGB color space" -variable colorSpace \
|
||||
-value rgb -underline 0 -command {changeColorSpace rgb}
|
||||
.menu.file add radio -label "CMY color space" -variable colorSpace \
|
||||
-value cmy -underline 0 -command {changeColorSpace cmy}
|
||||
.menu.file add radio -label "HSB color space" -variable colorSpace \
|
||||
-value hsb -underline 0 -command {changeColorSpace hsb}
|
||||
.menu.file add separator
|
||||
.menu.file add radio -label "Automatic updates" -variable autoUpdate \
|
||||
-value 1 -underline 0
|
||||
.menu.file add radio -label "Manual updates" -variable autoUpdate \
|
||||
-value 0 -underline 0
|
||||
.menu.file add separator
|
||||
.menu.file add command -label "Exit program" -underline 0 -command {exit}
|
||||
|
||||
# Create the command entry window at the bottom of the window, along
|
||||
# with the update button.
|
||||
|
||||
labelframe .command -text "Command:" -padx {1m 0}
|
||||
entry .command.e -textvariable command
|
||||
button .command.update -text Update -command doUpdate
|
||||
pack .command.update -side right -pady .1c -padx {.25c 0}
|
||||
pack .command.e -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.
|
||||
|
||||
grid .command -sticky nsew -row 2 -columnspan 3 -padx 1m -pady {0 1m}
|
||||
|
||||
grid columnconfigure . {1 2} -weight 1
|
||||
grid rowconfigure . 0 -weight 1
|
||||
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]
|
||||
labelframe .names -text "Select:" -padx .1c -pady .1c
|
||||
grid .names -row 0 -column 0 -sticky nsew -padx .15c -pady .15c -rowspan 2
|
||||
grid columnconfigure . 0 -weight 1
|
||||
listbox .names.lb -width 20 -height 12 -yscrollcommand ".names.s set" \
|
||||
-exportselection false
|
||||
bind .names.lb <Double-Button-1> {
|
||||
tc_loadNamedColor [.names.lb get [.names.lb curselection]]
|
||||
}
|
||||
scrollbar .names.s -orient vertical -command ".names.lb yview"
|
||||
pack .names.lb .names.s -side left -fill y -expand 1
|
||||
while {[gets $f line] >= 0} {
|
||||
if {[regexp {^\s*\d+\s+\d+\s+\d+\s+(\S+)$} $line -> col]} {
|
||||
.names.lb insert end $col
|
||||
}
|
||||
}
|
||||
close $f
|
||||
break
|
||||
}
|
||||
|
||||
# Create the three scales for editing the color, and the entry for
|
||||
# typing in a color value.
|
||||
|
||||
frame .adjust
|
||||
foreach i {1 2 3} {
|
||||
label .adjust.l$i -textvariable label$i -pady 0
|
||||
labelframe .adjust.$i -labelwidget .adjust.l$i -padx 1m -pady 1m
|
||||
scale .scale$i -from 0 -to 1000 -length 6c -orient horizontal \
|
||||
-command tc_scaleChanged
|
||||
pack .scale$i -in .adjust.$i
|
||||
pack .adjust.$i
|
||||
}
|
||||
grid .adjust -row 0 -column 1 -sticky nsew -padx .15c -pady .15c
|
||||
|
||||
labelframe .name -text "Name:" -padx 1m -pady 1m
|
||||
entry .name.e -textvariable name -width 10
|
||||
pack .name.e -side right -expand 1 -fill x
|
||||
bind .name.e <Return> {tc_loadNamedColor $name}
|
||||
grid .name -column 1 -row 1 -sticky nsew -padx .15c -pady .15c
|
||||
|
||||
# Create the color display swatch on the right side of the window.
|
||||
|
||||
labelframe .sample -text "Color:" -padx 1m -pady 1m
|
||||
frame .sample.swatch -width 2c -height 5c -background $color
|
||||
label .sample.value -textvariable color -width 13 -font {Courier 12}
|
||||
pack .sample.swatch -side top -expand yes -fill both
|
||||
pack .sample.value -side bottom -pady .25c
|
||||
grid .sample -row 0 -column 2 -sticky nsew -padx .15c -pady .15c -rowspan 2
|
||||
|
||||
|
||||
# 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
|
||||
}
|
||||
switch $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}]]
|
||||
}
|
||||
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}]]
|
||||
}
|
||||
hsb {
|
||||
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]
|
||||
.sample.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
|
||||
switch $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}]]
|
||||
}
|
||||
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}]]
|
||||
}
|
||||
hsb {
|
||||
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 .sample.swatch $name]
|
||||
set red [lindex $list 0]
|
||||
set green [lindex $list 1]
|
||||
set blue [lindex $list 2]
|
||||
} else {
|
||||
switch [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]
|
||||
.sample.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
|
||||
switch $space {
|
||||
rgb {
|
||||
set label1 "Adjust Red:"
|
||||
set label2 "Adjust Green:"
|
||||
set label3 "Adjust Blue:"
|
||||
tc_setScales
|
||||
return
|
||||
}
|
||||
cmy {
|
||||
set label1 "Adjust Cyan:"
|
||||
set label2 "Adjust Magenta:"
|
||||
set label3 "Adjust Yellow:"
|
||||
tc_setScales
|
||||
return
|
||||
}
|
||||
hsb {
|
||||
set label1 "Adjust Hue:"
|
||||
set label2 "Adjust Saturation:"
|
||||
set label3 "Adjust 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 [expr {double($red)}]
|
||||
set min [expr {double($green)}]
|
||||
} else {
|
||||
set max [expr {double($green)}]
|
||||
set min [expr {double($red)}]
|
||||
}
|
||||
if {$blue > $max} {
|
||||
set max [expr {double($blue)}]
|
||||
} elseif {$blue < $min} {
|
||||
set min [expr {double($blue)}]
|
||||
}
|
||||
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 {($bc - $gc)/6.0}]
|
||||
} elseif {$green == $max} {
|
||||
set hue [expr {(2 + $rc - $bc)/6.0}]
|
||||
} else {
|
||||
set hue [expr {(4 + $gc - $rc)/6.0}]
|
||||
}
|
||||
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)))}]]
|
||||
switch $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"}
|
||||
default {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
|
||||
|
||||
# Local Variables:
|
||||
# mode: tcl
|
||||
# End:
|
||||
@@ -0,0 +1,113 @@
|
||||
# text.tcl --
|
||||
#
|
||||
# This demonstration script creates a text widget that describes
|
||||
# the basic editing functions.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .text
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Text Demonstration - Basic Facilities"
|
||||
wm iconname $w "text"
|
||||
positionWindow $w
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w {} \
|
||||
{ttk::button $w.buttons.fontchooser -command fontchooserToggle}]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
text $w.text -yscrollcommand [list $w.scroll set] -setgrid 1 \
|
||||
-height 30 -undo 1 -autosep 1
|
||||
ttk::scrollbar $w.scroll -command [list $w.text yview]
|
||||
pack $w.scroll -side right -fill y
|
||||
pack $w.text -expand yes -fill both
|
||||
|
||||
# TIP 324 Demo: [tk fontchooser]
|
||||
proc fontchooserToggle {} {
|
||||
tk fontchooser [expr {[tk fontchooser configure -visible] ?
|
||||
"hide" : "show"}]
|
||||
}
|
||||
proc fontchooserVisibility {w} {
|
||||
$w configure -text [expr {[tk fontchooser configure -visible] ?
|
||||
"Hide Font Dialog" : "Show Font Dialog"}]
|
||||
}
|
||||
proc fontchooserFocus {w} {
|
||||
tk fontchooser configure -font [$w cget -font] \
|
||||
-command [list fontchooserFontSel $w]
|
||||
}
|
||||
proc fontchooserFontSel {w font args} {
|
||||
$w configure -font [font actual $font]
|
||||
}
|
||||
tk fontchooser configure -parent $w
|
||||
bind $w.text <FocusIn> [list fontchooserFocus $w.text]
|
||||
fontchooserVisibility $w.buttons.fontchooser
|
||||
bind $w <<TkFontchooserVisibility>> [list \
|
||||
fontchooserVisibility $w.buttons.fontchooser]
|
||||
focus $w.text
|
||||
|
||||
$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 the middle mouse button 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 the middle mouse button 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. Control-z undoes the last editing action performed,
|
||||
and }
|
||||
|
||||
switch [tk windowingsystem] {
|
||||
"aqua" - "x11" {
|
||||
$w.text insert end "Control-Shift-z"
|
||||
}
|
||||
"win32" {
|
||||
$w.text insert end "Control-y"
|
||||
}
|
||||
}
|
||||
|
||||
$w.text insert end { redoes undone edits.
|
||||
|
||||
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
|
||||
@@ -0,0 +1,62 @@
|
||||
# textpeer.tcl --
|
||||
#
|
||||
# This demonstration script creates a pair of text widgets that can edit a
|
||||
# single logical buffer. This is particularly useful when editing related text
|
||||
# in two (or more) parts of the same file.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .textpeer
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Text Widget Peering Demonstration"
|
||||
wm iconname $w "textpeer"
|
||||
positionWindow $w
|
||||
|
||||
set count 0
|
||||
|
||||
## Define a widget that we peer from; it won't ever actually be shown though
|
||||
set first [text $w.text[incr count]]
|
||||
$first insert end "This is a coupled pair of text widgets; they are peers to "
|
||||
$first insert end "each other. They have the same underlying data model, but "
|
||||
$first insert end "can show different locations, have different current edit "
|
||||
$first insert end "locations, and have different selections. You can also "
|
||||
$first insert end "create additional peers of any of these text widgets using "
|
||||
$first insert end "the Make Peer button beside the text widget to clone, and "
|
||||
$first insert end "delete a particular peer widget using the Delete Peer "
|
||||
$first insert end "button."
|
||||
|
||||
## Procedures to make and kill clones; most of this is just so that the demo
|
||||
## looks nice...
|
||||
proc makeClone {w parent} {
|
||||
global count
|
||||
set t [$parent peer create $w.text[incr count] -yscroll "$w.sb$count set"\
|
||||
-height 10 -wrap word]
|
||||
set sb [ttk::scrollbar $w.sb$count -command "$t yview" -orient vertical]
|
||||
set b1 [button $w.clone$count -command "makeClone $w $t" \
|
||||
-text "Make Peer"]
|
||||
set b2 [button $w.kill$count -command "killClone $w $count" \
|
||||
-text "Delete Peer"]
|
||||
set row [expr {$count * 2}]
|
||||
grid $t $sb $b1 -sticky nsew -row $row
|
||||
grid ^ ^ $b2 -row [incr row]
|
||||
grid configure $b1 $b2 -sticky new
|
||||
grid rowconfigure $w $b2 -weight 1
|
||||
}
|
||||
proc killClone {w count} {
|
||||
destroy $w.text$count $w.sb$count
|
||||
destroy $w.clone$count $w.kill$count
|
||||
}
|
||||
|
||||
## Now set up the GUI
|
||||
makeClone $w $first
|
||||
makeClone $w $first
|
||||
destroy $first
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
grid [addSeeDismiss $w.buttons $w] - - -sticky ew -row 5000
|
||||
grid columnconfigure $w 0 -weight 1
|
||||
@@ -0,0 +1,47 @@
|
||||
#!/bin/sh
|
||||
# the next line restarts using wish \
|
||||
exec wish "$0" ${1+"$@"}
|
||||
|
||||
# timer --
|
||||
# This script generates a counter with start and stop buttons.
|
||||
|
||||
package require Tk
|
||||
|
||||
label .counter -text 0.00 -relief raised -width 10 -padx 2m -pady 1m
|
||||
button .start -text Start -command {
|
||||
if {$stopped} {
|
||||
set stopped 0
|
||||
set startMoment [clock clicks -milliseconds]
|
||||
tick
|
||||
.stop configure -state normal
|
||||
.start configure -state disabled
|
||||
}
|
||||
}
|
||||
button .stop -text Stop -state disabled -command {
|
||||
set stopped 1
|
||||
.stop configure -state disabled
|
||||
.start configure -state normal
|
||||
}
|
||||
pack .counter -side bottom -fill both
|
||||
pack .start -side left -fill both -expand yes
|
||||
pack .stop -side right -fill both -expand yes
|
||||
|
||||
set startMoment {}
|
||||
|
||||
set stopped 1
|
||||
|
||||
proc tick {} {
|
||||
global startMoment stopped
|
||||
if {$stopped} {return}
|
||||
after 50 tick
|
||||
set elapsedMS [expr {[clock clicks -milliseconds] - $startMoment}]
|
||||
.counter config -text [format "%.2f" [expr {double($elapsedMS)/1000}]]
|
||||
}
|
||||
|
||||
bind . <Control-c> {destroy .}
|
||||
bind . <Control-q> {destroy .}
|
||||
focus .
|
||||
|
||||
# Local Variables:
|
||||
# mode: tcl
|
||||
# End:
|
||||
@@ -0,0 +1,92 @@
|
||||
# toolbar.tcl --
|
||||
#
|
||||
# This demonstration script creates a toolbar that can be torn off.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .toolbar
|
||||
destroy $w
|
||||
toplevel $w
|
||||
wm title $w "Toolbar Demonstration"
|
||||
wm iconname $w "toolbar"
|
||||
positionWindow $w
|
||||
|
||||
ttk::label $w.msg -wraplength 4i -text "This is a demonstration of how to do\
|
||||
a toolbar that is styled correctly and which can be torn off. The\
|
||||
buttons are configured to be \u201Ctoolbar style\u201D buttons by\
|
||||
telling them that they are to use the Toolbutton style. At the left\
|
||||
end of the toolbar is a simple marker that the cursor changes to a\
|
||||
movement icon over; drag that away from the toolbar to tear off the\
|
||||
whole toolbar into a separate toplevel widget. When the dragged-off\
|
||||
toolbar is no longer needed, just close it like any normal toplevel\
|
||||
and it will reattach to the window it was torn off from."
|
||||
|
||||
## Set up the toolbar hull
|
||||
set t [frame $w.toolbar] ;# Must be a frame!
|
||||
ttk::separator $w.sep
|
||||
ttk::frame $t.tearoff -cursor fleur
|
||||
ttk::separator $t.tearoff.to -orient vertical
|
||||
ttk::separator $t.tearoff.to2 -orient vertical
|
||||
pack $t.tearoff.to -fill y -expand 1 -padx 4 -side left
|
||||
pack $t.tearoff.to2 -fill y -expand 1 -side left
|
||||
ttk::frame $t.contents
|
||||
grid $t.tearoff $t.contents -sticky nsew
|
||||
grid columnconfigure $t $t.contents -weight 1
|
||||
grid columnconfigure $t.contents 1000 -weight 1
|
||||
|
||||
## Bindings so that the toolbar can be torn off and reattached
|
||||
bind $t.tearoff <B1-Motion> [list tearoff $t %X %Y]
|
||||
bind $t.tearoff.to <B1-Motion> [list tearoff $t %X %Y]
|
||||
bind $t.tearoff.to2 <B1-Motion> [list tearoff $t %X %Y]
|
||||
proc tearoff {w x y} {
|
||||
if {[string match $w* [winfo containing $x $y]]} {
|
||||
return
|
||||
}
|
||||
grid remove $w
|
||||
grid remove $w.tearoff
|
||||
wm manage $w
|
||||
wm protocol $w WM_DELETE_WINDOW [list untearoff $w]
|
||||
}
|
||||
proc untearoff {w} {
|
||||
wm forget $w
|
||||
grid $w.tearoff
|
||||
grid $w
|
||||
}
|
||||
|
||||
## Toolbar contents
|
||||
ttk::button $t.button -text "Button" -style Toolbutton -command [list \
|
||||
$w.txt insert end "Button Pressed\n"]
|
||||
ttk::checkbutton $t.check -text "Check" -variable check -style Toolbutton \
|
||||
-command [concat [list $w.txt insert end] {"check is $check\n"}]
|
||||
ttk::menubutton $t.menu -text "Menu" -menu $t.menu.m
|
||||
ttk::combobox $t.combo -value [lsort [font families]] -state readonly
|
||||
menu $t.menu.m
|
||||
$t.menu.m add command -label "Just" -command [list $w.txt insert end Just\n]
|
||||
$t.menu.m add command -label "An" -command [list $w.txt insert end An\n]
|
||||
$t.menu.m add command -label "Example" \
|
||||
-command [list $w.txt insert end Example\n]
|
||||
bind $t.combo <<ComboboxSelected>> [list changeFont $w.txt $t.combo]
|
||||
proc changeFont {txt combo} {
|
||||
$txt configure -font [list [$combo get] 10]
|
||||
}
|
||||
|
||||
## Some content for the rest of the toplevel
|
||||
text $w.txt -width 40 -height 10
|
||||
interp alias {} doInsert {} $w.txt insert end ;# Make bindings easy to write
|
||||
|
||||
## Arrange contents
|
||||
grid $t.button $t.check $t.menu $t.combo -in $t.contents -padx 2 -pady 4 -sticky ns
|
||||
grid $t -sticky ew
|
||||
grid $w.sep -sticky ew
|
||||
grid $w.msg -sticky ew
|
||||
grid $w.txt -sticky nsew
|
||||
grid rowconfigure $w $w.txt -weight 1
|
||||
grid columnconfigure $w $w.txt -weight 1
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
grid $btns -sticky ew
|
||||
@@ -0,0 +1,89 @@
|
||||
# tree.tcl --
|
||||
#
|
||||
# This demonstration script creates a toplevel window containing a Ttk
|
||||
# tree widget.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .tree
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Directory Browser"
|
||||
wm iconname $w "tree"
|
||||
positionWindow $w
|
||||
|
||||
## Explanatory text
|
||||
ttk::label $w.msg -font $font -wraplength 4i -justify left -anchor n -padding {10 2 10 6} -text "Ttk is the new Tk themed widget set. One of the widgets it includes is a tree widget, which allows the user to browse a hierarchical data-set such as a filesystem. The tree widget not only allows for the tree part itself, but it also supports an arbitrary number of additional columns which can show additional data (in this case, the size of the files found in your filesystem). You can also change the width of the columns by dragging the boundary between them."
|
||||
pack $w.msg -fill x
|
||||
|
||||
## See Code / Dismiss
|
||||
pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x
|
||||
|
||||
## Code to populate the roots of the tree (can be more than one on Windows)
|
||||
proc populateRoots {tree} {
|
||||
foreach dir [lsort -dictionary [file volumes]] {
|
||||
populateTree $tree [$tree insert {} end -text $dir \
|
||||
-values [list $dir directory]]
|
||||
}
|
||||
}
|
||||
|
||||
## Code to populate a node of the tree
|
||||
proc populateTree {tree node} {
|
||||
if {[$tree set $node type] ne "directory"} {
|
||||
return
|
||||
}
|
||||
set path [$tree set $node fullpath]
|
||||
$tree delete [$tree children $node]
|
||||
foreach f [lsort -dictionary [glob -nocomplain -dir $path *]] {
|
||||
set f [file normalize $f]
|
||||
set type [file type $f]
|
||||
set id [$tree insert $node end -text [file tail $f] \
|
||||
-values [list $f $type]]
|
||||
|
||||
if {$type eq "directory"} {
|
||||
## Make it so that this node is openable
|
||||
$tree insert $id 0 -text dummy ;# a dummy
|
||||
$tree item $id -text [file tail $f]/
|
||||
|
||||
} elseif {$type eq "file"} {
|
||||
set size [file size $f]
|
||||
## Format the file size nicely
|
||||
if {$size >= 1024*1024*1024} {
|
||||
set size [format %.1f\ GB [expr {$size/1024/1024/1024.}]]
|
||||
} elseif {$size >= 1024*1024} {
|
||||
set size [format %.1f\ MB [expr {$size/1024/1024.}]]
|
||||
} elseif {$size >= 1024} {
|
||||
set size [format %.1f\ kB [expr {$size/1024.}]]
|
||||
} else {
|
||||
append size " bytes"
|
||||
}
|
||||
$tree set $id size $size
|
||||
}
|
||||
}
|
||||
|
||||
# Stop this code from rerunning on the current node
|
||||
$tree set $node type processedDirectory
|
||||
}
|
||||
|
||||
## Create the tree and set it up
|
||||
ttk::treeview $w.tree -columns {fullpath type size} -displaycolumns {size} \
|
||||
-yscroll "$w.vsb set" -xscroll "$w.hsb set"
|
||||
ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview"
|
||||
ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview"
|
||||
$w.tree heading \#0 -text "Directory Structure"
|
||||
$w.tree heading size -text "File Size"
|
||||
$w.tree column size -width 70
|
||||
populateRoots $w.tree
|
||||
bind $w.tree <<TreeviewOpen>> {populateTree %W [%W focus]}
|
||||
|
||||
## Arrange the tree and its scrollbars in the toplevel
|
||||
lower [ttk::frame $w.dummy]
|
||||
pack $w.dummy -fill both -expand 1
|
||||
grid $w.tree $w.vsb -sticky nsew -in $w.dummy
|
||||
grid $w.hsb -sticky nsew -in $w.dummy
|
||||
grid columnconfigure $w.dummy 0 -weight 1
|
||||
grid rowconfigure $w.dummy 0 -weight 1
|
||||
@@ -0,0 +1,84 @@
|
||||
# ttkbut.tcl --
|
||||
#
|
||||
# This demonstration script creates a toplevel window containing several
|
||||
# simple Ttk widgets, such as labels, labelframes, buttons, checkbuttons and
|
||||
# radiobuttons.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .ttkbut
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Simple Ttk Widgets"
|
||||
wm iconname $w "ttkbut"
|
||||
positionWindow $w
|
||||
|
||||
ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Ttk is the new Tk themed widget set. This is a Ttk themed label, and below are three groups of Ttk widgets in Ttk labelframes. The first group are all buttons that set the current application theme when pressed. The second group contains three sets of checkbuttons, with a separator widget between the sets. Note that the \u201cEnabled\u201d button controls whether all the other themed widgets in this toplevel are in the disabled state. The third group has a collection of linked radiobuttons."
|
||||
pack $w.msg -side top -fill x
|
||||
|
||||
## See Code / Dismiss
|
||||
pack [addSeeDismiss $w.seeDismiss $w {enabled cheese tomato basil oregano happiness}]\
|
||||
-side bottom -fill x
|
||||
|
||||
## Add buttons for setting the theme
|
||||
ttk::labelframe $w.buttons -text "Buttons"
|
||||
foreach theme [ttk::themes] {
|
||||
ttk::button $w.buttons.$theme -text $theme \
|
||||
-command [list ttk::setTheme $theme]
|
||||
pack $w.buttons.$theme -pady 2
|
||||
}
|
||||
|
||||
## Helper procedure for the top checkbutton
|
||||
proc setState {rootWidget exceptThese value} {
|
||||
if {$rootWidget in $exceptThese} {
|
||||
return
|
||||
}
|
||||
## Non-Ttk widgets (e.g. the toplevel) will fail, so make it silent
|
||||
catch {
|
||||
$rootWidget state $value
|
||||
}
|
||||
## Recursively invoke on all children of this root that are in the same
|
||||
## toplevel widget
|
||||
foreach w [winfo children $rootWidget] {
|
||||
if {[winfo toplevel $w] eq [winfo toplevel $rootWidget]} {
|
||||
setState $w $exceptThese $value
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
## Set up the checkbutton group
|
||||
ttk::labelframe $w.checks -text "Checkbuttons"
|
||||
ttk::checkbutton $w.checks.e -text Enabled -variable enabled -command {
|
||||
setState .ttkbut .ttkbut.checks.e \
|
||||
[expr {$enabled ? "!disabled" : "disabled"}]
|
||||
}
|
||||
set enabled 1
|
||||
## See ttk_widget(n) for other possible state flags
|
||||
ttk::separator $w.checks.sep1
|
||||
ttk::checkbutton $w.checks.c1 -text Cheese -variable cheese
|
||||
ttk::checkbutton $w.checks.c2 -text Tomato -variable tomato
|
||||
ttk::separator $w.checks.sep2
|
||||
ttk::checkbutton $w.checks.c3 -text Basil -variable basil
|
||||
ttk::checkbutton $w.checks.c4 -text Oregano -variable oregano
|
||||
pack $w.checks.e $w.checks.sep1 $w.checks.c1 $w.checks.c2 $w.checks.sep2 \
|
||||
$w.checks.c3 $w.checks.c4 -fill x -pady 2
|
||||
|
||||
## Set up the radiobutton group
|
||||
ttk::labelframe $w.radios -text "Radiobuttons"
|
||||
ttk::radiobutton $w.radios.r1 -text "Great" -variable happiness -value great
|
||||
ttk::radiobutton $w.radios.r2 -text "Good" -variable happiness -value good
|
||||
ttk::radiobutton $w.radios.r3 -text "OK" -variable happiness -value ok
|
||||
ttk::radiobutton $w.radios.r4 -text "Poor" -variable happiness -value poor
|
||||
ttk::radiobutton $w.radios.r5 -text "Awful" -variable happiness -value awful
|
||||
pack $w.radios.r1 $w.radios.r2 $w.radios.r3 $w.radios.r4 $w.radios.r5 \
|
||||
-fill x -padx 3 -pady 2
|
||||
|
||||
## Arrange things neatly
|
||||
pack [ttk::frame $w.f] -fill both -expand 1
|
||||
lower $w.f
|
||||
grid $w.buttons $w.checks $w.radios -in $w.f -sticky nwe -pady 2 -padx 3
|
||||
grid columnconfigure $w.f {0 1 2} -weight 1 -uniform yes
|
||||
@@ -0,0 +1,53 @@
|
||||
# ttkmenu.tcl --
|
||||
#
|
||||
# This demonstration script creates a toplevel window containing several Ttk
|
||||
# menubutton widgets.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .ttkmenu
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Ttk Menu Buttons"
|
||||
wm iconname $w "ttkmenu"
|
||||
positionWindow $w
|
||||
|
||||
ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Ttk is the new Tk themed widget set, and one widget that is available in themed form is the menubutton. Below are some themed menu buttons that allow you to pick the current theme in use. Notice how picking a theme changes the way that the menu buttons themselves look, and that the central menu button is styled differently (in a way that is normally suitable for toolbars). However, there are no themed menus; the standard Tk menus were judged to have a sufficiently good look-and-feel on all platforms, especially as they are implemented as native controls in many places."
|
||||
pack $w.msg [ttk::separator $w.msgSep] -side top -fill x
|
||||
|
||||
## See Code / Dismiss
|
||||
pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x
|
||||
|
||||
ttk::menubutton $w.m1 -menu $w.m1.menu -text "Select a theme" -direction above
|
||||
ttk::menubutton $w.m2 -menu $w.m1.menu -text "Select a theme" -direction left
|
||||
ttk::menubutton $w.m3 -menu $w.m1.menu -text "Select a theme" -direction right
|
||||
ttk::menubutton $w.m4 -menu $w.m1.menu -text "Select a theme" \
|
||||
-direction flush -style TMenubutton.Toolbutton
|
||||
ttk::menubutton $w.m5 -menu $w.m1.menu -text "Select a theme" -direction below
|
||||
|
||||
menu $w.m1.menu -tearoff 0
|
||||
menu $w.m2.menu -tearoff 0
|
||||
menu $w.m3.menu -tearoff 0
|
||||
menu $w.m4.menu -tearoff 0
|
||||
menu $w.m5.menu -tearoff 0
|
||||
|
||||
foreach theme [ttk::themes] {
|
||||
$w.m1.menu add command -label $theme -command [list ttk::setTheme $theme]
|
||||
$w.m2.menu add command -label $theme -command [list ttk::setTheme $theme]
|
||||
$w.m3.menu add command -label $theme -command [list ttk::setTheme $theme]
|
||||
$w.m4.menu add command -label $theme -command [list ttk::setTheme $theme]
|
||||
$w.m5.menu add command -label $theme -command [list ttk::setTheme $theme]
|
||||
}
|
||||
|
||||
pack [ttk::frame $w.f] -fill x
|
||||
pack [ttk::frame $w.f1] -fill both -expand yes
|
||||
lower $w.f
|
||||
|
||||
grid anchor $w.f center
|
||||
grid x $w.m1 x -in $w.f -padx 3 -pady 2
|
||||
grid $w.m2 $w.m4 $w.m3 -in $w.f -padx 3 -pady 2
|
||||
grid x $w.m5 x -in $w.f -padx 3 -pady 2
|
||||
@@ -0,0 +1,57 @@
|
||||
# ttknote.tcl --
|
||||
#
|
||||
# This demonstration script creates a toplevel window containing a Ttk
|
||||
# notebook widget.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .ttknote
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Ttk Notebook Widget"
|
||||
wm iconname $w "ttknote"
|
||||
positionWindow $w
|
||||
|
||||
## See Code / Dismiss
|
||||
pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x
|
||||
|
||||
ttk::frame $w.f
|
||||
pack $w.f -fill both -expand 1
|
||||
set w $w.f
|
||||
|
||||
## Make the notebook and set up Ctrl+Tab traversal
|
||||
ttk::notebook $w.note
|
||||
pack $w.note -fill both -expand 1 -padx 2 -pady 3
|
||||
ttk::notebook::enableTraversal $w.note
|
||||
|
||||
## Popuplate the first pane
|
||||
ttk::frame $w.note.msg
|
||||
ttk::label $w.note.msg.m -font $font -wraplength 4i -justify left -anchor n -text "Ttk is the new Tk themed widget set. One of the widgets it includes is the notebook widget, which provides a set of tabs that allow the selection of a group of panels, each with distinct content. They are a feature of many modern user interfaces. Not only can the tabs be selected with the mouse, but they can also be switched between using Ctrl+Tab when the notebook page heading itself is selected. Note that the second tab is disabled, and cannot be selected."
|
||||
ttk::button $w.note.msg.b -text "Neat!" -underline 0 -command {
|
||||
set neat "Yeah, I know..."
|
||||
after 500 {set neat {}}
|
||||
}
|
||||
bind $w <Alt-n> "focus $w.note.msg.b; $w.note.msg.b invoke"
|
||||
ttk::label $w.note.msg.l -textvariable neat
|
||||
$w.note add $w.note.msg -text "Description" -underline 0 -padding 2
|
||||
grid $w.note.msg.m - -sticky new -pady 2
|
||||
grid $w.note.msg.b $w.note.msg.l -pady {2 4}
|
||||
grid rowconfigure $w.note.msg 1 -weight 1
|
||||
grid columnconfigure $w.note.msg {0 1} -weight 1 -uniform 1
|
||||
|
||||
## Populate the second pane. Note that the content doesn't really matter
|
||||
ttk::frame $w.note.disabled
|
||||
$w.note add $w.note.disabled -text "Disabled" -state disabled
|
||||
|
||||
## Popuplate the third pane
|
||||
ttk::frame $w.note.editor
|
||||
$w.note add $w.note.editor -text "Text Editor" -underline 0
|
||||
text $w.note.editor.t -width 40 -height 10 -wrap char \
|
||||
-yscroll "$w.note.editor.s set"
|
||||
ttk::scrollbar $w.note.editor.s -orient vertical -command "$w.note.editor.t yview"
|
||||
pack $w.note.editor.s -side right -fill y -padx {0 2} -pady 2
|
||||
pack $w.note.editor.t -fill both -expand 1 -pady 2 -padx {2 0}
|
||||
@@ -0,0 +1,112 @@
|
||||
# ttkpane.tcl --
|
||||
#
|
||||
# This demonstration script creates a Ttk pane with some content.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .ttkpane
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Themed Nested Panes"
|
||||
wm iconname $w "ttkpane"
|
||||
positionWindow $w
|
||||
|
||||
ttk::label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration shows off a nested set of themed paned windows. Their sizes can be changed by grabbing the area between each contained pane and dragging the divider."
|
||||
pack $w.msg [ttk::separator $w.msgSep] -side top -fill x
|
||||
|
||||
## See Code / Dismiss
|
||||
pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x
|
||||
|
||||
ttk::frame $w.f
|
||||
pack $w.f -fill both -expand 1
|
||||
set w $w.f
|
||||
ttk::panedwindow $w.outer -orient horizontal
|
||||
$w.outer add [ttk::panedwindow $w.outer.inLeft -orient vertical]
|
||||
$w.outer add [ttk::panedwindow $w.outer.inRight -orient vertical]
|
||||
$w.outer.inLeft add [ttk::labelframe $w.outer.inLeft.top -text Button]
|
||||
$w.outer.inLeft add [ttk::labelframe $w.outer.inLeft.bot -text Clocks]
|
||||
$w.outer.inRight add [ttk::labelframe $w.outer.inRight.top -text Progress]
|
||||
$w.outer.inRight add [ttk::labelframe $w.outer.inRight.bot -text Text]
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
foreach i [list inLeft.top inLeft.bot inRight.top inRight.bot] {
|
||||
$w.outer.$i configure -padding 3
|
||||
}
|
||||
}
|
||||
|
||||
# Fill the button pane
|
||||
ttk::button $w.outer.inLeft.top.b -text "Press Me" -command {
|
||||
tk_messageBox -type ok -icon info -message "Ouch!" -detail "That hurt..." \
|
||||
-parent .ttkpane -title "Button Pressed"
|
||||
}
|
||||
pack $w.outer.inLeft.top.b -padx 2 -pady 5
|
||||
|
||||
# Fill the clocks pane
|
||||
set i 0
|
||||
proc every {delay script} {
|
||||
uplevel #0 $script
|
||||
after $delay [list every $delay $script]
|
||||
}
|
||||
set testzones {
|
||||
:Europe/Berlin
|
||||
:America/Argentina/Buenos_Aires
|
||||
:Africa/Johannesburg
|
||||
:Europe/London
|
||||
:America/Los_Angeles
|
||||
:Europe/Moscow
|
||||
:America/New_York
|
||||
:Asia/Singapore
|
||||
:Australia/Sydney
|
||||
:Asia/Tokyo
|
||||
}
|
||||
# Force a pre-load of all the timezones needed; otherwise can end up
|
||||
# poor-looking synch problems!
|
||||
set zones {}
|
||||
foreach zone $testzones {
|
||||
if {![catch {clock format 0 -timezone $zone}]} {
|
||||
lappend zones $zone
|
||||
}
|
||||
}
|
||||
if {[llength $zones] < 2} { lappend zones -0200 :GMT :UTC +0200 }
|
||||
foreach zone $zones {
|
||||
set city [string map {_ " "} [regexp -inline {[^/]+$} $zone]]
|
||||
if {$i} {
|
||||
pack [ttk::separator $w.outer.inLeft.bot.s$i] -fill x
|
||||
}
|
||||
ttk::label $w.outer.inLeft.bot.l$i -text $city -anchor w
|
||||
ttk::label $w.outer.inLeft.bot.t$i -textvariable time($zone) -anchor w
|
||||
pack $w.outer.inLeft.bot.l$i $w.outer.inLeft.bot.t$i -fill x
|
||||
every 1000 "set time($zone) \[clock format \[clock seconds\] -timezone $zone -format %T\]"
|
||||
incr i
|
||||
}
|
||||
|
||||
# Fill the progress pane
|
||||
ttk::progressbar $w.outer.inRight.top.progress -mode indeterminate
|
||||
pack $w.outer.inRight.top.progress -fill both -expand 1
|
||||
$w.outer.inRight.top.progress start
|
||||
|
||||
# Fill the text pane
|
||||
if {[tk windowingsystem] ne "aqua"} {
|
||||
# The trick with the ttk::frame makes the text widget look like it fits with
|
||||
# the current Ttk theme despite not being a themed widget itself. It is done
|
||||
# by styling the frame like an entry, turning off the border in the text
|
||||
# widget, and putting the text widget in the frame with enough space to allow
|
||||
# the surrounding border to show through (2 pixels seems to be enough).
|
||||
ttk::frame $w.outer.inRight.bot.f -style TEntry
|
||||
text $w.txt -wrap word -yscroll "$w.sb set" -width 30 -borderwidth 0
|
||||
pack $w.txt -fill both -expand 1 -in $w.outer.inRight.bot.f -pady 2 -padx 2
|
||||
ttk::scrollbar $w.sb -orient vertical -command "$w.txt yview"
|
||||
pack $w.sb -side right -fill y -in $w.outer.inRight.bot
|
||||
pack $w.outer.inRight.bot.f -fill both -expand 1
|
||||
pack $w.outer -fill both -expand 1
|
||||
} else {
|
||||
text $w.txt -wrap word -yscroll "$w.sb set" -width 30 -borderwidth 0
|
||||
ttk::scrollbar $w.sb -orient vertical -command "$w.txt yview"
|
||||
pack $w.sb -side right -fill y -in $w.outer.inRight.bot
|
||||
pack $w.txt -fill both -expand 1 -in $w.outer.inRight.bot
|
||||
pack $w.outer -fill both -expand 1 -padx 10 -pady {6 10}
|
||||
}
|
||||
|
||||
@@ -0,0 +1,46 @@
|
||||
# ttkprogress.tcl --
|
||||
#
|
||||
# This demonstration script creates several progress bar widgets.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .ttkprogress
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Progress Bar Demonstration"
|
||||
wm iconname $w "ttkprogress"
|
||||
positionWindow $w
|
||||
|
||||
ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Below are two progress bars. The top one is a \u201Cdeterminate\u201D progress bar, which is used for showing how far through a defined task the program has got. The bottom one is an \u201Cindeterminate\u201D progress bar, which is used to show that the program is busy but does not know how long for. Both are run here in self-animated mode, which can be turned on and off using the buttons underneath."
|
||||
pack $w.msg -side top -fill x
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
ttk::frame $w.f
|
||||
pack $w.f -fill both -expand 1
|
||||
set w $w.f
|
||||
|
||||
proc doBars {op args} {
|
||||
foreach w $args {
|
||||
$w $op
|
||||
}
|
||||
}
|
||||
ttk::progressbar $w.p1 -mode determinate
|
||||
ttk::progressbar $w.p2 -mode indeterminate
|
||||
ttk::button $w.start -text "Start Progress" -command [list \
|
||||
doBars start $w.p1 $w.p2]
|
||||
ttk::button $w.stop -text "Stop Progress" -command [list \
|
||||
doBars stop $w.p1 $w.p2]
|
||||
|
||||
grid $w.p1 - -pady 5 -padx 10
|
||||
grid $w.p2 - -pady 5 -padx 10
|
||||
grid $w.start $w.stop -padx 10 -pady 5
|
||||
grid configure $w.start -sticky e
|
||||
grid configure $w.stop -sticky w
|
||||
grid columnconfigure $w all -weight 1
|
||||
@@ -0,0 +1,39 @@
|
||||
# ttkscale.tcl --
|
||||
#
|
||||
# This demonstration script shows an example with a horizontal scale.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .ttkscale
|
||||
catch {destroy $w}
|
||||
toplevel $w -bg [ttk::style lookup TLabel -background]
|
||||
wm title $w "Themed Scale Demonstration"
|
||||
wm iconname $w "ttkscale"
|
||||
positionWindow $w
|
||||
|
||||
pack [ttk::frame [set w $w.contents]] -fill both -expand 1
|
||||
|
||||
ttk::label $w.msg -font $font -wraplength 3.5i -justify left -text "A label tied to a horizontal scale is displayed below. If you click or drag mouse button 1 in the scale, you can change the contents of the label; a callback command is used to couple the slider to both the text and the coloring of the label."
|
||||
pack $w.msg -side top -padx .5c
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons [winfo toplevel $w]]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
ttk::frame $w.frame -borderwidth 10
|
||||
pack $w.frame -side top -fill x
|
||||
|
||||
# List of colors from rainbox; "Indigo" is not a standard color
|
||||
set colorList {Red Orange Yellow Green Blue Violet}
|
||||
ttk::label $w.frame.label
|
||||
ttk::scale $w.frame.scale -from 0 -to 5 -command [list apply {{w idx} {
|
||||
set c [lindex $::colorList [tcl::mathfunc::int $idx]]
|
||||
$w.frame.label configure -foreground $c -text "Color: $c"
|
||||
}} $w]
|
||||
# Trigger the setting of the label's text
|
||||
$w.frame.scale set 0
|
||||
pack $w.frame.label $w.frame.scale
|
||||
@@ -0,0 +1,351 @@
|
||||
# twind.tcl --
|
||||
#
|
||||
# This demonstration script creates a text widget with a bunch of
|
||||
# embedded windows.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
# Make an Aqua button's fill color match its parent's background
|
||||
proc blend {bt} {
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
$bt configure -highlightbackground [[winfo parent $bt] cget -background]
|
||||
}
|
||||
return $bt
|
||||
}
|
||||
|
||||
set w .twind
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Text Demonstration - Embedded Windows and Other Features"
|
||||
wm iconname $w "Embedded Windows"
|
||||
positionWindow $w
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
frame $w.f -highlightthickness 1 -borderwidth 1 -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
|
||||
ttk::scrollbar $w.scroll -command "$t yview"
|
||||
pack $w.scroll -side right -fill y
|
||||
panedwindow $w.pane
|
||||
pack $w.pane -expand yes -fill both
|
||||
$w.pane add $w.f
|
||||
# Import to raise given creation order above
|
||||
raise $w.f
|
||||
|
||||
$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
|
||||
|
||||
$t insert end "A text widget can contain many different kinds of items, "
|
||||
$t insert end "both active and passive. It can lay these out in various "
|
||||
$t insert end "ways, with wrapping, tabs, centering, etc. In addition, "
|
||||
$t insert end "when the contents are too big for the window, smooth "
|
||||
$t insert end "scrolling in all directions is provided.\n\n"
|
||||
|
||||
$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 [blend $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 [blend $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 -create {
|
||||
button %W.click -text "Click Here" -command "textWindPlot %W" \
|
||||
-cursor top_left_arrow
|
||||
blend %W.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 -create {
|
||||
button %W.delete -text "Delete" -command "textWindDel %W" \
|
||||
-cursor top_left_arrow
|
||||
blend %W.delete
|
||||
}
|
||||
$t insert end " the plot again.\n\n"
|
||||
|
||||
$t insert end "You can also create multiple text widgets each of which "
|
||||
$t insert end "display the same underlying text. Click this button to "
|
||||
$t window create end \
|
||||
-create {button %W.peer -text "Make A Peer" -command "textMakePeer %W" \
|
||||
-cursor top_left_arrow
|
||||
blend %W.peer} -padx 3
|
||||
$t insert end " widget. Notice how peer widgets can have different "
|
||||
$t insert end "font settings, and by default contain all the images "
|
||||
$t insert end "of the 'parent', but that the embedded windows, "
|
||||
$t insert end "such as buttons may not appear in the peer. To ensure "
|
||||
$t insert end "that embedded windows appear in all peers you can set the "
|
||||
$t insert end "'-create' option to a script or a string containing %W. "
|
||||
$t insert end "(The plot above and the 'Make A Peer' button are "
|
||||
$t insert end "designed to show up in all peers.) A good use of "
|
||||
$t insert end "peers is for "
|
||||
$t window create end \
|
||||
-create {button %W.split -text "Split Windows" -command "textSplitWindow %W" \
|
||||
-cursor top_left_arrow
|
||||
blend %W.split} -padx 3
|
||||
$t insert end " \n\n"
|
||||
|
||||
$t insert end "Users of previous versions of Tk will also be interested "
|
||||
$t insert end "to note that now cursor movement is now by visual line by "
|
||||
$t insert end "default, and that all scrolling of this widget is by pixel.\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"
|
||||
|
||||
$t insert end "\nNOTE: these buttons will not appear in peers!\n" "peer_warning"
|
||||
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 \
|
||||
"changeBg $t $color"
|
||||
$t window create end -window [blend $t.color$i] -padx 3 -pady 2
|
||||
incr i
|
||||
}
|
||||
$t tag add buttons [blend $t.default] end
|
||||
|
||||
button $t.bigB -text "Big borders" -command "textWindBigB $t" \
|
||||
-cursor top_left_arrow
|
||||
button $t.smallB -text "Small borders" -command "textWindSmallB $t" \
|
||||
-cursor top_left_arrow
|
||||
button $t.bigH -text "Big highlight" -command "textWindBigH $t" \
|
||||
-cursor top_left_arrow
|
||||
button $t.smallH -text "Small highlight" -command "textWindSmallH $t" \
|
||||
-cursor top_left_arrow
|
||||
button $t.bigP -text "Big pad" -command "textWindBigP $t" \
|
||||
-cursor top_left_arrow
|
||||
button $t.smallP -text "Small pad" -command "textWindSmallP $t" \
|
||||
-cursor top_left_arrow
|
||||
|
||||
set text_normal(border) [$t cget -borderwidth]
|
||||
set text_normal(highlight) [$t cget -highlightthickness]
|
||||
set text_normal(pad) [$t cget -padx]
|
||||
|
||||
$t insert end "\nYou can also change the usual border width and "
|
||||
$t insert end "highlightthickness and padding.\n"
|
||||
$t window create end -window [blend $t.bigB]
|
||||
$t window create end -window [blend $t.smallB]
|
||||
$t window create end -window [blend $t.bigH]
|
||||
$t window create end -window [blend $t.smallH]
|
||||
$t window create end -window [blend $t.bigP]
|
||||
$t window create end -window [blend $t.smallP]
|
||||
|
||||
$t insert end "\n\nFinally, images fit comfortably in text widgets too:"
|
||||
|
||||
$t image create end -image \
|
||||
[image create photo -file [file join $tk_demoDirectory images ouster.png]]
|
||||
|
||||
proc textWindBigB w {
|
||||
$w configure -borderwidth 15
|
||||
}
|
||||
|
||||
proc textWindBigH w {
|
||||
$w configure -highlightthickness 15
|
||||
}
|
||||
|
||||
proc textWindBigP w {
|
||||
$w configure -padx 15 -pady 15
|
||||
}
|
||||
|
||||
proc textWindSmallB w {
|
||||
$w configure -borderwidth $::text_normal(border)
|
||||
}
|
||||
|
||||
proc textWindSmallH w {
|
||||
$w configure -highlightthickness $::text_normal(highlight)
|
||||
}
|
||||
|
||||
proc textWindSmallP w {
|
||||
$w configure -padx $::text_normal(pad) -pady $::text_normal(pad)
|
||||
}
|
||||
|
||||
proc textWindOn w {
|
||||
catch {destroy $w.scroll2}
|
||||
set t $w.f.text
|
||||
ttk::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
|
||||
}
|
||||
|
||||
while {[string first [$t get plot] " \t\n"] >= 0} {
|
||||
$t delete plot
|
||||
}
|
||||
$t insert plot "\n"
|
||||
|
||||
$t window create plot -create {createPlot %W}
|
||||
$t tag add center plot
|
||||
$t insert plot "\n"
|
||||
}
|
||||
|
||||
proc createPlot {t} {
|
||||
set c $t.c
|
||||
|
||||
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 <Enter> "$c itemconfig current -fill red"
|
||||
$c bind point <Leave> "$c itemconfig current -fill SkyBlue2"
|
||||
$c bind point <Button-1> "embPlotDown $c %x %y"
|
||||
$c bind point <ButtonRelease-1> "$c dtag selected"
|
||||
bind $c <B1-Motion> "embPlotMove $c %x %y"
|
||||
return $c
|
||||
}
|
||||
|
||||
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 t {
|
||||
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 changeBg {t c} {
|
||||
$t configure -background $c
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
foreach b [$t window names] {
|
||||
if {[winfo class $b] eq "Button"} {
|
||||
$b configure -highlightbackground $c
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc embDefBg t {
|
||||
set bg [lindex [$t configure -background] 3]
|
||||
changeBg $t $bg
|
||||
}
|
||||
|
||||
proc textMakePeer {parent} {
|
||||
set n 1
|
||||
while {[winfo exists .peer$n]} { incr n }
|
||||
set w [toplevel .peer$n]
|
||||
wm title $w "Text Peer #$n"
|
||||
frame $w.f -highlightthickness 1 -borderwidth 1 -relief sunken
|
||||
set t [$parent peer create $w.f.text -yscrollcommand "$w.scroll set" \
|
||||
-borderwidth 0 -highlightthickness 0]
|
||||
$t tag configure peer_warning -font boldFont
|
||||
pack $t -expand yes -fill both
|
||||
ttk::scrollbar $w.scroll -command "$t yview"
|
||||
pack $w.scroll -side right -fill y
|
||||
pack $w.f -expand yes -fill both
|
||||
}
|
||||
|
||||
proc textSplitWindow {textW} {
|
||||
if {$textW eq ".twind.f.text"} {
|
||||
if {[winfo exists .twind.peer]} {
|
||||
destroy .twind.peer
|
||||
} else {
|
||||
set parent [winfo parent $textW]
|
||||
set w [winfo parent $parent]
|
||||
set t [$textW peer create $w.peer \
|
||||
-yscrollcommand "$w.scroll set"]
|
||||
$t tag configure peer_warning -font boldFont
|
||||
$w.pane add $t
|
||||
}
|
||||
} else {
|
||||
return
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,145 @@
|
||||
# unicodeout.tcl --
|
||||
#
|
||||
# This demonstration script shows how you can produce output (in label
|
||||
# widgets) using many different alphabets.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
set w .unicodeout
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
wm title $w "Unicode Label Demonstration"
|
||||
wm iconname $w "unicodeout"
|
||||
positionWindow $w
|
||||
|
||||
label $w.msg -font $font -wraplength 4i -anchor w -justify left \
|
||||
-text "This is a sample of Tk's support for languages that use\
|
||||
non-Western character sets. However, what you will actually see\
|
||||
below depends largely on what character sets you have installed,\
|
||||
and what you see for characters that are not present varies greatly\
|
||||
between platforms as well. The strings are written in Tcl using\
|
||||
UNICODE characters using the \\uXXXX escape so as to do so in a\
|
||||
portable fashion."
|
||||
pack $w.msg -side top
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
## The frame that will contain the sample texts.
|
||||
pack [frame $w.f] -side bottom -expand 1 -fill both -padx 2m -pady 1m
|
||||
grid columnconfigure $w.f 1 -weight 1
|
||||
set i 0
|
||||
proc addSample {w language args} {
|
||||
global font i
|
||||
set sample [join $args ""]
|
||||
set j [incr i]
|
||||
label $w.f.l$j -font $font -text "${language}:" -anchor nw -pady 0
|
||||
label $w.f.s$j -font $font -text $sample -anchor nw -width 30 -pady 0
|
||||
grid $w.f.l$j $w.f.s$j -sticky ew -pady 0
|
||||
grid configure $w.f.l$j -padx 1m
|
||||
}
|
||||
|
||||
## A helper procedure that determines what form to use to express languages
|
||||
## that have complex rendering rules...
|
||||
proc usePresentationFormsFor {language} {
|
||||
switch [tk windowingsystem] {
|
||||
aqua {
|
||||
# OSX wants natural character order; the renderer knows how to
|
||||
# compose things for display for all languages.
|
||||
return false
|
||||
}
|
||||
x11 {
|
||||
# The X11 font renderers that Tk supports all know nothing about
|
||||
# composing characters, so we need to use presentation forms.
|
||||
return true
|
||||
}
|
||||
win32 {
|
||||
# On Windows, we need to determine whether the font system will
|
||||
# render right-to-left text. This varies by language!
|
||||
try {
|
||||
package require registry
|
||||
set rkey [join {
|
||||
HKEY_LOCAL_MACHINE
|
||||
SOFTWARE
|
||||
Microsoft
|
||||
{Windows NT}
|
||||
CurrentVersion
|
||||
LanguagePack
|
||||
} \\]
|
||||
return [expr {
|
||||
[string toupper $language] ni [registry values $rkey]
|
||||
}]
|
||||
} trap error {} {
|
||||
# Cannot work it out, so use presentation forms.
|
||||
return true
|
||||
}
|
||||
}
|
||||
default {
|
||||
# Default to using presentation forms.
|
||||
return true
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
## Processing when some characters are not currently cached by the display
|
||||
## engine might take a while, so make sure we're displaying something in the
|
||||
## meantime...
|
||||
pack [label $w.wait -text "Please wait while loading fonts..." \
|
||||
-font {Helvetica 12 italic}]
|
||||
set oldCursor [$w cget -cursor]
|
||||
$w conf -cursor watch
|
||||
update
|
||||
|
||||
## Add the samples...
|
||||
if {[usePresentationFormsFor Arabic]} {
|
||||
# Using presentation forms (pre-layouted)
|
||||
addSample $w Arabic \
|
||||
"\uFE94\uFEF4\uFE91\uFEAE\uFECC\uFEDF\uFE8D " \
|
||||
"\uFE94\uFEE4\uFEE0\uFEDC\uFEDF\uFE8D"
|
||||
} else {
|
||||
# Using standard text characters
|
||||
addSample $w Arabic \
|
||||
"\u0627\u0644\u0643\u0644\u0645\u0629 " \
|
||||
"\u0627\u0644\u0639\u0631\u0628\u064A\u0629"
|
||||
}
|
||||
addSample $w "Trad. Chinese" "\u4E2D\u570B\u7684\u6F22\u5B57"
|
||||
addSample $w "Simpl. Chinese" "\u6C49\u8BED"
|
||||
addSample $w French "Langue fran\xE7aise"
|
||||
addSample $w Greek \
|
||||
"\u0395\u03BB\u03BB\u03B7\u03BD\u03B9\u03BA\u03AE " \
|
||||
"\u03B3\u03BB\u03CE\u03C3\u03C3\u03B1"
|
||||
if {[usePresentationFormsFor Hebrew]} {
|
||||
# Visual order (pre-layouted)
|
||||
addSample $w Hebrew \
|
||||
"\u05EA\u05D9\u05E8\u05D1\u05E2 \u05D1\u05EA\u05DB"
|
||||
} else {
|
||||
# Standard logical order
|
||||
addSample $w Hebrew \
|
||||
"\u05DB\u05EA\u05D1 \u05E2\u05D1\u05E8\u05D9\u05EA"
|
||||
}
|
||||
addSample $w Hindi \
|
||||
"\u0939\u093F\u0928\u094D\u0926\u0940 \u092D\u093E\u0937\u093E"
|
||||
addSample $w Icelandic "\xCDslenska"
|
||||
addSample $w Japanese \
|
||||
"\u65E5\u672C\u8A9E\u306E\u3072\u3089\u304C\u306A, " \
|
||||
"\u6F22\u5B57\u3068\u30AB\u30BF\u30AB\u30CA"
|
||||
addSample $w Korean "\uB300\uD55C\uBBFC\uAD6D\uC758 \uD55C\uAE00"
|
||||
addSample $w Russian \
|
||||
"\u0420\u0443\u0441\u0441\u043A\u0438\u0439 \u044F\u0437\u044B\u043A"
|
||||
if {([tk windowingsystem] ne "x11") || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))} {
|
||||
if {[package vsatisfies [package provide Tcl] 8.7-]} {
|
||||
addSample $w Emoji "😀💩👍🇳🇱"
|
||||
} else {
|
||||
addSample $w Emoji \
|
||||
"\uD83D\uDE00\uD83D\uDCA9\uD83D\uDC4D\uD83C\uDDF3\uD83C\uDDF1"
|
||||
}
|
||||
}
|
||||
|
||||
## We're done processing, so change things back to normal running...
|
||||
destroy $w.wait
|
||||
$w conf -cursor $oldCursor
|
||||
@@ -0,0 +1,46 @@
|
||||
# vscale.tcl --
|
||||
#
|
||||
# This demonstration script shows an example with a vertical scale.
|
||||
|
||||
if {![info exists widgetDemo]} {
|
||||
error "This script should be run from the \"widget\" demo."
|
||||
}
|
||||
|
||||
package require Tk
|
||||
|
||||
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
|
||||
|
||||
## See Code / Dismiss buttons
|
||||
set btns [addSeeDismiss $w.buttons $w]
|
||||
pack $btns -side bottom -fill x
|
||||
|
||||
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
|
||||
}
|
||||
@@ -0,0 +1,734 @@
|
||||
#!/bin/sh
|
||||
# the next line restarts using wish \
|
||||
exec wish "$0" ${1+"$@"}
|
||||
|
||||
# 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.
|
||||
|
||||
package require Tk 8.5
|
||||
package require msgcat
|
||||
|
||||
eval destroy [winfo child .]
|
||||
set tk_demoDirectory [file join [pwd] [file dirname [info script]]]
|
||||
::msgcat::mcload $tk_demoDirectory
|
||||
namespace import ::msgcat::mc
|
||||
wm title . [mc "Widget Demonstration"]
|
||||
if {[tk windowingsystem] eq "x11"} {
|
||||
# This won't work everywhere, but there's no other way in core Tk at the
|
||||
# moment to display a coloured icon.
|
||||
image create photo TclPowered \
|
||||
-file [file join $tk_library images logo64.gif]
|
||||
wm iconwindow . [toplevel ._iconWindow]
|
||||
pack [label ._iconWindow.i -image TclPowered]
|
||||
wm iconname . [mc "tkWidgetDemo"]
|
||||
}
|
||||
|
||||
if {"defaultFont" ni [font names]} {
|
||||
# TIP #145 defines some standard named fonts
|
||||
if {"TkDefaultFont" in [font names] && "TkFixedFont" in [font names]} {
|
||||
# FIX ME: the following technique of cloning the font to copy it works
|
||||
# fine but means that if the system font is changed by Tk
|
||||
# cannot update the copied font. font alias might be useful
|
||||
# here -- or fix the app to use TkDefaultFont etc.
|
||||
font create mainFont {*}[font configure TkDefaultFont]
|
||||
font create fixedFont {*}[font configure TkFixedFont]
|
||||
font create boldFont {*}[font configure TkDefaultFont] -weight bold
|
||||
font create titleFont {*}[font configure TkDefaultFont] -weight bold
|
||||
font create statusFont {*}[font configure TkDefaultFont]
|
||||
font create varsFont {*}[font configure TkDefaultFont]
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
font configure titleFont -size 17
|
||||
}
|
||||
} else {
|
||||
font create mainFont -family Helvetica -size 12
|
||||
font create fixedFont -family Courier -size 10
|
||||
font create boldFont -family Helvetica -size 12 -weight bold
|
||||
font create titleFont -family Helvetica -size 18 -weight bold
|
||||
font create statusFont -family Helvetica -size 10
|
||||
font create varsFont -family Helvetica -size 14
|
||||
}
|
||||
}
|
||||
|
||||
set widgetDemo 1
|
||||
set font mainFont
|
||||
|
||||
image create photo ::img::refresh -format GIF -data {
|
||||
R0lGODlhEAAQAJEDAP///wAAACpnKv///yH5BAEAAAMALAAAAAAQABAAAAI63IKp
|
||||
xgcPH2ouwgBCw1HIxHCQ4F3hSJKmwZXqWrmWxj7lKJ2dndcon9EBUq+gz3brVXAR
|
||||
2tICU0gXBQA7
|
||||
}
|
||||
|
||||
image create photo ::img::view -format GIF -data {
|
||||
R0lGODlhEAAQAKIHAP///wwMDAAAAMDAwNnZ2SYmJmZmZv///yH5BAEAAAcALAAA
|
||||
AAAQABAAAANMKLos90+ASamDRxJCgw9YVnlDOXiQBgRDBRgHKE6sW8QR3doPKK27
|
||||
yg33q/GIOhdg6OsEJzeZykiBSUcs06e56Xx6np8ScIkFGuhQAgA7
|
||||
}
|
||||
|
||||
image create photo ::img::delete -format GIF -data {
|
||||
R0lGODlhEAAQAIABAIQAAP///yH5BAEAAAEALAAAAAAQABAAAAIjjI+pmwAc3HGy
|
||||
PUSvqYpuvWQg40FfSVacBa5nN6JYDI3mzRQAOw==
|
||||
}
|
||||
|
||||
image create photo ::img::print -format GIF -data {
|
||||
R0lGODlhEAAQALMKAAAAAP///52VunNkl8C82Yl+qldBgq+pyrOzs1fYAP///wAA
|
||||
AAAAAAAAAAAAAAAAACH5BAEAAAoALAAAAAAQABAAAARGUMlJKwU4AztB+ODGeUiJ
|
||||
fGLlgeEYmGWQXmx7aXgmAUTv/74N4EAsGhOJg1DAbDqbwoJ0Sp0KB9isNis0eL/g
|
||||
ryhH5pgnEQA7
|
||||
}
|
||||
|
||||
# Note that this is run through the message catalog! This is because this is
|
||||
# actually an image of a word.
|
||||
image create photo ::img::new -format PNG -data [mc {
|
||||
iVBORw0KGgoAAAANSUhEUgAAAB4AAAAOCAYAAAA45qw5AAACMElEQVR4AeVTAwxd
|
||||
QRCc2tZHGtQ2w9q2bdsOa9u2bUW1bdt2Z372JZe6DapJLqtb3h7+T8yKi5j4CsYD
|
||||
EUQXxETclT7kWOlH2VV+tFkdQHPSwksSISF+BauCqL0qgOcMWgGfgEkaMsHxqUBk
|
||||
3plE/sOnh/qDPAPJH/CKFBivGHWzFwBRnHhlqbu1Mh6CoFNnC/JshQ9p4YC2lrKt
|
||||
DCAV+THiVejyhMjAbrNSrroiEfKR9g7ZfCgOog8QfnUQV62wAk68ndQ9ZbyoWO1H
|
||||
Y6eDY1LCQL6a9ApOp9Hi1T0+gQq2JKMlky/oTKQliKWxEZvyG575kpW4pl1aZnQK
|
||||
CLOVt45Lkp8uXp2SL8KO6uitNTZLdpK6s+I/eZbhpmsmWeOGOVQNKYLITzpKPAO3
|
||||
tY7LSNZ7ccSLxX9y3uuOxRkg3dKESMoCHvL+GRVCutXsB3guLgDCeXOv4iWWkvwG
|
||||
BaS+PmlpK6SI9ApI2oC2UtrwZQEkhkH+NtolVlQXJl1I+QltuU3XEc721bIRFpa8
|
||||
IA5iqTo6vNNWmkNBLQbPeXwF2g17Q94nTQAfY3YzeY+WSu8MDzQ2kpELUhSGJUHE
|
||||
0zeR3rY1L+Xl5G/re+jbiK6KhThwwInsts1fbMUUcpZszKeVtggZEiGdZDe5AtHh
|
||||
7vL4CGiRvvKPS8FAvq9Nr4ZkFadR2y6kggu1z4vlyIbBp6BugQ8JLEg4bTkD9eMZ
|
||||
QZ8hpJ3VvTtuvbWrY/ElvP/9R+Aj3603+iE3fkEAAAAASUVORK5CYII=
|
||||
}]
|
||||
|
||||
#----------------------------------------------------------------
|
||||
# The code below creates 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.
|
||||
#----------------------------------------------------------------
|
||||
|
||||
menu .menuBar -tearoff 0
|
||||
|
||||
# On Aqua, just use the default menu.
|
||||
if {[tk windowingsystem] ne "aqua"} {
|
||||
# This is a tk-internal procedure to make i18n easier
|
||||
::tk::AmpMenuArgs .menuBar add cascade -label [mc "&File"] \
|
||||
-menu .menuBar.file
|
||||
menu .menuBar.file -tearoff 0
|
||||
::tk::AmpMenuArgs .menuBar.file add command -label [mc "&About..."] \
|
||||
-command {tkAboutDialog} -accelerator [mc "<F1>"]
|
||||
bind . <F1> {tkAboutDialog}
|
||||
.menuBar.file add sep
|
||||
if {[string match win* [tk windowingsystem]]} {
|
||||
# Windows doesn't usually have a Meta key
|
||||
::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \
|
||||
-command {exit} -accelerator [mc "Ctrl+Q"]
|
||||
bind . <[mc "Control-q"]> {exit}
|
||||
} else {
|
||||
::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \
|
||||
-command {exit} -accelerator [mc "Meta-Q"]
|
||||
bind . <[mc "Meta-q"]> {exit}
|
||||
}
|
||||
. configure -menu .menuBar
|
||||
}
|
||||
|
||||
ttk::frame .statusBar
|
||||
ttk::label .statusBar.lab -text " " -anchor w
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
ttk::separator .statusBar.sep
|
||||
pack .statusBar.sep -side top -expand yes -fill x -pady 0
|
||||
}
|
||||
pack .statusBar.lab -side left -padx 2 -expand yes -fill both
|
||||
if {[tk windowingsystem] ne "aqua"} {
|
||||
ttk::sizegrip .statusBar.foo
|
||||
pack .statusBar.foo -side left -padx 2
|
||||
}
|
||||
pack .statusBar -side bottom -fill x -pady 2
|
||||
|
||||
set textheight 30
|
||||
catch {
|
||||
set textheight [expr {
|
||||
([winfo screenheight .] * 0.7) /
|
||||
[font metrics mainFont -displayof . -linespace]
|
||||
}]
|
||||
}
|
||||
|
||||
ttk::frame .textFrame
|
||||
ttk::scrollbar .s -orient vertical -command {.t yview} -takefocus 1
|
||||
pack .s -in .textFrame -side right -fill y
|
||||
text .t -yscrollcommand {.s set} -wrap word -width 70 -height $textheight \
|
||||
-font mainFont -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
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
pack configure .statusBar.lab -padx {10 18} -pady {4 6}
|
||||
pack configure .statusBar -pady 0
|
||||
.t configure -padx 10 -pady 0
|
||||
}
|
||||
|
||||
# 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 titleFont
|
||||
.t tag configure subtitle -font titleFont
|
||||
.t tag configure bold -font boldFont
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
.t tag configure title -spacing1 8
|
||||
.t tag configure subtitle -spacing3 3
|
||||
}
|
||||
|
||||
# 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
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
.t tag configure demo -foreground systemLinkColor
|
||||
.t tag configure visited -foreground purple
|
||||
}
|
||||
.t tag configure hot -foreground red -underline 1
|
||||
}
|
||||
.t tag bind demo <ButtonRelease-1> {
|
||||
invoke [.t index {@%x,%y}]
|
||||
}
|
||||
set lastLine ""
|
||||
.t tag bind demo <Enter> {
|
||||
set lastLine [.t index {@%x,%y linestart}]
|
||||
.t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
|
||||
.t config -cursor [::ttk::cursor link]
|
||||
showStatus [.t index {@%x,%y}]
|
||||
}
|
||||
.t tag bind demo <Leave> {
|
||||
.t tag remove hot 1.0 end
|
||||
.t config -cursor [::ttk::cursor text]
|
||||
.statusBar.lab config -text ""
|
||||
}
|
||||
.t tag bind demo <Motion> {
|
||||
set newLine [.t index {@%x,%y linestart}]
|
||||
if {$newLine ne $lastLine} {
|
||||
.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.
|
||||
|
||||
# addFormattedText --
|
||||
#
|
||||
# Add formatted text (but not hypertext) to the text widget after first
|
||||
# passing it through the message catalog to allow for localization.
|
||||
# Lines starting with @@ are formatting directives (insert title, insert
|
||||
# demo hyperlink, begin newline, or change style) and all other lines
|
||||
# are literal strings to be inserted. Substitutions are performed,
|
||||
# allowing processing pieces through the message catalog. Blank lines
|
||||
# are ignored.
|
||||
#
|
||||
proc addFormattedText {formattedText} {
|
||||
set style normal
|
||||
set isNL 1
|
||||
set demoCount 0
|
||||
set new 0
|
||||
foreach line [split $formattedText \n] {
|
||||
set line [string trim $line]
|
||||
if {$line eq ""} {
|
||||
continue
|
||||
}
|
||||
if {[string match @@* $line]} {
|
||||
set data [string range $line 2 end]
|
||||
set key [lindex $data 0]
|
||||
set values [lrange $data 1 end]
|
||||
switch -exact -- $key {
|
||||
title {
|
||||
.t insert end [mc $values]\n title \n normal
|
||||
}
|
||||
newline {
|
||||
.t insert end \n $style
|
||||
set isNL 1
|
||||
}
|
||||
subtitle {
|
||||
.t insert end "\n" {} [mc $values] subtitle \
|
||||
" \n " demospace
|
||||
set demoCount 0
|
||||
}
|
||||
demo {
|
||||
set description [lassign $values name]
|
||||
.t insert end "[incr demoCount]. [mc $description]" \
|
||||
[list demo demo-$name]
|
||||
if {$new} {
|
||||
.t image create end -image ::img::new -padx 5
|
||||
set new 0
|
||||
}
|
||||
.t insert end " \n " demospace
|
||||
}
|
||||
new {
|
||||
set new 1
|
||||
}
|
||||
default {
|
||||
set style $key
|
||||
}
|
||||
}
|
||||
continue
|
||||
}
|
||||
if {!$isNL} {
|
||||
.t insert end " " $style
|
||||
}
|
||||
set isNL 0
|
||||
.t insert end [mc $line] $style
|
||||
}
|
||||
}
|
||||
|
||||
addFormattedText {
|
||||
@@title Tk Widget Demonstrations
|
||||
|
||||
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
|
||||
@@bold
|
||||
See Code
|
||||
@@normal
|
||||
button to see the Tcl/Tk code that created the demonstration. If
|
||||
you wish, you can edit the code and click the
|
||||
@@bold
|
||||
Rerun Demo
|
||||
@@normal
|
||||
button in the code window to reinvoke the demonstration with the
|
||||
modified code.
|
||||
@@newline
|
||||
|
||||
@@subtitle Labels, buttons, checkbuttons, and radiobuttons
|
||||
@@demo label Labels (text and bitmaps)
|
||||
@@demo unicodeout Labels and UNICODE text
|
||||
@@demo button Buttons
|
||||
@@demo check Check-buttons (select any of a group)
|
||||
@@demo radio Radio-buttons (select one of a group)
|
||||
@@demo puzzle A 15-puzzle game made out of buttons
|
||||
@@demo icon Iconic buttons that use bitmaps
|
||||
@@demo image1 Two labels displaying images
|
||||
@@demo image2 A simple user interface for viewing images
|
||||
@@demo labelframe Labelled frames
|
||||
@@demo ttkbut The simple Themed Tk widgets
|
||||
|
||||
@@subtitle Listboxes and Trees
|
||||
@@demo states The 50 states
|
||||
@@demo colors Colors: change the color scheme for the application
|
||||
@@demo sayings A collection of famous and infamous sayings
|
||||
@@demo mclist A multi-column list of countries
|
||||
@@demo tree A directory browser tree
|
||||
|
||||
@@subtitle Entries, Spin-boxes and Combo-boxes
|
||||
@@demo entry1 Entries without scrollbars
|
||||
@@demo entry2 Entries with scrollbars
|
||||
@@demo entry3 Validated entries and password fields
|
||||
@@demo spin Spin-boxes
|
||||
@@demo combo Combo-boxes
|
||||
@@demo form Simple Rolodex-like form
|
||||
|
||||
@@subtitle Text
|
||||
@@demo text Basic editable text
|
||||
@@demo style Text display styles
|
||||
@@demo bind Hypertext (tag bindings)
|
||||
@@demo twind A text widget with embedded windows and other features
|
||||
@@demo search A search tool built with a text widget
|
||||
@@demo textpeer Peering text widgets
|
||||
|
||||
@@subtitle Canvases
|
||||
@@demo items The canvas item types
|
||||
@@demo plot A simple 2-D plot
|
||||
@@demo ctext Text items in canvases
|
||||
@@demo arrow An editor for arrowheads on canvas lines
|
||||
@@demo ruler A ruler with adjustable tab stops
|
||||
@@demo floor A building floor plan
|
||||
@@demo cscroll A simple scrollable canvas
|
||||
@@demo knightstour A Knight's tour of the chess board
|
||||
|
||||
@@subtitle Scales and Progress Bars
|
||||
@@demo hscale Horizontal scale
|
||||
@@demo vscale Vertical scale
|
||||
@@new
|
||||
@@demo ttkscale Themed scale linked to a label with traces
|
||||
@@demo ttkprogress Progress bar
|
||||
|
||||
@@subtitle Paned Windows and Notebooks
|
||||
@@demo paned1 Horizontal paned window
|
||||
@@demo paned2 Vertical paned window
|
||||
@@demo ttkpane Themed nested panes
|
||||
@@demo ttknote Notebook widget
|
||||
|
||||
@@subtitle Menus and Toolbars
|
||||
@@demo menu Menus and cascades (sub-menus)
|
||||
@@demo menubu Menu-buttons
|
||||
@@demo ttkmenu Themed menu buttons
|
||||
@@demo toolbar Themed toolbar
|
||||
|
||||
@@subtitle Common Dialogs
|
||||
@@demo msgbox Message boxes
|
||||
@@demo filebox File selection dialog
|
||||
@@demo clrpick Color picker
|
||||
@@demo fontchoose Font selection dialog
|
||||
|
||||
@@subtitle Animation
|
||||
@@demo anilabel Animated labels
|
||||
@@demo aniwave Animated wave
|
||||
@@demo pendulum Pendulum simulation
|
||||
@@demo goldberg A celebration of Rube Goldberg
|
||||
|
||||
@@subtitle Miscellaneous
|
||||
@@demo bitmap The built-in bitmaps
|
||||
@@demo dialog1 A dialog box with a local grab
|
||||
@@demo dialog2 A dialog box with a global grab
|
||||
}
|
||||
|
||||
##############################################################################
|
||||
|
||||
.t configure -state disabled
|
||||
focus .s
|
||||
|
||||
# addSeeDismiss --
|
||||
# Add "See Code" and "Dismiss" button frame, with optional "See Vars"
|
||||
#
|
||||
# Arguments:
|
||||
# w - The name of the frame to use.
|
||||
|
||||
proc addSeeDismiss {w show {vars {}} {extra {}}} {
|
||||
## See Code / Dismiss buttons
|
||||
ttk::frame $w
|
||||
ttk::separator $w.sep
|
||||
#ttk::frame $w.sep -height 2 -relief sunken
|
||||
grid $w.sep -columnspan 4 -row 0 -sticky ew -pady 2
|
||||
ttk::button $w.dismiss -text [mc "Dismiss"] \
|
||||
-image ::img::delete -compound left \
|
||||
-command [list destroy [winfo toplevel $w]]
|
||||
ttk::button $w.code -text [mc "See Code"] \
|
||||
-image ::img::view -compound left \
|
||||
-command [list showCode $show]
|
||||
set buttons [list x $w.code $w.dismiss]
|
||||
if {[llength $vars]} {
|
||||
ttk::button $w.vars -text [mc "See Variables"] \
|
||||
-image ::img::view -compound left \
|
||||
-command [concat [list showVars $w.dialog] $vars]
|
||||
set buttons [linsert $buttons 1 $w.vars]
|
||||
}
|
||||
if {$extra ne ""} {
|
||||
set buttons [linsert $buttons 1 [uplevel 1 $extra]]
|
||||
}
|
||||
grid {*}$buttons -padx 4 -pady 4
|
||||
grid columnconfigure $w 0 -weight 1
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
foreach b [lrange $buttons 1 end] {$b configure -takefocus 0}
|
||||
grid configure $w.sep -pady 0
|
||||
grid configure {*}$buttons -pady {10 12}
|
||||
grid configure [lindex $buttons 1] -padx {16 4}
|
||||
grid configure [lindex $buttons end] -padx {4 18}
|
||||
}
|
||||
return $w
|
||||
}
|
||||
|
||||
# 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
|
||||
if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog}
|
||||
wm title $w [mc "Variable values"]
|
||||
|
||||
set b [ttk::frame $w.frame]
|
||||
grid $b -sticky news
|
||||
set f [ttk::labelframe $b.title -text [mc "Variable values:"]]
|
||||
foreach var $args {
|
||||
ttk::label $f.n$var -text "$var:" -anchor w
|
||||
ttk::label $f.v$var -textvariable $var -anchor w
|
||||
grid $f.n$var $f.v$var -padx 2 -pady 2 -sticky w
|
||||
}
|
||||
ttk::button $b.ok -text [mc "OK"] \
|
||||
-command [list destroy $w] -default active
|
||||
bind $w <Return> [list $b.ok invoke]
|
||||
bind $w <Escape> [list $b.ok invoke]
|
||||
|
||||
grid $f -sticky news -padx 4
|
||||
grid $b.ok -sticky e -padx 4 -pady {6 4}
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
$b.ok configure -takefocus 0
|
||||
grid configure $b.ok -pady {10 12} -padx {16 18}
|
||||
grid configure $f -padx 10 -pady {10 0}
|
||||
}
|
||||
grid columnconfig $f 1 -weight 1
|
||||
grid rowconfigure $f 100 -weight 1
|
||||
grid columnconfig $b 0 -weight 1
|
||||
grid rowconfigure $b 0 -weight 1
|
||||
grid columnconfig $w 0 -weight 1
|
||||
grid rowconfigure $w 0 -weight 1
|
||||
}
|
||||
|
||||
# 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_demoDirectory
|
||||
set tags [.t tag names $index]
|
||||
set i [lsearch -glob $tags demo-*]
|
||||
if {$i < 0} {
|
||||
return
|
||||
}
|
||||
set cursor [.t cget -cursor]
|
||||
.t configure -cursor [::ttk::cursor busy]
|
||||
update
|
||||
set demo [string range [lindex $tags $i] 5 end]
|
||||
uplevel 1 [list source -encoding utf-8 [file join $tk_demoDirectory $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 {
|
||||
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 [::ttk::cursor text]
|
||||
} else {
|
||||
set demo [string range [lindex $tags $i] 5 end]
|
||||
.statusBar.lab config -text [mc "Run the \"%s\" sample program" $demo]
|
||||
set newcursor [::ttk::cursor link]
|
||||
}
|
||||
if {$cursor ne $newcursor} {
|
||||
.t config -cursor $newcursor
|
||||
}
|
||||
}
|
||||
|
||||
# evalShowCode --
|
||||
#
|
||||
# Arguments:
|
||||
# w - Name of text widget containing code to eval
|
||||
|
||||
proc evalShowCode {w} {
|
||||
set code [$w get 1.0 end-1c]
|
||||
uplevel #0 $code
|
||||
}
|
||||
|
||||
# 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_demoDirectory
|
||||
set file [string range $w 1 end].tcl
|
||||
set top .code
|
||||
if {![winfo exists $top]} {
|
||||
toplevel $top
|
||||
if {[tk windowingsystem] eq "x11"} {wm attributes $top -type dialog}
|
||||
|
||||
set t [frame $top.f]
|
||||
set text [text $t.text -font fixedFont -height 24 -wrap word \
|
||||
-xscrollcommand [list $t.xscroll set] \
|
||||
-yscrollcommand [list $t.yscroll set] \
|
||||
-setgrid 1 -highlightthickness 0 -pady 2 -padx 3]
|
||||
ttk::scrollbar $t.xscroll -command [list $t.text xview] \
|
||||
-orient horizontal
|
||||
ttk::scrollbar $t.yscroll -command [list $t.text yview] \
|
||||
-orient vertical
|
||||
|
||||
grid $t.text $t.yscroll -sticky news
|
||||
#grid $t.xscroll
|
||||
grid rowconfigure $t 0 -weight 1
|
||||
grid columnconfig $t 0 -weight 1
|
||||
|
||||
set btns [ttk::frame $top.btns]
|
||||
ttk::separator $btns.sep
|
||||
grid $btns.sep -columnspan 4 -row 0 -sticky ew -pady 2
|
||||
ttk::button $btns.dismiss -text [mc "Dismiss"] \
|
||||
-default active -command [list destroy $top] \
|
||||
-image ::img::delete -compound left
|
||||
ttk::button $btns.print -text [mc "Print Code"] \
|
||||
-command [list printCode $text $file] \
|
||||
-image ::img::print -compound left
|
||||
ttk::button $btns.rerun -text [mc "Rerun Demo"] \
|
||||
-command [list evalShowCode $text] \
|
||||
-image ::img::refresh -compound left
|
||||
set buttons [list x $btns.rerun $btns.print $btns.dismiss]
|
||||
grid {*}$buttons -padx 4 -pady 4
|
||||
grid columnconfigure $btns 0 -weight 1
|
||||
if {[tk windowingsystem] eq "aqua"} {
|
||||
foreach b [lrange $buttons 1 end] {$b configure -takefocus 0}
|
||||
grid configure $btns.sep -pady 0
|
||||
grid configure {*}$buttons -pady {10 12}
|
||||
grid configure [lindex $buttons 1] -padx {16 4}
|
||||
grid configure [lindex $buttons end] -padx {4 18}
|
||||
}
|
||||
grid $t -sticky news
|
||||
grid $btns -sticky ew
|
||||
grid rowconfigure $top 0 -weight 1
|
||||
grid columnconfig $top 0 -weight 1
|
||||
|
||||
bind $top <Return> {
|
||||
if {[winfo class %W] ne "Text"} { .code.btns.dismiss invoke }
|
||||
}
|
||||
bind $top <Escape> [bind $top <Return>]
|
||||
} else {
|
||||
wm deiconify $top
|
||||
raise $top
|
||||
}
|
||||
wm title $top [mc "Demo code: %s" [file join $tk_demoDirectory $file]]
|
||||
wm iconname $top $file
|
||||
set id [open [file join $tk_demoDirectory $file]]
|
||||
fconfigure $id -encoding utf-8 -eofchar "\032 {}"
|
||||
$top.f.text delete 1.0 end
|
||||
$top.f.text insert 1.0 [read $id]
|
||||
$top.f.text mark set insert 1.0
|
||||
close $id
|
||||
}
|
||||
|
||||
# printCode --
|
||||
# Prints the source code currently displayed in the See Code dialog. Much
|
||||
# thanks to Arjen Markus for this.
|
||||
#
|
||||
# Arguments:
|
||||
# w - Name of text widget containing code to print
|
||||
# file - Name of the original file (implicitly for title)
|
||||
|
||||
proc printCode {w file} {
|
||||
set code [$w get 1.0 end-1c]
|
||||
|
||||
set dir "."
|
||||
if {[info exists ::env(HOME)]} {
|
||||
set dir "$::env(HOME)"
|
||||
}
|
||||
if {[info exists ::env(TMP)]} {
|
||||
set dir $::env(TMP)
|
||||
}
|
||||
if {[info exists ::env(TEMP)]} {
|
||||
set dir $::env(TEMP)
|
||||
}
|
||||
|
||||
set filename [file join $dir "tkdemo-$file"]
|
||||
set outfile [open $filename "w"]
|
||||
puts $outfile $code
|
||||
close $outfile
|
||||
|
||||
switch -- $::tcl_platform(platform) {
|
||||
unix {
|
||||
if {[catch {exec lp -c $filename} msg]} {
|
||||
tk_messageBox -title "Print spooling failure" \
|
||||
-message "Print spooling probably failed: $msg"
|
||||
}
|
||||
}
|
||||
windows {
|
||||
if {[catch {PrintTextWin32 $filename} msg]} {
|
||||
tk_messageBox -title "Print spooling failure" \
|
||||
-message "Print spooling probably failed: $msg"
|
||||
}
|
||||
}
|
||||
default {
|
||||
tk_messageBox -title "Operation not Implemented" \
|
||||
-message "Wow! Unknown platform: $::tcl_platform(platform)"
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Be careful to throw away the temporary file in a gentle manner ...
|
||||
#
|
||||
if {[file exists $filename]} {
|
||||
catch {file delete $filename}
|
||||
}
|
||||
}
|
||||
|
||||
# PrintTextWin32 --
|
||||
# Print a file under Windows using all the "intelligence" necessary
|
||||
#
|
||||
# Arguments:
|
||||
# filename - Name of the file
|
||||
#
|
||||
# Note:
|
||||
# Taken from the Wiki page by Keith Vetter, "Printing text files under
|
||||
# Windows".
|
||||
# Note:
|
||||
# Do not execute the command in the background: that way we can dispose of the
|
||||
# file smoothly.
|
||||
#
|
||||
proc PrintTextWin32 {filename} {
|
||||
package require registry
|
||||
set app [auto_execok notepad.exe]
|
||||
set pcmd "$app /p %1"
|
||||
catch {
|
||||
set app [registry get {HKEY_CLASSES_ROOT\.txt} {}]
|
||||
set pcmd [registry get \
|
||||
{HKEY_CLASSES_ROOT\\$app\\shell\\print\\command} {}]
|
||||
}
|
||||
|
||||
regsub -all {%1} $pcmd $filename pcmd
|
||||
puts $pcmd
|
||||
|
||||
regsub -all {\\} $pcmd {\\\\} pcmd
|
||||
set command "[auto_execok start] /min $pcmd"
|
||||
eval exec $command
|
||||
}
|
||||
|
||||
# tkAboutDialog --
|
||||
#
|
||||
# Pops up a message box with an "about" message
|
||||
#
|
||||
proc tkAboutDialog {} {
|
||||
tk_messageBox -icon info -type ok -title [mc "About Widget Demo"] \
|
||||
-message [mc "Tk widget demonstration application"] -detail \
|
||||
"[mc "Copyright \xA9 %s" {1996-1997 Sun Microsystems, Inc.}]
|
||||
[mc "Copyright \xA9 %s" {1997-2000 Ajuba Solutions, Inc.}]
|
||||
[mc "Copyright \xA9 %s" {2001-2009 Donal K. Fellows}]
|
||||
[mc "Copyright \xA9 %s" {2002-2007 Daniel A. Steffen}]"
|
||||
}
|
||||
|
||||
# Local Variables:
|
||||
# mode: tcl
|
||||
# End:
|
||||
Reference in new issue
Block a user