#
# Copyright 2007 (c) Pointwise, Inc.
# All rights reserved.
# 

gg::tkLoad

puts "############################################################################"
puts "#                                                                           "
puts "# This sample Gridgen script is not supported by Pointwise, Inc.            "
puts "# It is provided freely for demonstration purposes only.                    "
puts "# SEE THE WARRANTY DISCLAIMER AT THE BOTTOM OF THIS FILE.                   "
puts "#                                                                           "
puts "#          o--------|-|o------------------|----|o                           "
puts "#          B1          B2                       B3                          "
puts "#                   dsB2                  EndDs                             "
puts "#                                                                           "
puts "#  B1B3 is the original connector where the GEOMETRIC function is applied to" 
puts "#  B1B2 while the TANH function is applied to B2B3.                         "
puts "#                                                                           "
puts "# Input parameter list:                                                     "
puts "#                                                                           "
puts "# Beginning ds -- the spacing of the selected connector end.                "
puts "# Ending ds    -- the spacing of the other end of the selected connector.   "
puts "# Growth Rate  -- the ratio of the spacing at a given grid point in B1B2.   "
puts "#                 It should match the value of the growth rate in the       "
puts "#                 Aniso Tri Attibutes if used to generate aniso tris domain."
puts "# Total Layer  -- the maximum number of layers of aniso tris to be generated"
puts "#                 (Total Layer + 1) is the dimension of B1B2.               "
puts "# Dimension factor                                                          "
puts "#              -- controls how dense the distribution of B2B3 will be. The  "
puts "#                 default is 1.5 and can be larger if you want more points. "
puts "#                                                                           "
puts "# If you want to solve the domain where this connector (or connectors)      "
puts "# belongs 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 "# the same as the Total Layer, Beginning ds and Growth Rate you define here."
puts "#                                                                           "
puts "#                                                                           "
puts "#                                                                           "
          

gg::tkLoad

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 BeginDs 0.0001
set EndDs 1
set DimFac 1.5
set tol [gg::tolGP]

