Software Interest Group

• Schedule
• Documentation
• Resources
• Thanks

---

Tcl and the Tk toolkit

by Aaron King

---

Table of Contents

• Why Tcl/Tk?
• Where do I go to Learn?
• A Simple Sample Tcl/Tk Script
• A Not-Quite-So-Simple Sample

---

---

Why Tcl/Tk?

Tcl (tool command language) is an easy-to-learn scripting language perfect for manipulating a number of applications. The Tk toolkit is a set of Tcl commands which create and manage widgets (or graphical user interface (GUI) elements).

The primary use of Tcl/Tk is in implementing a graphics-based front end for a set of applications. You don't have to write the code for the windows, text-boxes, buttons, and menus yourself using X Windows libraries---the authors of Tcl/Tk have done it for you.

Tcl/Tk is free software and can be downloaded from several places including Tcl Developer Xchange. It runs under Unix, Linux, and also Windows. Thus, in theory, your Tcl/Tk applications, developed and tested under, for example, Unix, can be readily ported to Windows computers.

---

---

Where do I go to Learn?

Books

The best way to learn Tcl is to read one of the introductory books:

    Tcl and the Tk Toolkit, by John Ousterhout,
    Addison-Wesley, 1994, ISBN 0-201-63337-X

    Practical Programming in Tcl and Tk, by Brent Welch,
    Prentice-Hall, 1995, ISBN 0-13-182007-9

The first, by the originator of Tcl/Tk, is both informative and quite readable.

---

Web Sites

There is an Official Homepage for Tcl and Tk on the WWW and also a Database of Tcl/Tk webpages at Santa Cruz. It has links to lots of places where people are making applications using Tcl/Tk.

Tix is a set of Tk "mega-widgets", i.e., big Tcl/Tk scripts that implement things like toolbars, dialog-boxes, drag-and-drop, and all those things that people who don't program computers have come to expect in an application. The Tix toolkit homepage has loads of stuff to look at and steal.

---

On the Departmental Computers

• Tcl is located in /usr/local/tcl7.4/ with some scripts in /usr/local/lib/tcl7.4/
• Tk is in /usr/local/tk4.0/ and some scripts in /usr/local/lib/tk4.0/ and demos in /usr/local/lib/tk4.0/demos/
• Tix is (are?) located in /usr/local/Tix4.0b4/ with tons of scripts in /usr/local/lib/tix/

Man pages:

• man Tcl
• man wish
• Every Tcl/Tk command has its own man page. These are generally found in /usr/local/man/mann/

Demonstrations:

• /usr/local/tk4.0/library/demos/widget
• /usr/local/Tix4.0b4/demos/widget

---

On your own Computer

Tcl/Tk are easily downloaded and installed. To download the source, try Tcl Developer Xchange. The latest versions are Tcl version 7.6 and Tk version 4.2.

---

---

A Simple Sample Tcl/Tk Script

#!/usr/local/bin/wish4.0

label .counter -text 0.00 -relief raised -width 10
button .start -text Start -command {
    if $stopped {
        set stopped 0
        tick
    }
}
button .stop -text Stop -command {set stopped 1}
pack .counter -side bottom -fill both
pack .start -side left -fill both -expand yes
pack .stop -side right -fill both -expand yes

set seconds 0
set hundredths 0
set stopped 1

proc tick {} {
    global seconds hundredths stopped
    if $stopped return
    after 50 tick
    set hundredths [expr $hundredths+5]
    if {$hundredths >= 100} {
        set hundredths 0
        set seconds [expr $seconds+1]
    }
    .counter config -text [format "%d.%02d" $seconds $hundredths]
}

bind . <Control-c> {destroy .}
bind . <Control-q> {destroy .}
focus .

---

A Not-Quite-So-Simple Sample

#!/usr/local/bin/wish4.0

global sourceFile targetFile n1 n2

if [expr !($argc == 4)] {
  puts {Usage: crop <sourcefile> <layer1> <layer2> <targetfile>}
  exit
}

set sourceFile [lindex $argv 0]
if [expr ![string match "*.pic" $sourceFile]] {
  eval set sourceFile [join {$sourceFile ".pic"} {}]
}
set n1 [lindex $argv 1]
set n2 [lindex $argv 2]

set targetFile [lindex $argv 3]
if [expr ![string match "*.pic" $targetFile]] {
  eval set targetFile [join {$targetFile ".pic"} {}]
}

set nn [exec picspec $sourceFile]
set NX [lindex $nn 0]
set NY [lindex $nn 1]
set NZ [lindex $nn 2]

set projFile "/tmp/proj.pic"

catch {exec projstack $sourceFile $n1 $n2 > $projFile} projrv

frame .m -relief groove
button .m.ref -text Refresh -relief raised -command deleteRect
button .m.crop -text Crop -relief raised -command Crop
button .m.exit -text Quit -relief raised -command exit
pack .m.ref .m.crop .m.exit -side left
canvas .c -width $NX -height $NY -relief sunken 
pack .m .c

set baseImage [image create photo -file $projFile -palette 128]
.c create image 0 0 -anchor nw -image $baseImage

pack .c -side left
bind .c <1> {startRect %x %y}
bind .c <Button1-Motion> {stretchRect %x %y}
bind .c <ButtonRelease-1> {fixRect %x %y}
bind . <q> exit
bind . <x> exit
bind . <d> deleteRect
bind . <r> deleteRect
bind . <c> Crop

proc startRect {x y} {
  global holdX holdY cursorX cursorY Rectangle
  set holdX [.c canvasx $x]
  set holdY [.c canvasy $y]
  set cursorX $holdX
  set cursorY $holdY
  set box [rectBox]
  set nwx [lindex $box 0]
  set nwy [lindex $box 1]
  set sex [lindex $box 2]
  set sey [lindex $box 3]
  set Rectangle [.c create rectangle $nwx $nwy $sex $sey -outline blue]
}

proc stretchRect {x y} {
  global holdX holdY cursorX cursorY Rectangle box
  set cursorX [.c canvasx $x]
  set cursorY [.c canvasy $y]
  set box [rectBox]
  set nwx [lindex $box 0]
  set nwy [lindex $box 1]
  set sex [lindex $box 2]
  set sey [lindex $box 3]
  .c coords $Rectangle $nwx $nwy $sex $sey
}

proc fixRect {x y} {
  global Rectangle cropBox box
  stretchRect $x $y
  set cropBox $box
}

proc rectBox {} {
  global holdX holdY cursorX cursorY
  set nwx [expr ($cursorX < $holdX) ? $cursorX : $holdX]
  set nwy [expr ($cursorY < $holdY) ? $cursorY : $holdY]
  set sex [expr ($cursorX > $holdX) ? $cursorX : $holdX]
  set sey [expr ($cursorY > $holdY) ? $cursorY : $holdY]
  return [list $nwx $nwy $sex $sey]
}

proc deleteRect {} {
  global Rectangle
  .c delete $Rectangle
}

proc Crop {} {
  global cropBox sourceFile targetFile n1 n2
  set c1 [expr floor([lindex $cropBox 0])]
  set r1 [expr floor([lindex $cropBox 1])]
  set c2 [expr ceil([lindex $cropBox 2])]
  set r2 [expr ceil([lindex $cropBox 3])]
  catch {exec cropstack $sourceFile $c1 $r1 $n1 $c2 $r2 $n2 > $targetFile &} subrv
}