# Menus are identified by name
# (positions of options in their menus start at 0)

# Updates changes
proc UpdateMenus {} {
   CreateTopMenus
}


# Creates a new menu. New menus are inserted
# between the 'Calculate' and 'Help' menu
# Arg 'prepost' can have these values:
# "PRE" to create the menu only in the preprocess
# "POST" to create the menu only in the postprocess
# or "PREPOST" to create the menu in the pre and postprocess 


proc CreateMenu {new_menu_name prepost} {
    global MenuNames MenuEntries MenuCommands MenuAcceler
    global MenuNamesP MenuEntriesP MenuCommandsP MenuAccelerP

  if {$prepost!="PRE" && $prepost!="POST" && $prepost!="PREPOST"} {  
      return -code error [_ "Wrong arg. Must be PRE, POST or PREPOST."]}


  set n_menu ""
  set length   [llength $MenuNames]  
  set lengthP  [llength $MenuNamesP]
  set pos   [expr [llength $MenuNames]-1]  
  set posP  [expr [llength $MenuNamesP]-1]

  if {$prepost == "PRE" || $prepost == "PREPOST"} {
     set n_menu [linsert $MenuNames $pos "$new_menu_name"]
     set MenuNames $n_menu  
     set MenuEntries($length)  $MenuEntries($pos) 
     set MenuCommands($length) $MenuCommands($pos) 
     set MenuAcceler($length)  $MenuAcceler($pos) 

     set MenuEntries($pos)  [list ""]
     set MenuCommands($pos) [list ""]
     set MenuAcceler($pos)  [list ""]
  } 

  set n_menu ""
  if {$prepost == "POST" || $prepost == "PREPOST"} {
     set n_menu [linsert $MenuNamesP $posP "$new_menu_name"]
     set MenuNamesP $n_menu 
     set MenuEntriesP($lengthP)  $MenuEntriesP($posP) 
     set MenuCommandsP($lengthP) $MenuCommandsP($posP) 
     set MenuAccelerP($lengthP)  $MenuAccelerP($posP) 

     set MenuEntriesP($posP)  [list ""]
     set MenuCommandsP($posP) [list ""]
     set MenuAccelerP($posP)  [list ""]
  }   
}

# Creates a new option for a given menu in a given
# position. (positions start at 0)
# By default, if it already exists an option in the given position,
# that option is substitued by the new one.
# if Arg ins_repl is "insert" the new menu option is inserted
# Arg 'command' is the command called when the menu option
# is selected.
# Arg 'prepost' can have these values:
# "PRE" to insert the option in the preprocess menus
# "POST" to insert the option in the postprocess menus
# or "PREPOST" to insert the option in the pre and postprocess menus


