|
|
TCL
TCL is a script language, like PERL. TCL is avalaible for UNIX, Windows, even Machintosh.
puts "words";
puts (words};
set string "toto";
puts $string;
puts "this is $string"
|
words
(words}
toto
this is toto
|
set a "1";
set b "2";
puts "a=$a and b=$b";
set X [expr $a + $b];
puts "$X";
set X [expr 5+2];
puts "$X";
|
a=1 and b=2
3
7
|
set x "toto";
switch $x \
"ONE" "puts ONE=1" \
"TWO" "puts TWO=2" \
"default" "puts NO_MATCH";
|
NO_MATCH |
set x "toto";
switch $x \
"ONE" "puts ONE=1" \
"TWO" "puts TWO=2" \
"toto" "puts MATCH" \
"default" "puts NO_MATCH";
|
MATCH |
set x "1";
if {$x == 1} \
then \
{ \
puts "x=1"; \
} else { \
puts "x!=1"; \
}
|
x=1
|
set x "0";
while {$x < 10} \
{ \
puts "x = $x"; \
set x [expr $x+1]; \
}
|
x = 0
x = 1
x = 2
x = 3
x = 4
x = 5
x = 6
x = 7
x = 8
x = 9 |
for { set i "0"; } {$i < 10} {set i [expr $i+1];} \
{ puts "$i"; };
for { set i "0"; } {$i < 10} { incr i; } \
{ puts "$i"; };
|
0
1
2
3
4
5
6
7
8
9
0
1
2
3
4
5
6
7
8
9
|
proc toto {a b} \
{ \
set x [expr $a+$b]; \
return $x; \
};
set y [toto "33" "20"];
puts "$y";
|
53 |
proc toto { first args } \
{ \
puts "args = $args"; \
puts "first = $first"; \
};
puts "[toto a b c d]";
|
args means "variable number of arguments".
args = b c d
first = a |
proc toto { {first "11"} } \
{ \
puts "first = $first"; \
};
puts "[toto]";
puts "[toto 10]";
|
The {...} means "default value".
first = 11
first = 10 |
proc toto { x y } \
{ \
upvar $x pointer1 $y pointer2; \
set pointer1 "10"; \
set pointer2 "20"; \
};
proc print {} \
{ \
set y "22"; \
set z "12"; \
puts "y=$y z=$z"; \
toto y z; \
puts "y=$y z=$z"; \
}
print;
|
upvar $x var means that 'x' can be see as a C pointer.
y=22 z=12
y=10 z=20
|
set tab {a b c d};
set x [lindex $tab 2];
puts "$x";
|
lindex $tab 2 means "return the element that index is 2".
c |
set tab [split "el1.el2.el3" "."];
set x [lindex $tab 2];
puts "$x";
puts "[lindex $tab 1]";
|
split takes the string "el1.el2.el3" and extracts each elements separated by a ".". So the
string "el1.el2.el3" returns the list {el1 el2 el3}.
el3
el2 |
set tab [list "el1_" "el2_" "el3_"];
set x [lindex $tab 2];
puts "$x";
puts "[lindex $tab 1]";
|
list just creates a list.
el3_
el2_ |
set tab [list "el1_" "el2_" "el3_"];
set n "0";
foreach i $tab \
{ \
puts "$n: $i"; \
incr n; \
};
|
foreach takes each item of a list, one at the time.
0: el1_
1: el2_
2: el3_ |
set list1 [list a b c d];
set list2 [list "e1" "e2" "e3" "e4"];
set list3 [concat $list1 $list2];
puts "list3 = $list3";
|
list3 = a b c d e1 e2 e3 e4 |
set list3 [list a b c d "e1" "e2" "e3" "e4"];
lappend list3 {1 2} "toto"
puts "list3 = $list3";
|
list3 = a b c d e1 e2 e3 e4 {1 2} toto |
set list3 [list a b c d "e1" "e2" "e3" "e4" {1 2} "toto"];
set list4 [lreplace $list3 8 9 "el8" "el9"];
puts "list4 = $list4";
|
list4 = a b c d e1 e2 e3 e4 el8 el9 |
set list3 [list a b c d "e1" "e2" "e3" "e4" {1 2} "toto"];
set list5 [linsert $list3 4 "elem1 elem2"];
puts "list5 = $list5";
|
list5 = a b c d {elem1 elem2} e1 e2 e3 e4 {1 2} toto |
set list1 [list {toto est la} "e2" "e3" "e4"];
set zz [lsearch $list1 toto*];
puts "index of \"toto*\" = $zz";
puts "list1\[$zz\] = [lindex $list1 $zz]";
|
index of "toto*" = 0
list1[0] = toto est la |
set list1 [list {toto est la} "e2" "e3" "e4"];
set sorted [lsort $list1];
puts "$sorted";
|
e2 e3 e4 {toto est la} |
set list1 [list {toto est la} "e2" "e3" "e4"];
set cutted [lrange $list1 1 3];
puts "$cutted";
|
e2 e3 e4
|
set chaine "my string";
puts "the size of \"$chaine\" is [string length $chaine]";
puts "the character index 3 of \"$chaine\" is [string index $chaine 3]";
puts "chaine\[3..7\]: [string range $chaine 3 7]";
|
the size of "my string" is 9
the character index 3 of "my string" is s
chaine[3..7]: strin |
set s1 "toto1";
set s2 "toto2";
set s3 "toto2";
if { [string compare $s1 $s2] == 0} \
then \
{ \
puts "\"$s1\" equal \"$s2\""; \
} \
else \
{ \
puts "\"$s1\" not equal \"$s2\""; \
};
if { [string compare $s2 $s3] == 0} \
then \
{ \
puts "\"$s2\" equal \"$s3\""; \
} \
else \
{ \
puts "\"$s2\" not equal \"$s3\""; \
};
|
"toto1" not equal "toto2"
"toto2" equal "toto2" |
set ch "the computer is running for too long now - comp";
set m "comp";
set n [string first $m $ch];
puts "the match \"$m\" appears first at position $n";
|
the match "comp" appears first at position 4 |
set ch "the computer is running for too long now - comp";
set m "comp";
set n [string last $m $ch];
puts "the match \"$m\" appears last at position $n";
|
the match "comp" appears last at position 43 |
set ch "the computer is running for too long now - comp";
set m "comp";
set c [string wordend $ch 5];
puts "The index of the first character after word at index 5 is $c";
|
The index of the first character after word at index 5 is 12 |
set ch "the computer is running for too long now - comp";
set m "comp";
set c [string wordstart $ch 5];
puts "The index of the first character before word at index 5 is $c";
|
The index of the first character before word at index 5 is 4 |
set ch "the computer is running for too long now - comp";
set rc [string match "*computer*" $ch];
puts "rc = $rc";
if {$rc == 1} \
{ \
puts "string ch contains match \"computer\""; \
} \
else \
{ \
puts "string ch not contains match \"computer\""; \
};
|
string ch contains match "computer"
|
Open the file "c:\tmp\toto.txt" in read only mode.
Read the content of the file (and place it into the variable buff).
Then print buff and close the file.
set fd [open "c:/tmp/toto.txt" w];
set buff "exemple d'ecriture";
puts $fd "$buff"
close $fd;
|
Open the file "c:\tmp\toto.txt" in write mode only.
Write the content of the buffer buff into the file.
Then close the file.
|
set fd [open "com2" w];
set buff "exemple d'ecriture";
puts $fd "$buff"
close $fd;
|
com1 and com2 are connected with a null modem. The 2
serial ports have the same configuration (9600/8 bits/none/1 bits/none).
On com1 we open a terminal.
Open serial port "com2".
Write the content of the buffer buff into the port.
Then close the serial port. We can see the data on the terminal. |
set fd [open "com2" w];
fconfigure $fd -mode 9600,n,8,1
set buff "toto";
puts $fd $buff
close $fd;
|
Serial configuration:
- 9600 baud
- parity: none
- 8 bits data
- 1 stop bit
|
set fd [open "com2" r];
fconfigure $fd -mode 9600,n,8,1
set car [read $fd 1];
puts $car;
close $fd;
|
com1 and com2 are connected with a null modem. The 2
serial ports have the same configuration (9600/8 bits/none/1 bits/none).
On com1 we open a terminal.
Open serial port "com2" for reading.
read 1 character from the serial port.
Then close the serial port.
Note: it is very important to give the 2 serial ports the same setting. |
set fd [open "com2" r];
fconfigure $fd -mode 9600,n,8,1
set car "0"
while {$car != "s"} \
{ \
set car [read $fd 1]; \
puts $car; \
}
close $fd;
|
Same but with a "while" loop. |
|
|
|
Buttons
# global variables
set number "0"
# callback
proc bouton_proc {} \
{ \
global number; \
set number [expr $number + 1]; \
.bouton configure -text "$number"; \
}
# Tk GUI
button .bouton -text "$number" -command bouton_proc
pack .bouton
|
Each time you click on the button, the number value increases by 1. |
Buttons
# global variables
set number "0"
# callbacks
proc bouton_proc {} \
{ \
global number; \
set number [expr $number + 1]; \
.bouton configure -text "$number"; \
}
proc quit_proc {} \
{ \
destroy .button .quit; \
exit 0; \
}
# Tk GUI
button .bouton -text "$number" -command bouton_proc
button .quit -text "quit" -command quit_proc
pack .bouton .quit
|
When you press "quit" the application is destroyed. Note the a call to exit is enough. |
Color image with labels
#callbacks
proc quit_proc {} \
{ \
destroy .baner .quit; \
exit 0; \
}
# Tk GUI
image create photo map -file imag.gif
label .baner -image map
button .quit -text "quit" -command quit_proc
pack .baner .quit
|
 |
