Tcl

1
2
3
#!/usr/bin/tclsh

puts "Hello World" ;# This is a comment

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#!/usr/bin/tclsh

set money 1900
puts "money is = $money"
puts {money is = $money}

set a 10
set b [expr $a + 5]
puts "==a is $a===b is $b=="

unset a
puts "==a is $a===b is $b=="

if {![info exists a]}{
  set a 50
}
  incr a
puts "==a is $a===b is $b=="

1
2
3
4
5
6
7
8
9
10
#!/usr/bin/tclsh

set x 1
if {$x != 1} {
  puts "$x is != 1"
} elseif {$x == 2} {
  puts "$x is 2"
} else {
  puts "$x is 1"
}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
#!/usr/bin/tclsh

set i 0
while {$i < 100} {
  incr i
  if {$i == 85} {
    puts "Now $i is 85"
    continue
  } elseif {$i == 90} {
    puts "I am getting out of the loop at i=$i"
    break
  } else {
    puts "I am at count $i"
  }
}

1
2
3
4
5
6
7
8
#!/usr/bin/tclsh

# for upcounting
for {set i 0} {$i < 10} {incr i} {
  puts "I am at count $i and going up"
  after 200
  update
}

1
2
3
4
5
6
7
8
#!/usr/bin/tclsh

# for down counting / decrement by 1
for {set i 20 } {$i > 0} {incr i-1} {
  puts "I am at count $i and going down"
  after 200
  update
}

1
2
3
4
5
6
7
8
#!/usr/bin/tclsh

# for increment other than 1
for {set i 0 } {$i < 100} {incr i 5} {
  puts "I am at count $i and going up"
  after 200
  update
}

1
2
3
4
5
6
7
#!/usr/bin/tclsh

foreach col {red orange yellow green blue purple} {
  puts $col
  after 200
  update
}

1
2
3
4
5
6
7
8
9
10
11
#!/usr/bin/tclsh

# defining a list separately
set listColors "red orange yellow green blue purple"
foreach col $listColors {
  puts $col
  after 200
  update
}

# Remarks: List can be list of nets in VLSI: set ListOfNets [getallnets *clk*]

1
2
3
4
5
6
7
8
#!/usr/bin/tclsh

set tclfiles [glob *.tcl]
foreach fileName $tclfiles {
  puts "file = $fileName"
}

# Remarks: This may be used to list files and operate or source them in VLSI

1
2
3
4
5
6
7
8
9
10
11
12
13
#!/usr/bin/tclsh

set listColors {red orange yellow green blue purple}
set listFoods {apple orange banana lime berry grape}
set status "ok bad ok ok bad bad"

foreach {a b c} $listColors {
  puts "c is $c--b is $b--a is $a"
  after 300
  update
}

# Remarks: This may be used as a look up table

1
2
3
4
5
6
7
8
9
10
11
12
#!/usr/bin/tclsh

set no_of_edge 3
switch $no_of_edge {
  0 -
  1 -
  2 -
  3 {puts "This is a 3"}
  4 {puts "This is a 4"}
  5 {puts "This is a 5"}
  default {puts "This is a default"}
}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
#!/usr/bin/tclsh

proc add {a b} {
  return [expr $a + $b]
}

set sum [add 5 8]
puts "\n===sum is $sum"

proc separator {} {
  puts "================================"  
}

separator

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
#!/usr/bin/tclsh

set a 2
set b 3
set c 4
puts "\n===a is $a===b is $b===c is $c"

porc var_scope {}{
  global a
  set a 20
  set ::b 30
  set c 100
}

var_scope
puts "\n===a is $a===b is $b===c is $c"

# Results:
# ===2===3===4
# ===20===30===4

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#!/usr/bin/tclsh

proc SetPositive {variable value} {
  upvar $variable myvar
  if {$value < 0} {
    set myvar [expr {-$value}]
  } else {
    set myvar $value  
  }
  return 1
}

SetPositive x 5
SetPositive y -15
puts "X: $x  Y: $y\n"

# Results:
# X: 5  Y: 15

1
2
3
4
5
set myList [list a b c]
set myList "a b c"
set myList {a b c}
set myList [list $a $b $c]
set myList {$a $b $c}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
#!/usr/bin/tclsh

set myList [split "/home/lchen/script/tcl_test" "/"]
puts $myList

set lst [list 0 1 2 3 4 5 6 7]
puts $lst
puts [lindex $lst 3]

set lst2 [concat $lst {8 9 10}]
puts $lst2
lappend lst2 11 12 13 14
puts $lst2
lset lst2 end 15
puts $lst2
set len [llength $lst2]
puts "\n===length of lst2 is $len"

set lst2 [lsort -ascii $lst2]
puts $lst2
set lst2 [lsort -integer $lst2]
puts $lst2
set lst2 [lsort -integer -decreasing $lst2]
puts $lst2
set lst2 [lsort -dictionary $lst2]
puts $lst2

