gmviz.tcl

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

proc gmviz {obj {vizcolor ""} {vizdim ""}} {
    ## gmviz $obj {$vizcolor {$vizdim}}
    ## Displays an object.  The object is either a brep or simplicial
    ## complex.  The object is either displayed in the
    ## graphics window or is sent to a file in VRML1.0 format, 
    ## and may be automatically loaded by a web browser.  The
    ## selection of the graphics engine is controlled by gmvizgui.
    ## Argument color is either a list of X11 colors like red, white
    ## or a matrix with a 4-element color spec per row.
    ## vizdim is the dimension or dimensions to plot.  The number
    ## of colors specified must be the same as the number of dimensions
    ## specified.  See the documentation for more information.
    ## A second calling format is 
    ## gmviz [list $simpcomp $brep] {$vizcolor {$vizdim}}
    ## in which case the simplicial complex colors are derived
    ## from the brep color specifications.

    set ty [gm_objtype $obj]
    if {$ty == "brep"} {
	set pair 0
	set objl [gm_obj2list $obj]
    } elseif {$ty == "simpcomp"} {
	set pair 0
	set objl [gm_obj2list $obj]
    } else {
	if {[llength $obj] == 2} {
	    set pair 1
	    set objl [gm_obj2list [lindex $obj 0]]
	} else {
	    set pair 0
	    set objl [gm_obj2list $obj]
	}
    }


    set gdim [lindex $objl 1]


    set di [lindex $objl 2]
    if {$gdim < 0} {
	error "Attempt to plot empty object"
    }
    if {$di != 2 && $di != 3} {
	error "Object must have embedded dimension either 2 or 3"
    }
    if {$di == 2} {
	set bbox {{1e307 1e307} {-1e307 -1e307}}
    } else {
	set bbox {{1e307 1e307 1e307} {-1e307 -1e307 -1e307}}
    }


    set bigreturn [gmvizgui getglobals $di]
    set engine [lindex $bigreturn 0]
    set filename [lindex $bigreturn 1]
    set filestat [lindex $bigreturn 2]
    set notify [lindex $bigreturn 3]
    set format [lindex $bigreturn 4]
    set thickness [lindex $bigreturn 5]
    set default_color [lindex $bigreturn 6]
    set beziersub [lindex $bigreturn 7]
    if {[string length $vizcolor] == 0} {
	set vizcolor [list $default_color]
    }
    if {[string length $vizdim] == 0} {
	if {$gdim < [expr $di - 1]} {
	    set vizdim1 $gdim
	} else {
	    set vizdim1 [expr $di - 1]
	}
	set vizdim [list $vizdim1]
    }
    
    if {[llength $vizcolor] !=  [llength $vizdim]} {
	error "vizcolor and vizdim arguments must have the same number of entries"
    }
    
    set vizcolor1 {}
    foreach item $vizcolor {
	set item1 $item
	if {[llength $item] != 4} {
	    set item1 [gmviz_process_rgb $item1]
	}
	lappend vizcolor1 $item1
    }

    if {[llength $vizdim] > 3} {
	error "At most 3 dimensions plotted at once"
    }

    if {$engine == "local"} {
	set plotcmd [list gm_viztk $thickness]
    } else {
	set plotcmd [list gm_vizvrml $filename $filestat $notify $thickness]
    }


    for {set k 0} {$k < [llength $vizdim]} {incr k} {
	if {$pair} {
	    set bigreturn [gm_vizp [lindex $obj 0] [lindex $obj 1] \
		    [lindex $vizcolor1 $k] \
		    [lindex $vizdim $k]  $beziersub]
	} else {
	    set bigreturn [gm_vizp $obj [lindex $vizcolor1 $k] \
		    [lindex $vizdim $k]  $beziersub]
	}
	set plist [lindex $bigreturn 0]
	set bbox [gm_viz_updatebbox $bbox $plist]
	lappend plotcmd [lindex $vizdim $k]
	lappend plotcmd [lindex $bigreturn 0]
	lappend plotcmd [lindex $bigreturn 1]
	lappend plotcmd [lindex $bigreturn 2]
    }
    lappend plotcmd $bbox
    eval $plotcmd
}


