source: utils/developer/tcl/surfacing.tcl

#!/usr/bin/tclsh
#
# This scripts parsed a tecplot style file of triangles and produces one
# frame for each found triangle to be used in animation of the tesselation
# including the rolling sphere via VMD's graphics interface.
#
# Use as follows:
# surfacing <filename>          # to start
# surfacing_off                 # to end

# fname is the filename of the tecplot .dat file
proc surfacing { fname } {
        global nodes
        global Triangles
        global tcount
        # open file
        set file [open $fname r]
        gets $file title
        gets $file variables
        gets $file zone
        # parse nodes
        set ncount 1
        gets $file line
        while { $line != {} } {
                set nodes($ncount) $line
                incr ncount
                gets $file line
        }
        set ncount [ expr $ncount -1 ]
        puts "There are $ncount nodes."
        # there's a blank line in between
        # parse triangles
        set tcount 0
        gets $file line
        while { $line != {} } {
                set Triangles($tcount) [ split $line " "]
                incr tcount
                gets $file line
        }
        puts "There are $tcount triangles."
        

        # avoid some 'animate dup' bug
        set molid [molinfo top]
        if {$tcount < 2} {
                error "tcount should be greater than 2."
        }
        # make tcount-1 copies of current frame
        for {set i 0} {$i <$tcount} {incr i} {
                animate dup frame 0 $molid
        }
        animate goto 0

        global vmd_frame
        trace variable vmd_frame([molinfo top]) w update_current_surface
        display update
        return
}       

proc update_current_surface {name index op} { 
        draw delete all
        global nodes
        global Triangles
        set count 0
        set frame [molinfo $index get frame]
        while { [expr $count+1] < $frame } {
                draw color red
                draw material Transparent
                set first [ lrange $nodes([ lindex $Triangles($count) 0 ]) 0 2 ]
                set second [ lrange $nodes([ lindex $Triangles($count) 1 ]) 0 2 ]
                set third [ lrange $nodes([ lindex $Triangles($count) 2 ]) 0 2 ]
                draw triangle $first $second $third
                incr count
        }
        if { [expr $count+1] <= $frame } {
                draw color green
                draw material Opaque
                puts "Last triangle is [lindex $Triangles($count) 0] [lindex $Triangles($count) 1] [lindex $Triangles($count) 2]"
                set first [ lrange $nodes([ lindex $Triangles($count) 0 ]) 0 2 ]
                set second [ lrange $nodes([ lindex $Triangles($count) 1 ]) 0 2 ]
                set third [ lrange $nodes([ lindex $Triangles($count) 2 ]) 0 2 ]
                draw triangle $first $second $third
        }
        #enumerate_atoms 0
        
        return
}

proc surfacing_off {} {
        global vmd_frame
        global tcount
        trace vdelete vmd_frame([molinfo top]) w update_current_surface
        draw delete all
        animate delete beg 1 end $tcount skip 0 [molinfo top]
        return
}