set rlst "0.01 0.002 0.2 9.345 2.387"
set rlst [lsort -real $rlst]
puts $rlst
set rlst [lsort -real -decreasing $rlst]
puts $rlst

# Results:
# home lchen script tcl_test
# 0 1 2 3 4 5 6 7
# 3
# 0 1 2 3 4 5 6 7 8 9 10
# 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
# 0 1 2 3 4 5 6 7 8 9 10 11 12 13 15
#
# ===length of lst2 is 15
# 0 1 10 11 12 13 15 2 3 4 5 6 7 8 9
# 0 1 2 3 4 5 6 7 8 9 10 11 12 13 15
# 15 13 12 11 10 9 8 7 6 5 4 3 2 1
# 0 1 2 3 4 5 6 7 8 9 10 11 12 13 15
# 0.002 0.01 0.2 2.387 9.345
# 9.345 2.387 0.2 0.01 0.002

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
#!/usr/bin/tclsh

set x "a b c"
puts "Item at index 2 of the list {$x} is: [lindex $x 2]\n"

set i 0
foreach j $x {
  puts "$j is item number $i in list x"
  incr i
}

# Results:
# Item at index 2 of the list {a b c} is: c
# a is item number 0 in list x
# b is item number 1 in list x
# c is item number 2 in list x

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
#!/usr/bin/tclsh

set testList "a b c"
# Accessing the elements by index
puts [lindex $testList 0]
puts [lindex $testList end]
lappend testList "d" ;# entry from RHS
puts $testList
set testList [linsert $testList 0 "e"] ;# entry from LHS
puts $testList
# Replace a single element
set testList [lreplace $testList 2 2 "k"]
puts $testList
set testList [lreplace $testList end end "i"]
puts $testList

# Results:
# a
# c
# a b c d
# e a b c d
# e a k c d
# e a k c i

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
#!/usr/bin/tclsh

set b [list a b {c d e} {f {g h}}]
puts "$b\n"
set b [split "a b {c d e} {f {g h}}"]
puts "$b\n"

set a [concat a b {c d e} {f {g h}}]
puts "$a\n"
lappend a {ij K lm}
puts "$a\n"

set b [linsert $a 3 "1 2 3"]
puts "$b\n"
set b [lreplace $b 3 5 "AA" "BB"]
puts "$b\n"

# Results:
# a b {c d e} {f {g h}} 
# a b \{c d e\} \{f \{g h\}\}
# a b c d e f {g h} 
# a b c d e f {g h} {ij K lm}
# a b c {1 2 3} d e f {g h} {ij K lm}
# a b c AA BB f {g h} {ij K lm}

1
2
3
4
5
6
7
8
9
10
11
12
13
#!/usr/bin/tclsh

set jlst [list a b c [list k l m] p q [list r w]]
puts $jlst
puts [lindex $jlst 3]
puts [lindex $jlst 6]
puts [lindex [lindex $jlst 6] 1]

# Results:
# a b c {k l m} p q {r w}
# k l m
# r w
# w

1
2
3
4
5
6
7
8
9
10
11
#!/usr/bin/tclsh

# positive or 0 return val for existing element
# negative return val=-1 for the non-existing elements
set lst {apple app ban banna c carrot}
puts [lsearch $lst "app"]
puts [lsearch $lst "ap"]

# Results:
# 1
# -1

1
2
3
4
5
6
7
8
9
10
11
12
#!/usr/bin/tclsh

set color(rose) red
set color(sky) blue
set color(medal) gold
set color(leaves) green
set color(board) black

# Accessing the array elements
foreach ele [array names color] {
  puts "\n$ele is $color($ele)"
}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
#!/usr/bin/tclsh

array set colorobject {
  rose red
  sky blue
  medal gold
  leaves green
  board black
}

# Accessing the array elements
foreach {obj col} [array get colorobject] {
  puts "\n$obj is $colorobject($obj)"
  puts "\n$obj is $col"
}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
#!/usr/bin/tclsh

array set colorcount {
  red 1
  green 5
  blue 4
  white 9
}

set lst [list red green yellow pink white]

foreach col $lst {
  catch {info exists $colorcount($col)} ret
  if {0==$ret} {
    puts "\n EXIST==$col is $colorcount($col)"
  }  else {
    puts "\n NOT EXIST==$col"  
  }
}

# Remarks: We can use such data structure when we are iterating a perticular design stage again & again for eradicating errors

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
#!/usr/bin/tclsh

array set colorcount {
  red 1
  green 5
  blue 4
  white 9
}

set h2l [array get colorcount]
puts ">>> $h2l"
array set l2h $h2l
foreach {obj col} [array get l2h] {
  puts "\n #### $obj is $l2h($obj)"  
}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#!/usr/bin/tclsh