######################################################
# 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
#                  B1          B2                       B3
#                           dsB2                  EndDs
#
#  B1B3 is the original connector where the GEOMETRIC function is applied to B1B2
#  while the TANH function is applied to B2B3. 
#
#  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 (GEOMETRIC) according to the Total Layer, BeginDs
#     and growthRate.
#  5. Add the break point at B2 for spacing adjustment.
#  6. Push/pull the break point B2 to redimension B1B2 to (Total Layer+1).
#  7. Apply the GOMETRIC function to B1B2, define the spacing constraint of B2
#     and apply the TANH function to B2B3.
#  
#  Another solution is to apply the GEOMETRIC function to B1B2 first and add the
#  break point B2. Then apply the TANH function to B2B3. This gives poor result
#  due to the limitation of gg::conSubConDim. This command do not allow changes 
#  in the dimension of B1B3, which leads to a coarse grid on B2B3.
##################################################################################
proc Distribution { } {
  global selected growthRate deltaS BeginDs EndDs TotalN DimFac B1B3InitDim
  global tol

  set zero 0.0
  if { [expr $BeginDs - $tol]<0.0 | [expr $EndDs - $tol]<0.0 } {
      tk_messageBox -icon warning -title "End spacing input warning" \
       -message "Your end spacing input is smaller than the default grid point tolerance. The tolerance will be reset." -type ok
	  set tol $BeginDs
	  if { [expr $EndDs - $BeginDs] < 0.0 } {
		  set tol $EndDs
	  }
	  gg::tolGP $tol
	  puts "# Info -- The defaul grid point tolerance is reset to $tol."
  }

  foreach cs $selected {
    foreach {con side} $cs {break}

    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]
      set B1B2Length [expr $BeginDs * pow($growthRate, $TotalN -1) / ($growthRate -1)]
      set B2B3Length [expr $Arc - $B1B2Length]
	 
#     Another method is obtain the RMS of the two spacings: BeginDs and EndDs.
#     B1B3InitDim = TotalN + 1 + B2B3Length / sqrt( dsB2 * EndDs / 2 )
#     However, this method does not work at all as the EndDs is way larger than
#     BeginDs.

#     set B2B3InitDs [expr sqrt( $BeginDs * $EndDs / 2 )]
#	  set B1B3InitDim3 [expr $TotalN + 1 + int( $B2B3Length / $B2B3InitDs )]
#     puts "# Info -- Method 3. The initial dimension of $con is $B1B3InitDim3"


#     Initial guess of the new dimension of B1B3. The dimension can be adjusted
#     by changing the value of DimFac. The default DimFac is 1.0 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.

#     Old method of guessing the initial dimension of the connector based on the 2
#     end spacings of the TANH part. However, this does not work in the situation 
#     where 'EndDs' is so large but work well if the ratio is on the order of 1.0e2.

      set dsB2 [expr $BeginDs * pow($growthRate, $TotalN-1)]

      if { [expr $B2B3Length - $EndDs -$dsB2] < 0.0 } {
          tk_messageBox -icon error -title "Invalid End spacing input" \
          -message "Please set the 'End spacing' or 'Total Layer' to a smaller value." -type ok
		  return
	  }

      set B2B3InitDs [expr ($dsB2 + $EndDs)/2.0]
      set B1B3InitDim1 [expr int( $B2B3Length/$B2B3InitDs*$DimFac + $TotalN + 1 )]
      puts "# Info -- Method 1. The initial dimension of $con is $B1B3InitDim1"

#     New method of guessing the initial dimension of the connector. It is based on
#     the GEOM equation using 'BeginDs' and 'EndDs'.
#     EndDs = BeginDs * (GrowthRate) ^ (n-2), where n is the initial guess.
#     B1B3InitDim = [log (EndDs/BeginDs) / log (GrowthRate)] + 2
#     This method works for the cases where the given EndDs is much larger than BeginDs.
#     For instance, the ratio is on the order of 1.0e4.

	  set EndbyBegin [expr $EndDs / $BeginDs]
	  set B1B3InitDim [expr int( log($EndbyBegin) / log($growthRate) + 2 )]
      puts "# Info -- Method 2. The initial dimension of $con is $B1B3InitDim"

#     Investigation suggests that the better solution is to use the larger dim of the
#     above two guessing methods if the larger guess is less than 100. Otherwise,
#     use RMS guess of these two.

	  if { [expr $B1B3InitDim1 - $B1B3InitDim] > 0 & [expr $B1B3InitDim1 - 100] > 0 } {
          set B1B3InitDim [expr int( sqrt( $B1B3InitDim1*$B1B3InitDim/2 ) )]
	  } elseif { [expr $B1B3InitDim1 - $B1B3InitDim] > 0 } {
          set B1B3InitDim [expr $B1B3InitDim1 ]
	  }

      puts "# Info -- The initial dimension of $con is $B1B3InitDim"


#     Send a warning if the initial dimension is smaller than Total Layer
      if {$B1B3InitDim <= $TotalN} {
        set result [tk_messageBox -parent . \
        -title "Initial guess of connector dimension fails" \
        -type ok -icon error \
        -message "Your total layer must be smaller than $B1B3InitDim. Please check your input." ]
		gg::abort
#       puts $result
      }

#     Send an info if the initial dimension is greater than 1000.
	  if { [expr $B1B3InitDim - 300] > 0 } {
          tk_messageBox -icon info -title "Long wait is expected" \
          -message "Domain refinement and decimation are in progress ..."
      }
     
#     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

#     The perfect result is produced when the current connector constraints are on the
#     same/similar order of the user input. Dramatic change in con dimensions will cause
#     errors during the following unstructured domain refinement and decimation. 
#     The typical error will be:
#     PT_Polygon_Iriangulate: Cannot triangulate polygan!!!

	  if { $side == "Begin" } {
        gg::conBeginSpacing $con $BeginDs
        gg::conEndSpacing $con $EndDs
      } else {
        gg::conEndSpacing $con $BeginDs
        gg::conBeginSpacing $con $EndDs
      }

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


#     Add one breakpoint at the (TotalN+1) point from the selected end. 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 B1B2divB1B3 [expr $B1B2Length / $Arc]

      if { $side == "Begin" } {
        set xyz [gg::conGetPt $con -arc $B1B2divB1B3]
      } else {
        set xyz [gg::conGetPt $con -arc [expr 1.0-$B1B2divB1B3]]
      }

      gg::conSetBreakPt $con $xyz
      puts "# Info -- Add break point B2 to B1B3 "
     

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

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

      if { $side == "Begin" } {
        set C [list [expr $TotalN + 1] [expr $B1B3InitDim - $TotalN]]
      } else {
        set C [list [expr $B1B3InitDim - $TotalN] [expr $TotalN + 1]]
      }
      puts "# Info -- The B1B2 and B2B3 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 $EndDs
        gg::conDistFunc $con -sub 2 -function TANH
      } else {
        gg::conDistFunc $con -sub 2 -function GEOMETRIC
        gg::conBeginSpacing $con -sub 1 $EndDs
        gg::conEndSpacing $con -sub 1 $dsB2
        gg::conDistFunc $con -sub 1 -function TANH
      }
     
      puts "# Info -- Apply GEOMETRIC function to B1B2 and TANH to B2B3"
      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 warning -title "Dramatical change in dimension/distribution is applied" \
       -message "This may cause triangulation problems during domain refinement and decimation." \
    }
  }
}

proc select { } {
  global selected conList growthRate deltaS

  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 x -padx 1 -pady 2
  pack [label .top.lbl1 -text "Apply Geometric to One End and Tanh to The Other" \
    -wraplength 408] -padx 1 

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

  #pack [label .top.caption -text "Please read instructions in README-ConGeomTanhDist." -wraplength 380]

  pack [button .top.enterSelect -text "Select One Spacing Constraint of Con(s)" \
    -width 35 -command { select }] -pady 8 -padx 2

  frame .input -bd 1 -relief solid 

  pack [makeInputField .input inp1 "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 inp3 "Beginning ds:" BeginDs 10 \
    [list checkRealGTInput %W 0.0 arc %P %d]] -fill x -pady 2 -padx 2
  set Breakpoint(arc) 1

  pack [makeInputField .input inp2 "Ending ds:" EndDs 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" -width 5 -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.
#