utils.tcl

卫星仿真软件 卫星仿真软件 卫星仿真软件

    set stext [ build_StdFrame $parent $name ]

    # add text widget
    if {[winfo exists $stext.text] == 0} {
	text $stext.text -relief sunken -bd 2 \
	    -yscrollcommand "$stext.scroll set" \
	    -bg COLOR(entry) -font $FONT(label) \
	    -width 1 -height 1
	$stext.text configure -width $width -height $height
	pack $stext.text -side left -fill both -expand 1
    }
    # add scrollbar
    if {[winfo exists $stext.scroll] == 0} {
       scrollbar $stext.scroll -command "$stext.text yview" \
	pack $stext.scroll -side right -fill y
    }
    pack $stext -expand 1 -fill both
    return $stext.text
}

#
# build_Text
#
# Builds a widget for text
#
proc build_Text {parent name width height} {
    global COLOR FONT

    # build text widget
    if {[winfo exists $parent.text] == 0} {
	text $parent.text -relief sunken -bd 2 \
	    -bg COLOR(entry) -font $FONT(label) \
	    -width 1 -height 1
	$parent.text configure -width $width -height $height
	pack $parent.text -fill both -expand 1
    }
    return $parent.text
}

#
# build_Dialog
#
# Builds a dialog box for immediate action
#
# Usage: set choice [build_Dialog dialog "Title" "Question ?" \
#			 0 "Choice 0" "Choice 1" ... ]
# where the default choice is specified by the integer which is in this
# example 0.
#
#
proc build_Dialog {name title text default args} {
    global COLOR FONT dialog

    set w .$name

    # create window and top and bottom parts
    toplevel $w -class Dialog
    build_Title $w "$title"
    set top [build_StdFrame $w top]
    set bottom [build_StdFrame $w bottom]
    pack $top -side top -fill both
    pack $bottom -side bottom -fill both

    # put message in top
    message $top.msg -text $text -font $FONT(label)
    pack $top.msg -expand 1 -fill both

    # put buttons in bottom
    set i 0
    foreach but $args {
	button $bottom.b$i -text $but -command "set dialog(button) $i" \
	    -font $FONT(button)
	if {$i == $default} {
	    frame $bottom.default -relief sunken -bd 1
	    raise $bottom.b$i
	    pack $bottom.default -side left -expand 1 -padx 3m -pady 2m
	    pack $bottom.b$i -in $bottom.default -side left \
		-padx 2m -pady 2m -ipadx 2m -ipady 1m
	} else {
	    pack $bottom.b$i -side left -expand 1 \
		-padx 3m -pady 3m -ipadx 2m -ipady 1m
	}
	incr i
    }

    # set up bindings etc.
    if {$default >= 0} {
	bind $w <Return> "$bottom.b$default flash; set dialog(button) $default"
    }
    set oldFocus [focus]
    grab set $w
    focus $w

    # wait for response
    tkwait variable dialog(button)
    destroy $w
    focus $oldFocus
    return $dialog(button)

}

#
# update_PopupMenu
#
# Utility routine for build_PopupMenu and build_IPopupMenu
#
proc update_PopupMenu {name str cmd args} {
    # $name configure -text "$str  ~"
    $name configure -text "$str"
    foreach arg $args {
	uplevel #0 $arg
    }
    eval $cmd
}

#
# build_IPopupMenu
#
# Constructs a popup menu
#
proc build_IPopupMenu { parent name label ivar command items } {
    global COLOR FONT

    set wname [build_StdFrame $parent $name]

    # make label
    if {![winfo exists $wname.label]} {
	label $wname.label -anchor w -font $FONT(label)
    }
    $wname.label configure -text $label

    # if no items then do not create menubar!
    if {![llength $items]} {
	if {[winfo exists $wname.mb]} {destroy $wname.mb}
	pack $wname.label -side left -padx 0.1c
	pack $wname -fill x
	return $wname -pady 0.1c
    }

    # make menubutton
    if {![winfo exists $wname.mb]} {
	menubutton $wname.mb -menu $wname.mb.m -anchor n -relief raised \
	    -font $FONT(label) \
	    -indicatoron 1
    }
    upvar #0 $ivar iv
    set w [expr [longest $items] + 4]
    $wname.mb configure -text "[lindex $items $iv]" -width $w

    # make menu
    if {[winfo exists $wname.mb.m]} {
	destroy $wname.mb.m
    }
    menu $wname.mb.m -font $FONT(label)
    set i 0
    foreach item $items {
	$wname.mb.m add command -label $item -command \
	    [list update_PopupMenu $wname.mb $item $command [list set $ivar $i]]
	incr i
    }

    pack $wname.label $wname.mb -side left -padx 0.1c
    pack $wname -fill x -pady 0.1c

    return $wname
}

