# units.tcl --
#
#        Este fichero implementa el código Tcl para leer y mantener un conjunto
#        de magnitudes y sus unidades.
#
# Copyright (c) 2000 CIMNE
#
# units.tcl --
#
#        Este fichero implementa el código Tcl para leer y mantener un conjunto
#        de magnitudes y sus unidades.
#
# Copyright (c) 2000 CIMNE
#

catch {
    LoadDebugger
}

package provide Units 0.1
#package require ParserUnit

namespace eval Units {
    namespace export Init AppendFile

    variable  exp_space     {[ ]*}
    variable  exp_dig       \[0-9\]
    variable  exp_letra     \[a-z_\]
    variable  exp_magname   "$exp_letra+\[a-z_ \]*"
    variable  exp_int       $exp_dig+
    variable  exp_real      \[+-\]?$exp_int\\.?$exp_dig*\(e\[+-\]?$exp_int\)?
    variable  exp_unittype  \{$exp_space\(Reference|Basic\)($exp_space,$exp_space\(Reference|Basic\))?$exp_space\}
    variable  exp_strunit   "\[ a-z0-9^\\*/\-\u00B0\u00BA]+"
    variable  exp_unit      "($exp_real)?$exp_space\($exp_strunit\)($exp_unittype)?"
    variable  exp_unitlist  ($exp_unit)($exp_space\,(.+))?
    variable  exp_magnitude "^($exp_magname)$exp_space\:$exp_space\(.+)"
    variable  exp_sysunit   ^($exp_magname)$exp_space\:\($exp_strunit)$
    variable  exp_bstruct   "^BEGIN$exp_space\(SYSTEM$exp_space\\($exp_space\(.+)$exp_space\\)|TABLE)$"
    variable  exp_estruct    ^END$
    variable  exp_modelunit  ^(MODEL|PROBLEM)$exp_space\:(.*)
    variable  exp_udsystem    ^BEGIN$exp_space\SYSTEM
    variable  exp_udstate    "^USER DEFINED$exp_space\:(.*)"
    variable  exp_bsstate    "^USE BASE SYSTEMS$exp_space\:(.*)"
    variable  exp_maghidden  "^HIDDEN(?:\\s*):(.+)"
    variable  FileName       ""
    variable  FileId         ""
    variable  CurrentLine    ""
    variable  LineCounter    0
    variable  bInModelFile   0
    variable  TableIdx       0

    variable  UserDefinedState 1
    variable  UseBaseSystemsState 1

    variable  MagNames {}
    variable  Magnitudes
    variable  Hidden {}
    variable  MagHidden {}
    
    variable  SysNames {}
    variable  Systems

    variable  ModelUnit    ""
    variable  ModelSysName ""
    variable  OwnerSystem  ""
    variable  FactorCache
}


#  Units::Init --
#
#        Inicializa el estado de Unit
#
#  Argumentos:
#
#  Resultados:
#        

proc Units::Init { } {
    variable  exp_space     {[ ]*}
    variable  exp_dig       \[0-9\]
    variable  exp_letra     \[a-z_\]
    variable  exp_magname   "$exp_letra+\[a-z_ \]*"
    variable  exp_int       $exp_dig+
    variable  exp_real      \[+-\]?$exp_int\\.?$exp_dig*\(e\[+-\]?$exp_int\)?
    variable  exp_unittype  \{$exp_space\(Reference|Basic\)($exp_space,$exp_space\(Reference|Basic\))?$exp_space\}
    variable  exp_strunit   {[ \\a-z0-9^\*/\-\u00B0\u00BA]+}
    variable  exp_unit      "($exp_real)?$exp_space\($exp_strunit\)($exp_unittype)?"
    variable  exp_unitlist  ($exp_unit)($exp_space\,(.+))?
    variable  exp_magnitude "^($exp_magname)$exp_space\:$exp_space\(.+)"
    variable  exp_sysunit   ^($exp_magname)$exp_space\:\($exp_strunit)$
    variable  exp_bstruct   "^BEGIN$exp_space\(SYSTEM$exp_space\\($exp_space\(.+)$exp_space\\)|TABLE)$"
    variable  exp_estruct   ^END$
    variable  exp_modelunit  ^(MODEL|PROBLEM)$exp_space\:(.*)
    variable  exp_udsystem    ^BEGIN$exp_space\SYSTEM
    variable  exp_udstate    "^USER DEFINED$exp_space\:(.*)"
    variable  exp_bsstate    "^USE BASE SYSTEMS$exp_space\:(.*)"
    variable  exp_maghidden  "^HIDDEN(?:\\s*):(.+)"

    variable  FileId        ""
    variable  CurrentLine   ""
    variable  LineCounter    0
    variable  bInModelFile   0
    variable  bInGidFile     0
    variable  TableIdx       0

    variable  UserDefinedState 1
    variable  UseBaseSystemsState 1

    variable  MagNames {}
    variable  Magnitudes
    variable  Hidden {}
    variable  MagHidden {}
    variable  SysNames {}
    variable  Systems

    variable  ModelUnit    ""
    variable  ModelSysName ""
    variable  OwnerSystem  ""
    variable  FactorCache

    catch {unset Magnitudes}
    catch {unset Systems}
    catch {array unset FactorCache}
}

#  Units::ParserTableLine --
#
#        Analiza la linea line y determina si es una definicion de magnitud válida
#        en caso positivo adiciona las unidades definidas a la tabla de magnitudes.
#
#  Argumentos:
#        line    linea que contiene la deinicion.
#
#  Resultados:
#        La tabla de magnitudes se incrementa en la nuevas unidades para la magnitud
#        o error.