proc InsertMenuOption {menu_name option_name position command prepost {ins_repl "replace"} } {
    global MenuNames MenuEntries MenuCommands MenuAcceler
    global MenuNamesP MenuEntriesP MenuCommandsP MenuAccelerP
    
    if {$prepost!="PRE" && $prepost!="POST" && $prepost!="PREPOST"} {  
	return -code error [_ "Wrong arg. Must be PRE, POST or PREPOST."]
    }
	
    set $ins_repl [string tolower $ins_repl]
    if {$ins_repl != "replace" && $ins_repl != "insert"} {  
	return -code error [_ "Wrong arg. Must be replace or insert."]
    }
	    
    set option_nameP $option_name
    set i 0

    if {$prepost=="PRE" || $prepost=="PREPOST"} {
	set i [lsearch $MenuNames $menu_name]
	if { $i == "-1" } {
	    #try to search the translated word, for old problemtypes not updated to translation
	    set i [lsearch $MenuNames [_ $menu_name]]
	    if { $i == "-1" } {
		WarnWin [_ "ERROR: Menu %s doesn't exist in PRE." $menu_name]
		return
	    } else {
		::GidUtils::SetWarnLine [_ "Warning: This problemtype must be updated for translation"]
	    }
	}
	
	set option_name [find_option i $option_name "pre" 1]
	if {$option_name== ""} {return}
	
	if {[llength $MenuEntries($i)]<= $position} {
	    set MenuEntries($i)  [linsert $MenuEntries($i)  end $option_name]
	    set MenuCommands($i) [linsert $MenuCommands($i) end "-np- $command"]
	    if {[info exists MenuAcceler($i)]} {
		set MenuAcceler($i)  [linsert $MenuAcceler($i) end ""]
	    }
	} else { 
	    if {$ins_repl=="replace"} {
		del_submenus $i $position "pre"
		set MenuEntries($i)  [lreplace $MenuEntries($i) $position $position $option_name]
		set MenuCommands($i) [lreplace $MenuCommands($i) $position $position "-np- $command"]
		if {[info exists MenuAcceler($i)]} {
		    set MenuAcceler($i)  [lreplace $MenuAcceler($i) $position $position ""]
		}
	    } elseif {$ins_repl=="insert"} {
		set MenuEntries($i)  [linsert $MenuEntries($i) $position  $option_name]
		set MenuCommands($i) [linsert $MenuCommands($i) $position  "-np- $command"]
		if {[info exists MenuAcceler($i)]} {
		    set MenuAcceler($i)  [linsert $MenuAcceler($i) $position  ""]
		}
		move_submenus $i $position "pre" "down"
	    }
	}
		
    }
    set i 0
    set option_name $option_nameP
    if {$prepost=="POST" || $prepost=="PREPOST"} {

	set i [lsearch $MenuNamesP $menu_name]
	if { $i == "-1" } {
	    #try to search the translated word, for old problemtypes not updated to translation
	    set i [lsearch $MenuNamesP [_ $menu_name]]
	    if { $i == "-1" } {
		WarnWin [_ "ERROR: Menu %s doesn't exist in POST." $menu_name]
		return
	    } else {
		::GidUtils::SetWarnLine [_ "Warning: This problemtype must be updated for translation"]
	    }
	}

	set option_name [find_option i $option_name "post" 1]
	if {$option_name== ""} {return}

	if {[llength $MenuEntriesP($i)]<= $position} {
	    set MenuEntriesP($i)  [linsert $MenuEntriesP($i)  end $option_name]
	    set MenuCommandsP($i) [linsert $MenuCommandsP($i) end "-np- $command"]
	    if {[info exists MenuAccelerP($i)]} {
		set MenuAccelerP($i)  [linsert $MenuAccelerP($i) end ""]
	    }
	} else { 
	    if {$ins_repl=="replace"} {
		del_submenus $i $position "post"
		set MenuEntriesP($i)  [lreplace $MenuEntriesP($i) $position $position $option_name]
		set MenuCommandsP($i) [lreplace $MenuCommandsP($i) $position $position "-np- $command"]
		if {[info exists MenuAccelerP($i)]} {
		    set MenuAccelerP($i)  [lreplace $MenuAccelerP($i) $position $position ""]
		}
	    } elseif {$ins_repl=="insert"} {
		set MenuEntriesP($i)  [linsert $MenuEntriesP($i) $position  $option_name]
		set MenuCommandsP($i) [linsert $MenuCommandsP($i) $position  "-np- $command"]
		if {[info exists MenuAccelerP($i)]} {
		    set MenuAccelerP($i)  [linsert $MenuAccelerP($i) $position  ""]
		}
		move_submenus $i $position "post" "down"
	    }
	}
    }    
}




# Removes an option of a given menu. 
# Arg 'prepost' can have these values:
# "PRE" to remove an option of the preprocess menus
# "POST" to remove an option of the postprocess menus
# or "PREPOST" to remove an option of the pre and the postprocess menus

proc RemoveMenuOption {menu_name option_name prepost} {
    global MenuNames MenuEntries MenuCommands MenuAcceler
    global MenuNamesP MenuEntriesP MenuCommandsP MenuAccelerP

    if {$prepost!="PRE" && $prepost!="POST" && $prepost!="PREPOST"} {  
	return -code error [_ "Wrong arg. Must be PRE, POST or PREPOST."]
    }

    set i 0
    if {$prepost=="PRE" || $prepost=="PREPOST"} {

	set i [lsearch $MenuNames $menu_name]
	if { $i == "-1" } {
	    #try to search the translated word, for old problemtypes not updated to translation
	    set i [lsearch $MenuNames [_ $menu_name]]
	    if { $i == "-1" } {
		WarnWin [_ "ERROR: Menu %s doesn't exist in PRE." $menu_name]
		return
	    } else {
		::GidUtils::SetWarnLine [_ "Warning: This problemtype must be updated for translation"]
	    }
	}
	set position [find_option i $option_name "pre"]
	if {$position == ""} {return}

	del_submenus $i $position "pre"
	move_submenus $i $position "pre" "up"
	set MenuEntries($i)  [lreplace $MenuEntries($i) $position $position ]
	set MenuCommands($i) [lreplace $MenuCommands($i) $position $position]
	if {[info exists MenuAcceler($i)] && [llength $MenuAcceler($i)] > $position} {
	    set MenuAcceler($i) [lreplace $MenuAcceler($i) $position $position ] 
	}
    }
  

    set i 0
    set position 0
    if {$prepost=="POST" || $prepost=="PREPOST"} {
	set i [lsearch $MenuNamesP $menu_name]
	if { $i == "-1" } {
	    #try to search the translated word, for old problemtypes not updated to translation
	    set i [lsearch $MenuNamesP [_ $menu_name]]
	    if { $i == "-1" } {
		WarnWin [_ "ERROR: Menu %s doesn't exist in POST." $menu_name]
		return
	    } else {
		::GidUtils::SetWarnLine [_ "Warning: This problemtype must be updated for translation"]
	    }
	}

	set position [find_option i $option_name "post"]
	if {$position == ""} {return}

	del_submenus $i $position "post"
	move_submenus $i $position "post" "up"
	set MenuEntriesP($i)  [lreplace $MenuEntriesP($i) $position $position ]
	set MenuCommandsP($i) [lreplace $MenuCommandsP($i) $position $position]
	if {[info exists MenuAccelerP($i)] && [llength $MenuAccelerP($i)] > $position} {
	    set MenuAccelerP($i) [lreplace $MenuAccelerP($i) $position $position] 
	}
    }
}


