set objectType [lindex $argv 0]
GuidoScript scripts/graphicsPickSegment.tcl
GuidoScript scripts/geologyutilities.tcl
set ssiforminitialised 0
GuidoApp get_handle "GET DATABASE HANDLE"
$get_handle setParam sessionType "GeologyDatabase"
set status [$get_handle invoke]
if {$status >= 0} {
set dbHandle [$get_handle getParam DatabaseHandle]
} else {
set dbHandle 0
}
$get_handle destroy
set bmParam [GuidoExecServer IsBlockModelLoaded {}]
set bmLoaded [GuidoGetParamBufferValue $bmParam "BlockModelLoaded"]
if {$bmLoaded} {
set bmSectionExists "1"
set defaultParams [GuidoExecServer "GetSectionInformationForSaving" {}]
if {"[GuidoGetParamBufferValue $defaultParams section_block_model]" == "false"} {
if {$dbHandle == 0} {
GuidoMessage warning APP_NEEDS_BLOCK_MODEL_SECTION
return
}
set bmSectionExists "0"
}
} else {
set bmSectionExists "0"
}
if {$dbHandle == "0" && $bmSectionExists == "0"} {
GuidoMessage warning APP_NO_DB_OR_BM_SECTION
return
} else {
set buffer [ GuidoExecServer GetSectionType {} ]
set section_type [ GuidoGetParamBufferValue $buffer section_type ]
if {$section_type == "" || $section_type == "none"} {
return
}
}
proc ssiforminitialisedvalue { } {
global ssiforminitialised
return $ssiforminitialised
}
proc updateTraceTableName {field table} {
global dbHandle
set current_field "[$field getCurrentValue]"
set current_table "[$table getCurrentValue]"
if {"$current_table" == ""} {
$field removeAllItems
$field setCurrentValue ""
return 0
} else {
$field setDatabaseHandle $dbHandle
$field setTableHandle "$current_table"
$field updateBrowserList
if {[$field findItemIndex "$current_field"] == -1} {
$field setCurrentValue ""
} else {
$field setCurrentValue "$current_field"
}
return 1
}
}
proc PrevValue {fieldName} {
set val [ssiforminitialisedvalue]
if {$val} {
set rval [$fieldName getCurrentValueRelative -1]
if {[string length $rval] > 0} {
$fieldName setCurrentValue $rval
}
}
}
proc blockAttributeList { } {
global bm_attribute
set buffer [ GuidoExecServer GetAttributeValueList {} ]
if {[ GuidoGetParamBufferValue $buffer attributeNumber ] > 0} {
set attributeList [ GuidoGetParamBufferValue $buffer attribute ]
foreach idx $attributeList {
set buffer [ GuidoExecServer "GetAttributeData" [subst {attribute = "$idx"} ]]
if {[ GuidoGetParamBufferValue $buffer status ] >= 0} {
set type [GuidoGetParamBufferValue $buffer type]
if {$type == "double" || $type == "integer" || $type == "float"} {
lappend attributes $idx
}
}
}
eval [concat {$bm_attribute} {setValues} $attributes]
}
}
set databuf [ GuidoExecServer GetStringComposites {} ]
set shrunk [GuidoGetParamBufferValue $databuf shrunk]
GuidoForm form {
-default_buttons
if {$objectType == "segment"} {
-label "Digitised Segment Grade"
} else {
-label "Digitised String Grade"
}
-tip DB_SEG_GRADE_TIP
-layout BoxLayout Y_AXIS
-next_focus hide
-help_id 1138
GuidoTabbedPane tabPane {
if {$dbHandle != "0"} {
GuidoPanel panel1 {
-layout BoxLayout Y_AXIS
-label "Database"
GuidoPanel panel1a {
-layout BoxLayout X_AXIS
GuidoComboBox included {
-label "Composite method"
-tip APP_DRILLHOLE_COMPOSITE_GRADE_TIP
-value_in "length weighted" "area weighted"
-default "length weighted"
-exclusive true
-null false
}
}
GuidoPanel panel1b {
-layout BoxLayout X_AXIS
GuidoField minimum_percentage {
-format double
-default 75
-label "Minimum % of sample to be included"
-tip APP_DRILLHOLE_COMPOSITE_MINIMUM_PERCENTAGE
}
}
GuidoScrollPane scroller {
-height 8
GuidoTable table {
-instances 1 1 200
-interactive true "insert|remove|add"
GuidoDatabaseTableBrowser tbl {
-display_length 5
-label "Table"
-database dbHandle
-table_types "interval"
-exclusive true
-action valueChanged {[
updateTableName $fld $tbl
]}
-action focusGained {[
set ssiforminitialised 1
]}
-tip DB_SEG_GRADE_TBL_TIP
}
GuidoTableFieldBrowser fld {
-display_length 5
-label "Field"
-format string
-exclusive true
-database dbHandle
-null false
-dependency {"[updateTraceTableName $fld $tbl]"}
-action focusGained {[
updateTraceTableName $fld $tbl
set ssiforminitialised 1
]}
-validation {[validateTableFieldPair $tbl $fld]}
-tip DB_SEG_GRADE_FLD_TIP
}
GuidoCheckBox dilute {
-default false
-label "Dilute"
-selected_value Y
-tip DB_SEG_GRADE_DILUTE_TIP
-unselected_value N
-action initial {[PrevValue $dilute]}
}
GuidoComboBox dfield {
-label "D Field"
-value_in D1 D2 D3 D4 D5 D6 D7 D8 D9 D10 D11 D12 D13 D14 D15 D16 D17 D18 D19 D20 D21 D22 D23 D24 D25 D26 D27 D28 D29 D30 D31 D32 D33 D34 D35 D36 D37 D38 D39 D40 D41 D42 D43 D44 D45 D46 D47 D48 D49 D50 D51 D52 D53 D54 D55 D56 D57 D58 D59 D60 D61 D62 D63 D64 D65 D66 D67 D68 D69 D70 D71 D72 D73 D74 D75 D76 D77 D78 D79 D80 D81 D82 D83 D84 D85 D86 D87 D88 D89 D90 D91 D92 D93 D94 D95 D96 D97 D98 D99 D100
if {$objectType == "segment"} {
-tip SEG_GRADE_DFIELD_TIP
} else {
-tip STR_GRADE_DFIELD_TIP
}
-exclusive true
-null true
}
}
}
}
}
if {$bmSectionExists != "0"} {
GuidoPanel panel2 {
-layout BoxLayout Y_AXIS
-label "Block model"
if {$shrunk != "N"} {
GuidoPanel warningPanel {
-layout BorderLayout
GuidoPanel warningPanel1 {
-position North
GuidoFiller fill {
-height 2
}
}
GuidoPanel warningPanel2 {
-position South
GuidoFiller fill {
-height 2
}
}
GuidoPanel warningPanel4 {
-layout FlowLayout Centre
GuidoPanel warningPanel4 {
-layout BoxLayout Y_AXIS
-position Center
GuidoLabel label1 {
-label "You cannot calculate composited grades"
}
GuidoLabel label2 {
-label "of block model sections if you specified"
}
GuidoLabel label3 {
-label "a non-zero shrinkage."
}
}
}
}
} else {
GuidoScrollPane scroller {
-height 8
GuidoTable bm_table {
-instances 1 1 200
-interactive true "insert|remove|add"
GuidoComboBox bm_attribute {
-display_length 5
-label "Attribute"
-exclusive true
-action focusGained {[
set ssiforminitialised 1
]}
}
GuidoCheckBox bm_dilute {
-default false
-label "Dilute"
-selected_value Y
-tip DB_SEG_GRADE_DILUTE_TIP
-unselected_value N
-action initial {[PrevValue $bm_dilute]}
}
GuidoComboBox bm_dfield {
-label "D Field"
-value_in D1 D2 D3 D4 D5 D6 D7 D8 D9 D10 D11 D12 D13 D14 D15 D16 D17 D18 D19 D20 D21 D22 D23 D24 D25 D26 D27 D28 D29 D30 D31 D32 D33 D34 D35 D36 D37 D38 D39 D40 D41 D42 D43 D44 D45 D46 D47 D48 D49 D50 D51 D52 D53 D54 D55 D56 D57 D58 D59 D60 D61 D62 D63 D64 D65 D66 D67 D68 D69 D70 D71 D72 D73 D74 D75 D76 D77 D78 D79 D80 D81 D82 D83 D84 D85 D86 D87 D88 D89 D90 D91 D92 D93 D94 D95 D96 D97 D98 D99 D100
-tip SEG_GRADE_DFIELD_TIP
-exclusive true
-null true
}
}
}
}
}
}
}
}
set status [GuidoGetParamBufferValue $databuf status]
if {$bmSectionExists != "0"} {
if {$shrunk == "N"} {
blockAttributeList
if {$status >= 0} {
set num_rows [GuidoGetParamBufferValue $databuf "bm_num_rows"]
$bm_table setInitialRows $num_rows 1 200
for {set i 0} {$i < $num_rows} {incr i} {
$bm_attribute setCurrentValue $i [GuidoGetParamBufferValue $databuf "bm_attribute($i)"]
$bm_dilute setCurrentValue $i [GuidoGetParamBufferValue $databuf "bm_dilute($i)"]
$bm_dfield setCurrentValue $i [GuidoGetParamBufferValue $databuf "bm_dfield($i)"]
}
}
}
}
if {$dbHandle != "0"} {
if {$status >= 0} {
set num_rows [GuidoGetParamBufferValue $databuf "num_rows"]
$table setInitialRows $num_rows 1 200
for {set i 0} {$i < $num_rows} {incr i} {
$tbl setCurrentValue $i [GuidoGetParamBufferValue $databuf "tbl($i)"]
$fld setCurrentValue $i [GuidoGetParamBufferValue $databuf "fld($i)"]
$dilute setCurrentValue $i [GuidoGetParamBufferValue $databuf "dilute($i)"]
$dfield setCurrentValue $i [GuidoGetParamBufferValue $databuf "dfield($i)"]
}
}
if {[GuidoGetParamBufferValue $databuf "included"]} {
$included setCurrentValue "length weighted"
} else {
$included setCurrentValue "area weighted"
}
$minimum_percentage setCurrentValue [GuidoGetParamBufferValue $databuf "minimum_percentage"]
$tbl updateBrowserList
}
set show_form "yes"
while {$show_form == "yes"} {
set show_form "no"
set return_code [$form interact]
if {$return_code == "apply"} {
GuidoApp app "DRILLHOLE GRADE NEW"
set dbCount 0
set usedFields [list]
if {$dbHandle != "0"} {
for {set row 0} {$row < [$table getRowCount]} {incr row} {
if {[$tbl getCurrentValue $row] == ""} {
continue
}
if {[$fld getCurrentValue $row] == ""} {
continue
}
set field [$dfield getCurrentValue $row]
if {[string length $field]} {
if {[lsearch $usedFields $field] == -1} {
lappend usedFields "$field"
} else {
GuidoMessage warning APP_REUSED_DFIELD $field
set show_form "yes"
set return_code "cancel"
continue
}
}
$app setParam "tbl($row)" [$tbl getCurrentValue $row]
$app setParam "fld($row)" [$fld getCurrentValue $row]
if {"[$dilute getCurrentValue $row]" == "Y"} {
$app setParam "dilute($row)" true
} else {
$app setParam "dilute($row)" false
}
$app setParam "dfield($row)" [$dfield getCurrentValue $row]
incr dbCount
}
$app setParam num_rows $dbCount
if {"[$included getCurrentValue]" == "length weighted"} {
$app setParam included true
} else {
$app setParam included false
}
$app setParam minimum_percentage [$minimum_percentage getCurrentValue]
}
set bmCount 0
if {$bmSectionExists != "0"} {
if {$shrunk == "N"} {
for {set row 0} {$row < [$bm_table getRowCount]} {incr row} {
if {[$bm_attribute getCurrentValue $row] == ""} {
continue
}
set field [$bm_dfield getCurrentValue $row]
if {[string length $field]} {
if {[lsearch $usedFields $field] == -1} {
lappend usedFields "$field"
} else {
GuidoMessage warning APP_REUSED_DFIELD $field
set show_form "yes"
set return_code "cancel"
continue
}
}
$app setParam "bm_attribute($row)" [$bm_attribute getCurrentValue $row]
if {"[$bm_dilute getCurrentValue $row]" == "Y"} {
$app setParam "bm_dilute($row)" true
} else {
$app setParam "bm_dilute($row)" false
}
$app setParam "bm_dfield($row)" [$bm_dfield getCurrentValue $row]
incr bmCount
}
$app setParam bm_num_rows $bmCount
}
}
if {[expr $dbCount + $bmCount] > 0 && $return_code == "apply"} {
set return_code [$app invoke]
if {$return_code < "0"} {
set show_form "yes"
set return_code "cancel"
} else {
set return_code "apply"
}
} else {
if {[expr $dbCount + $bmCount] == 0} {
GuidoMessage warning APP_NEED_COMPOSITE_FIELD
set show_form "yes"
set return_code "cancel"
}
}
$app destroy
}
while {$return_code == "apply"} {
set pickresult 0
if {$objectType == "segment"} {
set pickresult [graphicsPickSegment "DB_SELECT_SEGMENT" layer_name string_number segment_number points_var collinear_var]
} else {
set pickresult [graphicsPickString "DB_SELECT_STRING" layer_name string_number]
}
if {$pickresult != 0} {
if {$objectType == "segment"} {
GuidoApp app "DRILLHOLE SEGMENT GRADE"
$app setParam "segment_number" $segment_number
} else {
GuidoApp app "DRILLHOLE STRING GRADE"
}
$app setParam "layer_name" $layer_name
$app setParam "string_number" $string_number
$app invoke
$app destroy
set return_code "apply"
} else {
set return_code "cancel"
set show_form "no"
set return_code "cancel"
}
}
GuidoApp app "DRILLHOLE GRADE DELETE"
$app invoke
$app destroy
}
$form destroy