Color images and labels
# globals
set image_num "0";
#callbacks
proc quit_proc {} \
{ \
destroy .baner .quit .change; \
exit 0; \
}
proc change_proc {} \
{ \
global image_num;
if {$image_num == "0"} \
then \
{ \
.baner configure -image new_map; \
set image_num "1"; \
} \
else \
{ \
.baner configure -image map; \
set image_num "0"; \
} \
}
# Tk GUI
image create photo map -file imag.gif;
image create photo new_map -file new_imag.gif;
label .baner -image map;
button .change -text "change image" -command change_proc;
button .quit -text "quit" -command quit_proc;
pack .baner .quit .change;
|
Each time you click on "change image", you change the image.
 |
Color image and canvas
# globals
set image_num "0";
#callbacks
proc quit_proc {} \
{ \
destroy .baner .quit .change; \
exit 0; \
}
proc change_proc {} \
{ \
global image_num; \
if {$image_num == "0"} \
then \
{ \
set image_num "1"; \
.baner delete image_1; \
.baner create image 50 25 -image \
new_map -tag image_2; \
} \
else \
{ \
set image_num "0"; \
.baner delete image_2; \
.baner create image 75 30 -image \
map -tag image_1; \
} \
}
# Images (items for the canvas)
image create photo map -file imag.gif;
image create photo new_map -file new_imag.gif;
# create the canvas and associate the items
# The identifier 'image_1' represents the image 'map'. Identifiers are
# used to access each part of the canvas.
# Note that the "origine" of the image is the center of the image (not
# the upper left coner !).
canvas .baner -width 150 -height 100;
.baner create image 75 30 -image map -tag image_1;
button .change -text "change image" -command change_proc;
button .quit -text "quit" -command quit_proc;
pack .baner .quit .change;
|
When you press the button "change image" the content of the canvas is modified.
 |