proc gm_viz_make_axes {lbx ubx lby uby} {
    global gm_default_axis_color 
    set axcolor $gm_default_axis_color

    # Take care of the case of a degenerate bounding box.
    
    if {$lbx > $ubx} {
	set lbx 0
	set ubx 1
    }
    if {$lby > $uby} {
	set lby 0
	set uby 1
    }

    # These parameters determine the size of the graphing window in absolute
    # pixel coordinates.  Currently there is no way to change these settings
    # other than editing this file.

    # offset of axes from picture boundary.
    set offsetx 40
    set offsety 20

    # max number of pixels in each dimension
    set maxpixel 500

    # colors

    # Make a top level; use gmviz-1, gmviz-2, etc.
    # Find the first free index.

    set index 1
    set found 0
    set cmds [info commands]
    while {$found == 0} {
	set toplevname "gmviz-$index"
	if {[lsearch $cmds .$toplevname] < 0} {
	    set found 1
	} else {
	    incr index
	}
    }
    set handle $index
    toplevel .$toplevname
    frame .$toplevname.frame
    pack .$toplevname.frame

    # Figure out the coordinate transformations from
    # real coordinates to pixel coordinates.
    # continue figuring out the transform.
    
    set deltax [expr 1.2 * ($ubx - $lbx)]
    set deltay [expr 1.2 * ($uby - $lby)]
    set basex [expr $lbx - 0.1 * $deltax]
    set basey [expr $lby - 0.1 * $deltay]
    if {$deltax <= 0.0} {
	set deltax 1.0
    }

    if {$deltay <= 0.0} {
	set deltay 1.0
    }

    if {$deltax > $deltay} {
	set maxx $maxpixel
	set maxy [expr int($deltay * $maxpixel / $deltax)]
    } else {
	set maxy $maxpixel
	set maxx [expr int($deltax * $maxpixel / $deltay)]
    }

    canvas .$toplevname.v -background khaki4 \
	    -width [expr $offsetx*2.5+$maxx] \
	    -height [expr $offsety*2.5+$maxy]	
    pack .$toplevname.v -in .$toplevname.frame


    # figure out tick-mark spacing.

    set inc [expr pow(10,floor(log10($deltax)))]
    set ct [expr $deltax/$inc]
    if {$ct <= 2} {
	set inc [expr (0.0+$inc) / 5.0]
    } elseif {$ct <= 5} {
	set inc [expr (0.0+$inc) / 2.0]
    }
    
    global tcl_precision

    # make the y-axis,  tick marks and tick mark labels
    
    .$toplevname.v create line $offsetx 0 \
	    $offsetx $maxy -fill $axcolor
    set yc [expr ceil($basey/$inc)*$inc]
    while {$yc < $basey+$deltay} {
	set y [expr (0.0 + $yc - $basey) * $maxy / $deltay]
	set yy [expr $maxy-$y]
	.$toplevname.v create line [expr $offsetx-3] $yy \
		[expr $offsetx+3] $yy -fill $axcolor
	set tmp $tcl_precision
	set tcl_precision 4
	set yc1 "[expr 0.0+$yc] "
	set tcl_precision $tmp
	.$toplevname.v create text [expr $offsetx-15] $yy \
		-text $yc1 -fill $axcolor
	set yc [expr $yc+$inc]
    }
    
    # make the x-axis,  tick marks and tick mark labels
    
    .$toplevname.v create line $offsetx $maxy \
	    [expr $maxx+$offsetx] $maxy -fill $axcolor
    set xc [expr ceil($basex/$inc)*$inc]
    while {$xc < $basex+$deltax} {
	set x [expr (0.0 + $xc - $basex) * $maxx / $deltax]
	set xx [expr $offsetx+$x]
	.$toplevname.v create line $xx [expr $maxy+3] \
		$xx [expr $maxy-3] -fill $axcolor
	set tmp $tcl_precision
	set tcl_precision 4
	set xc1 "[expr 0.0+$xc] "
	set tcl_precision $tmp
	set xc [expr $xc+$inc]
	.$toplevname.v create text $xx [expr $maxy+10]\
		-text $xc1 -fill $axcolor
    }


    set xoffset [expr $offsetx - $basex * $maxx / $deltax]
    set xmult [expr $maxx / $deltax]
    set yoffset [expr $maxy + $basey * $maxy / $deltay]
    set ymult [expr -$maxy / $deltay]

    return [list $toplevname v $xoffset $yoffset $xmult $ymult]
}

