Attachment "disag.tcl" to
ticket [753170ffff]
added by
jaspert
2003-06-12 16:58:32.
proc Disaggregate {parent title colour type fatness icount step \
comment enumLists matherror hide separate} {
global disaggregate
foreach varName {colour type fatness icount matherror hide \
separate} {
set disaggregate($varName) [set $varName]
}
if [llength $icount]>0 {
set disaggregate(icount) [join $icount ,]
} else {
set disaggregate(icount) 1
}
switch -- $step {
-1 {
set disaggregate(step) "Initialize only"
} 0 {
set disaggregate(step) "Reset only"
} default {
set disaggregate(step) $step
}
}
set t [toplevel .disaggregation -bd 4 -class Disaggregation]
# wm transient $t $parent
wm resizable $t 0 1
wm protocol $t WM_DELETE_WINDOW {set disaggregate(done) 0}
wm title $t "Properties of $title"
frame $t.simple
frame $t.simple.left
TitleFrame $t.simple.left.count -text "Control of number of instances:"
set countf [$t.simple.left.count getframe]
frame $countf.radio
foreach rbutton {{population "Using population symbols"} {generated "Using specified dimensions:"}} {
radiobutton $countf.radio.$rbutton -text [lindex $rbutton 1] \
-value [lindex $rbutton 0] \
-variable disaggregate(type) \
-command "SetHighlights $countf"
pack $countf.radio.$rbutton -anchor w
}
pack $countf.radio -anchor w -side left
Entry $countf.value -textvariable disaggregate(icount) -width 10
pack $countf.value -side left -anchor s -pady 4
pack $t.simple.left.count -expand 0;# -fill both
TitleFrame $t.simple.left.colour -text "Background shade"
set colourf [$t.simple.left.colour getframe]
pack [button $colourf.clear -text "Clear" \
-width 10 -command "set disaggregate(colour) {}"] \
-padx 2 -pady 4 -side left
pack [button $colourf.fixcolour -text "Colour" \
-width 10 -command "UpdateColour $colourf"] \
-padx 2 -pady 4 -side left
if {[catch {image type $disaggregate(colour)}]} {
$colourf.fixcolour configure -bg $disaggregate(colour)
set disaggregate(defColour) $disaggregate(colour)
} else {
set disaggregate(defColour) [$colourf.fixcolour cget -bg]
}
pack [button $colourf.setimage -text "Image..." \
-width 10 -command ChooseImage] \
-padx 2 -pady 4 -side left
pack $t.simple.left.colour -anchor w -pady 4 -fill both -expand true
pack $t.simple.left -side left; # -expand 1 -fill both
frame $t.simple.right
button $t.simple.right.ok -text "OK" -width 10 -default active \
-command {set disaggregate(done) 1}
pack $t.simple.right.ok -padx 2 -pady 4
button $t.simple.right.cancel -text "Cancel" -width 10 \
-command {set disaggregate(done) 0}
pack $t.simple.right.cancel -padx 2 -pady 4
button $t.simple.right.help -text "Help" -width 10 \
-command {ContextSensitiveHelp .disaggregation submodels/dialogue.htm}
pack $t.simple.right.help -padx 2 -pady 4
button $t.simple.right.more -text "More" -width 10 -command "ShowComplexity $t"
pack $t.simple.right.more -padx 2 -pady 4
pack $t.simple.right -anchor ne -padx 4 -pady 4
pack $t.simple -anchor nw -fill both; # -expand 1 -fill both
label $t.commentlabel -text Comments:
pack $t.commentlabel -padx 2 -pady 4 -anchor w
# ScrolledWindow causes crash under Linux so replaced with ordinary frame
# frame $t.commentsSW
ScrolledWindow $t.commentsSW
text $t.commentsSW.comment -height 4 -width 40 -wrap word
# $t.commentsSW setwidget $t.commentsSW.comment
$t.commentsSW.comment insert 1.0 $comment
pack $t.commentsSW.comment $t.commentsSW -anchor nw -fill both -expand true
frame $t.complex
TitleFrame $t.complex.enumtypes -text "Enumerated types"
set enumtypef [$t.complex.enumtypes getframe]
pack [set canId [frame $enumtypef.listpair]] -side left -fill both \
-expand true
# pack [frame $windowId.buttonframe] -side bottom
listbox $canId.scrf -yscrollcommand [list AdjustCanvas $canId scrf y]
foreach enumList $enumLists {
set newType [lindex $enumList 0]
set disaggregate(enumtype,$newType) [lrange $enumList 1 end]
$canId.scrf insert end $newType
}
bind $canId.scrf <ButtonRelease-1> "EnableTypeOps $enumtypef"
set PopCmd [list QueuePopup AddEnumTypePopup %W %y %X %Y]
bind $canId.scrf <Enter> $PopCmd
bind $canId.scrf <Motion> "RemovePopup;$PopCmd"
bind $canId.scrf <Leave> RemovePopup
scrollbar $canId.yscroll -orient v -command [list $canId.scrf yview]
menu $enumtypef.curmembers -tearoff 0 \
-postcommand [list AddEnumTypeMems $enumtypef]
pack $canId.yscroll -side right -fill y
pack $canId.scrf -side left -fill both -expand true
pack [set btnId [frame $enumtypef.btns]] -side left
pack [entry $btnId.e -textvariable enumTypeMPEntry]
bind $btnId.e <ButtonRelease-1> "EnableTypeOps $enumtypef"
pack [button $btnId.addtype -text "Add type" -command "AddEnumType $canId"] \
-padx 2 -pady 4 -fill x
pack [button $btnId.remtype -text "Remove type" -state disabled -command "RemoveEnumType $enumtypef"] \
-padx 2 -pady 4 -fill x
pack [button $btnId.addmems -text "Add member" -state disabled -command "AddEnumMem $enumtypef"] \
-padx 2 -pady 4 -fill x
pack [button $btnId.remmem -text "Remove member" -state disabled -command "RemoveEnumMem $enumtypef"] \
-padx 2 -pady 4 -fill x
pack $t.complex.enumtypes -anchor nw -side bottom -padx 4 -pady 4 -fill both -expand true
TitleFrame $t.complex.appearance -text Appearance
set appearancef [$t.complex.appearance getframe]
checkbutton $appearancef.hide -text "Hide contents" \
-variable disaggregate(hide)
pack $appearancef.hide -anchor w
frame $appearancef.scale
scale $appearancef.scale.value -from .01 -to 1 -length 150 -orient horizontal \
-resolution 0.01 -variable disaggregate(fatness)
pack $appearancef.scale.value
label $appearancef.scale.caption -text "Relative scale"
pack $appearancef.scale.caption
pack $appearancef.scale -anchor w
pack $t.complex.appearance -anchor nw -side left -padx 4 -pady 4 -fill both -expand true
TitleFrame $t.complex.math -text Calculation
set mathf [$t.complex.math getframe]
checkbutton $mathf.separate -text "Build submodel in separate dll" \
-variable disaggregate(separate)
pack $mathf.separate -anchor w
# checkbutton $mathf.matherror -text "Ignore math errors during calculation" \
# -variable disaggregate(matherror)
# pack $mathf.matherror -anchor w
frame $mathf.step
label $mathf.step.caption -text "Time step index:"
pack $mathf.step.caption -side left
#tk_optionMenu $mathf.step.pulldown disaggregate(step) Default -1 0 1 2 3 4 5 6 7
ComboBox $mathf.step.pulldown -textvariable disaggregate(step) \
-values [list Default "Initialize only" "Reset only" 1 2 3 4 5 6 7] \
-width 10 -editable false
pack $mathf.step.pulldown
pack $mathf.step -anchor w -padx 4 -pady 6
pack $t.complex.math -side left -padx 4 -pady 4 -fill both -expand true
# The above "complex" frame has been constructed, but is not packed until the "More" button is pressed
# unless, conditional expressions indicate that one of the complex attributes does not have its default
# value
# pack $t.complex -anchor w
if (![string match $disaggregate(step) Default]) {
ShowComplexity $t
} elseif ($disaggregate(matherror)) {
ShowComplexity $t
} elseif ($disaggregate(separate)) {
ShowComplexity $t
} elseif ($disaggregate(fatness)!=1.0) {
ShowComplexity $t
} elseif ($disaggregate(hide)) {
ShowComplexity $t
}
SetHighlights $countf
tkwait visibility $t
grab $t
tkwait variable disaggregate(done)
grab release $t
set disaggregate(comment) [string trimright [$t.commentsSW.comment get 1.0 end]]
destroy $t
if [string match $disaggregate(icount) 1] {
set disaggregate(icount) [list]
}
if {$disaggregate(done)} {
switch $disaggregate(step) {
"Initialize only" {
set step -1
} "Reset only" {
set step 0
} default {
set step $disaggregate(step)
}
}
set enumTypes {}
foreach {typename members} [array get disaggregate enumtype,*] {
lappend enumTypes [concat [list [string range $typename 9 end]] \
$members]
}
set result [list $disaggregate(colour) $disaggregate(type) \
$disaggregate(fatness) $disaggregate(icount) \
$step $disaggregate(comment) \
$disaggregate(matherror) $disaggregate(hide) \
$disaggregate(separate) $enumTypes]
} else {
set result {}
}
unset disaggregate
return $result
}
proc SetHighlights {t} {
global disaggregate
switch -regexp $disaggregate(type) {
none|population {
$t.value configure -state disabled
}
simple|generated {
$t.value configure -state normal
}
}
}