proc find_option {i option_name prepost {insert 0}} {
    global MenuNames MenuEntries MenuCommands MenuAcceler
    global MenuNamesP MenuEntriesP MenuCommandsP MenuAccelerP
    
    
    upvar $i path_menu
    set p 0
    while {$p<[string length $option_name]} {
	set option ""
	set char [string index $option_name $p]
	if {$char == ">"} {
	    set p [expr $p +1]
	    set char [string index $option_name $p]
	}
	while {$char != ">" && $p < [string length $option_name]} {
	    append option $char
	    set p [expr $p +1]
	    set char [string index $option_name $p]
	}

	set position 0
	set end 0
	if {$prepost == "pre"} {
	    if {![info exists MenuEntries($path_menu)]} {
		set MenuEntries($path_menu)  ""
		set MenuCommands($path_menu) ""
		set MenuAcceler($path_menu)  ""
		
		regexp {(.*),([0-9]+)} $path_menu b previous_menu previous_position
		set MenuCommands($previous_menu) [lreplace $MenuCommands($previous_menu) $previous_position $previous_position ""]
		set MenuAcceler($previous_menu)  [lreplace $MenuAcceler($previous_menu) $previous_position $previous_position ""]
	    }
	    
	    while {[lindex $MenuEntries($path_menu) $position] != $option && $end==0} {
		set position [expr $position +1]
		if {$position >= [llength $MenuEntries($path_menu)]} { 
		    if {$insert==0 || $p < [string length $option_name]} {
		        WarnWin [_ "Menu ERROR: Option menu %s doesn't exist in the preprocess." $option ]
		        return ""
		    }
		    set end 1
		}
	    }
	}
	
    
	set end 0
	if {$prepost == "post"} {
	    if {![info exists MenuEntriesP($path_menu)]} {
		set MenuEntriesP($path_menu)  ""
		set MenuCommandsP($path_menu) ""
		set MenuAccelerP($path_menu)  ""
		
		regexp {(.*),([0-9]+)} $path_menu b previous_menu previous_position
		set MenuCommandsP($previous_menu) [lreplace $MenuCommandsP($previous_menu) $previous_position $previous_position ""]
		set MenuAccelerP($previous_menu)  [lreplace $MenuAccelerP($previous_menu) $previous_position $previous_position ""]
		
	    }
	    while {[lindex $MenuEntriesP($path_menu) $position] != $option && $end==0} {
		set position [expr $position +1]
		if {$position >= [llength $MenuEntriesP($path_menu)]} {
		    if {$insert==0 || $p < [string length $option_name]} {
		        WarnWin [_ "Menu ERROR: Option menu %s doesn't exist in the postprocess." $option]
		        return ""
		    }
		    set end 1
		}
	    }
	}
	if {$p<[string length $option_name]} {set path_menu "$path_menu,$position"}
    }
    
    if {$insert==1} {
	return $option
    } else {
	return $position
    }
}





proc del_submenus {i position pre} {
    global MenuNames MenuEntries MenuCommands MenuAcceler
    global MenuNamesP MenuEntriesP MenuCommandsP MenuAccelerP
    
    if {$pre=="pre"} {
	if {[info exists MenuEntries($i,$position)]} {
	    append i ",$position"
	    #tkMessageBox -message $i
	    rec_del_menu $i MenuEntries MenuCommands MenuAcceler
	}
    }

    if {$pre=="post"} {
	if {[info exists MenuEntriesP($i,$position)]} {
	    append i ",$position"
	    rec_del_menu $i MenuEntriesP MenuCommandsP MenuAccelerP
	}
    }
}



proc rec_del_menu {param ent com acc} {

  upvar $ent Entries
  upvar $com Commands
  upvar $acc Acceler
  

  set m_length [llength $Entries($param)]

  set pos 0

  unset Entries($param) 
  if {[info exists Commands($param)]} {unset Commands($param) }
  if {[info exists Acceler($param)]}  {unset Acceler($param) } 


  set base $param
  while {$pos<$m_length} {
     set param "$base,$pos"
     #tkMessageBox -message "REC_DEL base: $base   param: $param   pos: $pos"
     if {[info exists Entries($param)]} {rec_del_menu $param Entries Commands Acceler}
     set pos [expr $pos +1]
    }

}




