CS118 Programming Languages

Lecture 15

Contents

1. Tcl/Tk
2. Tcl Examples
3. Tk Examples
4. Assignments

Tcl/Tk

• Origins -- too many cheap scripting interfaces
• The tail that wagged the Ousterhout
• Callable from C
• Standalone (wish tclsh)
• Extremely simple syntax and rules
• Gives easy access to X windows

Tcl Documentation

• Osterhaut, Tcl and the Tk Toolkit
• help not very helpful in tcl, try man in linux

tcl> help lreplace

linux-prompt> man lreplace

Tcl Examples

# FILE:    anExpr.tcl
# PURPOSE: simple tcl expression demo
set a 13.0
puts [expr -$a*13/2] 
# ! ~ * / % + - << >> < > <= >= == != & | ^ && || ?:
# abs acos asin atan atan2 ceil cos cosh double exp floor fmod
# hypot int log log10 pow round sin sinh sqrt tan tanh

# FILE:    lists.tcl
# PURPOSE: demo tcl list constructs

set list1 "a b c";                       # a b c
set list2 {x y z};                       # x y z
puts  [concat $list1 m n o $list2];      # a b c m n o x y z
puts  " $list1 m n o $list2 ";           # a b c m n o x y z
puts  { $list1 m n o $list2 };           # $list1 m n o $list2     
set p {a {b {c} d} e};
puts  $p;                                # a {b {c} d} e
puts  [lindex $p 1];                     # b {c} d
puts  [lreplace $p 1 1 17];              # b 17 d 
puts  [lsearch [lreplace $p 1 1 17] 17]; # 1
set p [split "a;b;c,d;e;f;g" ",;"];    
puts  $p;                                # a b c d e f g
puts  [lsort -decreasing $p];            # g f e d c b a

# FILE:    control.tcl
# PURPOSE: demo tcl control constructs

# paragraphing not optional here
if {1<2} {
  puts 1;                    # 1
} else {
  puts 2
}
# break continue eval for foreach source switch while

set cmd "set a 0"
eval $cmd
puts $a;                     # 0
unset a
puts $a;                     # error

# FILE:    procs.tcl
# PURPOSE: demo tcl proc definition and use

# paragraphing not optional here
if {1<2} {
  proc f {a b} {expr $a + $b}
} else {
  proc f "a b" {expr $a - $b}
}

puts [f 3 4];                   # 7

# FILE:    strings.tcl
# PURPOSE: demo tcl strings

set p "abbbbc"

puts [regsub -all b $p x r];    # 4

puts $r;                        # axxxxc

puts [regsub b+ $p x r];        # 1

puts $r;                        # axc

puts [string compare $r $p];    # 0

# string 
#    compare first index last length match range 
#    tolower toupper trim trimleft trimright

Tk Examples

#!/usr/local/bin/wish -f
# FILE:    hello.tcl
# PURPOSE: simple Tk demo

button .b -text "Hello World!" -background red -command exit
pack .b

#!/usr/local/bin/wish -f
# FILE:    labels.tcl
# PURPOSE: label demo

set tk_library /usr/contrib/lib/tk8.0
label .bitmap -bitmap @$tk_library/demos/images/flagdown.bmp
label .text -text "No new mail"
pack .bitmap .text;                  # implicit -side down

#!/usr/local/bin/wish -f
# FILE:    buttons.tcl
# PURPOSE: button detail demo

set pushed 0
foreach relief {raised sunken flat groove ridge} {
  button .$relief -width 6 -height 4 -relief $relief \
        -borderwidth 4 -text $relief
  pack .$relief -side left -padx 2 -pady 2
}

.flat configure -background black

.sunken configure -command {
  if {$pushed} {
    .sunken configure -background blue
  } else {
    .sunken configure -background red
  }
  set pushed [expr ! $pushed]
}

#!/usr/local/bin/wish -f
# FILE:    scroll.tcl
# PURPOSE: scrollbar demo

set states {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
           "West Virginia" Washington Wisconsin Wyoming}


listbox   .states -yscrollcommand ".sb set"
label     .lab    -text "List of States"
scrollbar .sb     -command ".states yview"

foreach s $states {
   .states insert end $s
}

pack .lab   -side top -fill x
pack .sb    -side right -fill y
pack .states

Finally, we get a start on a chessboard implementation. It should look nice and you should be able to move pieces around. You will get to finish it.