Interacting with the canvans (moving tags)
# globals
set image_num "0";
set x_line_1 "75";
#callbacks
proc quit_proc {} \
{ \
destroy .baner .quit .change .left . \
exit 0; \
}
proc change_proc {} \
{ \
global image_num; \
if {$image_num == "0"} \
then \
{ \
set image_num "1"; \
.baner delete image_1; \
.baner create image 50 25 -image \
new_map -tag image_2; \
} \
else \
{ \
set image_num "0"; \
.baner delete image_2; \
.baner create image 75 30 -image \
map -tag image_1; \
} \
}
proc left_proc {} \
{ \
global x_line_1;
.baner delete line_1; \
set x_line_1 [expr $x_line_1 + 3]; \
.baner create line $x_line_1 0 \
$x_line_1 60 -smooth on \
-fill black -tag line_1; \
}
# create canvas tags
# - Images items for the canvas
image create photo map -file imag.gif;
image create photo new_map -file new_imag.gif;
# create the canvas and associate the items
# The identifier 'image_1' represents the image 'map'. Identifiers are
# used to access each part of the canvas.
# Note that the "origine" of the image is the center of the image (not
# the upper left coner !).
canvas .baner -width 150 -height 100;
.baner create image 75 30 -image map -tag image_1;
.baner create line 75 0 75 60 -smooth on -fill black -tag line_1
.baner create line 0 30 150 30 -smooth on -fill black -tag line_2
button .change -text "change image" -command change_proc;
button .left -text "left" -command left_proc;
button .quit -text "quit" -command quit_proc;
pack .baner .quit .change .left;
|
Same as previous but when you click on the buuton "left", the vertical line
moves to the left.
 |