proc move_submenus {i position pre inc} {
    global MenuNames MenuEntries MenuCommands MenuAcceler
    global MenuNamesP MenuEntriesP MenuCommandsP MenuAccelerP
  
  
    set j 0
    set last_menu 0
    while {$j<[string length $i]} {
	set char [string index $i $j]
	if {$char != ","} {set last_menu [expr $last_menu +1]}
	set j [expr $j +1]
    }
    set last_menu [expr $last_menu +1]
    
    if {$pre=="pre"} {
	set j 1
	set m_length [llength $MenuEntries($i)]
	set base $i
	while {$position<$m_length} {
	    
	    # llegeixo de baix cap a dalt si insereixo, i de dalt a baix si faig remove
	    set param1 "$base,$position"
	    set param2 "$base,[expr $m_length - $j]"
	    if {[info exists MenuEntries($param1)]} {
		if {$inc=="up"}   {rec_move_menu $param1 $last_menu MenuEntries MenuCommands MenuAcceler $inc}
	    }
     
	    if {[info exists MenuEntries($param2)]} {
		if {$inc=="down"} {rec_move_menu $param2 $last_menu MenuEntries MenuCommands MenuAcceler $inc}      
	    }
	    set position [expr $position +1]
	    set j [expr $j +1]
	} 
    }   
    

    if {$pre=="post"} {
	set m_length [llength $MenuEntriesP($i)]
	set base $i
	while {$position<$m_length} {
	    set param "$base,$position"
	    if {[info exists MenuEntriesP($param)]} {
		rec_move_menu $param $last_menu MenuEntriesP MenuCommandsP MenuAccelerP $inc
	    }
	    set position [expr $position +1]
	} 
    }  
}





proc dec_inc_menu {param last_menu inc} { 
    set up_menus   ""
    set down_menus ""
    set menu ""
    set j 0
    set num 0
    
    while {$num < [expr $last_menu-1]} {
	set char [string index $param $j]
	append up_menus $char
	if {$char == ","} {set num [expr $num +1]}
	set j [expr $j +1]
    }
    
    set char [string index $param $j]
    while {$char != "," && $j<[string length $param]}  {
	append menu $char
	set j [expr $j +1]
	set char [string index $param $j]
    }
    
    while {$j <= [string length $param]} {
	append down_menus $char
	set j [expr $j +1]
	set char [string index $param $j]
    }
    append down_menus $char
    
    if {$inc=="down"} {
	set menu [expr $menu + 1]
    } else {
	set menu [expr $menu - 1]
    }
    set new_menu $up_menus$menu$down_menus
    #tkMessageBox -message "param: $param    last: $last_menu    $new_menu \n  menu: $menu    down_menu $down_menus"
    return $new_menu
}




proc rec_move_menu {param last_menu ent com acc inc} { 

    upvar $ent Entries
    upvar $com Commands
    upvar $acc Acceler
    
    set m_length [llength $Entries($param)]
    set pos 0
    
    set new_menu [dec_inc_menu $param $last_menu $inc]
    
    set Entries($new_menu) $Entries($param)
    unset Entries($param)
    
    if {[info exists Commands($param)]} {
	set Commands($new_menu) $Commands($param)
	unset Commands($param)
    }
    if {[info exists Acceler($param)]}  {
	set Acceler($new_menu)  $Acceler($param)
	unset Acceler($param)
    } 
    
    set base $param
    while {$pos<$m_length} {
	set param "$base,$pos"
	#tkMessageBox -message "RECMOVE base: $base   param: $param   pos: $pos"
	if {[info exists Entries($param)]} {rec_move_menu $param $last_menu Entries Commands Acceler $inc}
	set pos [expr $pos +1]
    }
}



#compatibility with old versions without namespace

proc GiDVersionNumber { VersionString } {
    return [GidUtils::VersionNumber $VersionString]
}

proc GiDVersionSubchar { VersionString } {
    return [GidUtils::VersionSubchar $VersionString]
}

proc GiDVersionBetaNumber { VersionString } {
    return [GidUtils::VersionBetaNumber $VersionString]
}

proc GiDVersionCmp { Version } {
    return [GidUtils::VersionCmp $Version]
}

proc CorrectExp { realnum  } {
    return [MathUtils::CorrectExp $realnum]
}




#utilities not interacting with GiD

namespace eval MathUtils {
    variable Epsilon 1e-10
    variable Pi [ expr 2.0 * acos(0.0)] 
}

#pi is a list with x y z? coordinates, return the diff vector as list
proc MathUtils::VectorDiff { p1 p2 } {
    set diff ""
    foreach i $p1 j $p2 {
	lappend diff [expr $j-$i]
    }
    return $diff
}

proc MathUtils::VectorSum { p1 p2 } {
    set sum ""
    foreach i $p1 j $p2 {
	lappend sum [expr {$j+$i}]
    }
    return $sum
}

#pi is a list with x y z? coordinates, return the dot prod value
proc MathUtils::VectorDotProd { p1 p2 } {    
    set dotprod 0
    foreach i $p1 j $p2 {
	set dotprod [expr $dotprod+($i*$j)]
    }
    return $dotprod
}

