#
# Copyright 2007 (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

puts "##########################################################################"
puts "#                                                                         "
puts "#          o|-|-------|-|o----------------o|-|----------|-|o              "
puts "#          B1            B2              B4                B3             "
puts "#          BeginDs1   dsB2                 dsB4       BeginDs2            "           
puts "#          |                                               |              "
puts "#          |                                               |              "
puts "#          |                                               |              "
puts "#          |                                               |              "
puts "#          o-------------o-----------------o---------------o              "
puts "#          B1'           B2'               B4'             B3'            "
puts "#                                                                         "
puts "#                                                                         "
puts "# B1B3 (B1'B3') is the original connector where the GEOMETRIC function is "
puts "# applied to B1B2 (B1'B2') and B3B4 (B3'B4') whereas the TANH function is "
puts "# applied to B2B4.                                                        " 
puts "#                                                                         "
puts "# Input parameter list:                                                   "
puts "#                                                                         "
puts "# Beginning ds1 -- the spacing at the selected connector end B1.          "
puts "# Beginning ds2 -- the spacing at the other end B3.                       "
puts "# Growth Rate   -- the ratio of the spacing at a given grid point in B1B2 "
puts "# and B3B4. It should match the value of the growth rate in the Aniso Tris"
puts "#                 Attibutes if used to generate aniso tris along B1B1' and"
puts "#                 B3B3'.                                                  "
puts "# Total Layer   -- the maximum number of layers of aniso tris to be gener-"
puts "#                 ated. (Total Layer+1) is the dimension of B1B2 and B3B4."
puts "# Dimension factor                                                        "
puts "#               -- controls how dense the distribution of B2B4 will be.   "
puts "#                  The defalt is 1.0 and can be larger if you want more   "
puts "#                  points there.                                          "
puts "#                                                                         "
puts "# If you want to solve the domain where this connector (or connectors)    "
puts "# belong to by using Aniso Tris attributes, please set the Total layer,   "
puts "# Layer hight of the edges from which aniso tris grow and Growth Rate     "
puts "# exactly the same as the Total Layer, Beginning ds and Growth Rate you   "
puts "# define here.                                                            "
puts "#                                                                         "
puts "#                                                                         "
puts "#                                                                         "


set tDBPOINTS ""

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

#######################################################################
# Get a list of everything in the first list that is not in the second
#######################################################################
proc AminusB { lista listb } {
  set result {}

  foreach elem $lista {
      if { [lsearch -exact $listb $elem] == -1 } {
         lappend result $elem
      }
  }
  return $result
}

####################################################################
# Set the default growth rate, Total layer, beginning and ending Ds
# (note: growthRate smaller than 1.01 brings mathematic difficulty
#  calculating deltaS * ( growthRate^N - 1 )/( growthRate -1 )
#  To be safe, the spacing should be greater than the node tolerance
####################################################################
set growthRate 1.35
set TotalN 10 
set BeginDs1 0.0001
set BeginDs2 0.0001
set DimFac 1.5

######################################################
# Look in the defaults for the default initial spacing
######################################################
  set deltaBeg [gg::defConDistBeg]
  set deltaEnd [gg::defConDistEnd]
  if { $deltaBeg > 0.0 && $deltaEnd > 0.0 } {
   set deltaS [expr 0.5 * ($deltaBeg + $deltaEnd)]
  } elseif { $deltaBeg > 0.0 } {
     set deltaS $deltaBeg
  } elseif { $deltaEnd > 0.0 } {
     set deltaS $deltaEnd
  } else {
     set deltaS 0.0001
  }

set badCons1 {}

########################################################
# List of all connectors belonging to structured domains
# (note: this script cannot be used for connectors that
#  belong to a structured domain or undimensioned)
########################################################
puts "# Note: this script cannot be used for undimensioned connectors "
puts "#       or connectors that belong to a structured domain.       "

foreach dom [gg::domGetAll] {
  gg::domReport $dom diag [list STRUCTURE REFERENCE]
  if {[string equal "STRUCTURED" $diag(type)]} {
    foreach con $diag(refCons) {
       lappend badCons1 $con
   }
  }
}

# undimensioned cons appended to the list 
# (this is a requirement of gg::dispPick SUBCON_END only)
foreach con [gg::conGetAll] {
  if { [gg::conDim $con] == 0 } {
    lappend badCons1 $con
  }
}