#
# build_PopupMenu
#
# Constructs a popup menu
#
# Usage: build_PopupMenu parent name "Algorithm:" \
#            alg_var alg_proc {"Alg 0" "Alg 1" "Alg 2" ...}
# wher alg_var is the variable which gives the index of the selected
# algorithm and alg_proc gets called whenever the algorithm is changed.
#
proc build_PopupMenu { parent name label ivar command items } {
    global COLOR FONT

    set wname [build_StdFrame $parent $name]

    # make label
    if {![winfo exists $wname.label]} {
	label $wname.label -anchor w -font $FONT(label)
    }
    $wname.label configure -text $label

    # if no items then do not create menubar!
    if {![llength $items]} {
	if {[winfo exists $wname.mb]} {destroy $wname.mb}
	pack $wname.label -side left -padx 0.1c
	pack $wname -fill x -pady 0.1c
	return $wname
    }

    # make menubutton
    if {![winfo exists $wname.mb]} {
	menubutton $wname.mb -menu $wname.mb.m -anchor n -relief raised \
	    -font $FONT(label) \
            -indicatoron 1
    }
    upvar #0 $ivar iv
    set w [expr [longest $items] + 4]
    $wname.mb configure -text "[lindex $items $iv]" -width $w

    # make menu
    if {[winfo exists $wname.mb.m]} {
	destroy $wname.mb.m
    }
    menu $wname.mb.m -font $FONT(label)
    set i 0
    foreach item $items {
	$wname.mb.m add command -label $item -command \
	    [list update_PopupMenu $wname.mb $item $command \
		 [list set $ivar $i]]
	incr i
    }

    pack $wname.label $wname.mb -side left -padx 0.1c
    pack $wname -fill x -pady 0.1c

    return $wname
}

##########################################################################
#
# utility: n-column builder
# notes:   builds n columns, each column is one of
#          entry or label widget
#
# buildTopLevel zoo col ZOO
# buildLabelEntryColumns lentry zoo.col sel \
#	{label "title1" {l1 l2 l3 l4} } 		\
#	{entry "title2" {e1 e2 e3 e4} } 		\
#	{foo   "title3" {f1 f2 f3 f4} } 		\
#
##########################################################################

