proc can_transfer_current_out { constraint_type stringFile x y equals y_value x_value } {
set constraint_text "[$constraint_type getCurrentValue]"
set return_val 0
if { "$constraint_text" == "STRING" } {
set stringFile_value "[ $stringFile getCurrentValue ]"
if { [string length $stringFile_value] == 0 } {
set return_val 0
} else {
set return_val 1
}
} elseif { "$constraint_text" == "LINE" } {
set x_curr_value "[$x getCurrentValue ]"
set y_curr_value "[$y getCurrentValue ]"
set equals_value "[$equals getCurrentValue ]"
if { [string length $x_curr_value] == 0 ||
[string length $y_curr_value] == 0 ||
[string length $equals_value] == 0 } {
set return_val 0
} else {
set return_val 1
}
} elseif { "$constraint_text" == "X VALUE" } {
set x_value_curr_value "[$x_value getCurrentValue ]"
if { [string length $x_value_curr_value] == 0 } {
set return_val 0
} else {
set return_val 1
}
} elseif { "$constraint_text" == "Y VALUE" } {
set y_value_curr_value "[$y_value getCurrentValue ]"
if { [string length $y_value_curr_value] == 0 } {
set return_val 0
} else {
set return_val 1
}
}
return $return_val;
}
proc transfer_values { constraintTypeValue location id operation not rnga rngb index} {
global constraintValue
set temp_text ""
if { "$constraintTypeValue" == "STRING" } {
set FileExt [string last "." $location ]
set chk [string last "/" $location ]
if { $FileExt == -1 || [expr $FileExt > $chk] == 0 } {
set temp_text "String Constraint: $not$operation $location $id .STR"
} else {
set temp_text "String Constraint: $not$operation $location"
}
if { $rnga != "" } {
append temp_text " String Range: $rnga"
}
if { $rngb != "" } {
append temp_text " Segment Range: $rngb"
}
} elseif {"$constraintTypeValue" == "LINE"} {
set temp_text "Line Constraint: $not$operation $location\X+$id\Y=$rnga"
} elseif {"$constraintTypeValue" == "Y VALUE" } {
set temp_text "Y Value Constraint: $not$operation Y=$location"
} elseif {"$constraintTypeValue" == "X VALUE" } {
set temp_text "X Value Constraint: $not$operation X=$location"
} else {
return
}
$constraintValue setCurrentValue $index $temp_text
return
}
proc transfer_current { } {
global stringFile
global stringID
global x
global y
global equals
global y_value
global x_value
global constraintLetter
global constraintType
global above_line
global above_x
global above_y
global inside
global stringRange
global segmentRange
scan "[$constraintLetter getCurrentValue]" "%c" number1
scan a "%c" number2
set index [expr $number1 - $number2]
set constraintTypeValue [$constraintType getCurrentValue]
if { "$constraintTypeValue" == "STRING" } {
set operation inside
set notValue [$inside getCurrentValue]
set location [$stringFile getCurrentValue]
set id [$stringID getCurrentValue]
set rnga [$stringRange getCurrentValue]
set rngb [$segmentRange getCurrentValue]
} elseif {"$constraintTypeValue" == "LINE"} {
set operation above
set notValue [$above_line getCurrentValue]
set location [$x getCurrentValue]
set id [$y getCurrentValue]
set rnga [$equals getCurrentValue]
set rngb ""
} elseif {"$constraintTypeValue" == "X VALUE"} {
set operation above
set notValue [$above_x getCurrentValue]
set location [$x_value getCurrentValue]
set id ""
set rnga ""
set rngb ""
} else {
set operation above
set notValue [$above_y getCurrentValue]
set location [$y_value getCurrentValue]
set id ""
set rnga ""
set rngb ""
}
if {$notValue == "N"} {
set notValue "Not "
} else {
set notValue ""
}
transfer_values $constraintTypeValue $location $id $operation $notValue $rnga $rngb $index
scan z "%c" number2
if {$number1 == $number2 } {
$constraintLetter setCurrentValue "a"
} else {
$constraintLetter setCurrentValue [format %c [incr number1]]
}
}
proc clear_edit_template { } {
global stringFile
global stringID
global x
global y
global equals
global y_value
global x_value
global value
global stringRange
global segmentRange
global inside
global above_line
global above_x
global above_y
$stringFile setCurrentValue ""
$stringID setCurrentValue ""
$x setCurrentValue ""
$y setCurrentValue ""
$equals setCurrentValue ""
$y_value setCurrentValue ""
$x_value setCurrentValue ""
$stringRange setCurrentValue ""
$segmentRange setCurrentValue ""
$inside setCurrentValue "false"
$above_line setCurrentValue "false"
$above_x setCurrentValue "false"
$above_y setCurrentValue "false"
}
proc start_again { table field} {
set numberOfRows [$table getRowCount]
for { set i 0} {$i < $numberOfRows} {incr i} {
$field setCurrentValue $i ""
}
}
proc parseTableString { constraint_string constraintTypeValue location id operation not rnga rngb} {
if {$constraint_string == "" } {
return
}
upvar $constraintTypeValue constraintTypeValue_ref
upvar $location location_ref
upvar $id id_ref
upvar $operation operation_ref
upvar $not not_ref
upvar $rnga rnga_ref
upvar $rngb rngb_ref
scan $constraint_string {%s} constraint_name
if { "$constraint_name" == "String" } {
set constraintTypeValue_ref STRING
set constraintList [split $constraint_string]
if { "[lindex $constraintList 2]" == "Not"} {
set not_ref NOT
set currentListIndex 4
} else {
set not_ref ""
set currentListIndex 3
}
set operation_ref INSIDE
set location_start $currentListIndex
set surpac true
incr currentListIndex
incr currentListIndex
set currentString [lindex $constraintList $currentListIndex]
if { [string first ".STR" $currentString ] != -1 } {
while { [string match .STR $currentString] == 0 } {
incr currentListIndex
set currentString [lindex $constraintList $currentListIndex]
}
set surpac true
} else {
set surpac false
}
set location_end $currentListIndex
if { $surpac } {
set id_ref [lindex $constraintList [expr $location_end - 1] ]
} else {
set id_ref 0
}
set currentString [lindex $constraintList $location_start]
while { $location_start < [expr $location_end - 1] } {
append location_ref $currentString " "
incr location_start
set currentString [lindex $constraintList $location_start]
}
set location_ref [string trimright $location_ref]
set rnga_ref ""
set rngb_ref ""
set totalListLength [llength $constraintList]
incr currentListIndex
if { $totalListLength > $currentListIndex } {
set currentString [lindex $constraintList $currentListIndex]
if { "$currentString" == "String" } {
incr currentListIndex 2
set currentString [lindex $constraintList $currentListIndex]
while { [expr $totalListLength > $currentListIndex] &&
![string match Segment $currentString] } {
append rnga_ref $currentString " "
incr currentListIndex
set currentString [lindex $constraintList $currentListIndex]
}
set rnga_ref [string trimright $rnga_ref]
}
if { "$currentString" == "Segment" } {
incr currentListIndex 2
set currentString [lindex $constraintList $currentListIndex]
while { [expr $totalListLength > $currentListIndex]} {
append rngb_ref $currentString " "
incr currentListIndex
set currentString [lindex $constraintList $currentListIndex]
}
set rngb_ref [string trimright $rngb_ref]
}
}
} elseif { "$constraint_name" == "Line"} {
set constraintTypeValue_ref LINE
set aboveAndRest [string range $constraint_string 17 [string length $constraint_string]]
set operation_ref ABOVE
if { "[string wordend $aboveAndRest 1]" == "3"} {
set not_ref "NOT"
set values [string range $constraint_string 27 [string length $constraint_string]]
} else {
set not_ref ""
set values [string range $constraint_string 23 [string length $constraint_string]]
}
scan $values {%[0123456789]X+%[0123456789]Y=%[0123456789]} location_ref id_ref rnga_ref
} elseif { "$constraint_name" == "Y"} {
set constraintTypeValue_ref "Y VALUE"
set aboveAndRest [string range $constraint_string 20 [string length $constraint_string]]
set operation_ref ABOVE
if { "[string wordend $aboveAndRest 0]" == "3"} {
set not_ref "NOT"
set location_ref [string range $aboveAndRest 12 [string length $aboveAndRest]]
} else {
set not_ref ""
set location_ref [string range $aboveAndRest 8 [string length $aboveAndRest]]
}
} elseif { "$constraint_name" == "X"} {
set constraintTypeValue_ref "X VALUE"
set aboveAndRest [string range $constraint_string 20 [string length $constraint_string]]
set operation_ref ABOVE
if { "[string wordend $aboveAndRest 0]" == "3"} {
set not_ref "NOT"
set location_ref [string range $aboveAndRest 12 [string length $aboveAndRest]]
} else {
set not_ref ""
set location_ref [string range $aboveAndRest 8 [string length $aboveAndRest]]
}
}
return
}
proc load_template { table field } {
global constraintType
global inside
global stringFile
global stringID
global id
global x
global y
global equals
global y_value
global x_value
global value
global stringRange
global segmentRange
global above_line
global above_x
global above_y
global constraintLetter
clear_edit_template
set tableRow [$table getEditingRow]
set letter [format "%c" [expr $tableRow + 97] ]
$constraintLetter setCurrentValue $letter
set constraint_string [$field getCurrentValue $tableRow]
set constraint_name ""
set location ""
set id ""
set operation ""
set not ""
set rnga ""
set rngb ""
parseTableString $constraint_string constraint_name location id operation not rnga rngb
$constraintType setCurrentValue $constraint_name
if { "$constraint_name" == "STRING" } {
if { "$not" == "NOT"} {
$inside setCurrentValue "N"
} else {
$inside setCurrentValue "Y"
}
$stringRange setCurrentValue $rnga
$segmentRange setCurrentValue $rngb
$stringFile setCurrentValue $location
$stringID setCurrentValue $id
} elseif { "$constraint_name" == "LINE"} {
if { "$not" == "NOT"} {
$above_line setCurrentValue "N"
} else {
$above_line setCurrentValue "Y"
}
$x setCurrentValue $location
$y setCurrentValue $id
$equals setCurrentValue $rnga
} elseif { "$constraint_name" == "Y VALUE"} {
if { "$not" == "NOT"} {
$above_y setCurrentValue "N"
} else {
$above_y setCurrentValue "Y"
}
$y_value setCurrentValue $location
} elseif { "$constraint_name" == "X VALUE"} {
if { "$not" == "NOT"} {
$above_x setCurrentValue "N"
} else {
$above_x setCurrentValue "Y"
}
$x_value setCurrentValue $location
}
}
proc loadValues { formHandle } {
global conexp
$conexp setCurrentValue "[$formHandle readInputField conexp]"
for {set index 0} {$index < 26} {incr index} {
set constraintTypeValue "[$formHandle readInputField constraints($index).contype]"
set location "[$formHandle readInputField constraints($index).location]"
set id "[$formHandle readInputField constraints($index).id]"
set operation [string tolower [string trim "[$formHandle readInputField constraints($index).op]"]]
set not [string tolower [string trim "[$formHandle readInputField constraints($index).not]"]]
set rnga "[$formHandle readInputField constraints($index).rnga]"
set rngb "[$formHandle readInputField constraints($index).rngb]"
if {$not == "not"} {
set not "Not "
} else {
set not ""
}
if {"$constraintTypeValue" != ""} {
transfer_values $constraintTypeValue $location $id $operation $not $rnga $rngb $index
}
}
}
proc writeValues { formHandle } {
global constraintValue
global conexp
if { [string compare [$formHandle getStatus] "legacy preprocess apply"] ==  0 } {
for {set index 0} {$index < 26} {incr index} {
set constraintTypeValue ""
set location ""
set id ""
set operation ""
set not ""
set rnga ""
set rngb ""
parseTableString "[$constraintValue getCurrentValue $index]" constraintTypeValue location id operation not rnga rngb
$formHandle writeOutputField "constraints($index).contype" $constraintTypeValue
$formHandle writeOutputField "constraints($index).location" $location
$formHandle writeOutputField "constraints($index).id" $id
$formHandle writeOutputField "constraints($index).op" $operation
$formHandle writeOutputField "constraints($index).not" $not
$formHandle writeOutputField "constraints($index).rnga" $rnga
$formHandle writeOutputField "constraints($index).rngb" $rngb
}
$formHandle writeOutputField conexp [$conexp getCurrentValue]
$formHandle finishedWritingFields
}
}
GuidoForm frm00674 {
-action initial {[loadValues $frm00674]}
-action stateChanged {[writeValues $frm00674]}
-default_buttons
-label "Enter Constraints"
-layout BoxLayout Y_AXIS
-tip "00674_TIP_001"
GuidoPanel main_panel {
-layout BoxLayout X_AXIS
GuidoPanel new_panel {
-border etched true
-layout BoxLayout Y_AXIS
GuidoPanel constraintTypePanel {
-layout CentreLineLayout
GuidoComboBox constraintLetter {
-display_length 1
-format none
-label "Constraint Name"
-max_length 1
-null false
-no_mlt
-value_in a b c d e f g h i j k l m n o p q r s t u v w x y z
}
GuidoComboBox constraintType {
-display_length 6
-format none
-label "Constraint Type"
-max_length 7
-null false
-value_in STRING "Y VALUE" "X VALUE" LINE
}
}
GuidoFiller filler_height_1 {
-height 1
}
GuidoPanel overlay_panel {
-layout OverlayLayout
GuidoPanel string_panel {
-dependency { "[$constraintType getCurrentValue]" == "STRING" }
-layout CentreLineLayout
GuidoFileBrowserField stringFile {
-display_length 16
-label "String File"
-format none
-max_length 256
-translate upper
-file_mask *.str
-link stringID
}
GuidoField stringID {
-display_length 16
-label "ID Range"
-format none
-max_length 32
-translate mixed
}
GuidoLabel inside_label {
-label Inside
}
GuidoCheckBox inside {
-default true
-selected_value Y
-unselected_value N
}
GuidoLabel option_fields_label {
-font_style bold
-label "Optional Fields"
}
GuidoFiller filler {
}
GuidoField stringRange {
-display_length 16
-format none
-label "String Range"
-max_length 32
-translate upper
}
GuidoField segmentRange {
-display_length 16
-format none
-label "Segment Range"
-max_length 32
-translate upper
}
}
GuidoPanel line_panel {
-dependency { "[$constraintType getCurrentValue]" == "LINE"}
-layout BoxLayout Y_AXIS
GuidoLabel equation_label {
-label "Equation of Line:"
}
GuidoFiller filler_height_1 {
-height 1
}
GuidoPanel equation_panel {
-layout BoxLayout X_AXIS
GuidoField x {
-display_length 5
-format none
-max_length 16
-translate upper
}
GuidoLabel x_plus_label {
-label "X +"
}
GuidoField y {
-display_length 5
-format none
-max_length 32
-translate upper
}
GuidoLabel y_equals_label {
-label "Y = "
}
GuidoField equals {
-display_length 5
-format none
-max_length 32
-translate upper
}
}
GuidoFiller filler_height_1 {
-height 1
}
GuidoPanel  above_panel {
-layout CentreLineLayout
GuidoLabel above_label1 {
-label "Above"
}
GuidoCheckBox above_line {
-default true
-selected_value Y
-unselected_value N
}
}
}
GuidoPanel y_value_panel {
-dependency { "[$constraintType getCurrentValue]" == "Y VALUE"}
-layout CentreLineLayout
GuidoField y_value {
-display_length 5
-format none
-label "Y ="
-max_length 16
-translate upper
}
GuidoFiller filler_height_1 {
-height 1
}
GuidoFiller filler_height_1 {
-height 1
}
GuidoLabel above_label2 {
-label "Above"
}
GuidoCheckBox above_y {
-default true
-selected_value Y
-unselected_value N
}
}
GuidoPanel x_value_panel {
-dependency { "[$constraintType getCurrentValue]" == "X VALUE" }
-layout CentreLineLayout
GuidoField x_value {
-display_length 5
-format none
-label "X ="
-max_length 16
-translate upper
}
GuidoFiller filler_height_1 {
-height 1
}
GuidoFiller filler_height_1 {
-height 1
}
GuidoLabel above_label3 {
-label "Above"
}
GuidoCheckBox above_x {
-default true
-selected_value Y
-unselected_value N
}
}
}
}
GuidoFiller filler_width_1 {
-width 1
}
GuidoPanel button_panel {
-layout BoxLayout Y_AXIS
GuidoFiller filler_height_2 {
-height 2
}
GuidoButton transferOutButton {
-action valueChanged { [transfer_current ]}
-dependency { [can_transfer_current_out $constraintType $stringFile $x $y $equals $y_value $x_value] }
-caption  "Add"
-width 9
}
GuidoFiller filler_height_1 {
-height 1
}
GuidoButton clear_button {
-action valueChanged { [ clear_edit_template ]}
-caption  "Clear"
-width 9
}
GuidoFiller filler_height7 {
-height 1
}
GuidoButton start_again_button {
-caption  "Start Again"
-width 9
}
}
GuidoFiller filler_width_1 {
-width 1
}
GuidoPanel table_panel {
-layout BoxLayout Y_AXIS
GuidoLabel Constraint_values_label {
-label "Constraint values"
}
GuidoScrollPane scrollconstraints {
-scroll_size 30 30
-height 16
-width 24
GuidoTable constraintsTable {
-instances 26 1 26
-no_mlt
-row_headings a b c d e f g h i j k l m n o p q r s t u v w x y z
GuidoField constraintValue {
-action focusGained { [load_template $constraintsTable $constraintValue] }
-display_length 300
-format none
-input false
-max_length 320
-translate mixed
}
}
$start_again_button setActionCallback valueChanged { [ start_again $constraintsTable $constraintValue ]}
}
}
}
GuidoFiller frm00674_123 {
-height 1
}
GuidoPanel frm00674_124 {
-layout CentreLineLayout
GuidoField conexp {
-display_length 32
-format none
-label "Constraint combination"
-max_length 512
-tip "00674_TIP_002"
-translate lower
}
}
$frm00674 legacyProcessValues false
}
