---

---

---

---

---

• Impression
• Math
• Tests
• Boucles
• Fonctions
• Listes
• Chaînes de caractères
• Fichier
• Le port série
• Les widgets

puts "words"; puts (words}; set string "toto"; puts $string; puts "this is $string"

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";

set x "toto"; switch $x \ "ONE" "puts ONE=1" \ "TWO" "puts TWO=2" \ "default" "puts NO_MATCH";

set x "toto"; switch $x \ "ONE" "puts ONE=1" \ "TWO" "puts TWO=2" \ "toto" "puts MATCH" \ "default" "puts NO_MATCH";

set x "1"; if {$x == 1} \ then \ { \ puts "x=1"; \ } else { \ puts "x!=1"; \ }

set x "0"; while {$x < 10} \ { \ puts "x = $x"; \ set x [expr $x+1]; \ }

for { set i "0"; } {$i < 10} {set i [expr $i+1];} \ { puts "$i"; }; for { set i "0"; } {$i < 10} { incr i; } \ { puts "$i"; };

proc toto {a b} \ { \ set x [expr $a+$b]; \ return $x; \ }; set y [toto "33" "20"]; puts "$y";

proc toto { first args } \ { \ puts "args = $args"; \ puts "first = $first"; \ }; puts "[toto a b c d]";

proc toto { {first "11"} } \ { \ puts "first = $first"; \ }; puts "[toto]"; puts "[toto 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;

set tab {a b c d}; set x [lindex $tab 2]; puts "$x";

set tab [split "el1.el2.el3" "."]; set x [lindex $tab 2]; puts "$x"; puts "[lindex $tab 1]";

set tab [list "el1_" "el2_" "el3_"]; set x [lindex $tab 2]; puts "$x"; puts "[lindex $tab 1]";

set tab [list "el1_" "el2_" "el3_"]; set n "0"; foreach i $tab \ { \ puts "$n: $i"; \ incr n; \ };

set list1 [list a b c d]; set list2 [list "e1" "e2" "e3" "e4"]; set list3 [concat $list1 $list2]; puts "list3 = $list3";

set list3 [list a b c d "e1" "e2" "e3" "e4"]; lappend list3 {1 2} "toto" puts "list3 = $list3";

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";

set list3 [list a b c d "e1" "e2" "e3" "e4" {1 2} "toto"]; set list5 [linsert $list3 4 "elem1 elem2"]; puts "list5 = $list5";

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]";

set list1 [list {toto est la} "e2" "e3" "e4"]; set sorted [lsort $list1]; puts "$sorted";

set list1 [list {toto est la} "e2" "e3" "e4"]; set cutted [lrange $list1 1 3]; puts "$cutted";

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]";

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\""; \ };

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";

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";

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";

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";

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\""; \ };

set fd [open "c:/tmp/toto.txt" 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]; set buff "exemple d'ecriture"; puts $fd "$buff" close $fd;

# Serial configuration: # * 9600 baud # * parity: none # * 8 bits data # * 1 stop bit set fd [open "com2" w]; fconfigure $fd -mode 9600,n,8,1 set buff "toto"; 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" 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 [read $fd 1]; puts $car; close $fd;

# Same but with a "while" loop. 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

Les boutons

# 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

# 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

Les images

#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

# 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;

Les 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;

# 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;

Procédures en tâche de fond

# 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;

Barres de défilement et gestionnaire géométrique

# 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;

Ports séries et horloges

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;

---

---

---

---

---