proc Units::ParserTableLine {} {
    variable CurrentLine
    variable exp_magnitude
    variable Magnitudes

    # ----- Verifico la terminación del bloque table ------

    if ![string compare [string toupper $CurrentLine] "END"] {
	return [list 1 ok]
    }
    if [regexp -nocase $exp_magnitude $CurrentLine {} magname units] {
	set magname [string trim [string toupper $magname]]
	if { ![info exists Magnitudes($magname)] } {
	    set Magnitudes($magname) {}
	    set Magnitudes($magname,BASIC) -1
            set Magnitudes($magname,REFERENCE) -1
	} 
	return [ParserUnitsList $magname $units]
    } else {
	return [list 0 [_ "Invalid magnitud name or units list ill-formed"]]
    }
}

proc ParserSystemLine {} {
    variable CurrentLine
}

#  Units::ParserUnitsList --
#
#        Analiza la lista de unidades y determina si es una lista de unidades válida
#        en caso positivo adiciona las unidades definidas a la tabla de magnitudes.
#
#  Argumentos:
#        magname   nombre de la magnitud de las unidades
#        lista     cadena que contiene las unidades
#
#  Resultados:
#        La tabla de magnitudes se incrementa en la nuevas unidades para la magnitud
#        o error.

proc Units::ParserUnitsList { magname lista } {
    variable exp_unitlist
    variable  exp_unit
    variable MagNames

    set listatmp $lista
    while { $listatmp != "" } {
	set listatmp [string trim $listatmp]
	set llista [string length $listatmp]
	if { [regexp -nocase $exp_unitlist $listatmp Matched {} factor {} unidad {} tipo1 {} tipo2 {} listatmp] } {
	    if { $llista == [string length $Matched] } {
		AppendUnit $magname $factor $unidad $tipo1 $tipo2
	    } else {
		return [list 0 [_ "Could not read unit set %1\$s. Only read %2\$s" $lista $Matched]]
	    }
	}
    }
    lappend MagNames $magname
    return [list 1 ok]
}

#  Units::AppendUnit --
# 
#        Adiciona una unidad a la tabla de magnitudes. Verifica si ya existe.
#        En caso de existir sustituye la definición anterior.
#
#  Argumentos:
#
#        magname    nombre de la magnitud a la que pertenece la unidad.
#        factor     factor de conversion respecto a la unidad básica.
#        unidad     expresión que define la unidad.
#        tipo1      Tipo de la unidad ( Reference o Basic ).
#        tipo2      Tipo de la unidad ( Reference o Basic ).
#
#  Resultados:
#

proc Units::AppendUnit { magname factor unidad tipo1 tipo2 } {
    variable ShortFileName
    variable Magnitudes

    
    if { $factor == "" } {
	set factor 1.0
    }

    # Verifico si la expresión de la unidad es correcta

    ParserUnit::Init $unidad
    ParserUnit::Start
    if { $ParserUnit::Status != "END" } {
	WindowMessage "$ParserUnit::Status $magname $unidad ==> [lindex $ParserUnit::Status end]"
	return
    }
    # Verifico si ya existe esta unidad

    set SearchInfo [FindUnit $ParserUnit::Numerator $ParserUnit::Denominator]
    if { $SearchInfo != {} } {
 	set UnitsList $Magnitudes([lindex $SearchInfo 0])
	set u [lindex $UnitsList [lindex $SearchInfo 1]]
	if { $factor == [lindex $u 0] } {
	    putsunits [_ "In %1\$s, processing magnitude %2\$s: %3\$s is already defined as %4\$s" \
			   $ShortFileName $magname $unidad [lindex $SearchInfo 0]]
	} else {
	    putsunits [_ "Unit :%1\$s with factor %2\$g is already defined with %3\$g" $unidad $factor [lindex $u 0]]
	}
    } else {
	if {$magname eq "TEMPERATURE"} {
	    if {![catch "GiDTeXSymbols::Get $ParserUnit::Numerator"  NumeratorTextList]} {
		set DenominatorTextList ""
	    } else {
		putsunits [_ "Invalid temperature symbol %1\$s. Should be Cel, Kel, or Far" $ParserUnit::Numerator]
		return
	    }
	} else {
	    CreateExpTextList $ParserUnit::Numerator NumeratorTextList 
	    CreateExpTextList $ParserUnit::Denominator DenominatorTextList
	}
	regsub -all { } $unidad {} unidad
	lappend Magnitudes($magname) [list $factor $ParserUnit::Numerator $ParserUnit::Denominator \
					  $NumeratorTextList $DenominatorTextList [string trim $unidad]]
	set lastidx [llength $Magnitudes($magname)]
	incr lastidx -1
	if { $tipo1 != "" } {
	    set tipo1 [string toupper $tipo1]
	    if { $Magnitudes($magname,$tipo1) != -1 } {
		putsunits [_ "Type: %1\$s in magnitude %2\$s is already defined" $tipo1 $magname]
	    } else {
		set Magnitudes($magname,$tipo1) $lastidx
	    }
	}
	if { $tipo2 != "" } {
	    set tipo2 [string toupper $tipo2]
	    if { $Magnitudes($magname,$tipo2) != -1 } {
		putsunits [_ "Type: %1\$s in magnitude $magname is already defined" $tipo2]
	    } else {
		set Magnitudes($magname,$tipo2) $lastidx
	    }
	}
    }
}

#  Units::AppendFile --
#
#        Incrementa el contenido de la tabla de magnitudes a partir del
#        contenido de un fichero.
#
#  Argumentos:
#
#        filename   nombre del fichero
#
#  Resultados:
#        

