gm_cpoly.tcl

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

proc gm_cpoly {verts codes} {
    # gm_cpoly:
    # Tcl/Tk:  gmset newbrep [gm_cpoly $vtxlist $codelist]
    # This routine creates a 2D polygon.  The argument $vtxlist is a matrix
    # of vertices.  Each row has two entries that are vertex coordinates.
    # These are the vertices of the polygon in order.  The codelist is a
    # list of codes; there is one code per vertex.  The codes are as
    # follows:
    #  0 = vertex is start of a new loop
    #  1 = vertex is start of a new toplogical edge; part of existing loop
    #  2 = vertex is start of bezier curve; part of existing topological edge
    #  3 = vertex is an intermediate bezier control point.
    # The first entry in codes must be 0.  An interactive graphical
    # front-end to this routine is provided by gmmouse.

    global gm_brep_type_code
    set numv [llength $verts]
    if {$numv < 3} {
	error "Need at least three vertices for gm_cpoly."
    }
    if {[llength $codes] != $numv} {
	error "Two arguments to gm_cpoly must have the same number of entries"
    }
    if {[lindex $codes 0] != 0} {
	error "first entry of nodetypelist must be 0"
    }

    for {set j 0} {$j < $numv} {incr j} {
	set nodetype [lindex $codes $j]
	if {$nodetype < 0 || $nodetype > 3 || \
		$nodetype != int($nodetype)} {
	    error "each entry of nodetype must be an integer in 0..3"
	}
    }
    
    # A code to close the final loop.
    lappend verts {-1e308 -1e308}
    lappend codes -1

    set cplist {}
    set tvert {}
    set tedge {}
    set rbdry {}
    set thisedgecurves {}
    set thiscurve {}

    for {set cpind 0} {$cpind < $numv + 1} {incr cpind} {
	set vert [lindex $verts $cpind]
	set code [lindex $codes $cpind]
	if {$code < 3 && $cpind > 0} {
	    if {$code <= 0} {
		set fvertex $loopstart
	    } else {
		set fvertex $cpind
	    }
	    lappend thiscurve $fvertex
	    set degree [expr [llength $thiscurve] - 1]
	    set bez1 [list bezier_curve $degree]
	    append bez1 " " $thiscurve
	    lappend thisedgecurves $bez1
	    set thiscurve {}
	    if {$code < 2} {
		lappend tedge e$cpind {} [list v$edgestart v$fvertex] \
			{} $thisedgecurves
		lappend rbdry e$cpind
		set thisedgecurves {}
	    }
	}
	if {$code == -1} {
	    break
	}
	lappend cplist [lindex $vert 0] [lindex $vert 1]
	lappend thiscurve $cpind
	if {$code < 2} {
	    set edgestart $cpind
	    lappend tvert v$cpind {} {} {} [list [list vertex $cpind]]
	    if {$code < 1} {
		set loopstart $cpind
	    }
	}
    }
    set tregion [list mregion {} $rbdry {} {}]
    set brep0 [list $gm_brep_type_code 2 2 {} $cplist $tvert $tedge $tregion]
    return [gm_list2obj $brep0]
}
# ------------------------------------------------------------------
# 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
# ------------------------------------------------------------------