Updated 2012-09-21 12:44:52 by RLE

I recently had a need to generate triangle strips for OpenGL triangle meshes and found Pierre Terdiman's nice C++ code at http://www.codercorner.com/Strips.htm. I was in the middle of converting it to plain C when it occurred to me that this would be a nice little project to implement in Tcl, not only to validate my specfic conversion, but also to share with the community.

The basic idea is to turn a list of triangles (triples of vertex indices) into a list of tristrips (arbitrary length lists of vertex indices) while preserving the orientation of the original input triangles.

Here's some Tcl to do this :
``` package provide tristrip

namespace eval tristrip {

# public
variable oneside 1 ;# generate one-sided triangle strips
variable cnctall 0 ;# connect all strips
variable SGIalgo 0 ;# use SGI algorithm for trilist traversal
variable oppoext 1 ;# do opposite direction strip extension

#Generate Triangle Strips from Triangle List
#
proc genTriStrips {trilst {one 1s} {cnc noconnect} {sgi nosgi}} {
variable edgmap; catch { array unset edgmap }
variable usegbl; catch { array unset usegbl }

# set options (this needs reworking (suggestions welcome)...)
#
variable oneside; variable cnctall; variable SGIalgo
if {[string equal \$one "1s"]} {
set oneside 1 } else { set oneside 0 }
if {[string equal \$cnc "connect"]} {
set cnctall 1 } else { set cnctall 0 }
if {[string equal \$sgi "sgi"]} {
set SGIalgo 1 } else { set SGIalgo 0; }

# create edge -> triangles mapping
#
newEdgMap \$trilst ;

# unimplemented (exercise for the reader :)
#
variable SGIalgo
if {\$SGIalgo} {
# sort trilst ascending based on the number of neighbors
# per tri. i.e., visit most-isolated tris first.
}

# create strips
#
set stripLst [list]
foreach tri \$trilst {
# starting from unused triangles ...
if {![info exists usegbl(\$tri)]} {
# generate a strip, save it, mark its tri's used
foreach {s u} [genBestStrip \$tri] { break }
lappend stripLst \$s
foreach t \$u { set usegbl(\$t) 1 }
}
}

catch { array unset edgmap; array unset usegbl }

if {\$cnctall} {
set stripLst [list [connectAllStrips \$stripLst]]
}

return \$stripLst
}

# private
variable edgmap    ;# triangles sharing an edge
variable usegbl    ;# triangles in use globally

proc genBestStrip {tri0} {
# best strip so far for input tri
set bestVtxLst {}; set bestTriLst {}

# generate strips in all three directions
#
foreach \
fwdDir {{old mid dum} {mid dum old} {dum old mid}} \
bakDir {{mid old dum} {old dum mid} {dum mid old}} \
{
# initialize for this strip
catch {array unset uselcl};
foreach \$fwdDir [set tri \$tri0] { break }
set vLst [list \$old \$mid]; set tLst [list]

# extend strip
foreach {vLst tLst} \
[extendStrip \$vLst \$tLst \$tri \$old \$mid uselcl] { break }

# if opposite-direction strip extension is configured
variable oppoext
if {\$oppoext} {
# look backwards from original tri
foreach \$bakDir [set tri \$tri0] { break }

# for an adjacent unused tri
set tri [unusedTri [otherTri \$tri0 \$old \$mid] uselcl]
if {\$tri != ""} {
# found one so reverse strip
reverseLst vLst; reverseLst tLst

# extend again
foreach {vLst tLst} \
[extendStrip \$vLst \$tLst \$tri \$old \$mid uselcl] \
{ break }

# for one-sided strips,
# reverse strip and check/correct original windings
#
variable oneside
if {\$oneside} {
reverseLst vLst; reverseLst tLst;
set idxtri0 0;
foreach t \$tLst {
if {\$t == \$tri0} { break };
incr idxtri0
}
if {[expr {\$idxtri0%2}] == 1} {
set vLst [linsert \$vLst 0 [lindex \$vLst 0]]
}
}
}
}

# save strip if longer than current best strip
#
set tLen [llength \$tLst]
set bLen [llength \$bestTriLst]
if {\$tLen > \$bLen} {
set bestVtxLst \$vLst; set bestTriLst \$tLst
}
}

return [list \$bestVtxLst \$bestTriLst]
}

# extend input strip (and it's trilst) in the old/mid direction
proc extendStrip {vLst tLst tri old mid uselclnam} {
upvar 1 \$uselclnam uselcl

while {\$tri != ""} {
lappend vLst [set new [otherVtx \$tri \$old \$mid]]
lappend tLst \$tri; set uselcl(\$tri) 1
set tri [unusedTri [otherTri \$tri \$mid \$new] uselcl]
set old \$mid; set mid \$new
}

return [list \$vLst \$tLst]
}

# flatten all strip lists to one strip if configured
proc connectAllStrips {stripLst} {
variable oneside

set vLst [list]; set vLen 0
foreach s \$stripLst {
if {\$vLst != ""} {
set vEnd [lindex \$vLst end]
set sBeg [lindex \$s 0]

lappend vLst \$vEnd \$sBeg; incr vLen 2

# check/correct for one sided strip winding flip
if {\$oneside && [expr {\$vLen%2}] == 1} {
foreach {v1 v2 rest} \$s { break }
if {\$v1 != \$v2} {
lappend vLst \$v1; incr vLen
}
}
}

# append the existing strip
foreach v \$s { lappend vLst \$v; incr vLen }
}

return \$vLst
}

# Create an edge-to-triangles map.  Keys are ordered pairs of
# vertex indices and values are a list of triangles sharing the edge
#
proc newEdgMap {trilst} {
variable edgmap; array unset edgmap
foreach tri \$trilst { foreach {v1 v2 v3} \$tri { break }
}
# can't handle non-manifold meshes
foreach edg [array names edgmap] {
if {[llength \$edgmap(\$edg)] > 2} {
return -code error \
"Non-manifold input : edge \$edg \$edgmap(\$edg)"
}
}
}

# add a triangle to the list of triangles sharing edge ab
proc addEdgTri {a b tri} {
variable edgmap;
if {\$a < \$b} { set lo \$a; set hi \$b
} else       { set lo \$b; set hi \$a }
lappend edgmap(\$lo,\$hi) \$tri
}

# get the list of triangles sharing edge ab
proc getEdgTriLst {a b} {
variable edgmap
if {\$a < \$b} { set lo \$a; set hi \$b
} else       { set lo \$b; set hi \$a }
return \$edgmap(\$lo,\$hi)
}

# reverse list variable in the caller's scope
proc reverseLst {lstvarnam} {
upvar 1 \$lstvarnam lst
set revlst [list]; set n [llength \$lst]
while {[incr n -1] >= 0} { lappend revlst [lindex \$lst \$n] }
set lst \$revlst
}

# find the other vertex of a triangle when given two
proc otherVtx {tri a b} {
foreach {v1 v2 v3} \$tri { break }
if {\$v1 == \$a && \$v2 == \$b || \$v1 == \$b && \$v2 == \$a} { return \$v3 }
if {\$v2 == \$a && \$v3 == \$b || \$v2 == \$b && \$v3 == \$a} { return \$v1 }
if {\$v3 == \$a && \$v1 == \$b || \$v3 == \$b && \$v1 == \$a} { return \$v2 }
}

# find the other triangle sharing the edge ab
proc otherTri {tri a b} {
variable edgmap
foreach {t1 t2} [getEdgTriLst \$a \$b] { break }
if {\$tri == \$t1} { set oth \$t2 } else { set oth \$t1 }
return \$oth
}

# return input triangle if unused both globally and in the given map
proc unusedTri {tri lclusenam} {
variable usegbl; upvar 1 \$lclusenam uselcl
set unused \$tri
if {[info exists usegbl(\$tri)]} { set unused "" } ;# in use globally
if {[info exists uselcl(\$tri)]} { set unused "" } ;# in use locally
return \$unused
}
}```