#pi is a list with x y z coordinates, return the vectorial prod vector as list
proc MathUtils::VectorVectorialProd { p1 p2 } {    
    set ax [lindex $p1 0]
    set ay [lindex $p1 1]
    set az [lindex $p1 2]
    set bx [lindex $p2 0]
    set by [lindex $p2 1]
    set bz [lindex $p2 2]
    set vectorprod [expr $ay*$bz-$az*$by]
    lappend vectorprod [expr $az*$bx-$ax*$bz]
    lappend vectorprod [expr $ax*$by-$ay*$bx]   
    return $vectorprod
}

#multiplication of a scalar 'a' by a vector 'p'
proc MathUtils::ScalarByVectorProd { a p } {
    foreach i $p {
	lappend sum [expr {$a*$i}]
    }
    return $sum
}

#pi is a list with x y z? coordinates, return the modulus value
proc MathUtils::VectorNormalized { p } {
    variable Epsilon
    set m [::MathUtils::VectorModulus $p]
    if { [expr abs($m)] <  $Epsilon } {
	return $p
    }
    return [::MathUtils::ScalarByVectorProd [expr 1.0/$m] $p]
}

#pi is a list with x y z? coordinates, return the modulus value
proc MathUtils::VectorModulus { p } {
    return [expr sqrt([MathUtils::VectorDotProd $p $p])]
}

#pi is a list with x y z? coordinates, return the distance value
proc MathUtils::VectorDistance { p1 p2 } {
    return [MathUtils::VectorModulus [MathUtils::VectorDiff $p1 $p2]]
}

#pi is a list with x y z? coordinates, return the angle value in radians
proc MathUtils::VectorAngle { pvertex p2 p3} {
    set v1 [MathUtils::VectorDiff $p2 $pvertex]
    set modul1 [MathUtils::VectorModulus $v1]
    if { $modul1<$MathUtils::Epsilon } return ""
    
    set v2 [MathUtils::VectorDiff $p3 $pvertex]
    set modul2 [MathUtils::VectorModulus $v2]
    if { $modul2<$MathUtils::Epsilon } return ""
    
    set cosangle [expr [MathUtils::VectorDotProd $v1 $v2]/($modul1*$modul2)]
    set angle [expr acos($cosangle)]
    return $angle
}

proc MathUtils::FromRadToDegree { x } {
    return [expr $x*180.0/$MathUtils::Pi]
}

proc MathUtils::FromDegreeToRad { x } {
    return [expr $x*$MathUtils::Pi/180.0]
}


#NOTE:It exist from GiD7.4.7b a new GiD-tcl command, more powerful than CorrectExp
#     this command is:
#     GiD_FormatReal <format> <realnum> ?forcewidth|forcewidthnastran?
#     <format> is a 'C' style format, and if set "forcewidth" the minimum size of this format is considered
#     also as the final size (this is not the 'C' default). 
#     An special option is "forcewidthnastran", to allow to remove the 'e' character, 
#     sample: format="%8.3e" realnum=-2.345e-13
#             without width option    return -2.345e-13 (10 digits, not 8)
#             with forcewidth         return -2.3e-13 (8 digits, but only 2 significant digits)
#             with forcewidthnastran  return -2.34-13 (8 digits, without 'e', but with 3 significant digits)
#
# CorrectExp return two digits exponent: e.g 1.5e+045 return 1.5e+45
proc MathUtils::CorrectExp { realnum  } {
    set prev ""
    set expsgn ""
    set a [regexp "(.*)?(\[eE\])(\[\+\-\])?(\[0-9\]+)" $realnum match prev expchar expsgn expnum ]
    if { $a } {
	if { [string length $expnum] ==3 && [string index $expnum 0] == 0 } {
	    set expnum [string range $expnum 1 2]
	}
	return "$prev$expchar$expsgn$expnum"
    } else { 
	return $realnum
    }
}


#utilities interacting with GiD
namespace eval GidUtils {
}

#register a tcl command for the GiD Undo/Batch, and eval this command
proc GidUtils::EvalAndEnterInBatch { args } {
    GiD_EnterInBatch "\"-tcl- $args\"\n"
    eval $args
}

# returns the distance (or null) between two selected coordinates
proc GidUtils::GetDistance { } {
    set p1 [GidUtils::GetCoordinates [_ "Enter first point (ESC to leave)"]]
    if { $p1=="" } return ""
    set p2 [GidUtils::GetCoordinates [_ "Enter second point (ESC to leave)"]]
    if { $p2=="" } return ""
    
    set d [MathUtils::VectorDistance $p1 $p2]
    
    GidUtils::SetWarnLine [_ "Distance=%s" $d]    
    return $d 
}

proc GidUtils::GetVector { } {
    set p1 [GidUtils::GetCoordinates [_ "Enter origin point (ESC to leave)"]]
    if { $p1=="" } return ""
    set p2 [GidUtils::GetCoordinates [_ "Enter destination point (ESC to leave)"]]
    if { $p2=="" } return ""
    
    set p [MathUtils::VectorDiff $p1 $p2]
    
    GidUtils::SetWarnLine [_ "Vector=%s" $p]    
    return $p
}

