Open topic with navigation

You are here: Surpac Concepts > Macros > TCL > Reading formatted data
GEOVIA Surpac

Reading a string file using TCL

This example shows how a string file can be read into TCL arrays. This is not the most efficient method by which a string file may be read but it demonstrates the power of TCLs file, array and list commands.

The SclOpenSwaFile command provides a far more efficient way of reading a string file, or a DTM file.

  
proc ReadStringFile {filename string_array points_array yarray xarray zarray descarray} {
#
# Procedure to read a string file into arrays
# filename is opened and read and all values are returned
# in the remaining variables
#
  upvar $string_array strings
  upvar $points_array points
  upvar $yarray yvalues
  upvar $xarray xvalues
  upvar $zarray zvalues  
  upvar $descarray descvalues
  # open the file with read access
  if {[catch {set fileptr [open $filename r]}]} {
    # can't open the file so raise an error to terminate with my message
    error "Can't open $filename"
  }
  
  # skip the two header lines
  gets $fileptr line
  gets $fileptr line
  # initialise some variables to keep track of things
  set segmentcount 0
  set thissegment 0
  set stringcount 0
  set pointcount 0
  set thisstring 0
  while {[gets $fileptr line] >= 1} {
    # now read until end of file happens 
    # count=4 means no point description
    # count=5 means point a description exists
    set count [scan $line "%d, %f, %f, %f, %s" strnum y x z ptdesc]
    if {$strnum == 0} {
      # end/start of segment increment segment counter and reset point counter
      incr segmentcount
      set pointcount 0
    } elseif {[info exists strings($strnum)] == 1} {
      # the string already exists
      if {$strings($strnum) < $segmentcount} {
        # start a new segment
        incr thissegment
        set strings($strnum) $segmentcount
      }
      # remember values in arrays
      set yvalues($strnum,$thissegment,$pointcount) $y
      set xvalues($strnum,$thissegment,$pointcount) $x
      set zvalues($strnum,$thissegment,$pointcount) $z
      if {$count == 5} {
        # remember point description
        set descvalues($strnum,$thissegment,$pointcount) $ptdesc
      } else {
        # no point description for this point
        set descvalues($strnum,$thissegment,$pointcount) ""
      }
      incr pointcount; # increment the point counter for this segment
      set points($strnum,$thissegment) $pointcount; # remember num points for this segment
    } else {
      # the string doesn't exist neither does the segment
      set thisstring $stringcount
      incr stringcount
      set thissegment 0
      set segmentcount 1
      set pointcount 0
      set strings($strnum) $segmentcount
      # remember coordinates for this point
      set yvalues($strnum,$thissegment,$pointcount) $y
      set xvalues($strnum,$thissegment,$pointcount) $x
      set zvalues($strnum,$thissegment,$pointcount) $z
      if {$count == 5} {
        # remember point description
        set descvalues($strnum,$thissegment,$pointcount) $ptdesc
      } else {
        # no point description for this point
        set descvalues($strnum,$thissegment,$pointcount) ""
      }
      incr pointcount; # increment the point counter for this segment
      set points($strnum,$thissegment) $pointcount
    }
  }
  close $fileptr
}
# substitute your own string file for test1.str
ReadStringFile "test1.str" strings points yvalues xvalues zvalues descvalues
# create a list of string numbers
foreach {strnum segmentcount} [array get strings] {
  lappend stringslist $strnum
}
# now sort the list so that they are in ascending order
set sortedstrings [lsort $stringslist]
# print the coordinates - in string number order
foreach strnum $sortedstrings {
  set segmentcount $strings($strnum)
  for {set j 0} {$j < $segmentcount} {incr j} {
    for {set k 0} {$k < $points($strnum,$j)} {incr k} {
      puts [format "%d, %.3f, %.3f, %.3f, %s" $strnum $yvalues($strnum,$j,$k) $xvalues($strnum,$j,$k) $zvalues($strnum,$j,$k) $descvalues($strnum,$j,$k)]
    }
  }
}

Description

This example is most interesting as it shows how arrays in TCL are a bit different to arrays in normal programming languages.

TCL arrays may use any value as an index. In this example the string number is used as the array index for the strings array. The value stored in each element of this array is the number of segments in each string. stringnumber,segmentnumber,pointnumber is used as the index to the coordinate value and point description arrays. This is like a multi-dimensional array but it is much more powerful especially when you consider that array indexes in TCL need not be numbers. Letters and words also form valid array indexes in TCL.

So how does the ReadStringFile procedure work.

  1. After skipping the first two lines of the string file, the file is read a line at a time.
  2. If the string number is 0 then the segmentcount variable is incremented and the pointcount variable is reset to zero for the start of a new segment.
  3. If the string number already exists in the strings array and if a new segment has to be commenced then the number of segments in the string is incremented and the pointcounter is reset to 0. After this the coordinate values are remembered in the coordinate arrays.
  4. If the string to which the point belongs has not already been created in the strings array an entry is created for the string in the strings array with the number of segments set to 1 and the coordinate values are remembered in the coordinate arrays. In addition to recording that a string exists, the strings array also records the number of segments in a string.
  5. All arrays that record the string, segment and point information are returned to the calling procedure. This is achieved by using the upvar command.

Further suggestions

  • Determine if a specific string has been loaded from the file

    • This test works by using the info command to determine if the array element for the string Id in question exists or not. 

    		proc StringExists {stringsarray stringid} {
		  if {[info exists stringsarray($stringid)] == 1} {
		    puts "String $stringid exists"
		    return 1
		  } else {
		    puts "String $stringid does not exist"
		    return 0
		  }
		}

  • Write the data in a string file format

    • This example uses the ReadStringFile procedure described above to write the string file that has been read. Note that the file header and axis information has been ignored in this example. 

    		# 
		# procedure to write end of segment record
		#
		proc EndOfSegment {fileptr} {
		  puts $fileptr "0, 0.000, 0.000, 0.000"
		}
		# substitute your own string file for test1.str
		ReadStringFile "test1.str" strings points yvalues xvalues zvalues descvalues
		# create a list of string numbers
		foreach {strnum segmentcount} [array get strings] {
		  lappend stringslist $strnum
		}
		# now sort the list so that they are in ascending order
		set sortedstrings [lsort $stringslist]
		# open the new string file and write header and axis records
		set newfile [open "new1.str" w]
		puts $newfile "new, [clock format [clock seconds] -format %d-%b-%y], a sample string file, SSI_STYLES:styles.ssi"
		puts $newfile "0, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000"
		# now write the string data
		foreach strnum $sortedstrings {
		  set segmentcount $strings($strnum)
		  for {set j 0} {$j < $segmentcount} {incr j} {\
		    for {set k 0} {$k < $points($strnum,$j)} {incr k} {
		      puts $newfile [format "%d, %.3f, %.3f, %.3f, %s" $strnum $yvalues($strnum,$j,$k) $xvalues($strnum,$j,$k) $zvalues($strnum,$j,$k) $descvalues($strnum,$j,$k)]
		    }
		    EndOfSegment $newfile
		  }
		}
		# and finally don't forget to close the file
		close $newfile

Open topic with navigation