proc updateTraceTableName {field table default} {
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 "$default"
} else {
$field setCurrentValue "$current_field"
}
return 1
}
}
proc setLabel {cylinder_style cylinder_radius} {
set style [$cylinder_style getCurrentValue]
if {$style == "fixed width"} {
$cylinder_radius setLabel "Radius"
} else {
$cylinder_radius setLabel "Length/Unit"
}
}
proc setStylesAllowed {cylinder_table cylinder_field style} {
set table_name [$cylinder_table getCurrentValue]
set field_name [$cylinder_field getCurrentValue]
set field_value [$style getCurrentValue]
if {$table_name > "" && $field_name > ""} {
set databuf [ GuidoExecServer GetFieldInformation [subst {DatabaseType = "GeologyDatabase" SurpacTableName = $table_name SurpacFieldName = $field_name}] ]
set status [GuidoGetParamBufferValue $databuf status]
if {$status >= 0} {
$style removeAllItems
$style addItem "fixed width"
$style addItem "no cylinders"
set fieldType [GuidoGetParamBufferValue $databuf FieldType]
if {$fieldType == "integer" || $fieldType == "real"} {
$style addItem "variable width"
}
$style setCurrentValue $field_value
}
}
}
array set panel_inited { 0 1 1 0 2 0 3 0 4 0 5 0 6 0}
set tclPath [ GuidoGetParamBufferValue [ GuidoExecServer GetTCLPath { } ] tclPath ]
proc mouse_pressed_proc { main_tabbed_pane collar_panel geology_panel labels_panel graphs_panel depth_panel dipstick_panel} {
global panel_inited
global panel_handles
global tclPath
global form
set panel_idx [$main_tabbed_pane getSelectedIndex]
if {$panel_inited($panel_idx) == 0} {
set panel_inited($panel_idx) 1
source "$tclPath/drawholes_$panel_idx.tcl"
set this_panel [lindex $panel_handles $panel_idx]
if {[$form useLastValues]} {
$form setContainerLastValues $this_panel
} else {
$form setContainerDefaultValues $this_panel
}
}
}
GuidoApp check_db "CHECK DATABASE CONNECTED"
$check_db setParam "databasesession" "GeologyDatabase"
set result [$check_db invoke]
$check_db destroy
GuidoForm form {
-default_buttons
-label "Draw Holes"
-tip DB_DRAWHOLES_TIP
-layout BoxLayout Y_AXIS
-width 69
-height 18
-help_id 293
GuidoPanel top_panel {
-layout CentreLineLayout
GuidoCheckBox rescale {
-default true
-font_style bold
-label "Rescale view to show all holes in plan view?"
-selected_value true
-tip DB_DRAWHOLES_RESCALE_TIP
-unselected_value false
}
GuidoCheckBox add_constraint {
-default false
-font_style bold
-label "Add constraint to holes?"
-selected_value true
-tip DB_DRAWHOLES_ADD_CONSTRAINT_TIP
-unselected_value false
}
}
GuidoPanel borderLayout {
-layout borderlayout
GuidoTabbedPane main_tabbed_pane {
-action mousePressed {[mouse_pressed_proc $main_tabbed_pane $collar_panel $geology_panel $labels_panel $graphs_panel $depth_panel $dipstick_panel]}
-action keyReleased {[mouse_pressed_proc $main_tabbed_pane $collar_panel $geology_panel $labels_panel $graphs_panel $depth_panel $dipstick_panel]}
GuidoPanel options_panel {
-layout CentreLineLayout
-label "Trace styles"
-width 68
-height 12
-position Centre
GuidoLabel width_label {
-label "Colour traces by:"
}
GuidoFiller attributes_filler_2 {
-height 1
}
GuidoDatabaseTableBrowser tbl {
-display_length 6
-label "Table"
-database dbHandle
-table_types "interval | collar"
-tip DB_TRACE_STYLES_TBL_TIP
}
GuidoTableFieldBrowser fld {
-display_length 6
-exclusive false
-label "Field"
-format string
-null false
-tip DB_TRACE_STYLES_FLD_TIP
}
GuidoFiller attributes_filler_3 {
-height 0.5
}
GuidoFiller attributes_filler_4 {
-height 0.5
}
GuidoColourBrowserField trace_colour {
-label "Default trace colour"
-display_length 16
-exclusive false
-max_length 32
-default "forest green"
-tip DB_TRACE_STYLES_COLOUR_TIP
}
GuidoField trace_thickness {
-label "Default trace thickness"
-display_length 5
-format integer
-max_length 8
-null false
-default 1
-tip DB_TRACE_STYLES_WEIGHT_TIP
}
GuidoField tick_mark_weight {
-label "Tick line weight"
-display_length 5
-format double
-max_length 8
-null false
-default 1.0
-tip DB_TRACE_STYLES_TICK_WEIGHT_TIP
}
GuidoFiller attributes_filler_5 {
-height 0.5
}
GuidoFiller attributes_filler_6 {
-height 0.5
}
GuidoComboBox cylinder_style {
-label "Cylinder style"
-display_length 6
-format none
-max_length 14
-null false
-value_in "no cylinders" "fixed width" "variable width"
-default "no cylinders"
-tip DRILLHOLE_CYLINDER_STYLE
}
GuidoLabel cylinder_radius_label {
-label "Radius"
-dependency {"[$cylinder_style getCurrentValue]" != "no cylinders"}
}
GuidoField cylinder_radius {
-display_length 5
-format double
-decimals 3
-max_length 8
-null false
-default 1
-tip DRILLHOLE_CYLINDER_RADIUS
-dependency {"[$cylinder_style getCurrentValue]" != "no cylinders"}
}
GuidoField cylinder_maximum {
-label "Maximum"
-decimals 1
-display_length 5
-format double
-max_length 8
-null false
-default 50.0
-tip DRILLHOLE_CYLINDER_MAXIMUM
-dependency {"[$cylinder_style getCurrentValue]" == "variable width"}
}
}
GuidoPanel collar_panel {
-label "Collar styles"
-layout BoxLayout Y_AXIS
-width 68
-position Centre
}
GuidoPanel geology_panel {
-label "Geology patterns"
-layout BoxLayout Y_AXIS
-width 68
-position Centre
}
GuidoPanel labels_panel {
-label "Labels"
-layout BoxLayout Y_AXIS
-width 68
-position Centre
}
GuidoPanel graphs_panel {
-label "Graphs"
-layout BoxLayout Y_AXIS
-width 68
-position Centre
}
GuidoPanel depth_panel {
-label "Depth markers"
-layout BoxLayout Y_AXIS
-width 68
-position Centre
}
GuidoPanel dipstick_panel {
-label "Apparent dip indicators"
-layout BoxLayout Y_AXIS
-width 68
-position Centre
}
}
}
}
set panel_handles "$main_tabbed_pane $collar_panel $geology_panel $labels_panel $graphs_panel $depth_panel $dipstick_panel"
set use_styles "false"
if {$result == "0"} {
GuidoApp get_handle "GET DATABASE HANDLE"
$get_handle setParam sessionType "GeologyDatabase"
set result [$get_handle invoke]
set dbHandle [$get_handle getParam DatabaseHandle]
$get_handle destroy
GuidoScript scripts/geologyutilities.tcl
global use_styles
set databuf [ GuidoExecServer GetHoleAttributeList {} ]
set status [GuidoGetParamBufferValue $databuf status]
if {$status >= 0} {
$trace_thickness  setCurrentValue [GuidoGetParamBufferValue $databuf "trace_thickness"]
$trace_colour     setCurrentValue [GuidoGetParamBufferValue $databuf "trace_colour"]
$tick_mark_weight setCurrentValue [GuidoGetParamBufferValue $databuf "tick_mark_weight"]
$rescale          setCurrentValue [GuidoGetParamBufferValue $databuf "rescale"]
$add_constraint   setCurrentValue [GuidoGetParamBufferValue $databuf "add_constraint"]
$cylinder_style setCurrentValue [GuidoGetParamBufferValue $databuf "cylinder_style"]
$cylinder_radius setCurrentValue [GuidoGetParamBufferValue $databuf "cylinder_radius"]
$cylinder_maximum setCurrentValue [GuidoGetParamBufferValue $databuf "cylinder_maximum"]
set val [GuidoGetParamBufferValue $databuf "field"]
$tbl updateBrowserList
$tbl setCurrentValue [GuidoGetParamBufferValue $databuf "table"]
$fld setDependency {[updateTraceTableName $fld $tbl "$val"]}
$fld setActionCallback focusGained {[updateTraceTableName $fld $tbl "$val"]}
$fld setValidationCallback {[validateTableFieldPair $tbl $fld]}
}
$cylinder_style setActionCallback valueChanged {[setLabel $cylinder_style $cylinder_radius_label]}
setLabel $cylinder_style $cylinder_radius_label
$cylinder_style setActionCallback focusGained {[setStylesAllowed $tbl $fld $cylinder_style]}
$tbl setActionCallback valueChanged {[setStylesAllowed $tbl $fld $cylinder_style]}
$fld setActionCallback valueChanged {[setStylesAllowed $tbl $fld $cylinder_style]}
while {1} {
set return_code [$form interact]
if {$return_code == "apply"} {
GuidoApp attributes "DRILLHOLE ATTRIBUTES"
if {[$tbl getCurrentValue] > "" } {
set use_styles "true"
}
$attributes setParam trace_colour       [$trace_colour getCurrentValue]
$attributes setParam trace_thickness    [$trace_thickness getCurrentValue]
$attributes setParam table              [$tbl getCurrentValue]
$attributes setParam field              [$fld getCurrentValue]
$attributes setParam tick_mark_weight   [$tick_mark_weight getCurrentValue]
$attributes setParam rescale            [$rescale getCurrentValue]
$attributes setParam add_constraint     [$add_constraint getCurrentValue]
$attributes setParam cylinder_style     [$cylinder_style getCurrentValue]
$attributes setParam cylinder_radius    [$cylinder_radius getCurrentValue]
$attributes setParam cylinder_maximum   [$cylinder_maximum getCurrentValue]
if {$panel_inited(1) == 0} {
source "$tclPath/drawholes_1.tcl"
set panel_inited(1) 1
}
$attributes setParam show_collars       [$show_collars getCurrentValue]
set return_code [$attributes invoke]
$attributes destroy
if {"$return_code" == "-1"} {
continue
}
if {$panel_inited(1) == 0} {
source "$tclPath/drawholes_1.tcl"
if {[$form useLastValues]} {
$form setContainerLastValues $collar_panel
} else {
$form setContainerDefaultValues $collar_panel
}
}
GuidoApp collar_app "DRILLHOLE COLLARS"
$collar_app setParam show_collars       [$show_collars getCurrentValue]
$collar_app setParam collar_marker      [$collar_marker getCurrentValue]
$collar_app setParam collar_marker_size [$collar_marker_size getCurrentValue]
$collar_app setParam position           [$collar_position getCurrentValue]
$collar_app setParam collar_offset      [$collar_offset getCurrentValue]
set row 0
for {set row_idx 0} {$row_idx < [$collar_table getRowCount]} {incr row_idx} {
if {[$collar_fld getCurrentValue $row_idx] > ""} {
set use_styles "true"
$collar_app setParam "fld($row)" [$collar_fld getCurrentValue $row_idx]
if {[$collar_decimals getCurrentValue $row_idx] == ""} {
$collar_app setParam "decimals($row)" "-1"
} else {
$collar_app setParam "decimals($row)" [$collar_decimals getCurrentValue $row_idx]
}
$collar_app setParam "font_style($row)" [$collar_font_style getCurrentValue $row_idx]
$collar_app setParam "font_size($row)" [$collar_font_size getCurrentValue $row_idx]
$collar_app setParam "font_units($row)" [$collar_font_units getCurrentValue $row_idx]
$collar_app setParam "label_position($row)" [$collar_label_position getCurrentValue $row_idx]
incr row
}
}
$collar_app setParam num_rows $row
set return_code [$collar_app invoke]
$collar_app destroy
if {$panel_inited(2) == 0} {
source "$tclPath/drawholes_2.tcl"
if {[$form useLastValues]} {
$form setContainerLastValues $geology_panel
} else {
$form setContainerDefaultValues $geology_panel
}
}
GuidoApp geology_app "DRILLHOLE GEOLOGY"
set row 0
for {set row_idx 0} {$row_idx < [$geology_table getRowCount]} {incr row_idx} {
if {[$geology_tbl getCurrentValue $row_idx] > ""} {
set use_styles "true"
}
if {[$geology_tbl getCurrentValue $row_idx] > "" &&
[$geology_fld getCurrentValue $row_idx] > ""} {
$geology_app setParam "tbl($row)" [$geology_tbl getCurrentValue $row_idx]
$geology_app setParam "fld($row)" [$geology_fld getCurrentValue $row_idx]
$geology_app setParam "position($row)" [$geology_position getCurrentValue $row_idx]
$geology_app setParam "size($row)" [$geology_size getCurrentValue $row_idx]
$geology_app setParam "offset($row)" [$geology_offset getCurrentValue $row_idx]
incr row
}
}
$geology_app setParam num_rows $row
set return_code [$geology_app invoke]
$geology_app destroy
if {$panel_inited(3) == 0} {
source "$tclPath/drawholes_3.tcl"
if {[$form useLastValues]} {
$form setContainerLastValues $labels_panel
} else {
$form setContainerDefaultValues $labels_panel
}
}
GuidoApp labels_app "DRILLHOLE LABELS"
$labels_app setParam "tick_length" [$label_tick_length getCurrentValue]
set row 0
for {set row_idx 0} {$row_idx < [$label_table getRowCount]} {incr row_idx} {
if {[$label_tbl getCurrentValue $row_idx] > "" &&
[$label_fld getCurrentValue $row_idx] > ""} {
$labels_app setParam "tbl($row)" [$label_tbl getCurrentValue $row_idx]
$labels_app setParam "fld($row)" [$label_fld getCurrentValue $row_idx]
$labels_app setParam "position($row)" [$label_position getCurrentValue $row_idx]
$labels_app setParam "offset($row)" [$label_offset getCurrentValue $row_idx]
if {[$label_decimals getCurrentValue $row_idx] == ""} {
$labels_app setParam "decimals($row)" "-1"
} else {
$labels_app setParam "decimals($row)" [$label_decimals getCurrentValue $row_idx]
}
if {"[$label_use_styles getCurrentValue $row_idx]" == "true"} {
$labels_app setParam "use_styles($row)" "false"
} else {
$labels_app setParam "use_styles($row)" "true"
set use_styles "true"
}
$labels_app setParam "colour($row)" [$label_colour getCurrentValue $row_idx]
$labels_app setParam "font_style($row)" [$label_font_style getCurrentValue $row_idx]
$labels_app setParam "font_size($row)" [$label_font_size getCurrentValue $row_idx]
$labels_app setParam "font_units($row)" [$label_font_units getCurrentValue $row_idx]
$labels_app setParam "alignment($row)" [$label_alignment getCurrentValue $row_idx]
$labels_app setParam "combine($row)" [$label_combine getCurrentValue $row_idx]
$labels_app setParam "minValue($row)" [$label_minValue getCurrentValue $row_idx]
$labels_app setParam "maxValue($row)" [$label_maxValue getCurrentValue $row_idx]
incr row
}
}
$labels_app setParam num_rows $row
set return_code [$labels_app invoke]
$labels_app destroy
if {$panel_inited(4) == 0} {
source "$tclPath/drawholes_4.tcl"
if {[$form useLastValues]} {
$form setContainerLastValues $graphs_panel
} else {
$form setContainerDefaultValues $graphs_panel
}
}
GuidoApp graphs_app "DRILLHOLE GRAPHS"
set row 0
for {set row_idx 0} {$row_idx < [$graphs_table getRowCount]} {incr row_idx} {
if {[$graphs_tbl getCurrentValue $row_idx] > "" &&
[$graphs_fld getCurrentValue $row_idx] > ""} {
$graphs_app setParam "tbl($row)" [$graphs_tbl getCurrentValue $row_idx]
$graphs_app setParam "fld($row)" [$graphs_fld getCurrentValue $row_idx]
$graphs_app setParam "position($row)" [$graphs_position getCurrentValue $row_idx]
if {"[$graphs_use_styles getCurrentValue $row_idx]" == "true"} {
$graphs_app setParam "use_styles($row)" "false"
} else {
$graphs_app setParam "use_styles($row)" "true"
set use_styles "true"
}
$graphs_app setParam "colour($row)" [$graphs_colour getCurrentValue $row_idx]
$graphs_app setParam "scale($row)" [$graphs_scale getCurrentValue $row_idx]
$graphs_app setParam "maximum($row)" [$graphs_maximum getCurrentValue $row_idx]
$graphs_app setParam "type($row)" [$graphs_type getCurrentValue $row_idx]
$graphs_app setParam "offset($row)" [$graphs_offset getCurrentValue $row_idx]
incr row
}
}
$graphs_app setParam num_rows $row
set return_code [$graphs_app invoke]
$graphs_app destroy
if {$panel_inited(5) == 0} {
source "$tclPath/drawholes_5.tcl"
if {[$form useLastValues]} {
$form setContainerLastValues $depth_panel
} else {
$form setContainerDefaultValues $depth_panel
}
}
GuidoApp depth_app "DRILLHOLE DEPTH MARKERS"
$depth_app setParam "position"     [$depth_position     getCurrentValue]
$depth_app setParam "offset"       [$depth_offset       getCurrentValue]
$depth_app setParam "decimals"     [$depth_decimals     getCurrentValue]
$depth_app setParam "use_styles"   [$depth_use_styles   getCurrentValue]
if {"[$depth_use_styles getCurrentValue]" == "false" && "[$depth_display getCurrentValue]" == "true"} {
set use_styles "true"
}
if {[$depth_use_styles getCurrentValue]} {
$depth_app setParam "colour"       [$depth_colour       getCurrentValue]
} else {
$depth_app setParam "colour" ""
}
$depth_app setParam "font_style"   [$depth_font_style   getCurrentValue]
$depth_app setParam "font_size"    [$depth_font_size    getCurrentValue]
$depth_app setParam "font_units"   [$depth_font_units   getCurrentValue]
$depth_app setParam "alignment"    [$depth_alignment    getCurrentValue]
$depth_app setParam "major"        [$depth_major        getCurrentValue]
$depth_app setParam "minor"        [$depth_minor        getCurrentValue]
$depth_app setParam "display"      [$depth_display      getCurrentValue]
$depth_app setParam "major_length" [$depth_major_length getCurrentValue]
$depth_app setParam "minor_length" [$depth_minor_length getCurrentValue]
set return_code [$depth_app invoke]
$depth_app destroy
if {$panel_inited(6) == 0} {
source "$tclPath/drawholes_6.tcl"
if {[$form useLastValues]} {
$form setContainerLastValues $dipstick_panel
} else {
$form setContainerDefaultValues $dipstick_panel
}
}
GuidoApp dip_app "DRILLHOLE APPARENT DIP MARKERS"
set row 0
for {set row_idx 0} {$row_idx < [$dipstick_table getRowCount]} {incr row_idx} {
if {[$dipstick_az_fld getCurrentValue $row_idx] > ""} {
if {[$dipstick_dip_fld getCurrentValue $row_idx] > ""} {
$dip_app setParam "tbl($row)" [$dipstick_tbl getCurrentValue $row_idx]
$dip_app setParam "az_fld($row)" [$dipstick_az_fld getCurrentValue $row_idx]
$dip_app setParam "dip_fld($row)" [$dipstick_dip_fld getCurrentValue $row_idx]
$dip_app setParam "position($row)" [$dipstick_position getCurrentValue $row_idx]
$dip_app setParam "length($row)" [$dipstick_length getCurrentValue $row_idx]
$dip_app setParam "offset($row)" [$dipstick_offset getCurrentValue $row_idx]
incr row
}
}
}
$dip_app setParam num_rows $row
set return_code [$dip_app invoke]
$dip_app destroy
}
break
}
}
if { "$use_styles" == "true" } {
set buffer [ GuidoExecServer "DoesStylesExist" [subst {databasetype = "GeologyDatabase"}] ]
set HaveStyles [GuidoGetParamBufferValue $buffer StylesExist]
if { $HaveStyles != "true"  } {
GuidoMessage error DB_NEED_STYLES_TABLE
}
}
$form destroy