#return the angle in degrees
proc GidUtils::GetAngle { } {
    set p1 [GidUtils::GetCoordinates [_ "Enter vertex point (ESC to leave)"]]
    if { $p1=="" } return ""
    set p2 [GidUtils::GetCoordinates [_ "Enter second point (ESC to leave)"]]
    if { $p2=="" } return ""
    set p3 [GidUtils::GetCoordinates [_ "Enter third point (ESC to leave)"]]
    if { $p3=="" } return ""
    
    set angle [MathUtils::FromRadToDegree [MathUtils::VectorAngle $p1 $p2 $p3]]
    GidUtils::SetWarnLine [_ "Angle=%s" $angle]    
    return $angle
}


# It returns the enties identifier numbers (for example 1 3 5:8 represents 1 3 5 6 7 8)
# type can be "Points" "Lines" "Surfaces" "Volumes" "Dimensions" "AllTypes" "Nodes" or "Elements"
# selectmode can be "single" or "multiple"
# for AllTypes selection returns some as 
# Points 19 23 Lines 28:29 32:33 37 Surfaces 1 6 21:22 Volumes 1 Dimension 1:2
# or for mesh entities some as Nodes 236 244 Elements 4122 4130 4152 4165
proc GidUtils::PickEntities { type selectmode } {
    gidmakecurrent
    set vwait yes
    switch $selectmode {
      single {
	set args_sel "justone $type"
      }
      multiple {
	set args_sel "nojustone $type"
      }
      default {
	set args_sel "$type $selectmode escape"
	set vwait no
      }
    }
    .central.s process escape escape escape escape selectentities $args_sel
    if {$vwait} {
      vwait ::GidPriv(selection)
    }
    if { $selectmode == "single" } {
	set selection [eval lindex $::GidPriv(selection) 1]
    } else {
	set selection [eval lrange $::GidPriv(selection) 1 end]
    }
    return $selection
}


# returns the coordinates x y z Or null selecting from the screen
# GidPriv(selcoord,id) store the point id (-1 nothing selected, 0 new point, >0 point id)
# to get the number of a existent point, cal also use PickEntities
# JoinNoJoin can be "Join" or "NoJoin"

proc GidUtils::GetCoordinates { { WarnLineMsg "" } { JoinNoJoin  "Join" } } {
    if { $WarnLineMsg  == "" } { set WarnLineMsg [_ "Enter point (ESC to leave)"] }    
    gidmakecurrent
    GidUtils::SetWarnLine $WarnLineMsg
    set olddisablewarnline [GidUtils::DisableWarnLine]
    .central.s process escape escape escape escape utilities id
    update idletasks
    if { $JoinNoJoin == "NoJoin" && [lsearch -exact $::ActionsMenuVar NoJoin] != -1 } {        
	.central.s process NoJoin
    }
    #GidUtils::EnableWarnLine   

    vwait ::GidPriv(selcoord,id)
    if { $::GidPriv(selcoord,id) != -1 } {
      set xyz "$::GidPriv(selcoord,x) $::GidPriv(selcoord,y) $::GidPriv(selcoord,z)"
    } else {
      set xyz ""
    }
    .central.s process escape escape
    if { !$olddisablewarnline } { GidUtils::EnableWarnLine }
    return $xyz
}


#to compare if a GiD version is more recent of another
proc GidUtils::VersionNumber { VersionString } {
    set patron {([0-9]+).([0-9]+).?([0-9]*)([a-z]?)(?:-beta([0-9]+))?}
    regexp -nocase $patron $VersionString total v1 v2 v3 letra betanumber
    set res 0
    if { [info exists v1] } {
	if { $v1 != "" } { set res [expr $res+$v1*100000] }
    }
    if { [info exists v2] } { 
	if { $v2 != "" } { set res [expr $res+$v2*1000] }
    }
    if { [info exists v3] } { 
	if { $v3 != "" } { set res [expr $res+$v3] }
    }
    return $res
}

proc GidUtils::VersionSubchar { VersionString } {
    set patron {([0-9]+).([0-9]+).?([0-9]*)([a-z]?)(?:-beta([0-9]+))?}
    regexp -nocase $patron $VersionString total v1 v2 v3 letra betanumber
    set res ""
    if { [info exists letra] } { set res $letra }
    return $res
}

proc GidUtils::VersionBetaNumber { VersionString } {
    set patron {([0-9]+).([0-9]+).?([0-9]*)([a-z]?)(?:-beta([0-9]+))?}
    regexp -nocase $patron $VersionString total v1 v2 v3 letra betanumber
    set res ""
    if { [info exists betanumber] } { set res $betanumber }
    return $res
}

# this function always returns -1 if GiD is before to the
# 6.2.0 version, first including info GiDVersion
# return -1 if GidPriv(Version) < Version
# return  0 if GidPriv(Version) == Version
# return  1 if GidPriv(Version) > Version

