gm_meshgui.tcl

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

proc gm_mgui_maybe_delete handle {
    global gm_mgui_toplevname
    if {$handle != ""} {
	.$gm_mgui_toplevname.c delete $handle
    }
}

proc gm_meshgui args {
    ## gm_mggui $op $data
    ## Called by gm_meshgen to create a GUI for the quadtree/octree
    ## mesh generator
    global gm_mgui_cancel_pressed
    global gm_mgui_dismiss_posted
    global gm_mgui_error_occurred
    global gm_mgui_txt1
    global gm_mgui_txt2
    global gm_mgui_txt3
    global gm_mgui_txt4
    global gm_mgui_txt5
    global gm_mgui_txt6
    global gm_mgui_txt7
    global gm_mgui_toplev_name
    global gm_mgui_toplevname
    upvar #0 gm_default_button_color bcolor
    upvar #0 tcl_platform tcl_platform
    if {$tcl_platform(platform) == "windows"} {
	set mgfontname {Arial 12 bold}
	set mgfontnameh {Arial 15 bold}
    } else {
	set mgfontname -*-helvetica-bold-r-normal--12-*-*-*-*-*-*-*
	set mgfontnameh -*-helvetica-bold-r-normal--14-*-*-*-*-*-*-*
    }

    set operation [lindex $args 0]
    if {$operation == "init"} {
	set gm_mgui_dismiss_posted 0
	set gm_mgui_cancel_pressed 0
	set gm_mgui_error_occurred 0
	set index 1
	set found 0
	set cmds [info commands]
	while {$found == 0} {
	    set toplevname "gm_meshgen$index"
	    if {[lsearch $cmds .$toplevname] < 0} {
		set found 1
	    } else {
		incr index
	    }
	}
	set handle $index
	toplevel .$toplevname
	frame .$toplevname.fr
	pack .$toplevname.fr
	canvas .$toplevname.c -background khaki4 \
		-width 550 \
		-height 300
	pack .$toplevname.c -in .$toplevname.fr
	set gm_mgui_toplevname $toplevname
	set gm_mgui_txt7 [.$toplevname.c create text 2c 1.0c \
		-text "QMG 2.0 mesh generation in progress" \
		-font $mgfontnameh \
		-anchor sw \
		]


	set gm_mgui_txt1 ""
	set gm_mgui_txt2 ""
	set gm_mgui_txt3 ""
	set gm_mgui_txt4 ""
	set gm_mgui_txt5 ""
	set gm_mgui_txt6 ""
	button .$toplevname.cancelbutton -background $bcolor \
		-text Cancel -command {gm_meshgui cancelbuttonpress}
	pack .$toplevname.cancelbutton -in .$toplevname.fr -side top -anchor nw
    } elseif {$operation == "update"} {
	if {$gm_mgui_cancel_pressed} {
	    error "Cancel button was pressed."
	}
	gm_mgui_maybe_delete $gm_mgui_txt1
	set gm_mgui_txt1 [.$gm_mgui_toplevname.c create text 0.5c 2c \
		-text [list Number of active boxes = [lindex $args 1]] \
		-anchor sw \
		-font $mgfontname]
	gm_mgui_maybe_delete $gm_mgui_txt2
	set gm_mgui_txt2 [.$gm_mgui_toplevname.c create text 0.5c 2.5c \
		-anchor sw \
		-text [list Number of finished boxes = [lindex $args 2]] \
		-font $mgfontname]

	gm_mgui_maybe_delete $gm_mgui_txt3
	set gm_mgui_txt3 [.$gm_mgui_toplevname.c create text 0.5c 3.0c \
		-text [list Number of vertices = [lindex $args 4]] \
		-anchor sw \
		-font $mgfontname]

	gm_mgui_maybe_delete $gm_mgui_txt4
	set gm_mgui_txt4 [.$gm_mgui_toplevname.c create text 0.5c 3.5c \
		-text [list Number of elements = [lindex $args 3]] \
		-anchor sw \
		-font $mgfontname]

	update
    } elseif {$operation == "end"} {
	destroy .$gm_mgui_toplevname.cancelbutton
	gm_mgui_maybe_delete $gm_mgui_txt7
	if {$gm_mgui_error_occurred} {
	    set txt1 "QMG mesh generation terminated due to error"
	} else {
	    set txt1 "QMG mesh generation is complete"
	}

	set gm_mgui_txt7 [.$gm_mgui_toplevname.c create text 2c 1.0c \
		-anchor sw \
		-text $txt1 \
		-font $mgfontnameh]


#	puts "dismiss posted = $gm_mgui_dismiss_posted\n"

	if {!$gm_mgui_dismiss_posted} {
	    button .$gm_mgui_toplevname.dismissbutton -text "Dismiss" \
		-background $bcolor \
		-command [list destroy .$gm_mgui_toplevname]
	    pack .$gm_mgui_toplevname.dismissbutton \
		    -in .$gm_mgui_toplevname.fr -side top -anchor ne
	    update
	    set gm_mgui_dismiss_posted 1
	}
    } elseif {$operation == "errormsg"} {
#	gm_mgui_maybe_delete $gm_mgui_txt5
#	set gm_mgui_txt5 [.$gm_mgui_toplevname.c create text 0.5c 3.0c \
#		-text "Error has occurred: [lindex $args 1]" \
#		-anchor sw \
#		]
	text .$gm_mgui_toplevname.t \
		-yscrollcommand ".$gm_mgui_toplevname.s set" \
		-background white -height .2c
	scrollbar .$gm_mgui_toplevname.s \
		-command ".$gm_mgui_toplevname.t yview"
	pack .$gm_mgui_toplevname.s -side right -fill y
	pack .$gm_mgui_toplevname.t -side left
	.$gm_mgui_toplevname.t insert end \
		"Error has occurred: [lindex $args 1]"
	set gm_mgui_error_occurred 1
	if {!$gm_mgui_dismiss_posted} {
	    button .$gm_mgui_toplevname.dismissbutton -text "Dismiss" \
		-background $bcolor \
		-command [list destroy .$gm_mgui_toplevname]
	    pack .$gm_mgui_toplevname.dismissbutton \
		    -in .$gm_mgui_toplevname.fr -side top -anchor ne
	    update
	    set gm_mgui_dismiss_posted 1
	}
    } elseif {$operation == "operation"} {
	gm_mgui_maybe_delete $gm_mgui_txt5
	set gm_mgui_txt5 [.$gm_mgui_toplevname.c create text 0.5c 4.0c \
		-text [lindex $args 1] \
		-anchor sw \
		-font $mgfontname]
	gm_mgui_maybe_delete $gm_mgui_txt6
	set gm_mgui_txt6 ""
    } elseif {$operation == "operation2"} {
	gm_mgui_maybe_delete $gm_mgui_txt6
	set gm_mgui_txt6 [.$gm_mgui_toplevname.c create text 0.5c 4.5c \
		-text [list Current operation: [lindex $args 1]] \
		-anchor sw \
		-font $mgfontname]
    } elseif {$operation == "cancelbuttonpress"} {
	puts "cancel pressed\n"
	set gm_mgui_cancel_pressed 1
    } else {
	error "Unknown operation '$operation'"
    }
}


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