I have an array in tcl.
For example:
set a(1) "First element"
set a(2) "second element"
parray a
parray a displays output as
a(1) = "First element"
a(2) = "second element"
Is it possible to redirect the parray output to a file?
The parray command can't be redirected. It's a simple-minded procedure that is too stupid to be redirected. But it's source code isn't very long; in fact, it's short enough that I'll just paste it here (it's under the Tcl license):
proc parray {a {pattern *}} {
upvar 1 $a array
if {![array exists array]} {
return -code error "\"$a\" isn't an array"
}
set maxl 0
set names [lsort [array names array $pattern]]
foreach name $names {
if {[string length $name] > $maxl} {
set maxl [string length $name]
}
}
set maxl [expr {$maxl + [string length $a] + 2}]
foreach name $names {
set nameString [format %s(%s) $a $name]
puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
}
}
Redirecting it (hint: change the stdout for something obtained from open … a, and don't forget to close it afterwards) should be a simple exercise.
This builds on the answers by Dinesh and Donal Fellows: You could adapt the code of parray automatically, like this:
auto_load parray
proc printArray {a {pattern *} {channel stdout}} \
[string map {stdout $channel} [info body parray]]
This gives you a new proc printArray with an optional channel argument.
Related
I'm coding TCL and I would like to split a file into two lists of lists,
the file contain:
(1,2) (3,4) (5,6)
(7,8) (9,10) (11,12)
and I would like to get two list
one for each line, that contain lists that each one contain to two number
for example:
puts $list1 #-> {1 2} {3 4} {5 6}
puts [lindex $list1 0] #-> 1 2
puts [lindex $list2 2] #-> 11 12
I tried to use regexp and split but no success
The idea of using regexp is good, but you'll need to do some post-processing on its output.
# This is what you'd read from a file
set inputdata "(1,2) (3,4) (5,6)\n(7,8) (9,10) (11,12)\n"
foreach line [split $inputdata "\n"] {
# Skip empty lines.
# (I often put a comment format in my data files too; this is where I'd handle it.)
if {$line eq ""} continue
# Parse the line.
set bits [regexp -all -inline {\(\s*(\d+)\s*,\s*(\d+)\s*\)} $line]
# Example results of regexp:
# (1,2) 1 2 (3,4) 3 4 (5,6) 5 6
# Post-process to build the lists you really want
set list([incr idx]) [lmap {- a b} $bits {list $a $b}]
}
Note that this is building up an array; long experience says that calling variables list1, list2, …, when you're building them in a loop is a bad idea, and that an array should be used, effectively giving variables like list(1), list(2), …, as that yields a much lower bug rate.
An alternate approach is to use a simpler regexp and then have scan parse the results. This can be more effective when the numbers aren't just digit strings.
foreach line [split $inputdata "\n"] {
if {$line eq ""} continue
set bits [regexp -all -inline {\([^()]+\)} $line]
set list([incr idx]) [lmap substr $bits {scan $substr "(%d,%d)"}]
}
If you're not using Tcl 8.6, you won't have lmap yet. In that case you'd do something like this instead:
foreach line [split $inputdata "\n"] {
if {$line eq ""} continue
set bits [regexp -all -inline {\(\s*(\d+)\s*,\s*(\d+)\s*\)} $line]
set list([incr idx]) {}
foreach {- a b} $bits {
lappend list($idx) [list $a b]
}
}
foreach line [split $inputdata "\n"] {
if {$line eq ""} continue
set bits [regexp -all -inline {\([^()]+\)} $line]
set list([incr idx]) {}
foreach substr $bits {
lappend list($idx) [scan $substr "(%d,%d)"]
# In *very* old Tcl you'd need this:
# scan $substr "(%d,%d)" a b
# lappend list($idx) [list $a $b]
}
}
You have an answer already, but it can actually be done a little bit simpler (or at least without regexp, which is usually a good thing).
Like Donal, I'll assume this to be the text read from a file:
set lines "(1,2) (3,4) (5,6)\n(7,8) (9,10) (11,12)\n"
Clean it up a bit, removing the parentheses and any white space before and after the data:
% set lines [string map {( {} ) {}} [string trim $lines]]
1,2 3,4 5,6
7,8 9,10 11,12
One way to do it with good old-fashioned Tcl, resulting in a cluster of variables named lineN, where N is an integer 1, 2, 3...:
set idx 0
foreach lin [split $lines \n] {
set res {}
foreach li [split $lin] {
lappend res [split $li ,]
}
set line[incr idx] $res
}
A doubly iterative structure like this (a number of lines, each having a number of pairs of numbers separated by a single comma) is easy to process using one foreach within the other. The variable res is used for storing result lines as they are assembled. At the innermost level, the pairs are split and list-appended to the result. For each completed line, a variable is created to store the result: its name consists of the string "line" and an increasing index.
As Donal says, it's not a good idea to use clusters of variables. It's much better to collect them into an array (same code, except for how the result variable is named):
set idx 0
foreach lin [split $lines \n] {
set res {}
foreach li [split $lin] {
lappend res [split $li ,]
}
set line([incr idx]) $res
}
If you have the results in an array, you can use the parray utility command to list them in one fell swoop:
% parray line
line(1) = {1 2} {3 4} {5 6}
line(2) = {7 8} {9 10} {11 12}
(Note that this is printed output, not a function return value.)
You can get whole lines from this result:
% set line(1)
{1 2} {3 4} {5 6}
Or you can access pairs:
% lindex $line(1) 0
1 2
% lindex $line(2) 2
11 12
If you have the lmap command (or the replacement linked to below), you can simplify the solution somewhat (you don't need the res variable):
set idx 0
foreach lin [split $lines \n] {
set line([incr idx]) [lmap li [split $lin] {
split $li ,
}]
}
Still simpler is to let the result be a nested list:
set lineList [lmap lin [split $lines \n] {
lmap li [split $lin] {
split $li ,
}
}]
You can access parts of the result similar to above:
% lindex $lineList 0
{1 2} {3 4} {5 6}
% lindex $lineList 0 0
1 2
% lindex $lineList 1 2
11 12
Documentation:
array,
foreach,
incr,
lappend,
lindex,
lmap (for Tcl 8.5),
lmap,
parray,
set,
split,
string
The code works for windows :
TCL file code is :
proc captureImage {} {
#open the image config file.
set configFile [open "C:/main/image_config.txt" r]
#To retrive the values from the config file.
while {![eof $configFile]} {
set part [split [gets $configFile] "="]
set props([string trimright [lindex $part 0]]) [string trimleft [lindex $part 1]]
}
close $configFile
set time [clock format [clock seconds] -format %Y%m%d_%H%M%S]
set date [clock format [clock seconds] -format %Y%m%d]
#create the folder with the current date
set folderPath $props(folderPath)
append folderDate $folderPath "" $date "/"
set FolderCreation [file mkdir $folderDate]
while {0} {
if { [file exists $date] == 1} {
}
break
}
#camera selection to capture image.
set camera "video"
append cctv $camera "=" $props(cctv)
#set the image resolution (XxY).
set resolutionX $props(resolutionX)
set resolutionY $props(resolutionY)
append resolution $resolutionX "x" $resolutionY
#set the name to the save image
set imagePrefix $props(imagePrefix)
set imageFormat $props(imageFormat)
append filename $folderDate "" $imagePrefix "_" $time "." $imageFormat
set logPrefix "Image_log"
append logFile $folderDate "" $logPrefix "" $date ".txt"
#ffmpeg command to capture image in background
exec ffmpeg -f dshow -benchmark -i $cctv -s $resolution $filename >& $logFile &
after 3000
}
}
captureImage
thext file code is :
cctv=Integrated Webcam
resolutionX=1920
resolutionY=1080
imagePrefix=ImageCapture
imageFormat=jpg
folderPath=c:/test/
//camera=video=Integrated Webcam,Logitech HD Webcam C525
This code works for me me accept the code from text file were list of parameters are passed.
I have a file having following data
Anny : dancing
Sonny : reciting
Joel : dancing
Anny : reciting
Anny : singing
I want the following o/p in tcl:
Anny -
singing 1
dancing 1
reciting 1
Joel -
dancing 1
I want to print in this format along with their count.
Working with Donal's answer, but using a single dictionary instead of an array of dictionaries:
set data [dict create]
set f [open yourinputfile.txt r]
while {[gets $f line] != -1} {
if {[scan $line "%s : %s" who what] == 2} {
dict update data $who activities {
dict incr activities $what
}
}
}
close $f
dict for {who activities} $data {
puts "$who -"
dict for {what count} $activities {
puts "$what $count"
}
puts ""
}
This is really about counting words, so we're going to be dealing with dictionaries — dict incr is a perfect tool for this — but you also need to do a bit of parsing. Parsing is done in many ways, but in this case scan can do what we want easily. (Remember when reading my code that the result of scan is the number of fields that it managed to satisfy.)
set f [open "yourinputfile.txt"]
set data [split [read $f] "\n"]
close $f
# Peel apart that data
foreach line $data {
if {[scan $line "%s : %s" who what] == 2} {
dict incr activity($who) $what
}
}
# Now produce the output
foreach who [lsort [array names activity]] {
puts "$who -"
dict for {what count} $activity($who) {
puts "$what $count"
}
# And the extra blank line
puts ""
}
You could use an array to store the info while you're collecting in.
The regexp you're using is wrong.
Use a list of list to collect the matching in a pair way (i.e. word #n), and then assign all the collected matching to the proper key on the array.
Here is an example on how to do it:
set file_content {Anny : dancing
Sonny : reciting
Joel : dancing
Anny : reciting
Anny : singing
}
array set res {}
set anny {}
lappend anny [list dancing [regexp -all {Anny\s*:\s*dancing} $file_content] ]
lappend anny [list singing [regexp -all {Anny\s*:\s*singing} $file_content] ]
lappend anny [list reciting [regexp -all {Anny\s*:\s*reciting} $file_content] ]
set res(Anny) $anny
puts [array get res]
If I run this the output is:
Anny {{dancing 1} {singing 1} {reciting 1}}
Now you could use the array to format the output as you wish.
Of course you should do the same with other names, so the best is to put the code inside a function.
This is one way to do it.
Count the number of different lines. Get rid of the colon.
foreach line [split $data \n] {
dict incr d0 [string map {: {}} $line]
}
Convert the dictionary of lines and counts to a hierarchical dictionary with names on the highest level and activities on the next level. If line contains "Joel dancing", the invocation below will be, after expansion with {*}: dict set d1 Joel dancing 1, creating the dictionary item Joel {dancing 1}.
dict for {line count} $d0 {
dict set d1 {*}$line $count
}
Iterate over the dictionary and print the keys and values.
dict for {name activities} $d1 {
puts "$name -"
foreach {activity count} $activities {
puts "$activity $count"
}
puts {}
}
Documentation:
dict,
foreach,
puts,
split,
string,
{*} (syntax)
file1.txt
dut1Loop1Net = [::ip::contract [::ip::prefix 1.1.1.1/24]]/24
My script is
set in [open file1.txt r]
set line [gets $in]
if {[string trim [string range $line1 0 0]] != "#"} {
set devicePort [string trim [lindex $line1 0]]
set mark [expr [string first "=" $line1] + 1]
set val [string trim [string range $line1 $mark end]]
global [set t $devicePort]
set [set t $devicePort] $val
}
close $in
Problem
I am getting output as
% set dut1Loop1Net
[::ip::contract [::ip::prefix 1.1.1.1/24]]/24
Here i am getting the string without evaluating.
I am expecting the output as 1.1.1.0/24. Because TCL does not evaluate code here, it is printing like a string.
I am interesting to know how TCL stores the data and in which form it will retreive the data.
How Tcl stores values.
The short story:
Everything is a string
The long strory
Tcl stores the data in the last used datatype, calculate the string representation only when nessecary, uses copy on write, a simple refcount memory managment.
The answer how you evaluate it is with eval or subst. In your case probably subst.
Edit:
If your config file looks like this:
# This is a comment
variable = value
othervar = [doStuff]
you can use some tricks to get Tcl parsing it for you:
rename ::unknown ::_confp_unknown_orig
proc unknown args {
if {[llength $args] == 3 && [lindex $args 1] eq "="} {
# varname = value
uplevel 1 [list set [lindex $args 0] [lindex $args 2]
return [lindex $args 2]
}
# otherwise fallback to the original unknown
uplevel 1 [linsert $args 0 ::_confp_unknown_orig]
# if you are on 8.6, replace the line above with
# tailcall ::_confp_unknown_orig {*}$args
}
# Now just source the file:
source file1.txt
# cleanup - if you like
rename ::unknown {}
rename ::_confp_unknown_orig ::unknown
An other way to do that is to use a safe interp, but in this case using your main interp looks fine.
The problem is that the code you store inside val is never executed.
You access it using $val, but this way you get the code itself, and not the result of its execution.
To solve it, you must be sure [::ip::contract [::ip::prefix 1.1.1.1/24]]/24 is executed, and you can do that by replacing this line
set val [string trim [string range $line1 $mark end]]
with this one
eval "set val [string trim [string range $line1 $mark end]]"
Why? Here's my simple explaination:
The parser sees the "..." part, so it performs substitutions inside it
The first substitution is the execution of the string range $line1 $mark end command
The second substitution is the execution of the string trim ... command
So, when substitutions are complete and the eval command is ready to run, its like your line has become
eval {set val [::ip::contract [::ip::prefix 1.1.1.1/24]]/24}
Now the eval command is executed, it calls recursively the interpreter, so the string set val [::ip::contract [::ip::prefix 1.1.1.1/24]]/24 goes to another substitution phase, which finally runs what you want and puts the string 1.1.1/24 into the variable val.
I hope this helps.
I'm trying to create a program that the First and last characters are compared, Second and second to the last are compared, Third and third to the last are compared, and so on, and if any of these characters match, the two will be converted to the uppercase of that character.
Example:
Please enter a text: Hello Philippines
finals: HEllo PhIlippinEs
I can't create any piece of code, I'm stuck with
puts "Please enter text:"
set myText [gets stdin]
string index $myText 4
Can someone help me please?
This procedure will also capitalize the first i in Phillipines because it's equidistant from the start and the end of the string.
proc compare_chars {str} {
set letters [split $str ""]
for {set i [expr {[llength $letters] / 2}]} {$i >= 0} {incr i -1} {
set a [lindex $letters $i]
set b [lindex $letters end-$i]
if {$a eq $b} {
lset letters $i [set L [string toupper $a]]
lset letters end-$i $L
}
}
join $letters ""
}
puts [compare_chars "Hello Phillipines"]
# outputs => HEllo PhIllipinEs
The simplest way to code this is to use foreach over the split-up characters. (It's formally not the most efficient, but it's very easy to code correctly.)
puts "Please enter text:"
set myText [gets stdin]
set chars [split $myText ""]
set idx 0
foreach a $chars b [lreverse $chars] {
if {[string equals -nocase $a $b]} {
lset chars $idx [string toupper $a]
}
incr idx
}
set output [join $chars ""]
puts $output
Note that the foreach is iterating over a copy of the list; there are no problems with concurrent modification. In fact, the only vaguely-tricky part from a coding perspective is actually that we need to keep track of the index to modify, in the idx variable above.
With Tcl 8.6 you could write:
set chars [split $myText ""]
set output [join [lmap a $chars b [lreverse $chars] {
expr {[string equals -nocase $a $b] ? [string toupper $a] : $a}
}] ""]
That does depend on having the new lmap command though.
If you're really stuck with 8.3 (it's unsupported and has been so for years, so you should be prioritizing upgrading to something more recent) then try this:
set chars [split $myText ""]
set idx [llength $chars]
set output {}
foreach ch $chars {
if {[string equals -nocase $ch [lindex $chars [incr idx -1]]]} {
append output [string toupper $ch]
} else {
append output [string tolower $ch]
}
}
All the features this uses were present in 8.3 (though some were considerably slower than in later versions).
I am trying to write a small bit of code that will list all of the variables and the values they contain in the info globals command. I have tried several iterations of substitution but cant get Tcl to treat the variable name as a variable, and return its value. Below is what I started with:
set fileid [open "c:/tcl variables.txt" w+]
foreach {x} [lsort [info globals]] {
set y $x
puts $fileid "$x $y "
}
I can get
DEG2RAD DEG2RAD
PI PI
RAD2DEG RAD2DEG
.....
or
DEG2RAD $DEG2RAD
PI $PI
RAD2DEG $RAD2DEG
.....
but what I need is
DEG2RAD 0.017453292519943295
PI 3.1415926535897931
RAD2DEG 57.295779513082323
....
I think you are looking for the subst command:
set fileid [open "c:/tcl variables.txt" w+]
foreach {x} [lsort [info globals]] {
puts $fileid "$x [subst $$x] "
}
Alternatively, you can take advantage of the fact that set returns the value being set:
set fileid [open "c:/tcl variables.txt" w+]
foreach {x} [lsort [info globals]] {
puts $fileid "$x [set $x] "
}
The easiest method for doing this (because it avoids littering the output with your temporary variables) is to use a helper procedure and the upvar command:
proc listAllGlobals {filename} {
set fileid [open $filename w+]
foreach varname [lsort [info globals]] {
upvar "#0" $varname var
if {[array exists var]} continue; # Skip global arrays...
puts $fileid "$varname $var "
}
close $fileid
}
listAllGlobals "C:/tcl variables.txt"
If you've got Tcl 8.5, you can do this without creating a procedure:
apply {{} {
set fileid [open "C:/tcl variables.txt" w+]
foreach varname [lsort [info globals]] {
upvar "#0" $varname var
if {[array exists var]} continue; # Skip global arrays...
puts $fileid "$varname $var "
}
close $fileid
}}
This all works because what upvar does is link a local variable to a variable in another stack frame; #0 is the name of the global stack frame, $varname is the name of the variable in that context, and var is the local variable to bind to.
Arrays are variables too so just for reference, this outputs all variables (including arrays):
proc ListAllGlobals {{?pattern? *}} {
foreach {name} [lsort [info globals ${?pattern?}]] {
upvar {#0} $name var
if {[array exists var]} {
foreach {key val} [array get var] {
puts "${name}($key) [list $val]"
}
} else {
puts "$name [list $var]"
}
}
}
ListAllGlobals
ListAllGlobals tcl_platform
I'm using list to enhanced readability of the values.
A pattern can be specified for a subset of variables. It doesn't apply to array element names.
In keeping with previous examples the output can be written to an opened file with: puts $fileid [ListAllGlobals]