gmmouse.tcl

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

proc gmmouse {} {
    # gmset b [gmmouse]
    # This routine lets the user create a two-dimensional brep
    # by clicking points in a window.  The points trace out
    # the boundary of the brep.  The brep is actually create
    # by gm_cpoly.

    set maxx 500
    set maxy 400
    set offsetx 50
    set offsety 50
    upvar #0 gm_default_button_color bcolor
    global gm_default_axis_color 
    set axcolor $gm_default_axis_color
    global gmmouse_wait
    global gmmouse_nextclicktype
    global gmmouse_beziersub
    set gmmouse_beziersub 10
    set gmm_toplevname gmmouse
    set pointcolor red
    set curvecolor white
    set curvethickness 1
    global gm_brep_type_code


    toplevel .$gmm_toplevname
    # make the background
    canvas .$gmm_toplevname.d -background blue \
	    -width [expr $offsetx*2+$maxx] \
	    -height [expr $offsety*2+$maxy]
    pack .$gmm_toplevname.d -anchor nw

    # Make the y axis, tick marks, and tick labels.
    .$gmm_toplevname.d create line $offsetx $offsety $offsetx $maxy \
	    -fill $axcolor
    for {set y $offsety} {$y < $maxy} {incr y $offsety} {
	.$gmm_toplevname.d create line [expr $offsetx-3] [expr $maxy-$y] \
		[expr $offsetx+3] [expr $maxy-$y] -fill $axcolor
	.$gmm_toplevname.d create text [expr $offsetx-15] [expr $maxy-$y] \
		-text $y -fill $axcolor
    }
    #make the x axis, tick marks, and tick labels.
    .$gmm_toplevname.d create line $offsetx $maxy $maxx $maxy -fill $axcolor
    for {set x $offsetx} {$x < $maxx} {incr x $offsetx} {
	.$gmm_toplevname.d create line [expr $offsetx+$x] [expr $maxy+3] \
		[expr $offsetx+$x] [expr $maxy-3] -fill $axcolor
	.$gmm_toplevname.d create text [expr $offsetx+$x] [expr $maxy+10]\
		-text $x -fill $axcolor
    }
    bind .$gmm_toplevname.d <Button> {set gmmouse_wait [list %x %y]}


    frame .$gmm_toplevname.clicktype  -relief sunken -borderwidth 4
    pack .$gmm_toplevname.clicktype -in .$gmm_toplevname -side left
    label .$gmm_toplevname.clicktypel -text "Next point clicked is..."
    pack .$gmm_toplevname.clicktypel -in .$gmm_toplevname.clicktype
    set gmmouse_nextclicktype 4
    radiobutton .$gmm_toplevname.rb1 \
	    -text "Start of a new loop" -variable gmmouse_nextclicktype \
	    -value 4 -anchor w
    pack .$gmm_toplevname.rb1  -in .$gmm_toplevname.clicktype -side top -fill x
    radiobutton .$gmm_toplevname.rb2 \
	    -text "Start of a new topological edge" \
	    -variable gmmouse_nextclicktype \
	    -value 1 -anchor w -state disabled
    pack .$gmm_toplevname.rb2  -in .$gmm_toplevname.clicktype -side top -fill x
    radiobutton .$gmm_toplevname.rb3 \
	    -text "Start of a new Bezier curve" \
	    -variable gmmouse_nextclicktype \
	    -value 2 -anchor w -state disabled
    pack .$gmm_toplevname.rb3  -in .$gmm_toplevname.clicktype -side top -fill x



    radiobutton .$gmm_toplevname.rb4 \
	    -text "Interior Bezier control point (use GUI panel to control degree of interpolation in display)" \
	    -variable gmmouse_nextclicktype \
	    -value 3 -anchor w -state disabled
    pack .$gmm_toplevname.rb4  -in .$gmm_toplevname.clicktype -side top -fill x

    scale .$gmm_toplevname.slider1 -label \
	    "Number of Bezier subdivisions to display" \
		-from 1 -to 100 \
		-length 3c -orient horizontal \
		-variable gmmouse_beziersub \
		-showvalue 1
    pack .$gmm_toplevname.slider1  -in .$gmm_toplevname.clicktype -side top -fill x




    button .$gmm_toplevname.closepath -text "Close loop" \
	    -command {set gmmouse_wait "button closeloop"} \
	     -background $bcolor -state disabled
    pack .$gmm_toplevname.closepath  -side left
    button .$gmm_toplevname.done -text Done -command \
	    {set gmmouse_wait "button done"} \
	    -background $bcolor -state disabled
    pack .$gmm_toplevname.done  -side left
    button .$gmm_toplevname.cancel -text Cancel -command \
	    {set gmmouse_wait "button cancel"} \
	    -background $bcolor
    pack .$gmm_toplevname.cancel  -side left


    set allpoints {}
    set allcodes {}
    while 1 {
	set loopdone 0
	set loop_pcount 0
	set prevpoint {}
	while {!$loopdone} {
	    set edgedone 0
	    while {!$edgedone} {
		set curvedone 0
		set thiscurve {}
		if {[llength $prevpoint] > 0} {
		    lappend thiscurve $prevpoint
		}
		while {!$curvedone} {
		    tkwait variable gmmouse_wait
		    if {$gmmouse_wait == "button done"} {
			destroy .$gmm_toplevname
			return [gm_cpoly $allpoints $allcodes]
		    } elseif {$gmmouse_wait == "button cancel"} {
			destroy .$gmm_toplevname
			return
		    } elseif {$gmmouse_wait == "button closeloop"} {
			lappend thiscurve [list $loopstartx $loopstarty]
			set curvedone 1
			set edgedone 1
			set loopdone 1
		    } else {
			set screenx [lindex $gmmouse_wait 0]
			set screeny [lindex $gmmouse_wait 1]
			.$gmm_toplevname.d create oval \
				[expr $screenx-2] [expr $screeny-2] \
				[expr $screenx+2] [expr $screeny+2] \
				-outline $pointcolor
			set x [expr $screenx - $offsetx]
			set y [expr $maxy - $screeny]
			set thispoint [list $x $y]
			lappend thiscurve $thispoint
			set prevpoint $thispoint
			lappend allpoints $thispoint
			set ct $gmmouse_nextclicktype
			if {$ct == 4} {
			    lappend allcodes 0
			} else {
			    lappend allcodes $ct
			}
			incr loop_pcount
			if {$loop_pcount == 3} {
			    .$gmm_toplevname.closepath configure -state \
				    normal
			}
			if {$ct == 4} {
			    set loopstartx $x
			    set loopstarty $y
			    .$gmm_toplevname.rb1 configure -state disabled
			    .$gmm_toplevname.rb2 configure -state normal
			    .$gmm_toplevname.rb3 configure -state normal
			    .$gmm_toplevname.rb4 configure -state normal
			    .$gmm_toplevname.closepath configure -state \
				    disabled
			    .$gmm_toplevname.done configure -state \
				    disabled
			    set gmmouse_nextclicktype 1
			} elseif {$ct < 3} {
			    set curvedone 1
			}
		    }
		}
		# draw the curve -- convert to a one-edge brep.
		set cplist {}
		set degree [expr [llength $thiscurve] - 1]
		set bezlist [list bezier_curve $degree]
		set cpindex 0
		foreach pt $thiscurve {
		    lappend cplist [lindex $pt 0] [lindex $pt 1]
		    lappend bezlist $cpindex
		    incr cpindex
		}
		set smallbrep [list $gm_brep_type_code 2 2 {} $cplist \
			[list v0 {} {} {} {{vertex 0}} \
			v1 {} {} {} [list [list vertex $degree]]] \
			[list e0 {} {v0 v1} {} [list $bezlist]] {} ]
		set smallbrep1 [gm_list2obj $smallbrep]
#		puts "smallbrep1 = $smallbrep1\n"
		set ptslines [gm_vizp $smallbrep1 {0 0 0 0} 1 $gmmouse_beziersub]
		set plist [lindex $ptslines 0]
		set simlist [lindex $ptslines 1]
		foreach simp $simlist {
		    set coords [lindex $plist [lindex $simp 0]]
		    set coorde [lindex $plist [lindex $simp 1]]
		    set screenxs [expr [lindex $coords 0] + $offsetx]
		    set screenys [expr $maxy - [lindex $coords 1] ]
		    set screenxe [expr [lindex $coorde 0] + $offsetx]
		    set screenye [expr $maxy - [lindex $coorde 1] ]
		    .$gmm_toplevname.d \
			    create line $screenxs $screenys \
			    $screenxe $screenye -fill $curvecolor \
			    -width $curvethickness
		}
	    }
	}
	.$gmm_toplevname.closepath configure -state \
		disabled
	.$gmm_toplevname.done configure -state \
		normal
	set gmmouse_nextclicktype 4
	.$gmm_toplevname.rb1 configure -state \
		normal
	.$gmm_toplevname.rb2 configure -state \
		disabled
	.$gmm_toplevname.rb3 configure -state \
		disabled
	.$gmm_toplevname.rb4 configure -state \
		disabled


    }
}
	

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