gmoffread.tcl

来自「算断裂的」· TCL 代码 · 共 157 行

proc gm_offread_getline {fi} {
    global gm_offread_linecount
    while 1 {
	set rval [gets $fi line]
	incr gm_offread_linecount
	if {$rval < 0} {
	    error "Unexpected eof while reading file"
	}
	set line [string trim $line]
	if {[string length $line] > 0} {
	    if {[string range $line 0 0] != "#"} {
		return $line
	    }
	}
    }
}




proc gmoffread {filename {tol ""}} {
    # gmset brep [gmoffread filename]
    # This routine reads a brep in OFF format from a file.
    # See the documentation for a description of OFF format.
    # OFF format was developed at the University of Minnesota
    # Geometry Center.

    if {$tol == ""} {
	global gm_default_tol
	set tol $gm_default_tol
    }
    global gm_offread_linecount
    global gm_brep_type_code
    set gm_offread_linecount 0
    set fi [open $filename r]
    set filetype [string tolower [gm_offread_getline $fi]]
    if {$filetype != "off" && $filetype != "off\r"} {
	error "File must begin with header word 'OFF'"
    }
    set count [scan [gm_offread_getline $fi] \
	    "%d %d %d" numvtx numfacet numedge]
    if {$count != 3} {
	error "Second line of file must contain three integers"
    }
    set cplist {}
    set vlist {}
    for {set vnum 0} {$vnum < $numvtx} {incr vnum} {
	set count [scan [gm_offread_getline $fi] "%e %e %e" x y z]
	if {$count != 3} {
	    error "Each vertex line must contain three coordinates (error on line $gm_offread_linecount)"
	}
	lappend cplist $x $y $z
	lappend vlist v$vnum {} {} {} [list [list vertex $vnum]]
    }

    set elist {}
    set slist {}
    set rbdry {}
    for {set fnum 0} {$fnum < $numfacet} {incr fnum} {
	set fdesc [gm_offread_getline $fi]
	set numv [lindex $fdesc 0]
	if {[llength $fdesc] == $numv + 1} {
	    set color {}
	} elseif {[llength $fdesc] == $numv + 4} {
	    set color [lrange $fdesc [expr $numv + 1] end]
	} else {
	    error "Wrong number of entries in polygon (error on line $gm_offread_linecount)"
	}

#	puts "before trunc numv = $numv fdesc = $fdesc"
	for {set j1 0} {$j1 < $numv - 1} {incr j1} {
	    if {[lindex $fdesc [expr $j1+1]]==[lindex $fdesc [expr $j1+2]]} {
		set fdesc [concat [lrange $fdesc 0 [expr $j1 + 1]] \
			[lrange $fdesc [expr $j1+3] end]]
		incr numv -1
	    }
	}
#	puts "after trunc numv = $numv rbdry = $rbdry"


	set sbdry {}
	set thisvlist {}
	set thiselist {}
	for {set k 0} {$k < $numv} {incr k} {
	    set v1 [lindex $fdesc [expr $k + 1]]
	    set nextk [expr ($k == $numv - 1)? 0 : $k + 1]
	    set v2 [lindex $fdesc [expr $nextk + 1]]
	    lappend thisvlist [lrange $cplist [expr 3 * $v1] \
		    [expr 3 * $v1 + 2]]
	    lappend thiselist [list $k $nextk]
	    if {$v2 < $v1} {
		set tmp $v1
		set v1 $v2
		set v2 $tmp
	    }
	    if {[catch {incr ecount($v1,$v2)}]} {
		set ecount($v1,$v2) 1
		set topidx [expr [llength $elist] / 5] 
		set ehash($v1,$v2) $topidx
		lappend elist e$topidx {} [list v$v1 v$v2] {} \
			[list [list bezier_curve 1 $v1 $v2]]
	    } else {
		set topidx $ehash($v1,$v2)
	    }
	    lappend sbdry e$topidx
	}
	set trilist [gm_polytri $thisvlist $thiselist $tol]
	set bezlist {}
	foreach tri $trilist {
	    set bez {bezier_triangle 1}
	    for {set p 0} {$p < 3} {incr p} {
		set k [lindex $tri $p]
		set v [lindex $fdesc [expr $k + 1]]
		lappend bez $v
	    }
	    lappend bezlist $bez
	}
	lappend slist s$fnum
	if {[llength $color] == 0} {
	    lappend slist {}
	} else {
	    lappend slist [list color ([lindex $color 0] \
		    [lindex $color 1] [lindex $color 2] 1)]
	}
	lappend slist $sbdry
	lappend slist {}
	lappend slist $bezlist
	lappend rbdry s$fnum
    }
    set alle [array names ecount]
    set emit2d 0
    foreach item $alle {
	if {$ecount($item) != 2} {
	    puts "Boundary does not close: edge $item is contained by $ecount($item) polygon(s) (should be 2)"
	    set emit2d 1
	}
    }
    if {$emit2d} {
	puts "Because boundary does not close, returned brep has no regions"
	set brep [list $gm_brep_type_code 2 3 {} $cplist $vlist $elist $slist]
    } else {
	set rlist [list region {} $rbdry {} {}]
	set brep [list $gm_brep_type_code 3 3 {} $cplist $vlist $elist $slist $rlist]
    }
    return [gm_list2obj $brep]
}

# ------------------------------------------------------------------
# Copyright (c) 1999 by Cornell University.  All rights reserved
# See the accompanying file 'Copyright' for authorship information,
# the terms of the license governing this software, and disclaimers
# concerning this software.
# ------------------------------------------------------------------
# This file is part of the QMG software.  
# Version 2.0 of QMG, release date September 3, 1999
# ------------------------------------------------------------------