#
# Copyright 2004 (c) Pointwise, Inc.
# All rights reserved.
# 
# This sample Gridgen script is not supported by Pointwise, Inc.
# It is provided freely for demonstration purposes only.  
# SEE THE WARRANTY DISCLAIMER AT THE BOTTOM OF THIS FILE.
#

gg::tkLoad

set tDBPOINTS ""

catch {
  set scriptDir [file dirname [info script]]
  source [file join $scriptDir pwiLogo.glf]
}

proc sorter { a b } {
  set x 0
  set y 0
  scan $a "CN%d" x
  scan $b "CN%d" y
  return [expr $x-$y]
}

set percentage 50
set allcons {}
foreach con [lsort -command sorter [gg::conGetAll -enabled]] {
  lappend allcons "$con Begin" "$con End"
}

set selected {}

proc formatCons { cns } {
  set ret {}
  foreach c $cns {
    foreach {con side} $c {break}
    if { $side == "Begin" } {
      set sc 1
    } else {
      puts "gg::conGetNumSubCons $con"
      set sc [gg::conGetNumSubCons $con]
    }
    lappend ret [list $con $sc $side]
  }
  return $ret
}

proc AddBP { } {
  global percentage selected allcons
  foreach cs $selected {
    foreach {con side} $cs {break}
    if {[catch {
      if { $side == "Begin" } {
	set arc [expr {$percentage * 0.01}]
      } else {
	set arc [expr {1.0 - ($percentage * 0.01)}]
      }
      gg::conSetBreakPt $con [gg::conGetPt $con -arc $arc]
    }] == 1} {
      tk_messageBox -icon error -title "Error" \
        -message "Breakpoing could not be set on $con." -type ok
    }
  }
}

proc select { } {
  global selected allcons
  wm withdraw .
  set sel [gg::dispPick SUBCON_END -interior FALSE \
    -message "INSERT BREAKPOINTS:^nSelect the connector ends from which to insert a breakpoint." \
    -select [formatCons $selected]]
  foreach i $sel {
    lappend selected "[lindex $i 0] [lindex $i 2]"
  }
  if {[winfo exists .]} {
    wm deiconify .
  }
  checkSelection
}

proc getOther { c } { 
  foreach {con side} $c {break}
  if { $side == "Begin" } {
    return "$con End" 
  } else {
    return "$con Begin"
  }
}

proc checkSelection { } {
  global allcons tDBPOINTS percentage selected

  if { $tDBPOINTS != "" } {
    gg::dbDelete $tDBPOINTS
  }
  if { $selected != "" } {
    for { set i 0 } { $i < [llength $selected] } { incr i } {
      foreach {con side} [lindex $selected $i] {break}

      if { [expr $i+1] < [llength $selected] } {
	if { [lsearch $selected [getOther [lindex $selected $i]]] != -1 } {
	  switch [tk_dialog .diag "Selection Error" "Selecting both ends of connector $con is not allowed. Please choose either the begin, the end, or unselect both ends." warning 0 "Beginning" "End" "Skip"] {
	    0 {
	      set selected [lreplace $selected [lsearch $selected "$con End"] \
		[lsearch $selected "$con End"]]
	    }
	    1 {
	      set selected [lreplace $selected \
	        [lsearch $selected "$con Begin"] \
		[lsearch $selected "$con Begin"]]
	    }
	    2 {
	      set selected [lreplace $selected \
	        [lsearch $selected "$con Begin"] \
		[lsearch $selected "$con Begin"]]
	      set selected [lreplace $selected [lsearch $selected "$con End"] \
		[lsearch $selected "$con End"]]
	      set i [expr $i-1]
	    }
	  }
	}
      }
    }
  }
  gg::dbPtsBegin
  foreach cs $selected {
    foreach {con side} $cs {break}
    if { $side == "Begin" } {
      set arc [expr {$percentage * 0.01}]
    } else {
      set arc [expr {1.0 - ($percentage * 0.01)}]
    }
    catch {gg::dbPtsAddPt [gg::conGetPt $con -arc $arc]}
  }
  if { [catch { gg::dbPtsEnd } tDBPOINTS] == 1 } {
    set tDBPOINTS ""
  }
}

