gmviz.tcl

来自「算断裂的」· TCL 代码 · 共 705 行 · 第 1/2 页

    global $canv.offsets
    set $canv.offsets [list $xmult $xoffset $ymult $yoffset]
    return {}
}



proc gmviz_process_rgb colorname {
    set rgbnumeric [winfo rgb . $colorname]
    return [list \
	    [expr [lindex $rgbnumeric 0] / 65535.0] \
	    [expr [lindex $rgbnumeric 1] / 65535.0] \
	    [expr [lindex $rgbnumeric 2] / 65535.0] \
	    1]
}

proc gm_vizvrml_0dthin {plist colorlist channel} {
    puts $channel "  Separator \{"
    puts $channel "    Material \{"
    puts $channel "      diffuseColor \["
    foreach coloritem $colorlist {
	if {[lindex $coloritem 3] > 0} {
	    puts $channel "        [lrange $coloritem 0 2],"
	}
    }
    puts $channel "      \]  \# end of diffusecolor"
    puts $channel "      transparency \["
    foreach coloritem $colorlist {
	if {[lindex $coloritem 3] > 0} {
	    puts $channel "        [expr 1.0-[lindex $coloritem 3]],"
	}
    }
    puts $channel "      \] \# end of transparency"
    puts $channel "    \} \# end of Material"
    puts $channel "    MaterialBinding \{ value PER_FACE \}"
    puts $channel "    Coordinate3 \{"
    puts $channel "      point \["
    for {set i 0} {$i < [llength $plist]} {incr i} {
	set coloritem [lindex $colorlist $i]
	set point "[lindex $plist $i] 0 0 0"
	if {[lindex $coloritem 3] > 0} {
	    puts $channel "        [lrange $point 0 2],"
	}
    }
    puts $channel "      \] \# end of point"
    puts $channel "    \} \# end of Coordinate3"
    puts $channel "    PointSet \{startIndex 0 numPoints -1\}"
    puts $channel "  \} \# end of Separator"
}


proc gm_vizvrml_0dfat {plist colorlist channel thick} {
    for {set i 0} {$i < [llength $plist]} {incr i} {
	set point "[lindex $plist $i] 0 0 0"
	set coloritem [lindex $colorlist $i]
	set transp [lindex $coloritem 3]
	if {$transp > 0} {
	    puts $channel "  Separator \{"
	    puts $channel "    Material \{"
	    puts $channel "      diffuseColor [lrange $coloritem 0 2]"
	    puts $channel "      transparency [expr 1.0-$transp]"
	    puts $channel "    \}"
	    puts $channel "    Transform \{ translation [lrange $point 0 2] \}"
	    puts $channel "    Sphere \{ radius $thick \}"
	    puts $channel "  \}"
	}
    }
}

proc gm_vizvrml_1dthin {plist slist colorlist channel} {
    puts $channel "  Separator \{"
    puts $channel "    Material \{"
    puts $channel "      diffuseColor \["
    foreach coloritem $colorlist {
	if {[lindex $coloritem 3] > 0} {
	    puts $channel "        [lrange $coloritem 0 2],"
	}
    }
    puts $channel "      \]  \# end of diffuseColor"
    puts $channel "      transparency \["
    foreach coloritem $colorlist {
	if {[lindex $coloritem 3] > 0} {
	    puts $channel "        [expr 1.0-[lindex $coloritem 3]],"
	}
    }
    puts $channel "     \] \# end of transparency"
    puts $channel "    \} \# end of Material"
    puts $channel "    MaterialBinding \{ value PER_FACE \}"
    puts $channel "    Coordinate3 \{"
    puts $channel "      point \["
    for {set i 0} {$i < [llength $plist]} {incr i} {
	set point "[lindex $plist $i] 0 0 0"
	puts $channel "        [lrange $point 0 2],"
    }
    puts $channel "      \] \# end of point"
    puts $channel "    \} \# end of Coordinate3"
    puts $channel "    IndexedLineSet \{"
    puts $channel "      coordIndex \["
    for {set i 0} {$i < [llength $slist]} {incr i} {
	set simp [lindex $slist $i]
	set coloritem [lindex $colorlist $i]
	if {[lindex $coloritem 3] > 0} {
	    puts $channel "        [lindex $simp 0], [lindex $simp 1], -1,"
	}
    }
    puts $channel "      \] \# end of coordIndex"
    puts $channel "    \} \# end of IndexedLineSet"
    puts $channel "  \} \# end of Separator"
}

