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. (Orientation is used in OpenGL to determine which of the two sides of a triangle will be drawn). For example:
% set trilst [list {0 1 2} {1 2 3} {2 3 4}]
% tristrip::genTriStrips $trilst 2s
% {0 1 2 3 4}Note the orientation of the odd triangles is preserved and the even ones have their original orientation reversed (this is what OpenGL expects).
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 }
addEdgTri $v1 $v2 $tri
addEdgTri $v2 $v3 $tri
addEdgTri $v3 $v1 $tri
}
# 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 everythingI 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.