gmmake_cyl.tcl

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

proc gmmake_cyl {subdiv} {
    # gmmake_cyl $subdiv
    # creates a cylinder with 3-by-1 degree patches on the
    # side and cubic triangles on top.
    # The argument indicates the number of subdivisions

    if {$subdiv < 3} {
	error "Number of bezier subdivisions must be at least 3"
    }

    global PI
    global qmg_library2

    gmset {vertex code} [gm_circ_approx 0 [expr 2 * $PI] $subdiv]

    set control_points {}

    # top and bottom layers of control points on edges

    for {set j 0} {$j < 3 * $subdiv} {incr j} {
	set thispt [lindex $vertex $j]
	for {set c 0} {$c < 2} {incr c} {
	    lappend control_points [lindex $thispt 0]
	    lappend control_points [lindex $thispt 1]
	    lappend control_points [expr 2 * $c - 1]
	}
    }

    # patches around the cylinder
    
    set surf1 {}
    for {set k 0} {$k < $subdiv} {incr k} {
	set kp1 [expr ($k + 1) % $subdiv]
	lappend surf1 [list bezier_quad 3 1 [expr $k * 6] \
		[expr $k * 6 + 2] \
		[expr $k * 6 + 4] \
		[expr $kp1 * 6] \
		[expr $k * 6 + 1] \
		[expr $k * 6 + 3] \
		[expr $k * 6 + 5] \
		[expr $kp1 * 6 + 1]]
    }

    set surflist [list side_face {} {top_edge bottom_edge} {} $surf1]

    # do the top and bottom

    set edgelist {}

    for {set c 0} {$c < 2} {incr c} {
	# generate an edge
	set thisedgecurve {}
	for {set k 0} {$k < $subdiv} {incr k} {
	    set kp1 [expr ($k + 1) % $subdiv]
	    lappend thisedgecurve [list bezier_curve 3 \
		    [expr $k * 6 + $c] \
		    [expr $k * 6 + 2 + $c] \
		    [expr $k * 6 + 4 + $c] \
		    [expr $kp1 * 6 + $c]]
	}
	if {$c == 0} {
	    set thisedgename bottom_edge
	} else {
	    set thisedgename top_edge
	}
	lappend edgelist $thisedgename {} {} {} $thisedgecurve

	set cpbase1 [expr [llength $control_points] / 3]
	# Generate control points around the bottom or top
	for {set k 0} {$k < $subdiv} {incr k} {
	    lappend control_points [expr .6*cos(2*$PI*$k / $subdiv)]
	    lappend control_points [expr .6*sin(2*$PI*$k / $subdiv)]
	    lappend control_points [expr 2*$c-1]
	}
	set cpbase2 [expr [llength $control_points] / 3]
	for {set k 0} {$k < $subdiv} {incr k} {
	    lappend control_points [expr .6*cos(2*$PI*(0.5+$k) / $subdiv)]
	    lappend control_points [expr .6*sin(2*$PI*(0.5+$k) / $subdiv)]
	    lappend control_points [expr 2*$c-1]
	}
	set cpbase3 [expr [llength $control_points] / 3]
	for {set k 0} {$k < $subdiv} {incr k} {
	    lappend control_points [expr .3*cos(2*$PI*$k / $subdiv)]
	    lappend control_points [expr .3*sin(2*$PI*$k / $subdiv)]
	    lappend control_points [expr 2*$c-1]
	}

	# Generate the last cp.
	set centercp [expr [llength $control_points] / 3]
	lappend control_points 0 0 [expr 2*$c-1]
	# generate the triangular patches making up the face.

	set thisbezlist {}
	for {set k 0} {$k < $subdiv} {incr k} {
	    set kp1 [expr ($k + 1) % $subdiv]
	    lappend thisbezlist [list bezier_triangle 3 \
		  $centercp \
		  [expr $cpbase3 + $k] \
		  [expr $cpbase3 + $kp1] \
		  [expr $cpbase1 + $k] \
		  [expr $cpbase2 + $k] \
		  [expr $cpbase1 + $kp1] \
		  [expr $k * 6 + $c] \
		  [expr $k * 6 + $c + 2] \
		  [expr $k * 6 + $c + 4] \
		  [expr $kp1 * 6 + $c]]
	}
	if {$c == 0} {
	    set surfname bottom_face
	} else {
	    set surfname top_face
	}
	lappend surflist $surfname {} $thisedgename {} $thisbezlist
    }
    set lobj [list brep_v2.0 3 3 {} $control_points {} $edgelist \
	    $surflist \
	    [list cylinder {} {top_face bottom_face side_face} {} {}]]
    return [gm_list2obj $lobj]
}

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