set FT [dict create .txt Text .jpg Image .zip ZipArchive .doc Document]

# adding additional key-value pairs
dict set FT .mp3 Music
dict set FT .avi Video

# using dict-for loop: special for loop for dictionaries ONLY
dict for {ext desc} $FT {
  puts "\n$desc file have extn: $ext"
}

puts "=========lets now use foreach=========="
foreach {ext desc} $FT {
  puts "\n$desc file have extn: $ext"
}

set lst [list .txt .ogg .rar .doc]
# Checking the exsistance of a Key
foreach ele $lst {
  puts "checking for $ele ===> \n"
  if {[dict exists $FT $ele]} {
    puts "\t Key==$ele exsists"
  } else {
      puts "\t Key==$ele NOT exsists"
    }
}

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
#!/usr/bin/tclsh

# Creation of Complex Data Structure
# Data for one employee
dict set EmployeeInfo 12345-A forenames "Joe"
dict set EmployeeInfo 12345-A surname "Schmoe"
dict set EmployeeInfo 12345-A street "147 Short Street"
dict set EmployeeInfo 12345-A city "Springfield"
dict set EmployeeInfo 12345-A phone "555-1234"
# Date for another employee
dict set EmployeeInfo 67890-J forenames "Anne"
dict set EmployeeInfo 67890-J surname "Walker"
dict set EmployeeInfo 67890-J street "995 Oakdale Way"
dict set EmployeeInfo 67890-J city "Springfield"
dict set EmployeeInfo 67890-J phone "555-8765"

# Print employee info
set i 0
puts "There are [dict size $EmployeeInfo] employees"
dict for {id info} $EmployeeInfo {
  puts "employee #[incr i]: $id"
  dict with info {
    puts "Name: $forenames $surname"
    puts "Address: $street $city"
    puts "Telephone: $phone"
  }
}

# Another Direct Way to iterate and pick out name
foreach id [dict keys $EmployeeInfo] {
  set name [dict get $EmployeeInfo $id forenames]
  set surn [dict get $EmployeeInfo $id surname]
}
puts "Hello $name $surn"

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#!/usr/bin/tclsh

set statement "Fan is a student"
puts $statement
set statement [string trim $statement]
puts $statement
puts [string length $statement]
puts [string index $statement 4]
puts [string index $statement end]
puts [string first "is" $statement]
puts [string last "is" $statement]
puts [string first $statement "is"]
puts [string range $statement 4 end]
puts [string replace $statement 9 end "processor"]
puts [string match "*stud*" $statement]

# Results:
# Fan is a student
#Fan is a student 
# 16
# i
# t
# 4
# 4
# -1
# is a student
# Fan is a professor
# 1

1
2
3
4
5
6
7
8
9
10
#!/usr/bin/tclsh

set myStr "A quick brown fox jumped over a brown lazy dog"

# use regexp to pattern match
if {[regexp -nocase "brown" $myStr]} {
  puts "Match found in \"$myStr\"... and replacing"
  regsub -nocase -all "brown" $myStr "REPLACED" myStr
  puts ""
}

1
2
3
4
5
6
7
8
9
#!/usr/bin/tclsh

set res "A quick brown fox jumped over a brwn lazy dog"

foreach ele $res {
  if {[regexp {b.*n} $ele]} {
    puts "$ele"
  }
}

1
2
3
4
5
6
7
8
9
#!/usr/bin/tclsh

set sample "Where there is a will, There is a way."

set result [regexp {[a-z]+} $sample match]
puts "match_status<$result> matched string: <$match>"

set result [regexp {([A-Za-z]+) +([a-z]+)} $sample match sub1 sub2]
puts "match_status<$result> matched string: <$match> 1st_string: <$sub1> 2nd_string: <$sub2>"

1
2
3
4
5
6
7
8
#!/usr/bin/tclsh

set sample "Where there is a will, There is a way."

regsub "way" $sample "abundance" sample2
puts "Old_string: $sample \nNew_string: $sample2"

puts "Number of matching words: [regexp -all {[^ ]+} $sample]"

1
2
3
4
5
6
7
8
9
10
11
12
13
14
#!/usr/bin/tclsh

set fRead [open infile.txt r]
set fWrite [open outfile.txt w]

while {![eof $fRead]} { ;# eof: end of file
  set line [gets $fRead]
  set line [string trimright $line "\n"] ;# ??? 
  puts "$line"
  set line [string toupper $line]
  puts $fWrite $line
}
close $fRead
close $fWrite

1
2
3
4
5
6
7
8
#!/usr/bin/tclsh

set Script {
  set Number1 11
  set Number2 34
  set Result [expr $Number1 + $Number2]
}
eval $Script ;# eval ???