proc gm_vizvrml_1dfat {plist slist colorlist channel thick1} {
    for {set i 0} {$i < [llength $slist]} {incr i} {
	set simp [lindex $slist $i]
	set coloritem [lindex $colorlist $i]
	set transp [lindex $coloritem 3]
	if {$transp > 0} {
	    puts $channel "  Separator \{"
	    puts $channel "    Material \{"
	    puts $channel "      diffuseColor [lrange $coloritem 0 2]"
	    puts $channel "      transparency [expr 1.0-$transp]"
	    puts $channel "    \}"
	    set spind [lindex $simp 0]
	    set epind [lindex $simp 1]
	    set sp "[lindex $plist $spind] 0 0 0"
	    set ep "[lindex $plist $epind] 0 0 0"
	    set displ {}
	    for {set j 0} {$j < 3} {incr j} {
		lappend displ [expr [lindex $sp $j] - [lindex $ep $j]]
	    }
	    set retval [gm_viz_make_hhtrans $displ]
	    set hhmat [gm_viz_make_hhmat [lindex $retval 0] [lindex $retval 1]]
	    set transformc0 {}
	    set transformc1 {}
	    set transformc2 {}
	    set transformc3 {}
	    for {set j 0} {$j < 3} {incr j} {
		lappend transformc0 [expr $thick1 * \
			[lindex [lindex $hhmat 1] $j]]
		lappend transformc1 [expr 0.5 * [lindex $displ $j]]
		lappend transformc2 [expr $thick1 * \
			[lindex [lindex $hhmat 2] $j]]
		lappend transformc3 [expr 0.5 * \
			([lindex $sp $j] + [lindex $ep $j])]
	    }
	    set det [expr \
		    [lindex $transformc0 0] * \
		    ([lindex $transformc1 1] * [lindex $transformc2 2] - \
		    [lindex $transformc1 2] * [lindex $transformc2 1]) + \
		    [lindex $transformc0 1] * \
		    ([lindex $transformc1 2] * [lindex $transformc2 0] - \
		    [lindex $transformc1 0] * [lindex $transformc2 2]) + \
		    [lindex $transformc0 2] * \
		    ([lindex $transformc1 0] * [lindex $transformc2 1] - \
		    [lindex $transformc1 1] * [lindex $transformc2 0])]
	    if {$det < 0} {
		set t0 {}
		for {set j 0} {$j < 3} {incr j} {
		    lappend t0 [expr -[lindex $transformc0 $j]]
		}
		set transformc0 $t0
	    }
	    lappend transformc0 0
	    lappend transformc1 0
	    lappend transformc2 0
	    lappend transformc3 1
	    puts $channel "    MatrixTransform \{ matrix "
	    puts $channel "      $transformc0"
	    puts $channel "      $transformc1"
	    puts $channel "      $transformc2"
	    puts $channel "      $transformc3"
	    puts $channel "    \}"
	    puts $channel "    Cylinder \{ \}"
	    puts $channel "  \} \# end of Separator"
	}
    }
}



proc gm_viz_make_hhtrans {vec} {
    set sigma 0.0
    for {set i 1} {$i < [llength $vec]} {incr i} {
	set sigma [expr $sigma + [lindex $vec $i] * [lindex $vec $i]]
    }
    if {$sigma == 0.0} {
	set beta 1.0
	set hhtrans {}
	for {set j 0 } {$j < [llength $vec]} {incr j} {
	    lappend hhtrans 0.0
	}	    
    } else {
	set vec0 [lindex $vec 0]
	set mu [expr sqrt($vec0 * $vec0 + $sigma)]
	if {$vec0 < 0} {
	    set hhtrans [expr $vec0 - $mu]
	} else {
	    set hhtrans [expr -$sigma / ($vec0 + $mu)]
	}
	set beta [expr -1.0 / ($mu * $hhtrans)]
	for {set i 1} {$i < [llength $vec]} {incr i} {
	    lappend hhtrans [lindex $vec $i]
	}
    }
    return [list $beta $hhtrans]
}

proc gm_viz_make_hhmat {beta hhtrans} {
    set hhmat {}
    set n [llength $hhtrans]
    for {set i 0} {$i < $n} {incr i} {
	set matrow {}
	for {set j 0} {$j < $n} {incr j} {
	    set entry \
		    [expr -$beta * [lindex $hhtrans $i] * [lindex $hhtrans $j]]
	    if {$i == $j} {
		set entry [expr $entry + 1.0]
	    }
	    lappend matrow $entry
	}
	lappend hhmat $matrow
    }
    return $hhmat
}