#sample use for a probletype that need GiD7.4b or later new features:
#    set VersionRequired "7.4b"
#    set comp -1
#    catch { 
#      set comp [::GidUtils::VersionCmp $VersionRequired]
#    }
#    if { $comp < 0 } {
#        WarnWin "Error: This interface requires GiD $VersionRequired or later."
#    }

proc GidUtils::VersionCmp { Version } {
    if { [catch { set GidVersion [.central.s info GiDVersion] }] }  {
	return -1
    }
    if { $GidVersion == "Unknown" } {
	return -1
    }
    set Number1 [GidUtils::VersionNumber $GidVersion]
    set Number2 [GidUtils::VersionNumber $Version]
    if { $Number1 < $Number2 } { return -1 }
    if { $Number1 > $Number2 } { return 1 }
    set c1 [GidUtils::VersionSubchar $GidVersion]
    set c2 [GidUtils::VersionSubchar $Version]
    if { $c1 < $c2 } { return -1 }
    if { $c1 > $c2 } { return 1 }
    #se supone más nueva la versión que no sea beta
    set BetaNumber1 [GidUtils::VersionBetaNumber $GidVersion]
    set BetaNumber2 [GidUtils::VersionBetaNumber $Version]
    if { $BetaNumber1 != "" } {
	if { $BetaNumber2 != "" } {
	    if { $BetaNumber1 < $BetaNumber2 } { return -1 }
	    if { $BetaNumber1 > $BetaNumber2 } { return 1 }
	} else {
	    return -1
	}
    } else {
	if { $BetaNumber2 != "" } { return 1 } 
    } 
    
    return 0
}

#to access to values by fieldname instead index (more easy to maintain code)
proc GidUtils::GetProblemDataValue { fieldname } {

    foreach "foundname foundvalue" [list "" ""] break
    foreach "name value" [lrange [.central.s info gendata] 1 end] {
	if { [string equal $fieldname $name] } { return $value }
	if { [string match $fieldname* $name] } {
	    if { $foundname != "" } {
		error "error: '$fieldname' has more than one names: $foundname and $name"
	    }
	    foreach "foundname foundvalue" [list $name $value] break
	}
    }
    if { $foundname == "" } {
	error "error: '$fieldname' is not found in Problem data"
    }
    return $foundvalue
}

#to access to values by fieldname instead index (more easy to maintain code)
proc GidUtils::GetCurrentIntervalDataValue { fieldname } {

    foreach "foundname foundvalue" [list "" ""] break
    foreach "name value" [lrange [.central.s info intvdata] 1 end] {
	if { [string equal $fieldname $name] } { return $value }
	if { [string match $fieldname* $name] } {
	    if { $foundname != "" } {
		error "error: '$fieldname' has more than one names: $foundname and $name"
	    }
	    foreach "foundname foundvalue" [list $name $value] break
	}
    }
    if { $foundname == "" } {
	error "error: '$fieldname' is not found in Problem data"
    }
    return $foundvalue
}

#change status of redraws, etc to speed or enhance scripts
proc GidUtils::DisableGraphics { } {
    .central.s disable windows 1
    .central.s disable graphinput 1
    .central.s disable graphics 1
    .central.s disable warnline 1
}

proc GidUtils::EnableGraphics { } {
    .central.s disable windows 0
    .central.s disable graphinput 0
    .central.s disable graphics 0
    .central.s disable warnline 0
}

proc GidUtils::EnableWarnLine {  } {
    set prevstate [.central.s disable warnline]
    if { $prevstate != 0 } {
	.central.s disable warnline 0
    }
    return $prevstate
}

proc GidUtils::DisableWarnLine {  } {
    set prevstate [.central.s disable warnline]
    if { $prevstate != 1 } {
	.central.s disable warnline 1
    }
    return $prevstate
}

proc GidUtils::WaitState { w } {
    $w conf -cursor watch
    .central.s waitstate 1
    update
}

proc GidUtils::EndWaitState { w } {
    .central.s waitstate 0
    $w conf -cursor ""
    update
}

proc GidUtils::SetWarnLine { text } {
    ChangeWarnLineVar $text
}

#Utility to show a progress bar. 
#varname must be a global variable name with the current value to be showed automatically
#stopproc is an optional callback procedure name to be called when the user press stop
#when the current value is equal to max the advance bar is automatically deleted
#Note: only is possible to use one progress bar
proc GidUtils::CreateAdvanceBar { title text varname { max 100 } { stopproc "" } } {
    variable ab_maximum
    variable ab_varname
    variable ab_stopproc
    set ab_maximum $max
    set ab_varname $varname
    set ab_stopproc $stopproc
    set ::GidPriv(StopLoading) 0
    AdvanceBar 0 $ab_maximum 0 $title $text
    if { $ab_varname != "" } {
	trace add variable $ab_varname write "::GidUtils::UpdateAdvanceBar ;#"
    }
    if { $ab_stopproc != "" } {
	trace add variable ::GidPriv(StopLoading) write "::GidUtils::CallStopProc ;#"
    }
}