# conList is all enabled connectors not belonging to badCons1
set conList [AminusB [gg::conGetAll -enabled] [lsort -unique $badCons1] ]

set selected {}

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

#################################################################################
#
#          o|-|-------|-|o----------------o|-|----------|-|o
#          B1            B2              B4                B3
#          BeginDs1   dsB2                 dsB4       BeginDs2
#          |                                               |
#          |                                               |
#          |                                               |
#          |                                               |
#          o-------------o-----------------o---------------o
#          B1'           B2'               B4'             B3'
#
#
#  1. Old break points of B1B3 are cleared.
#  2. Guess the initial spacing of B1B3 according to dsB2 and EndDs.
#  3. Define the new dimension of B1B3 and apply the TANH function.
#  4. Define the length of B1B2 and B3B4 (GEOMETRIC) according to the Total Layer,
#     BeginDs and growthRate.
#  5. Add the break points at B2 and B4 for spacing adjustment.
#  6. Push/pull B2, B4, or both to redimension B1B2 and B3B4 to (Total Layer+1).
#  7. Apply the GOMETRIC function to B1B2 and B3B4 while TANH to B2B4.
#  
##################################################################################
proc Distribution { } {
  global selected growthRate deltaS BeginDs1 BeginDs2 TotalN DimFac
  set zero 0.0

  foreach cs $selected {
    foreach {con side} $cs {break}
      set conDim [gg::conDim $con]

    if {[catch {
#    clear breakpoints
     for { set i 1 } { $i < [gg::conGetNumSubCons $con] } {incr i} {
       gg::conDeleteBreakPt $con 1
     }

     gg::conBeginSpacing $con $zero
     gg::conEndSpacing $con $zero
     puts "# Info -- Clear all the existing breakpoints"

#    The total arclength required for a geometric progression is equal to 
#    ArcTotal = deltaS * ( growthRate^N - 1 )/( growthRate -1 ), where N is 
#    equal to the number of intervals. (N=newDim-1) 

     set Arc [gg::conGetLength $con]

#    Initial guess of the new dimension of B1B3. The dimension can be adjusted
#    by changing the value of DimFac. The default DimFac is 1.5 and can be larger
#    if you wants more grid points on B2B3. Note the number of grid points on B1B2
#    is defined by the Total Layer and does not respond to the value of the DimFac.

     set dsB2 [expr $BeginDs1 * pow($growthRate, $TotalN-1)]
     set dsB4 [expr $BeginDs2 * pow($growthRate, $TotalN-1)]
     set B1B3InitDs [expr ($dsB2 + $dsB4)/2.0]
     #set B1B3InitDim [expr int( $Arc/$B1B3InitDs*$DimFac )]
     set B1B3InitDim [expr int( ($TotalN-1)*2 + $conDim*$DimFac) ]
     if { $B1B3InitDim > 200 } {
	  tk_messageBox -message "Initial guess of dimension, $B1B3InitDim, may be too large. Set DimFac to\
	    a smaller value if necessary." -type ok -icon warning -title "Warning"
     }
 
     puts "# Info -- The initial dimension of $con is $B1B3InitDim"
     if {$B1B3InitDim == 0} {
      set result [tk_messageBox -parent . \
      -title "Error message" \
      -type retrycancel -icon error \
      -message "Smaller ds1, ds2 or Total layer is needed." ]
      puts $result
     }

     
#    set the distFun of the selected connector to TANH
     gg::conDistFunc $con -function TANH

#    set Ds at two ends (B1 and B3) of the connector
     if { $side == "Begin" } {
       gg::conBeginSpacing $con $BeginDs1
       gg::conEndSpacing $con $BeginDs2
     } else {
       gg::conBeginSpacing $con $BeginDs2
       gg::conEndSpacing $con $BeginDs1       
     }

#    apply the new dimension to B1B3
     gg::conDim $con $B1B3InitDim
     puts "# Info -- Apply this dimension and the TANH function to $con"

#    Send a warning if the initial dimension is smaller than Total Layer
     if {$B1B3InitDim < [expr ($TotalN+1) * 2 + 2]} {
      set result [tk_messageBox -parent . \
      -title "Error message" \
      -type retrycancel -icon error \
      -message "Total layer must be smaller than [expr int($B1B3InitDim/2)-1]" ]
      puts $result
     }

#    Add two breakpoints at the (TotalN+1) point at both ends. We need
#    to decide whether this end is the begining or the ending because the index
#    of the point needs to be defined differently.

#    For some reason, we need to clear the existing break points agaion. Otherwise
#    three break points will be added.

     for { set i 1 } { $i < [gg::conGetNumSubCons $con] } {incr i} {
       gg::conDeleteBreakPt $con 1
     }

     set B1B2Length [expr $BeginDs1 * pow($growthRate, $TotalN -1) / ($growthRate -1)]
     set B3B4Length [expr $BeginDs2 * pow($growthRate, $TotalN -1) / ($growthRate -1)]
     set B1B2divB1B3 [expr $B1B2Length / $Arc]
     set B3B4divB1B3 [expr $B3B4Length / $Arc]
     set B2B4divB1B3 [expr 1.0 - $B1B2divB1B3 - $B3B4divB1B3]
     
#    Send a warning if B3B4 is shorter than (dsB2 + dsB4).
     if {[expr $B2B4divB1B3 * $Arc] - [expr $dsB2 + $dsB4] < 0.00} {
      set result [tk_messageBox -parent . \
      -title "Error message" \
      -type retrycancel -icon error \
      -message "Smaller Beginning ds1 or ds2 is needed." ]
      puts $result
     }
 
     if { $side == "Begin" } {
      set xyzB2 [gg::conGetPt $con -arc $B1B2divB1B3]
      set xyzB4 [gg::conGetPt $con -arc [expr 1.0-$B3B4divB1B3]]
      gg::conSetBreakPt $con $xyzB2
      gg::conSetBreakPt $con $xyzB4
     } else {
      set xyzB2 [gg::conGetPt $con -arc [expr 1.0-$B1B2divB1B3]]
      set xyzB4 [gg::conGetPt $con -arc [expr $B3B4divB1B3]]
      gg::conSetBreakPt $con $xyzB2
      gg::conSetBreakPt $con $xyzB4
     }

     puts "# Info -- Break points B2 and B4 are added."
     

#    Adjust the dimension of the subconnector where GEOMETRIC is applied.
#    More points will be moved to B1B2 or B3B4 from B2B4 if the dimension of 
#    B1B2 or B3B4 is smaller than TotalN, vice visa.

     set B1B2B3Dims [gg::conSubConDim $con]
     puts "# Info -- Current B1B2 and B2B3 dimensions are $B1B2B3Dims"

     set C [list [expr $TotalN + 1] [expr $B1B3InitDim - $TotalN * 2] [expr $TotalN + 1]]
     puts "# Info -- The B1B2, B2B4 and B3B4 dimensions are adjusted to $C"

     gg::conSubConDim $con $C
     
#    Apply the GEOMETIC function to the 1st subconnector.
     if {$side == "Begin"} {
      gg::conDistFunc $con -sub 1 -function GEOMETRIC
      gg::conBeginSpacing $con -sub 2 $dsB2
      gg::conEndSpacing $con -sub 2 $dsB4
      gg::conDistFunc $con -sub 2 -function TANH
      gg::conDistFunc $con -sub 3 -function GEOMETRIC
     } else {
      gg::conDistFunc $con -sub 1 -function GEOMETRIC
      gg::conBeginSpacing $con -sub 2 $dsB4
      gg::conEndSpacing $con -sub 2 $dsB2
      gg::conDistFunc $con -sub 2 -function TANH
      gg::conDistFunc $con -sub 3 -function GEOMETRIC
     }
     puts "# Info -- Apply GEOMETRIC function to B1B2 and B3B4 while TANH to B2B4       "
     puts "# Info -- The connector(s) is successfully redimensioned and redistributed   "
     puts "# If you want to make it finer, please set a larger value to Dimension Factor"
     puts "#                                                                            "
     puts "#############################################################################"

    }] == 1} {
      tk_messageBox -icon error -title "Error" \
        -message "Distfun failed to be applied to $con." -type ok
    }
  }
}