proc gm_viz_make_dismiss toplevname {
    global gm_default_button_color
    button .$toplevname.dismiss \
	    -text "Dismiss" \
	    -command [list destroy .$toplevname] \
	    -background $gm_default_button_color
    pack .$toplevname.dismiss -in .$toplevname.frame -side top -anchor ne
}

proc gm_viz_updatebbox {initbbox plist} {
    set lb [lindex $initbbox 0]
    set ub [lindex $initbbox 1]
    set dim [llength $lb]
    foreach point $plist {
	for {set i 0} {$i < $dim} {incr i} {
	    set c [lindex $point $i]
	    if {$c < [lindex $lb $i]} {
		set lb [lreplace $lb $i $i $c]
	    }
	    if {$c > [lindex $ub $i]} {
		set ub [lreplace $ub $i $i $c]
	    }
	}
    }
    return [list $lb $ub]
}
    


proc gm_viztk args {
    set thickness [lindex $args 0]
    set numrender [expr ([llength $args] - 2) / 4]
    set bbox [lindex $args end]
    set lb [lindex $bbox 0]
    set ub [lindex $bbox 1]
    set lbx [lindex $lb 0]
    set lby [lindex $lb 1]
    set ubx [lindex $ub 0]
    set uby [lindex $ub 1]
    set axdata [gm_viz_make_axes $lbx $ubx $lby $uby]
    set toplevname [lindex $axdata 0]
    set canvname [lindex $axdata 1]
    set xoffset [lindex $axdata 2]
    set yoffset [lindex $axdata 3]
    set xmult [lindex $axdata 4]
    set ymult [lindex $axdata 5]
    set canv .${toplevname}.${canvname}
    for {set whichr 0} {$whichr < $numrender} {incr whichr} {
	set dim [lindex $args [expr $whichr * 4 + 1]]
	set plist [lindex $args [expr $whichr * 4 + 2]]
	set simlist [lindex $args [expr $whichr * 4 + 3]]
	set colorlist [lindex $args [expr $whichr * 4 + 4]]
	set numsimp [llength $simlist]
	set thick [lindex $thickness $dim]
	set th1 [expr int($thick / 50.0)]

	for {set snum 0} {$snum < $numsimp} {incr snum} {
	    set color [lindex $colorlist $snum]
	    if {[lindex $color 3] > 0} {
		set hexcolor [format "#%2x%2x%2x" \
			[expr int([lindex $color 0]*255.0)] \
			[expr int([lindex $color 1]*255.0)] \
			[expr int([lindex $color 2]*255.0)]]
		regsub -all " " $hexcolor 0 hexcolor1
		set simp [lindex $simlist $snum]
		if {$dim == 0} {
		    set coord [lindex $plist [lindex $simp 0]]
		    set xc [expr [lindex $coord 0] * $xmult + $xoffset]
		    set yc [expr [lindex $coord 1] * $ymult + $yoffset]
		    $canv create oval [expr $xc - $th1] \
			    [expr $yc - $th1] \
			    [expr $xc + $th1] [expr $yc + $th1] \
			    -fill $hexcolor1
		} elseif {$dim == 1} {
		    set coords [lindex $plist [lindex $simp 0]]
		    set coorde [lindex $plist [lindex $simp 1]]
		    set xs [expr [lindex $coords 0] * $xmult + $xoffset]
		    set ys [expr [lindex $coords 1] * $ymult + $yoffset]
		    set xe [expr [lindex $coorde 0] * $xmult + $xoffset]
		    set ye [expr [lindex $coorde 1] * $ymult + $yoffset]
		    $canv create line $xs $ys $xe $ye -fill $hexcolor1 \
			    -width $th1
		} else {
		    set coorda [lindex $plist [lindex $simp 0]]
		    set coordb [lindex $plist [lindex $simp 1]]
		    set coordc [lindex $plist [lindex $simp 2]]
		    set xa [expr [lindex $coorda 0] * $xmult + $xoffset]
		    set ya [expr [lindex $coorda 1] * $ymult + $yoffset]
		    set xb [expr [lindex $coordb 0] * $xmult + $xoffset]
		    set yb [expr [lindex $coordb 1] * $ymult + $yoffset]
		    set xc [expr [lindex $coordc 0] * $xmult + $xoffset]
		    set yc [expr [lindex $coordc 1] * $ymult + $yoffset]
		    $canv create polygon \
			    $xa $ya $xb $yb $xc $yc -fill $hexcolor1
		}
	    }
	}
    }
    gm_viz_make_dismiss $toplevname