proc checkInputStatus { } {
  global Breakpoint
  if {0 == $Breakpoint(arc)} {
    $Breakpoint(okButton) configure -state disabled
  } else {
    $Breakpoint(okButton) configure -state normal
  }
}

proc checkPercentInput { w var text action } {
  global Breakpoint

  # Ignore force validations
  if {$action == -1} {
    return 1
  }

  if {![string is double $text] || 0.0 >= $text || 100.0 <= $text} {
    set Breakpoint($var) 0
    $w configure -bg "#FFCCCC"
  } else {
    set Breakpoint($var) 1
    $w configure -bg "#FFFFFF"
  }

  checkInputStatus
  return 1
}

proc makeInputField { parent name title variable {width 7} {valid ""}} {
  frame $parent.$name
  label .lbl$name -text $title
  entry .ent$name -textvariable $variable -width $width
  if { [string compare $valid ""]!=0 } {
    .ent$name configure -validate all
    .ent$name configure -validatecommand $valid
  }
  pack ".lbl$name" -side left -padx 3 -pady 1 -in $parent.$name
  pack ".ent$name" -side right -padx 3 -pady 1 -in $parent.$name
  return $parent.$name
}

proc makeWindow { } {
  global Breakpoint
  pack [frame .top] -fill both -padx 2 -pady 2
  pack [label .top.lbl1 -text "Insert Break Point at Percent of Arclength" \
    -wraplength 220 -justify center] -fill x -side top

  set font [.top.lbl1 cget -font]
  .top.lbl1 configure -font [font create -family [font actual $font -family] \
    -weight bold]

  pack [frame .hr1 -height 2 -relief sunken -bd 1] -fill x -padx 2 -pady 4 \
    -side top -in .top

  pack [label .top.caption -text "Select connectors by the end point from which the arclength should be measured." -wraplength 200]
  pack [button .top.enterSelect -text "Enter Selection Mode" \
    -command { select }] -pady 2 -padx 2

  pack [makeInputField .top in "Arclength %:" percentage 7 \
    [list checkPercentInput %W arc %P %d]] -side bottom
  set Breakpoint(arc) 1

  pack [frame .buttons] -fill x -padx 2 -pady 2 -side bottom
  pack [button .buttons.cancel -text "Cancel" -command { exit }] -side right \
    -padx 2
  pack [button .buttons.ok -text "OK" -command { AddBP; exit }] -side right \
    -padx 2
  set Breakpoint(okButton) .buttons.ok
  if {![catch {pwiLogoCreate .buttons.logo 1} b]} {
    $b configure -bd 0 -relief flat
    pack $b -side left -padx 5 -fill y
  }
  pack [frame .hr2 -height 2 -relief sunken -bd 1] -fill x -padx 2 -pady 4 \
    -side bottom
  bind .entin <KeyRelease> {
    checkSelection
  }
  bind . <Destroy> { 
    global tDBPOINTS
    if { $tDBPOINTS != "" } { 
      gg::dbDelete $tDBPOINTS
    }
  }
}

makeWindow
::tk::PlaceWindow . widget

gg::tkLoop
#
# DISCLAIMER:
# TO THE MAXIMUM EXTENT PERMITTED BY APPLICABLE LAW, POINTWISE DISCLAIMS
# ALL WARRANTIES, EITHER EXPRESS OR IMPLIED, INCLUDING, BUT NOT LIMITED
# TO, IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE, WITH REGARD TO THIS SCRIPT.  TO THE MAXIMUM EXTENT PERMITTED 
# BY APPLICABLE LAW, IN NO EVENT SHALL POINTWISE BE LIABLE TO ANY PARTY 
# FOR ANY SPECIAL, INCIDENTAL, INDIRECT, OR CONSEQUENTIAL DAMAGES 
# WHATSOEVER (INCLUDING, WITHOUT LIMITATION, DAMAGES FOR LOSS OF 
# BUSINESS INFORMATION, OR ANY OTHER PECUNIARY LOSS) ARISING OUT OF THE 
# USE OF OR INABILITY TO USE THIS SCRIPT EVEN IF POINTWISE HAS BEEN 
# ADVISED OF THE POSSIBILITY OF SUCH DAMAGES AND REGARDLESS OF THE 
# FAULT OR NEGLIGENCE OF POINTWISE.
#