proc select { } {
  global selected conList growthRate deltaS badCons1

  wm withdraw .

  set sel [gg::dispPick SUBCON_END -explicit $conList -interior FALSE \
    -message "GEOMETRIC SPACING:^nSelect the connector ends from which to specify spacing and growth rate constaints." \
    -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 selected growthRate deltaS tDBPOINTS

  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]
	    }
	  }
	}
      }
    }

  }

# query the total arclength of all selected connectors 
  if { $growthRate != "" && $deltaS != "" } {
    foreach cs $selected {
      foreach {con side} $cs {break}
      set arcLen($con) [gg::conGetLength $con]
    }
  }

  gg::dbPtsBegin
  if { $growthRate != "" && $deltaS != "" } {
    foreach cs $selected {
      foreach {con side} $cs {break}
      if { $side == "Begin" } {
          set arc [expr 0.0]
        catch {gg::dbPtsAddPt [gg::conGetPt $con -arc $arc]}
          set arc [expr {$deltaS / $arcLen($con)}]
          if { $arc > 1.0 } {
            set arc 1.0
          }
        catch {gg::dbPtsAddPt [gg::conGetPt $con -arc $arc]}
          set arc [expr {$deltaS / $arcLen($con) * (1 + $growthRate)}]
          if { $arc > 1.0 } {
            set arc 1.0
          }
        catch {gg::dbPtsAddPt [gg::conGetPt $con -arc $arc]}
      } else {
          set arc [expr 0.0]
        catch {gg::dbPtsAddPt [gg::conGetPt $con -arc $arc]}
          set arc [expr {1 - $deltaS / $arcLen($con)}]
          if { $arc < 0.0 } {
            set arc 0.0
          }
        catch {gg::dbPtsAddPt [gg::conGetPt $con -arc $arc]}
          set arc [expr {1 - $deltaS / $arcLen($con) * (1 + $growthRate)}]
          if { $arc < 0.0 } {
            set arc 0.0
          }
        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
  }
}

# real value must be > lowerLim
proc checkRealGTInput { w lowerLim var text action } {
  global Breakpoint

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

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

  checkInputStatus
  return 1
}

# real value must be >= lowerLim
proc checkRealGEInput { w lowerLim var text action } {
  global Breakpoint

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

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

  checkInputStatus
  return 1
}

# value must be > 0 && < 100 percent
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 "Apply Geometric to Both Ends and Tanh to The Middle" \
    -wraplength 428 -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 at one end point (Beginning ds1) at which \
  #      the geometric distribution should be applied. Information on how to define \
  #      the parameters will be given in the console window." -wraplength 320]
  pack [button .top.enterSelect -text "Select One Spacing Constraint of Con(s)" \
    -command { select }] -pady 8 -padx 2
  
  frame .input -bd 1 -relief solid 

  pack [makeInputField .input inp3 "Total layer (Aniso Tris)" TotalN 10 \
    [list checkRealGTInput %W 0.0 arc %P %d]] -fill x -pady 2 -padx 2
  set Breakpoint(arc) 1

  pack [makeInputField .input inp4 "Growth Rate (>1.01)" growthRate 7 \
    [list checkRealGTInput %W 1.0 arc %P %d]] -fill x -pady 2 -padx 2
  set Breakpoint(arc) 1

  pack [makeInputField .input inp1 "Beginning ds1" BeginDs1 10 \
    [list checkRealGTInput %W 0.0 arc %P %d]] -fill x -pady 2 -padx 2
  set Breakpoint(arc) 1

  pack [makeInputField .input inp2 "Beginning ds2" BeginDs2 10 \
    [list checkRealGTInput %W 0.0 arc %P %d]] -fill x -pady 2 -padx 2
  set Breakpoint(arc) 1

  pack [makeInputField .input inp5 "Dimension Factor (>1 for refinement)" DimFac 10 \
    [list checkRealGTInput %W 0.0 arc %P %d]] -fill x -pady 2 -padx 2
  set Breakpoint(arc) 1

  pack .input -fill x -padx 30 -pady 8 

  pack [frame .buttons -width 200] -padx 2 -pady 8
  pack [button .buttons.ok -text "Redistribute selected con(s)" -width 25 -command { Distribution; exit }] \
	-side left 
  pack [button .buttons.cancel -text "Cancel" -command { exit }] -side left -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 .entinp1 <KeyRelease> {
    checkSelection
  }
  bind .entinp2 <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.
#