gm_circ_approx.tcl

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

proc gm_circ_approx {startang endang numsubdiv} {
    # gm_circ_approx $startang $endang $numsubdiv 
    # creates two lists suitable (after modification) for input to gm_cpoly
    # that are a bezier degree-3 approximation to a circular arc starting from
    # angle startang, going to endang, with numsubdiv
    # divisions.
    
    set totalarc [expr 0.0 + $endang - $startang]
    set onearc [expr $totalarc / $numsubdiv]
    set p [expr 1.0 / tan($onearc / 2)]
    set p1 [expr  1 + 1 / ($p * $p)]
    set alpha [expr (sqrt(3 * $p1 + 1) - 1) / (1.5 * $p1)]

    set r1 [expr sqrt((1 - $alpha) * (1 - $alpha) + \
	    ($alpha / $p + $p) * ($alpha / $p + $p)) / sqrt(1 + $p * $p)]
    set a1 [expr atan($alpha/$p)]

    set verts {}
    set codes {}
    for {set j 0} {$j < $numsubdiv} {incr j} {
	set baseang [expr 0.0 + $startang + $onearc * $j]
	set ang1 [expr $baseang + $a1]
	set ang2 [expr $baseang + $onearc - $a1]
	lappend verts [list [expr cos($baseang)] [expr sin($baseang)]]
	lappend verts [list [expr $r1 * cos($ang1)] [expr $r1 * sin($ang1)]]
	lappend verts [list [expr $r1 * cos($ang2)] [expr $r1 * sin($ang2)]]
	if {$j > 0} {
	    lappend codes 2 3 3
	} else {
	    lappend codes 1 3 3
	}
    }
    lappend verts [list [expr cos($endang)] [expr sin($endang)]]
    lappend codes 1
    return [list $verts $codes]
}

		
# ------------------------------------------------------------------
# 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
# ------------------------------------------------------------------