I suppose we need some code to test this too. Yes, this is probably more complex than needed (feel free to add the simple test cases) but I needed to check performance numbers on large regular closed meshes.
``` proc genShape {typ} {
set vclst [list]

if {[string equal \$typ "o"]} {
# octahedron vertices on unit sphere
set p [expr {double(1)}];
set m [expr {double(-1)}];
set z [expr {double(0)}];
set xp [list \$p \$z \$z] ; set xm [list \$m \$z \$z]
set yp [list \$z \$p \$z] ; set ym [list \$z \$m \$z]
set zp [list \$z \$z \$p] ; set zm [list \$z \$z \$m]
# octohedron (all tris ccw)
lappend vclst \
[list \$xp \$yp \$zp] [list \$xp \$zm \$yp] [list \$xp \$zp \$ym] \
[list \$xp \$ym \$zm] [list \$xm \$yp \$zm] [list \$xm \$zm \$ym] \
[list \$xm \$zp \$yp] [list \$xm \$ym \$zp]

} elseif {[string equal \$typ "d"]} {
# triangular dipyramid (a convex deltahedron)
# vertices on unit sphere
set Pi    [expr {3.14159265358979323846}]
set cos60 [expr {cos(\$Pi*30/180.0)}]
set sin60 [expr {sin(\$Pi*30/180.0)}]
set p     [expr {double(1)}]
set m     [expr {double(-1)}]
set z     [expr {double(0)}]
set top [list \$z \$p \$z]; set bot [list \$z \$m \$z]
set bak [list \$z \$z \$m]
set lft [list -\$cos60 \$z \$sin60]; set rit [list \$cos60 \$z \$sin60]
# triangular dipyramid
lappend vclst \
[list \$rit \$top \$lft] [list \$lft \$bot \$rit] \
[list \$rit \$bot \$bak] [list \$bak \$top \$rit] \
[list \$top \$bak \$lft] [list \$lft \$bot \$bak]

} elseif {[string equal \$typ "t"]} {
# tetrahedron vertices on unit sphere
set sqrt3p [expr {0.5773502692}]
set sqrt3m [expr {-0.5773502692}]
set PPP [list \$sqrt3p \$sqrt3p \$sqrt3p] ;# +X, +Y, +Z
set MMP [list \$sqrt3m \$sqrt3m \$sqrt3p] ;# -X, -Y, +Z
set MPM [list \$sqrt3m \$sqrt3p \$sqrt3m] ;# -X, +Y, -Z
set PMM [list \$sqrt3p \$sqrt3m \$sqrt3m] ;# +X, -Y, -Z
# tetrahedron (all tris ccw)
lappend vclst \
[list \$PPP \$MPM \$MMP] [list \$PPP \$MMP \$PMM] \
[list \$MPM \$PMM \$MMP] [list \$MPM \$PPP \$PMM]

} else {
return -code error "unknown shape type \$typ"
}

return \$vclst
}

# repeatedly subdivide a list of triangles to the given depth
# normalizes all generated vertices to lie on the unit sphere
# returns new list of triangle vertices
#
proc sphdivtrilst {tclst {depth 3}} {
proc K {a b} {set a}; # local K combiner

if {\$depth < 0}         { set depth 0
} elseif {\$depth > 5}   { set depth 5 }

set curlst \$tclst
set nxtlst [list]

while {[incr depth -1] >= 0} {
foreach t [K \$curlst [set curlst [list]]] {
# get triangle vertex coordiates
foreach {v1 v2 v3} \$t break
foreach {x1 y1 z1} \$v1 {x2 y2 z2} \$v2 {x3 y3 z3} \$v3 \
break

set x [expr {(\$x1+\$x2)}]
set y [expr {(\$y1+\$y2)}]
set z [expr {(\$z1+\$z2)}]
set l [expr {sqrt(\$x*\$x + \$y*\$y + \$z*\$z)}]
set v12 [list [expr {\$x/\$l}] [expr {\$y/\$l}] [expr {\$z/\$l}]]

set x [expr {(\$x2+\$x3)}]
set y [expr {(\$y2+\$y3)}]
set z [expr {(\$z2+\$z3)}]
set l [expr {sqrt(\$x*\$x + \$y*\$y + \$z*\$z)}]
set v23 [list [expr {\$x/\$l}] [expr {\$y/\$l}] [expr {\$z/\$l}]]

set x [expr {(\$x3+\$x1)}]
set y [expr {(\$y3+\$y1)}]
set z [expr {(\$z3+\$z1)}]
set l [expr {sqrt(\$x*\$x + \$y*\$y + \$z*\$z)}]
set v31 [list [expr {\$x/\$l}] [expr {\$y/\$l}] [expr {\$z/\$l}]]

lappend nxtlst \
[list \$v1 \$v12 \$v31] \
[list \$v2 \$v23 \$v12] \
[list \$v3 \$v31 \$v23] \
[list \$v12 \$v23 \$v31] \
}

set curlst \$nxtlst
set nxtlst [list]
}

return \$curlst
}

proc genSphere {ndv {typ o} {regen 0}} {

if {!\$regen} {
global sphereCache; if {[info exists sphereCache(\$typ,\$ndv)]} {
return \$sphereCache(\$typ,\$ndv)
} else {
array unset sphereCache ;# only cache 1 typ,ndv pair
}
}

set trilst [sphdivtrilst [genShape \$typ] \$ndv]

# create vertex list from sphere's triangles
set unqvtxlst {}
foreach t \$trilst {
foreach {v1 v2 v3} \$t { lappend unqvtxlst \$v1 \$v2 \$v3 } }
set unqvtxlst [lsort -unique \$unqvtxlst]

# create unique vertex map
set idx 0
foreach v \$unqvtxlst {
if {![info exists vtxidxmap(\$v)]} {
set vtxidxmap(\$v) \$idx
incr idx
}
}

# create triangle list using vertex indices
set i 0
set trivtxidxlst {}
foreach t \$trilst {
foreach {v1 v2 v3} \$t {
lappend trivtxidxlst \
[list \$vtxidxmap(\$v1) \$vtxidxmap(\$v2) \$vtxidxmap(\$v3)]
}
}
#puts "[llength \$trivtxidxlst] tris [llength \$unqvtxlst] unqvtx"

return [set sphereCache(\$typ,\$ndv) [list \$unqvtxlst \$trivtxidxlst]]
}

proc statStripList {vL tL sL} {
set vLen [llength \$vL]
set tLen [llength \$tL]
set sLen [llength \$sL]
puts "\t\$tLen input triangles \$vLen vertices \$sLen strips"
set vr 0; set lL [list]
foreach s \$sL { incr vr [set l [llength \$s]]; lappend lL \$l }
puts -nonewline "\ttotal vtx refs : \$vr : #/strip :"
foreach l \$lL { puts -nonewline " \$l" }; puts ""
puts "\ttri/tristrip vtx ref ratio : [expr {\$tLen*3.0/\$vr}]"
puts "\t#tristrip refs/~#min refs ratio : [expr {\$vr/2.0/\$vLen}]"
}

proc runtstTriStrip {n {typ o} {onesid 1s} {cnc connect}} {
set et0 [time {
foreach {vL tL} [genSphere \$n \$typ 1] { break }
}]
set et1 [time {
set sL [tristrip::genTriStrips \$tL \$onesid \$cnc]
}]
puts "genTriStrips \\$tl \$onesid \$cnc : \$et1"
puts "\tgenSphere \$n \$typ 1: \$et0"
statStripList \$vL \$tL \$sL
}

proc tstTriStrip {{nlst {0 1}} {tlst {t d}} {slst {2s}} {clst {connect}}} {
foreach n \$nlst {
foreach t \$tlst {
foreach s \$slst {
foreach c \$clst {
puts "runtstTriStrip \$n \$t \$s \$c"
runtstTriStrip \$n \$t \$s \$c
puts ""
} } } }
}

#tstTriStrip {0 1 2 3 4 5} {t d o} {2s 1s} {connect !connect} ;# test everything```

I don't currently have a way to easily visualize this directly since I haven't yet found a Tcl/Tk OpenGL widget (I must admit I haven't looked thoroughly) that handles indirect vertex references and tristrips at the scripting level.

Mark K. Greene