Background procedure
# globals
set image_num "0";
set x_line_1 "75";
#callbacks
proc quit_proc {} \
{ \
destroy .baner .quit .left . \
exit 0; \
}
proc left_proc {} \
{ \
global x_line_1;
.baner delete line_1; \
set x_line_1 [expr $x_line_1 + 3]; \
.baner create line $x_line_1 0 \
$x_line_1 60 -smooth on \
-fill black -tag line_1; \
after 1000 left_proc; \
}
proc stop_proc {} \
{ \
after cancel left_proc; \
}
# create canvas tags
# - Images items for the canvas
image create photo map -file imag.gif;
# create the canvas and associate the items
# The identifier 'image_1' represents the image 'map'. Identifiers are
# used to access each part of the canvas.
# Note that the "origine" of the image is the center of the image (not
# the upper left coner !).
canvas .baner -width 150 -height 100;
.baner create image 75 30 -image map -tag image_1;
.baner create line 75 0 75 60 -smooth on -fill black -tag line_1
button .left -text "left" -command left_proc;
button .stop -text "stop" -command stop_proc;
button .quit -text "quit" -command quit_proc;
pack .baner .quit .left .stop;
|
When you press "left" the vertical line begins to move to the left and it
keeps going until you press "stop".
 |
Scrollbars and geometry managers
# globals
set image_num "0";
#callbacks
proc quit_proc {} \
{ \
destroy .baner \
.quit \
.scroll_y \
.scroll_x \
. \
exit 0; \
}
# Laod map and get properties (used to center the image)
image create photo map -file pays.gif;
set border 20
set max_x [image width map];
set max_y [image height map];
set pos_x [expr $max_x / 2 - [expr $border / 2]];
set pos_y [expr $max_y / 2 - [expr $border / 2]];
set canvas_width [expr $max_x + [expr $border / 2]];
set canvas_height [expr $max_y + [expr $border / 2]];
set Scrolling_Win "-30/-30/$canvas_width/$canvas_height"
# Create scrollbars and apply them to the canvas
scrollbar .scroll_x -command ".baner xview" -orient horizontal;
scrollbar .scroll_y -command ".baner yview" -orient vertical;
canvas .baner -relief sunken -borderwidth 2 \
-width [expr $max_x + 10] \
-height [expr $max_y + 10] \
-scrollregion [split $Scrolling_Win /] \
-xscrollcommand ".scroll_x set" \
-yscrollcommand ".scroll_y set";
# apply the map into the canvas
.baner create image "$pos_x" "$pos_y" -image map -tag image_1;
button .quit -text "quit" -command quit_proc;
label .hauteur -text "$max_x x $max_y";
pack .quit -side bottom;
pack .scroll_y -side right -fill y;
pack .scroll_x -fill x;
pack .hauteur;
pack .baner;
pack .hauteur;
|
 |
Serial port and timer
set fd [open "com2" r];
fconfigure $fd -mode 9600,n,8,1
proc quit_proc {} \
{ \
global fd; \
after cancel Read_Com; \
close $fd; \
destroy .text \
.quit \
.screen \
.; \
exit 0;
}
proc Read_Com {} \
{ \
global fd; \
set car "0"; \
set car [read $fd 1]; \
.text configure -text "$car"; \
puts $car; \
update; \
after 1000 Read_Com;
}
button .quit -text "quit" -command quit_proc;
button .text -text "read" -command Read_Com;
label .screen -text "data";
pack .quit .text .screen;
|
com1 and com2 are connected with a
null modem. The 2 serial ports have the
same configuration (9600/8 bits/none/1
bits/none). On com1 we open a terminal.
If you click on "read" it opens the serial port "com2" for reading.
Then it reads 1 character from the serial port every second.
Keep in mind that the serial line is configured in "blocking mode": if
there is no character to read, then the read operation blocks the process.
The "update" command forces the refresh of the screen.
|
|
