I recently had a need to generate triangle strips for OpenGL meshes and found Pierre Tierdman'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.
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
}
}