proc build_LabelEntryColumns {parent name args } {
  global COLOR FONT

    build_StdFrame $parent $name

#    set _tablist {}

    set cn 0
    foreach c $args {
	set _type [lindex $c 0]
	set _code c$cn
	set _head [lindex $c 1]
	set _list [lindex $c 2]

	set valid_type 1
	set pady 0
	set col_config {$obj_n configure -textvariable $l}
#	set col_tab {set valid_type}
	if { [string compare $_type "label"] == 0 } {
	    set col_entry {label $obj_n -anchor n -font $FONT(label)}
	    set pady 2
	} elseif { [string compare $_type "dlabel"] == 0 } {
	    set col_entry {label $obj_n -width 23 -relief sunken -anchor w -font $FONT(label) }
	    set pady 2
	} elseif { [string compare $_type "ilabel"] == 0 } {
	    set col_entry {label $obj_n -width 10 -relief sunken -anchor w -font $FONT(label) }
	    set pady 2
	} elseif { [string compare $_type "text"] == 0 } {
	    set col_entry {label $obj_n -anchor e -font $FONT(label)}
	    set pady 2
	    set col_config {$obj_n configure -text $l}
        } elseif { [string compare $_type "dentry"] == 0 } {
	    set col_entry {entry $obj_n -width 10 -relief sunken -bg $COLOR(entry) -font $FONT(label) }
#	    set col_tab { lappend _tablist $obj_n }
        } elseif { [string compare $_type "ientry"] == 0 } {
	    set col_entry {entry $obj_n -width 10 -relief sunken -bg $COLOR(entry) -font $FONT(label)}
#	    set col_tab { lappend _tablist $obj_n }
        } elseif { [string compare $_type "lentry"] == 0 } {
	    set col_entry {entry $obj_n -width 40 -relief sunken -bg $COLOR(entry) -font $FONT(label)}
#	    set col_tab { lappend _tablist $obj_n }
        } elseif { [string compare $_type "checkbox"] == 0 } {
	    set col_entry {checkbutton $obj_n -anchor w -variable $l -font $FONT(label)}
	    set col_config {$obj_n configure -text ""}
        } elseif { [string compare $_type "lcheckbox"] == 0 } {
	    set col_entry {checkbutton $obj_n -anchor w -variable $l -font $FONT(label)}
	    set col_config {$obj_n configure -text "Record ground tracks       and project forwards "}
	} elseif { [string compare $_type "slider"] == 0 } {
	    set col_entry {scale $obj_n -from 0 -to 100 -command $l \
			       -length 5c -showvalue false
	    }
	    set pady 1
	    set col_config {$obj_n configure -orient horizontal}
	} else {
	    # widget type not recognized
	    set valid_type 0
	    puts stderr "ufo widget: $_type"
	}

	if $valid_type {
	    # create column and header
	    set obj $parent.$name.$_code
	    if { ![winfo exists $obj] } {
		frame $obj
		pack $obj -fill x -side left
		# -padx 2 -pady 1
	    }
	    if [string length "$_head"] {
		if { ![winfo exists $obj.head] } {
		    label $obj.head -anchor n -font $FONT(label)
		    pack $obj.head -side top -padx 2 -pady 1
		}
		$obj.head configure -text "$_head"
	    } else {
		if [winfo exists $obj.head] {
		    destroy $obj.head
		}
	    }

	    # add elements to column
	    set _n 0
	    foreach l $_list {
		set obj_n $obj.$_n
		if { ![winfo exists $obj_n] } {
		    eval $col_entry
		    pack $obj_n -side top -padx 0.1c -pady $pady -fill x
		}
		eval $col_config
#		eval $col_tab
		incr _n
	    }
	    while { [winfo exists $obj.$_n] } {
		destroy $obj.$_n
		incr _n
	    }
	}
	# prepare for next column
	incr cn
    }

    while { [winfo exists $parent.$name.c$cn] } {
	destroy $parent.$name.c$cn
	incr cn
    }

#    if {[llength $_tablist] > 0} {
#	setTabbing $_tablist $name
#	focus [lindex $_tablist 0]
#    }

    pack $parent.$name -fill x -pady 0.1c

    return $parent.$name

}

#
# build_Label
#
# Usage: build_Label parent name message
#
proc build_Label {parent name message} {
    global COLOR FONT

    set fname [build_StdFrame $parent $name]
    if {[winfo exists $fname.label]} {
        $fname.label configure -text $message
    } {
      label $fname.label -text $message -font $FONT(label)
      pack $fname.label -expand 1 -fill both
    }

    pack $fname -anchor w -padx 0 -pady 0
    return $fname
}

#
# build_options_menu
#
# Usage:
#	build_options_menu owner {"Load..." load_open} {} {"Exit" tk_exit} ...
#
# Where the number of entries is arbitrary and empty entries result
# in separators.
#
proc build_options_menu {owner args} {
    global COLOR FONT

    # create menu
    if [winfo exists $owner.menu] {destroy $owner.menu}
    menu $owner.menu -font $FONT(label)

    # add commands to menu
    foreach arg $args {
	if {[llength $arg] == 2} {
	    $owner.menu add checkbutton -label [lindex $arg 0] -variable [lindex $arg 1]
	} else {
	    $owner.menu add separator
	}
    }
}



# return the length of the longest string in a list
proc longest list {
    set len 0
    foreach l $list {
	set ll [string length $l]
	if {$ll > $len} {set len $ll}
    }
    return $len
}


#
# loads a file into the end of a text widget
#    returns 1 if succesful, else 0
#
proc loadfile_into_text {textw filename} {
    set ok 0
    if [file exists "$filename"] {
	set f [open "$filename"]
	while {![eof $f]} {
	    $textw insert end [read $f 1000]
	}
	close $f
	set ok 1
    }
    return $ok
}