proc GidUtils::UpdateAdvanceBar { } {
    variable ab_maximum
    variable ab_varname
    if { ![info exists $ab_varname] } return
    if { [set $ab_varname] == $ab_maximum } {
	::GidUtils::DeleteAdvanceBar
    } else {
	AdvanceBar [set $ab_varname] $ab_maximum [set $ab_varname]
    }
}

proc GidUtils::CallStopProc { } {
    variable ab_stopproc
    if { $::GidPriv(StopLoading) == "0" } return
    ::GidUtils::DeleteAdvanceBar
    if { $ab_stopproc != "" } {
	eval $ab_stopproc
    }
}

proc GidUtils::UpdateAdvanceBar { current } {
    variable ab_maximum
    AdvanceBar $current $ab_maximum $current
}

proc GidUtils::DeleteAdvanceBar { } {
    variable ab_maximum
    variable ab_varname
    variable ab_stopproc
    if { $ab_varname != "" } {
	trace remove variable $ab_varname write "GidUtils::UpdateAdvanceBar ;#"
    }
    if { $ab_stopproc != "" } {
	trace remove variable ::GidPriv(StopLoading) write "::GidUtils::CallStopProc ;#"
    }
    AdvanceBar $ab_maximum $ab_maximum $ab_maximum
}

#to show a splash image, for example: 
#global GIDDEFAULT 
#GidUtils::Splash [file join $GIDDEFAULT bitmaps about.gif]
proc GidUtils::Splash { imagefile {w .splash} } {
    if { ![.central.s info variable SplashWindow] || [.central.s disable windows] } return


    if { ![file exists $imagefile] } {
	WarnWinText [_ "Not exists file '%s'" $imagefile]
	return
    }
    if { [ winfo exist $w]} {
	destroy $w
	update
    }
    toplevel $w
    set im [image create photo -file $imagefile]
    set x [expr [winfo screenwidth $w]/2-[image width $im]/2]
    set y [expr [winfo screenheight $w]/2-[image height $im]/2]
    wm geom $w +$x+$y
    wm transient $w .gid
    wm overrideredirect $w 1
    pack [label $w.l -image $im -relief ridge -bd 2]
    bind $w <1> "destroy $w"
    bind $w <KeyPress> "destroy $w"
    raise $w .gid
    grab $w
    focus $w
    update
    after 2000 "if { [ winfo exist $w] } { destroy $w }"
}

proc GidUtils::GetCurrentLanguage { } {
    #instead for example "es_es_modern", return only "es"
    return [string range [::msgcat::mclocale] 0 1]
}        

proc GidUtils::SetCurrentLanguage { newlan {updatewidgets 1 } } {
    global ChangeVarInfo
    if { ![info exists ChangeVarInfo(Language)] || $ChangeVarInfo(Language) != $newlan } { 
	set ChangeVarInfo(Language) $newlan 
    }
    if { [::GidUtils::GetCurrentLanguage] != $newlan } {
	MsgcatSetLocale $newlan
    }
    
    if { $updatewidgets } { 
	UpdateWidgetsLanguage
    }
    #raise ChangedLanguage as a "event"
    if { [info procs ::ChangedLanguage] != "" } {
	::ChangedLanguage $newlan
    }
}

proc GidUtils::GetAllLanguages { } {
    return [MsgcatGetLocales]
}        


#GiD selection accept and returns entities idetifiers (integers > 0) as
#a "compacted" list, the sintax "a:a+n" is interpreted as "a a+1 a+2 ... a+n"

#instead "4 8 9 10 11 15" compact list --> "4 8:11 15" 
#items must be positive integer numbers (can be unordered)
proc GidUtils::CompactNumberList { a } {    
    set ret ""
    set istart 0
    if { [string match "*:*" $a] } {
	#imput list is compacted
	return $a
    }
    foreach i [lsort -integer $a] {  
	if { !$istart} {
	    set istart $i
	} else {
	    if {$i != [expr $iprev+1]} {
		if { $istart != $iprev } {
		    if { [expr $istart +1] == $iprev } {
		        append ret "$istart $iprev "
		    } else { 
		        append ret "$istart:$iprev "
		    }
		} else {
		    append ret "$istart "
		}            
		set istart $i
	    }        
	}
	set iprev $i
    }
    if { $istart } {
	if { $istart != $iprev } {
	    if { [expr $istart +1] == $iprev } {
		append ret "$istart $iprev"
	    } else { 
		append ret "$istart:$iprev"
	    }
	} else {
	    append ret "$istart"
	}   
    }
    return $ret
}

#instead "4 8:11 15"  uncompact list --> "4 8 9 10 11 15"
#items must be positive increasing integer numbers
proc GidUtils::UnCompactNumberList { a } {    
    set ret ""
    foreach item $a {
	if { [regexp   {([0-9]+)[ ]*:[ ]*([0-9]+)} $item dummy istart iend] } {
	    for { set i $istart } { $i <= $iend } { incr i } {
		lappend ret $i
	    }
	} else {
	    lappend ret $item
	}
    }
    return $ret
}