proc putsunits {text } {
  if [llength [info commands .central.s]] {
    .central.s OutPutPrintedMessages $text
  } else {
    puts $text
  }
}

proc Units::AppendFile { fname {gfile 0} } {
    variable FileName $fname
    variable ShortFileName [file tail $fname]
    variable FileId
    variable CurrentLine
    variable LineCounter  0
    variable bInModelFile 0
    variable bInGidFile   $gfile

    variable UserDefinedState 1
    variable UseBaseSystemsState 1

    variable exp_bstruct
    variable exp_udstate
    variable  exp_bsstate
    variable  exp_maghidden

    variable Hidden

    set result 1

    if { [catch {open $fname} FileId] } {
	set result 0
	putsunits $FileId
    } else {
	if { $gfile } {
	    # in order to read the special characters contained in
	    # units.gid in the definition of Temperature magnitude.

	    fconfigure $FileId -encoding "iso8859-1"
	}
	while { ![eof $FileId] } {
	    gets $FileId CurrentLine
	    incr LineCounter
	    # ---- Elimino los espacios al inicio y final de la linea ----

	    set CurrentLine [string trim $CurrentLine]
	    if { [string match \#* $CurrentLine] } { continue }
	    if { [string length $CurrentLine] } {
		if [regexp -nocase $exp_bstruct $CurrentLine {} struct argopt] {
		    if { ![string compare [string toupper $struct] "TABLE"] } {
			if ![ParserTable] {
			    set result 0
			    break
			}
		    } else {
			set argopt [string toupper $argopt]
			if ![ParserSystem $argopt] {
			    set result 0
			    break
			}
		    }
		} elseif [regexp -nocase $exp_bsstate $CurrentLine {} bsstate] {
		    set bsstate [string trim [string toupper $bsstate]]
		    if { ![string compare $bsstate "ENABLED"] } {
			set UseBaseSystemsState 1
		    } elseif { ![string compare $bsstate "DISABLED"] } {
			set UseBaseSystemsState 0
		    } else {
			putsunits [_ "Expected ENABLED | DISABLED at line %1\$i in %2\$s" $LineCounter $ShortFileName]
			set result 0
			break
		    }
		} elseif [regexp -nocase $exp_maghidden $CurrentLine -> lstmag] {
		  set lstmag [regexp -inline -all {[^,]+} $lstmag]
		  foreach _mag $lstmag {
		    # quizas deberiamos comprobar que las magnitudes
		    # estan definidas.
		    lappend Hidden [string toupper [string trim $_mag]]
		  }
		} elseif [regexp -nocase $exp_udstate $CurrentLine {} udstate] {
		    set udstate [string trim [string toupper $udstate]]
		    if { ![string compare $udstate "ENABLED"] } {
			set UserDefinedState 1
		    } elseif { ![string compare $udstate "DISABLED"] } {
			set UserDefinedState 0
		    } else {
			putsunits [_ "Expected ENABLED | DISABLED at line %1\$i in %2\$s" $LineCounter $ShortFileName]
			set result 0
			break
		    }
		} else {
		    if {[string equal -nocase [string range $CurrentLine 0 11] "DefineSymbol"]} {
			eval ::GiDTeXSymbols::DefineSymbol [string range $CurrentLine 12 end]
		    } else {
			putsunits [_ "Expected (BEGIN TABLE | SYSTEM) | USER DEFINED | USE BASE SYSTEMS | DefineSymbol at line %1\$i in %2\$s" $LineCounter $ShortFileName]
			set result 0
			break
		    }
		}
	    }
	}
	close $FileId
    }
    return $result
}

#  Units::AppendModelFile --
#
#        Lee un archivo de defiincion de unidades de trabajo de un modelo.
#
#  Argumentos:
#
#        filename   nombre del fichero
#
#  Resultados:
#        
#       Se tendra la unidad del modelo geometrico, el sistema de unidades de
#       salida al cálculo y posiblemente un sistema de unidades propio del modelo.
#       El sistema del modelo estara en una tabla aparte.
#        

proc Units::AppendModelFile { fname } {
    variable FileName $fname
    variable FileId
    variable CurrentLine
    variable LineCounter  0
    variable bInModelFile 1
    variable bInGidFile   0
    variable ModelUnit
    variable ModelSysName
    variable SysNames
    variable UseBaseSystemsState 

    variable exp_modelunit
    variable exp_udsystem
    variable exp_bsstate

    set result 1
    if { [catch {open $fname} FileId] } {
	set result 0
	putsunits $FileId
    } else {
	set prb  0
	set mdl  0
	set usys 0
	while { ![eof $FileId] } {
	    gets $FileId CurrentLine
	    incr LineCounter

	    # ---- Elimino los espacios al inicio y final de la linea ----

	    set CurrentLine [string trim $CurrentLine]
	    if { [string match #* $CurrentLine] } { continue }
	    if { [string length $CurrentLine] } {
		if [regexp -nocase $exp_modelunit $CurrentLine {} name value] {
		    set name [string toupper $name]
		    if [string compare $name "MODEL"] {
			if { [info commands .central.s] == "" } {
			    set lsys $SysNames
			} else {
			    set lsys [concat [.central.s info unitssystems gid] [.central.s info unitssystems prj]]
			}
			set msn [string trim [string toupper $value]]
			if { [string compare $msn "USER-DEFINED"] && [lsearch  $lsys $msn] == -1 } {
			    putsunits "Error in line $LineCounter at $FileName: system $value is not defined"
			    return 0
			} 
			set ModelSysName [string trim [string toupper $value]]
			set prb 1
		    } else {
			set mustr [string trim $value]
			set mdl 1
		    } 
		} elseif [regexp -nocase $exp_bsstate $CurrentLine {} bsstate] {
		    set bsstate [string trim [string toupper $bsstate]]
		    if { ![string compare $bsstate "ENABLED"] } {
			set UseBaseSystemsState 1
		    } elseif { ![string compare $bsstate "DISABLED"] } {
			set UseBaseSystemsState 0
		    } else {
			putsunits "Expected ENABLED | DISABLED at line $LineCounter in FileName"
			set result 0
			break
		    }
		} else {
		    if [regexp -nocase $exp_udsystem $CurrentLine] {
			if [ParserSystem USER-DEFINED] {
			    set usys 1
			} else {
			    set result 0
			    break
			}
		    } else {
			putsunits "Unknown structure at line: $LineCounter in file: $FileName"
			set result 0
			break
		    }
		}
		if { $prb && $mdl && $usys } break
	    }
	}
	close $FileId
	if !$result {
	    return 0
	}
	if { $mdl } {
	    FindUnitGidAndPrjStr $mustr ::Units::ModelUnit
	    
	} 
	if { !$mdl || $ModelUnit == {} } {
	    putsunits "There is not model unit defined in $fname"
	    return 0
	}
	if { [lindex $ModelUnit 0] != "LENGTH" } {
	    set ModelUnit {}
	    putsunits "Model unit $mustr must be defined within LENGTH magnitude in $fname"
	    return 0
	}
	if { !$prb } {
	    putsunits "There must be a unit system referenced in $fname"
	    return 0
	}
    }
    return 1
}

proc Units::ParserTable {} {
    variable FileName
    variable FileId
    variable CurrentLine
    variable LineCounter

    set isok 1
    while { ![eof $FileId] } {
	gets $FileId CurrentLine
	incr LineCounter
	
	# ---- Elimino los espacios al inicio y final de la linea ----
	
	set CurrentLine [string trim $CurrentLine]
	if { [string length $CurrentLine] } {
	    if { ![string compare [string toupper $CurrentLine] "END"] } {
		break
	    }
	    set r [ParserTableLine]
	    if { ![lindex $r 0] } {
		set isok 0
		putsunits "Error at line $LineCounter in file $FileName: [lindex $r 1]"
	    }
	}
    }
    return $isok
}

# busca la magnitud m en la lista l

proc Units::FindMagnitud { l m } {
    set i 0
    foreach mi $l {
	if ![string compare [lindex $mi 0] $m] {
	    return $i
	}
	incr i
    }
    return -1
}

proc Units::ParserSystem { sname } {
    variable FileName
    variable FileId
    variable CurrentLine
    variable LineCounter
    variable SysNames
    variable Systems
    variable OwnerSystem

    variable bInModelFile
    variable bInGidFile

    variable exp_sysunit

    set sname [string trim $sname]

    if { [lsearch -exact $SysNames $sname] != -1 } {
	putsunits "Error in $FileName, line $LineCounter : system $sname is already defined"
	return 0
    }
    set efound 0
    set blendefined 0
    while { ![eof $FileId] } {
	gets $FileId CurrentLine
	incr LineCounter
	
	# ---- Elimino los espacios al inicio y final de la linea ----
	
	set CurrentLine [string trim $CurrentLine]
	if { [string length $CurrentLine] } {
	    if { ![string compare [string toupper $CurrentLine] "END"] } {
		set efound 1
		break
	    }
	    if [regexp -nocase $exp_sysunit $CurrentLine {} mag unit] {
		ParserUnit::Init $unit
		ParserUnit::Start
		if { $ParserUnit::Status != "END" } {
		    putsunits [lindex $ParserUnit::Status end]
		    return 0
		}
		set SearchInfo [::Units::FindUnit $ParserUnit::Numerator $ParserUnit::Denominator]
		if { ![llength $SearchInfo] } {
		    set SearchInfo [FindUnitGidAndPrj $ParserUnit::Numerator $ParserUnit::Denominator]
		}
		if { [llength $SearchInfo] } {
		    set where [lindex $SearchInfo 2]
		    set magdef [lindex $SearchInfo 0]
		    set mag [string trim [string toupper $mag]]
		    if ![string compare $mag "LENGTH"] {
			set blendefined 1
		    }
		    if ![string compare $mag $magdef] {
			if $bInModelFile {
			    if { [FindMagnitud $OwnerSystem $mag] == -1 } {
				lappend OwnerSystem [list $mag [lindex $SearchInfo 1] $where]
			    } else {
				putsunits "$mag already referenced in line $LineCounter at file $FileName"
			    }
			} else {
			    lappend Systems($sname) [list $mag [lindex $SearchInfo 1] $where]
			}
		    } else {
			putsunits "Error at line $LineCounter: $unit should be referenced only in magnitude $magdef, not in $mag."
			return 0
		    }
		} else {
		    putsunits "Error at line $LineCounter in file $FileName: unit [string trim $unit] not defined."
		    return 0
		}
	    } else {
		putsunits "Syntax error at line $LineCounter in file $FileName."
		return 0
	    }
	}
    }
    
    if $bInModelFile {
	if !$blendefined {
	    set OwnerSystem ""
	    putsunits "Error: LENGTH not referenced in the unit system defined in file $FileName."
	    return 0
	}
    } elseif !$blendefined {
	set sysdefined [.central.s info unitssystems gid]
	if { [lsearch $sysdefined $sname] == -1 } {
	    set Systems($sname) ""
	    putsunits "Error:  LENGTH not referenced in the unit system $sname, defined in file $FileName."
	    return 0
	}
    }

    if !$efound {
	putsunits "Error: END expected at line $LineCounter in file $FileName."
	return 0
    }
    if !$bInModelFile {
	lappend SysNames $sname
    }
    return 1
}

#  FindUnit --
#
#        Dada una unidad ( Num/Den ) determina la magnitud y el indice
#        dentro de la magnitud de dicha unidad.
#
#  Argumentos:
#
#        Numerator       numerador de la unidad
#        Denominator     denominador de la unidad
#
#  Resultados:
#        Retorna una lista con el nombre de la magnitud como primer elemento
#        y el indice de la unidad como último elemento
#        

proc Units::FindUnit { Numerator Denominator } {
    variable MagNames
    variable Magnitudes
    variable bInGidFile

    set IdxFound -1
    set N [lsort $Numerator]
    set D [lsort $Denominator]
    foreach m $MagNames {
	set Idx 0
	set UnitsList $Units::Magnitudes($m)
	foreach u $UnitsList {
	    if { ![string compare [lsort [lindex $u 1]] $N] && \
		     ![string compare [lsort [lindex $u 2]] $D] } {
		set IdxFound $Idx
		break
	    }
	    incr Idx
	}
	if { $IdxFound != -1 } {
	    if $bInGidFile {
		return [list $m $IdxFound 0]
	    } else {
		return [list $m $IdxFound 1]
	    }
	}
    }
    return {}
}

#  Busca la unidad en la tabla global

proc FindUnitOnlyGid { Numerator Denominator } {
     if { [info commands .central.s] == ""} {
	 return {}
     }
    set IdxFound -1
    set N [lsort $Numerator]
    set D [lsort $Denominator]
    set MagNames [.central.s info magnitudes 0]
    foreach m $MagNames {
	set Idx 0
	set UnitsList [.central.s info magnitudes 0 $m UNITS]
	foreach u $UnitsList {
	    if { ![string compare [lsort [lindex $u 1]] $N] && \
		     ![string compare [lsort [lindex $u 2]] $D] } {
		set IdxFound $Idx
		break
	    }
	    incr Idx
	}
	if { $IdxFound != -1 } {
	    break
	}
    }
    if { $IdxFound == -1 } {
	return {}
    } else {
	return [list $m $IdxFound 0]
    }
}

# Busca la unidad en la tabla del proyecto y luego en la global

proc FindUnitGidAndPrj { Numerator Denominator } {
    if { [info commands .central.s] == ""} {
 	return [::Units::FindUnit $Numerator $Denominator]
    }
    set IdxFound -1
    set N [lsort $Numerator]
    set D [lsort $Denominator]
    foreach where {1 0} {
	set MagNames [.central.s info magnitudes $where]
	foreach m $MagNames {
	    set Idx 0
	    set UnitsList [.central.s info magnitudes $where $m UNITS]
	    foreach u $UnitsList {
		if { ![string compare [lsort [lindex $u 1]] $N] && \
			 ![string compare [lsort [lindex $u 2]] $D] } {
		    set IdxFound $Idx
		    break
		}
		incr Idx
	    }
	    if { $IdxFound != -1 } {
		return [list $m $IdxFound $where]
	    }
	}
    }
    return {}
}

proc FindUnitGidAndPrjStr { ustr uiname } {
    upvar \#0 $uiname v

    ParserUnit::Init $ustr
    ParserUnit::Start
    if { $ParserUnit::Status != "END" } {
	putsunits [lindex $ParserUnit::Status end]
	return 0
    }

    set v [FindUnitGidAndPrj $ParserUnit::Numerator $ParserUnit::Denominator]
    if [llength $v] {
	return 1
    } else {
	putsunits "Unit $ustr not found"
	return 0
    }
}

proc FindUnitInList { Numerator Denominator UnitsList} {
    set N [lsort $Numerator]
    set D [lsort $Denominator]
    set Idx 0
    foreach u $UnitsList {
	if { ![string compare [lsort [lindex $u 1]] $N] && \
		 ![string compare [lsort [lindex $u 2]] $D] } {
	    return $Idx
	}
	incr Idx
    }
    return {}
}

namespace eval GiDTeXSymbols {
    namespace export Get ForceLoadFont

# 	\\C      {iso8859-7 "\xB0\C"}
# 	\\F      {iso8859-7 "\xB0\F"}
# 	\\K      {iso8859-7 "\xB0\K"}
# 	ºC      {iso8859-7 "\xB0\C"}
# 	ºF      {iso8859-7 "\xB0\F"}
# 	ºK      {iso8859-7 "\xB0\K"}

    variable SymbolTable

    set SymbolTable(\\mult) [encoding convertfrom iso8859-7 \u00B7]
    set SymbolTable(\\degree) [encoding convertfrom iso8859-7 \u00B0]
    set SymbolTable(\\ohm) [encoding convertfrom iso8859-7 \u00D9]
    set SymbolTable(Cel) "[encoding convertfrom iso8859-7 \u00B0]C"
    set SymbolTable(Kel) "K"
    set SymbolTable(Far) "[encoding convertfrom iso8859-7 \u00B0]F"

    variable SymbolNames [list \\mult \\degree \\ohm Cel Kel Far]

    variable fontloaded 0

    proc ForceLoadFont {} {
	variable fontloaded

	if {!$fontloaded} {
	    font measure SmallFont [encoding convertfrom iso8859-7 "\u00D9"]
	    catch {
		label .__label__GID -text [encoding convertfrom iso8859-7 "\u00D9"]
	    }
	    set fontloaded 1
	}
    }
    
    proc DefineSymbol {txt utxt args} {
	variable SymbolTable

	array set options {
	    -encoding iso8859-1
	    -replace 0
	}
	array set options $args
	if {!$options(-replace) && [info exists SymbolTable($txt)]} {
	    return
	}
	set SymbolTable($txt) [encoding convertfrom $options(-encoding) $utxt]
	#eval encoding convertfrom $enc $utxt
    }

    proc Get { name } {
	variable SymbolTable

	return $SymbolTable($name)
    }
}

proc CreateExpTextList { Lista rTxtLista } {
    upvar $rTxtLista TxtLista


    set LastStr ""
    set adddot  0
    set TxtLista {}
    foreach e $Lista {
	if { $adddot } {
	    append LastStr [GiDTeXSymbols::Get "\\mult"]
	}
	set adddot 1
	if { [llength $e] == 2 } {
	    set txt [lindex $e 0]
	    if {![catch "GiDTeXSymbols::Get $txt" _txt]} {
		set txt $_txt
	    }
	    #	    if { [string index $txt 0] == "\\"  } {
	    #            || [string index $txt 0] == "º"
	    #            set txt [GiDTeXSymbols::Get $txt]
	    #        }
	    append LastStr $txt
	    lappend TxtLista $LastStr [lindex $e 1]
	    set LastStr ""
	} else {
	    if {[catch "GiDTeXSymbols::Get $e" txt]} {
		set txt $e
	    }
	    #if { [string index $e 0] == "\\" } {
	    #     || [string index $e 0] == "º"
	    #   set e [GiDTeXSymbols::Get $e]
	    #}
	    append LastStr $txt
	}
    }
    if { $LastStr != "" } {
	lappend TxtLista $LastStr
    }
}

# Retorna la lista de sistemas definidos

proc Units::GetUnitsSystems {} {
    variable SysNames
    variable UseBaseSystemsState

    if { [info commands .central.s] == "" } {
	return $SysNames
    } else {
	set PtSys [.central.s info unitssystems prj]
	if { $UseBaseSystemsState } {
	    foreach s [.central.s info unitssystems gid] {
		if { [lsearch -exact $PtSys $s] == -1 } {
		    lappend PtSys $s
		}
	    }
	}
	return $PtSys
    }
}

# Retorna la informacion de la unidad

proc Units::GetUnit { uinfo } {
    set mag [lindex $uinfo 0]
    set idx [lindex $uinfo 1]
    if { [info commands .central.s] == "" } {
	variable Magnitudes
	
	return [lindex $Magnitudes($mag) $idx]
    } else {
	return [.central.s info magnitudes [lindex $uinfo 2] $mag $idx]
    }
}

# Retorna las magnitudes dentro del sistema sname

proc Units::GetSystem { sname } {
    variable OwnerSystem
    variable Systems

    if { [info commands .central.s] == "" } {
	if { $sname == "" } {
	    return $OwnerSystem
	} else {
	    return $Systems($sname)
	}
    } else {

	if { $sname == "" } {
	    set sys [.central.s info unitssystems usersys]
	} else {
	    set sys [.central.s info unitssystems $sname prj]

	    foreach uinfo [.central.s info unitssystems $sname gid] {
		if { [FindMagnitud $sys [lindex $uinfo 0]] == -1 } {
		    lappend sys $uinfo
		}
	    }
	}
	return $sys
    }
}

proc Units::ConvertTemperature { value ufrom uto } {
    GidConvertTemperature $value [TemperatureFactor $ufrom $uto]
}

proc Units::ConvertTemperatureXX { value ufrom uto } {

    if {[string equal $ufrom {\C}] || [string equal $ufrom {ºC}] || [string equal $ufrom C]} {
	if { [string equal $uto {\F}] || [string equal $uto {ºF}]  || [string equal $uto F] } {
	    # Convierte de C a F
	    set value [format "%g" [expr 9.0/5 * $value + 32]]
	} elseif {[string equal $uto {\K}] || [string equal $uto {ºK}] || [string equal $uto K]} {
	    # Convierte de C a K
	    set value [format "%g" [expr $value + 275]]
	}
    } elseif { [string equal $ufrom {\F}] || [string equal $ufrom {ºF}] || [string equal $ufrom F] } {
	if { [string equal $uto {\C}] || [string equal $uto {ºC}] || [string equal $uto C]} {
	    # Convierte de F a C
	    set value [format "%g" [expr 5.0/9 * ($value - 32)]]
	} elseif { [string equal $uto {\K}] || [string equal $uto {ºK}] || [string equal $uto K]} {
	    # Convierte de F a K
	    set value [format "%g" [expr 5.0/9 * ($value - 32) + 275]]
	}
    } elseif { [string equal $ufrom {\K}] || [string equal $ufrom {ºK}] || [string equal $ufrom K]} {
	if { [string equal $uto {\C}] || [string equal $uto {ºC}] || [string equal $uto C] } {
	    # Convierte de K a C
	    set value [format "%g" [expr $value - 275]]
	} elseif { [string equal $uto {\F}] || [string equal $uto {ºF}] || [string equal $uto F]} {
	    # Convierte de K a F
	    set value [format "%g" [expr 9.0/5 * ($value - 275) + 32]]
	}
    }
    return $value
}

proc Units::ConvertFromBasic { str } {
}

proc Units::ConvertValueUnit { str sname } {
    variable exp_real
    variable exp_space
    variable exp_strunit
    variable uinfovar
    variable FactorCache

    set str [string trim $str]
    set eunit      "^($exp_real)$exp_space\($exp_strunit\)$"

    if [regexp -nocase $eunit $str {} value {} unit] {
	# look for unit first in cache
	if { [info exist FactorCache($unit)] } {
	    set cache $FactorCache($unit)
	    set factor [lindex $cache 0]
	    set unit [lindex $cache 1]
	    return [list  [format "%g" [expr $value * $factor]] $unit]
	} else {
	    set unitcvt $unit
	    if [FindUnitGidAndPrjStr $unit ::Units::uinfovar] {
		set syslist [GetSystem $sname]
		if [llength $syslist] {
		    set mag [lindex $uinfovar 0]
		    if { [set idx [FindMagnitud $syslist $mag]] != -1 } {
			set uiout [lindex $syslist $idx]
			if { [info commands .central.s] == "" } {
			    variable Magnitudes
			    
			    set u0 [lindex $Magnitudes($mag) [lindex $uinfovar 1]]
			    set u1 [lindex $Magnitudes($mag) [lindex $uiout 1]]
			} else {
			    set u0 [.central.s info magnitudes [lindex $uinfovar 2] $mag [lindex $uinfovar 1]]
			    set u1 [.central.s info magnitudes [lindex $uiout 2] $mag [lindex $uiout 1]]
			}
			if { [string compare $mag "TEMPERATURE"] } {
			    set factor [expr double([lindex $u1 0]) / [lindex $u0 0]]
			    set value [format "%g" [expr $value * $factor]]
			} else {
			    set value [ConvertTemperature $value [lindex $u0 end] [lindex $u1 end]]
			}
			set unitcvt [lindex $u1 end]
		    }
		} else {
		    putsunits "Unit system not found: $sname"
		}
	    } else {
		putsunits "Error in $str"
	    }
	}
	set FactorCache($unit) [list $factor $unitcvt]
	return [list $value $unitcvt]
    }
    putsunits "Invalid unit expresion: $str"
    return {}
}

proc GidConvertValueUnit { str } {
    
    if { [info commands .central.s] == "" } {
	set sname [::ModUnitWin::GetSysName]
    } else {
	set sname [.central.s info unitssystems prbsys]
    }
    set res [::Units::ConvertValueUnit $str $sname]

    if { $res == {} } {
	error "Error converting '$str' within units system '$sname'" 
    }
    return $res
}

proc Units::ConvertLength { value uinfo sname } {
    variable Magnitudes
    variable FactorCache
    
    if { [info commands .central.s] == "" } {
	set u0 [lindex $Magnitudes(LENGTH) [lindex $uinfo 1]]
    } else {
	set u0 [.central.s info magnitudes [lindex $uinfo 2] LENGTH [lindex $uinfo 1]]
    }
   
    set unit [lindex $u0 end]
    if { [info exist FactorCache($unit)] } {
	set cache $FactorCache($unit)
	set factor [lindex $cache 0]
	set unit [lindex $cache 1]
	return [list  [format "%g" [expr $value * $factor]] $unit]
    } 
    set unicvt $unit
    set syslist [GetSystem $sname]

    if [llength $syslist] {
	if { [set idx [FindMagnitud $syslist LENGTH]] != -1 } {
	    set uiout [lindex $syslist $idx]
	    if { [info commands .central.s] == "" } {
		set u1 [lindex $Magnitudes(LENGTH) [lindex $uiout 1]]
	    } else {
		set u1 [.central.s info magnitudes [lindex $uiout 2] LENGTH [lindex $uiout 1]]
	    }
	    set factor [expr double([lindex $u1 0]) / [lindex $u0 0]]
	    set value [format "%g" [expr $value * $factor]]
	    set unitcvt [lindex $u1 end]
	}
    }

    set FactorCache($unit) [list $factor $unitcvt ]
    return [list $value $unitcvt]
}

proc GidConvertLength { value } {
    if { [info commands .central.s] == "" } {
	set sname [::ModUnitWin::GetSysName]
	set uinfo $::ModUnitWin::LengthInfo
    } else {
	set sname  [.central.s info unitssystems prbsys]
	set uinfo  [.central.s info unitssystems modunit]
    }
    return [::Units::ConvertLength $value $uinfo $sname]
}

# -----------------------------------------------------------------
# TemperatureFactor, GidGetUnitFactor y GidGetLengthFactor
# son rutinas nuevas que se utilizan en C para hacer el catching
# de los factores de conversion entre unidades.
# -----------------------------------------------------------------

proc TemperatureFactor { ufrom uto } {
    if { [string equal $ufrom C] || [string equal $ufrom {\C}]
	 || [string equal $ufrom "\u00BAC"] 
	 || [string equal $ufrom "\u00B0C"]
	 || [string equal $ufrom "Cel"]} {
	if { [string equal $uto F] || [string equal $uto {\F}]
	     || [string equal $uto "\u00BAF"] 
	     || [string equal $uto "\u00B0F"]
	     || [string equal $uto "Far"]} {
	    # Convierte de C a F
	    return -1
	} elseif { [string equal $uto K] || [string equal $uto {\K}]
		   || [string equal $uto "\u00BAK"] 
		   || [string equal $uto "\u00B0K"] 
		   || [string equal $uto "Kel"]} {
	    # Convierte de C a K
	    return -2
	}
    } elseif { [string equal $ufrom F] || [string equal $ufrom {\F}]
	       || [string equal $ufrom "\u00BAF"] 
	       || [string equal $ufrom "\u00B0F"] 
	       || [string equal $ufrom "Far"]} {
	if { [string equal $uto C] || [string equal $uto {\C}]
	     || [string equal $uto "\u00BAC"]
	     || [string equal $uto "\u00B0C"]
	     || [string equal $uto "Cel"]} {
	    # Convierte de F a C
	    return -3
	} elseif { [string equal $uto K] || [string equal $uto {\K}]
		   || [string equal $uto "\u00BAK"]
		   || [string equal $uto "\u00B0K"]
		   || [string equal $uto "Kel"]} {
	    # Convierte de F a K
	    return -4
	}
    } elseif { [string equal $ufrom K] || [string equal $ufrom {\K}]
	       || [string equal $ufrom "\u00BAK"]
	       || [string equal $ufrom "\u00B0K"]
	       || [string equal $ufrom "Kel"]} {
	if { [string equal $uto C] || [string equal $uto {\C}]
	     || [string equal $uto  "\u00BAC"] 
	     || [string equal $uto  "\u00B0C"] 
	     || [string equal $uto "Cel"]} {
	    # Convierte de K a C
	    return -5
	} elseif { [string equal $uto F] || [string equal $uto {\F}]
		   || [string equal $uto "\u00BAF"]
		   || [string equal $uto "\u00B0F"]
		   || [string equal $uto "Far"]} {
	    # Convierte de K a F
	    return -6
	}
    }
    return -7
}

proc GidTclGetUnitFactor { unit } {
  global uinfovar

  set factor 0
  set sname [.central.s info unitssystems prbsys]
  if [FindUnitGidAndPrjStr $unit uinfovar] {
    set syslist [::Units::GetSystem $sname]
    if [llength $syslist] {
      set mag [lindex $uinfovar 0]
      if { [set idx [::Units::FindMagnitud $syslist $mag]] != -1 } {
	set uiout [lindex $syslist $idx]
	set u0 [.central.s info magnitudes [lindex $uinfovar 2] $mag [lindex $uinfovar 1]]
	set u1 [.central.s info magnitudes [lindex $uiout 2] $mag [lindex $uiout 1]]
	if { [string equal $mag "TEMPERATURE"] } {
	    WarnWinText "Factor de temperatura de [lindex $u0 end]  -->  [lindex $u1 end]"
	    set factor [TemperatureFactor [lindex $u0 end] [lindex $u1 end]]
	} else {
	  set factor [expr double([lindex $u1 0]) / [lindex $u0 0]]
	}
      }
    } else {
      putsunits "Unit system not found: $sname"
    }
  }
  unset uinfovar
  return $factor
}

proc GidGetLengthFactor { } {
  set sname  [.central.s info unitssystems prbsys]
  set uinfo  [.central.s info unitssystems modunit]
  set u0 [.central.s info magnitudes [lindex $uinfo 2] LENGTH [lindex $uinfo 1]]
  set syslist [::Units::GetSystem $sname]
  set factor 0
  if [llength $syslist] {
    if { [set idx [::Units::FindMagnitud $syslist LENGTH]] != -1 } {
      set uiout [lindex $syslist $idx]
      set u1 [.central.s info magnitudes [lindex $uiout 2] LENGTH [lindex $uiout 1]]
      set factor [expr double([lindex $u1 0]) / [lindex $u0 0]]
    }
  }
  return $factor
}

# ------------------------------------------------------------------
# END de rutinas de catching.
# ------------------------------------------------------------------

proc Units::GetUnitStr { smag sname } {
    variable Magnitudes

    #putsunits $sname

    set syslist [GetSystem $sname]

    #putsunits $syslist

    if { [set idx [FindMagnitud $syslist $smag]] != -1 } {
	set uinfo [lindex $syslist $idx]
	if { [info commands .central.s] == "" } {
	    set u [lindex $Magnitudes($smag) [lindex $uinfo 1]]
	} else {
	    set u [.central.s info magnitudes [lindex $uinfo 2] $smag [lindex $uinfo 1]]
	}
	return [lindex $u end]
    }
    putsunits "Error: magnitude $smag is not defined within system $sname"
    return ""
}

proc GidGetUnitStr { smag } {
    if { [info commands .central.s] == "" } {
	set sname [::ModUnitWin::GetSysName]
    } else {
	set sname [.central.s info unitssystems prbsys]
    }
    return [::Units::GetUnitStr [string toupper [string trim $smag]] $sname]
}

proc LoadGidUnits {} {

    global GIDDEFAULTTCL

    Units::Init
    
    set unipath [file join $GIDDEFAULTTCL units.gid]
    
    Units::AppendFile $unipath 1
}

proc GetUserDefSysState {} {
    return $::Units::UserDefinedState
}

proc GetUnitsList { MagName } {
    return $::Units::Magnitudes($MagName)
}

proc GetBasicUnit { MagName } {
    return $::Units::Magnitudes($MagName,BASIC)
}

proc GetReferenceUnit { MagName } {
    return $::Units::Magnitudes($MagName,REFERENCE)
}

proc GetUnitsSystem { SysName } {
    return $::Units::Systems($SysName)
}

proc LoadProblemTypeUnits { fname } {
  # esta variable se inicializa aqui para que Units::Init
  # no la sobreescriba. De hecho la lista de magnitudes 
  # ocultas solo tiene significado el en .uni del pt.
  namespace eval Units {
    variable MagHidden {}
  }

  Units::Init
  set r [Units::AppendFile $fname]
  if { $r } {
    namespace eval ::Units {
      variable Hidden
      variable MagHidden $Hidden
    }
  }
  return $r
}

proc LoadModelUnits { fname } {
    Units::Init
    
    return [Units::AppendModelFile $fname]
}

proc TestUnitsSystems {} {
    WindowMessage [set l [.central.s info unitssystems gid]]
    foreach i $l {
	WindowMessage [.central.s info unitssystems $i gid]
    }
}
