source: utils/developer/tcl/analyseconvexizing.tcl@ c79d7a

#!/usr/bin/tclsh
#
# This scripts parses a series of tecplot style files of triangles and displays them via VMD's graphics interface

# fname is the filename prefix of the tecplot .dat files, e.g. "convex" for "convex-0.dat"
proc convexizing { fname steps} {
        global framesteps
        global fileprefix
        set framesteps $steps
        set fileprefix $fname

        # avoid some 'animate dup' bug
        set molid [molinfo top]
        if {$steps < 2} {
                error "steps should be greater than 2."
        }
        # make tcount-1 copies of current frame
        for {set i 0} {$i <$steps} {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} { 
        global fileprefix

        set frame [molinfo $index get frame]
        set oldncount 0
        set oldtriangles {}
        if {$frame > 0} {
                # open file
                set previousframe [expr $frame - 1]
                set fname "$fileprefix-$previousframe.dat"
                #puts "Opening old file $fname."
                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 ]
                set oldncount $ncount
                #puts "There are $ncount nodes."
                # there's a blank line in between
                # parse triangles
                set tcount 0
                gets $file line
                while { $line != {} } {
                        set triangles [ split $line " "]
                        set oldtriangles [lappend oldtriangles $triangles]
                        incr tcount
                        gets $file line
                }
                close $file
        }
        # open file
        set fname "$fileprefix-$frame.dat"
        #puts "Opening new file $fname."
        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, and $oldncount old ones."
        # there's a blank line in between
        # parse triangles
        set tcount 0
        gets $file line
        set newtriangles {}
        set commontriangles {}
        while { $line != {} } {
                set triangles [ split $line " "]
                if {$ncount == $oldncount} {
                        # search in oldtriangles
                        set index [lsearch $oldtriangles $triangles]
                        if {$index == -1} {
                                # not present, then mind in new ones
                                #puts "$triangles not present in old ones."
                                set newtriangles [lappend newtriangles $triangles]
                        } else {
                                # present in both, hence remove in old ones
                                #puts "$triangles present in old ones."
                                set commontriangles [lappend commontriangles $triangles]
                                set oldtriangles [lreplace $oldtriangles[set oldtriangles {}] $index $index]
                        }
                } else {
                        set newtriangles [lappend newtriangles $triangles]
                }
                incr tcount
                gets $file line
        }
        close $file
        #puts "There are $tcount triangles."
        
        # draw all remaining old and new ones
        draw delete all
        foreach triangles $commontriangles {
                set first [ lrange $nodes([ lindex $triangles 0 ]) 0 2 ]
                set second [ lrange $nodes([ lindex $triangles 1 ]) 0 2 ]
                set third [ lrange $nodes([ lindex $triangles 2 ]) 0 2 ]
                draw color green
                draw material Transparent
                #puts "common: $first $second $third"
                #draw line $first $second style dashed
                #draw line $first $third style dashed
                #draw line $second $third style dashed
                draw triangle $first $second $third
        }       

        if {$ncount == $oldncount} {
                foreach triangles $oldtriangles {
                        set first [ lrange $nodes([ lindex $triangles 0 ]) 0 2 ]
                        set second [ lrange $nodes([ lindex $triangles 1 ]) 0 2 ]
                        set third [ lrange $nodes([ lindex $triangles 2 ]) 0 2 ]
                        draw color blue
                        draw material Diffuse
                        #puts "old: $first $second $third"
                        draw triangle $first $second $third
                }
        }
        foreach triangles $newtriangles {
                set first [ lrange $nodes([ lindex $triangles 0 ]) 0 2 ]
                set second [ lrange $nodes([ lindex $triangles 1 ]) 0 2 ]
                set third [ lrange $nodes([ lindex $triangles 2 ]) 0 2 ]
                draw color red
                draw material Transparent
                #puts "new: $first $second $third"
                draw triangle $first $second $third
        }       

        return
}

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