proc gm_vizvrml_2dthin {plist slist colorlist channel} {
    puts $channel "  Separator \{"
    puts $channel "    Material \{"
    puts $channel "      diffuseColor \["
    foreach coloritem $colorlist {
	if {[lindex $coloritem 3] > 0} {
	    puts $channel "        [lrange $coloritem 0 2],"
	}
    }
    puts $channel "      \]  \# end of diffuseColor"
    puts $channel "      transparency \["
    foreach coloritem $colorlist {
	if {[lindex $coloritem 3] > 0} {
	    puts $channel "        [expr 1.0-[lindex $coloritem 3]],"
	}
    }
    puts $channel "     \] \# end of transparency"
    puts $channel "    \} \# end of Material"
    puts $channel "    MaterialBinding \{ value PER_FACE \}"
    puts $channel "    Coordinate3 \{"
    puts $channel "      point \["
    for {set i 0} {$i < [llength $plist]} {incr i} {
	set point "[lindex $plist $i] 0 0 0"
	puts $channel "        [lrange $point 0 2],"
    }
    puts $channel "      \] \# end of point"
    puts $channel "    \} \# end of Coordinate3"
    puts $channel "    IndexedFaceSet \{"
    puts $channel "      coordIndex \["
    for {set i 0} {$i < [llength $slist]} {incr i} {
	set simp [lindex $slist $i]
	set coloritem [lindex $colorlist $i]
	if {[lindex $coloritem 3] > 0} {
	    puts $channel \
		    "        [lindex $simp 0], [lindex $simp 1], [lindex $simp 2], -1,"
	}
    }
    puts $channel "      \] \# end of coordIndex"
    puts $channel "    \} \# end of IndexedFaceSet"
    puts $channel "  \} \# end of Separator"
}

    



proc gm_vizvrml args {
    set filename [lindex $args 0]
    set filestat [lindex $args 1]
    set notify [lindex $args 2]
    set thickness [lindex $args 3]
    set bbox [lindex $args end]
    set numrender [expr ([llength $args] - 5) / 4]
#    puts "thickness = $thickness"

    set maxwidth 0
    set lb [lindex $bbox 0]
    set ub [lindex $bbox 1]
    for {set i 0} {$i < [llength $lb]} {incr i} {
	set delta [expr [lindex $ub $i] - [lindex $lb $i]]
	if {$delta > $maxwidth} {
	    set maxwidth $delta
	}
    }
    
    if {$maxwidth == 0} {
	set multiplier 1e-4
    } else {
	set multiplier [expr $maxwidth * 1e-4]
    }

    set camerax [expr 0.5 * ([lindex $lb 0] + [lindex $ub 0])]
    set cameray [expr 0.5 * ([lindex $lb 1] + [lindex $ub 1])]
    set maxz [lindex $ub 2]
    set cameraz [expr $maxz + 3*$maxwidth]

    if {$filestat == "replace"} {
	set channel [open $filename w]
    } else {
	set channel [open $filename a]
    }
    puts $channel "\#VRML V1.0 ascii"
    puts $channel "Separator \{"
    puts $channel "  PerspectiveCamera \{ position $camerax $cameray $cameraz \}"
    for {set ren 0} {$ren < $numrender} {incr ren} {
	set dim [lindex $args [expr $ren * 4 + 4]]
	set plist [lindex $args [expr $ren * 4 + 5]]
	set simlist [lindex $args [expr $ren * 4 + 6]]
	set colorlist [lindex $args [expr $ren * 4 + 7]]
	set thick0 [lindex $thickness $dim]
	set thick1 [expr $multiplier * $thick0]
#	puts "thick0 = $thick0 thick1 = $thick1"
	if {$dim == 0} {
	    if {$thick0 <= 1} {
		gm_vizvrml_0dthin $plist $colorlist $channel
	    } else {
		gm_vizvrml_0dfat $plist $colorlist $channel $thick1
	    }
	} elseif {$dim == 1} {
	    if {$thick0 <= 1} {
		gm_vizvrml_1dthin $plist $simlist $colorlist $channel
	    } else {
		gm_vizvrml_1dfat $plist $simlist $colorlist $channel $thick1
	    }
	} elseif {$dim == 2} {
	    gm_vizvrml_2dthin $plist $simlist $colorlist $channel
	}
    }
    puts $channel "\} \# end of top-lev separator (for camera)"
    close $channel
    if {$notify != "none"} {
	gm_url $notify $filename
    }
}


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