# gidunit.tcl --
#
#        Este fichero implementa el código Tcl de un control unidad
#        utilizado en GID. Se compone de un entry y un menucanvas.
#        
#
# Copyright (c) 2000 CIMNE
#

package provide GidUnit 0.1

namespace eval GidUnit {
    namespace export CreateInstance DeleteInstance

    variable LastInstance -1   
}

proc GidUnit::CreateInstance {} { 
    variable LastInstance

    incr LastInstance

    set _GidUnit ::GidUnit$LastInstance
    namespace eval $_GidUnit {
	namespace export Create GetStrUnit Enabled Disabled

	variable  MagName      ""
	variable  UnitsListName    ""
	variable  IdxName      ""
	variable  VarName      ""
	variable  txt_entry    ""
	variable  FrameControl ""
	variable  UEntry       ""
	variable  MCanvas      ""
	variable  State        1
        variable  Valid        1
    }

# Comentado, 27/11/00
#     proc $_GidUnit\::InitUnitsList {} {
# 	variable MagTable
# 	variable MagName
# 	variable IdxName
# 	variable IdxMenu
# 	variable MapG2M

# 	upvar \#0 $IdxName IdxUnit

# 	if { [info commands .central.s] == "" } {
# 	    variable UnitsList   $::Units::Magnitudes($MagName)
# 	} else {
# 	    # Lista de unidades dentro de la magnitud $MagName
# 	    # para el projecto actual
# 	    variable UnitsList   [.central.s info magnitudes 1 $MagName units]

# 	    # Lista de unidades dentro de la magnitud $MagName
# 	    # definidas solo en GiD
# 	    set ugl [.central.s info magnitudes 0 $MagName units]

# 	    if { $MagTable == 1 } {
# 		set IdxNeedUpdate 0
# 		set gidx 0
# 	    } else {
# 		set IdxNeedUpdate 1
# 		set gidx [llength $UnitsList]
# 		incr gidx -1
# 	    }
# 	    set lidx 0
# 	    foreach u $ugl {
# 		set N [lindex $u 1]
# 		set D [lindex $u 2]
# 		if { [FindUnitInList $N $D $UnitsList] == {} } {
# 		    lappend UnitsList $u
# 		    incr gidx
# 		}
# 		if { $IdxNeedUpdate && $lidx == $IdxUnit } {
# 		    set IdxUnit $gidx
# 		}
# 		incr lidx
# 	    }
# 	}
#     }

    proc $_GidUnit\::Create { w _magname _ulist _idxname _var } {
	variable MagName      $_magname
	variable UnitsListName    $_ulist
	variable IdxName      $_idxname
	variable VarName      $_var
	variable txt_entry    ""
	variable FrameControl $w
	variable UEntry       $w.e
	variable MCanvas

# Comentado, 27/11/00
	#InitUnitsList

	upvar \#0 $VarName _varvalue
	set txt_entry $_varvalue

	frame $FrameControl
	bind $w <Destroy> [namespace code "Destroy %W"]
	entry $UEntry -width 12 -textvariable [namespace current]::txt_entry
	bind $UEntry <FocusOut> [namespace code ValidateReal]
	set MCanvas [MenuCanvas::CreateInstance]
	$MCanvas\::Create $w.c \
	    [namespace code OnChangeUnit] \
	    [namespace code FillMenuUnit] \
	    [namespace code PopupEntry]

	InitMenu

	grid configure $UEntry -column 0 -row 0 -sticky "we"
	grid configure $w.c    -column 1 -row 0 -sticky "we"

	# Manipula update del botton

	upvar \#0 $IdxName IdxUnit
	trace variable IdxUnit w "[namespace code OnChangeIdx] ; \#"
	trace variable _varvalue w "[namespace code OnChangeGiDValue] ; \#"
    }

    proc $_GidUnit\::IsReal {} {
        variable Valid

        set Valid
    }

    proc $_GidUnit\::ValidateReal {} {
	variable VarName
	variable UEntry
	variable FrameControl
	variable txt_entry
        variable Valid

	upvar \#0 $VarName value

        if [catch { set r [string is double $txt_entry] }] {
	    set text "Invalid value: $txt_entry, must be a real number"
	    FloatMessage [winfo parent $FrameControl].mess $text
	    focus -force $UEntry
	    $UEntry selection range 0 end
            set Valid 0
	    return -1
	}
	set value $txt_entry
        set Valid 1
	return 0
    }
    proc $_GidUnit\::Destroy { W } {
	variable IdxName
	variable VarName
	

	#incr GidUnit::LastInstance -1
		    
	trace vdelete ::$IdxName w "[namespace code OnChangeIdx] ; \#"
	trace vdelete ::$VarName w "[namespace code OnChangeGiDValue] ; \#"
	namespace delete [namespace current]
    }

    proc $_GidUnit\::Enabled {} {
	variable State 1
	variable UEntry
	variable MCanvas

	$UEntry conf -state normal -fg black
	$MCanvas\::Enabled
    }

    proc $_GidUnit\::Disabled {} {
	variable State 0
	variable UEntry
	variable MCanvas

	$UEntry conf -state disabled -fg gray60
	$MCanvas\::Disabled
    }

    proc $_GidUnit\::GetStrUnit {} {
	variable MagName
	variable UnitsListName
	variable IdxName

	upvar \#0 $UnitsListName UnitsList
	upvar \#0 $IdxName IdxUnit

	return [lindex [lindex $UnitsList $IdxUnit] end]
    }

    proc $_GidUnit\::InitMenu {} {
	variable UnitsListName
	variable IdxName
	variable MCanvas

	upvar \#0 $UnitsListName UnitsList
	upvar \#0 $IdxName IdxUnit

	set Button [$MCanvas\::GetButton]
	set unitinfo [lindex $UnitsList $IdxUnit]
	set cgeo [GidDrawUnit [lindex $unitinfo 3] [lindex $unitinfo 4] black $Button]
	#RAMSAN
	set width [lindex $cgeo 0]
	if { $width < 30 } { set width 30 }
	$Button configure -width $width -height [lindex $cgeo 1]
    }
    
    proc $_GidUnit\::OnChangeUnit { menu idx } {
	variable UnitsListName
	variable IdxName
	variable VarName
	variable MagName

	variable txt_entry

	upvar \#0 $UnitsListName UnitsList
	upvar \#0 $IdxName IdxUnit
	upvar \#0 $VarName value

	if { $idx == $IdxUnit } {
	    return
	}

	# actualizo la cadena que describe la unidad

	set PrevIdx $IdxUnit

	# NO mover de aqui!!!!!!!!
	set IdxUnit $idx
	# es necesario para los trigger que se lanzaran ...!!!!

	set uactual [lindex $UnitsList $PrevIdx]
	set ucambio [lindex $UnitsList $idx]

	# Actualizo el valor del numero
	if { [string compare $MagName "TEMPERATURE"] } {
	    set factor [expr double([lindex $ucambio 0]) / [lindex $uactual 0]]
	    set value [format "%g" [expr $value * $factor]]
	} else {
	    set value [format "%g" [::Units::ConvertTemperature $value [lindex $uactual end] [lindex $ucambio end]]]
	}
	set txt_entry $value
    }

    proc $_GidUnit\::OnChangeIdx { } {
	variable UnitsListName
	variable IdxName
	variable MCanvas

	upvar \#0 $UnitsListName UnitsList
	upvar \#0 $IdxName IdxUnit

	set Button [$MCanvas\::GetButton]
	set unitinfo [lindex $UnitsList $IdxUnit]
	# Actualizo el contenido del botton
	$Button delete all
	set cgeo [GidDrawUnit [lindex $unitinfo 3] [lindex $unitinfo 4] black $Button]
	#RAMSAN
	set width [lindex $cgeo 0]
	if { $width < 30 } { set width 30 }
	$Button configure -width $width -height [lindex $cgeo 1]
    }

    proc $_GidUnit\::OnChangeGiDValue { } {
      variable txt_entry
      variable VarName
      upvar \#0 $VarName value

      set txt_entry $value
      
    }

    proc $_GidUnit\::FillMenuUnit { bmenu } {
	variable UnitsListName
	variable IdxName

	upvar \#0 $IdxName IdxUnit
	
	upvar \#0 $UnitsListName UnitsList

	set i 0
	foreach unitinfo $UnitsList {
	    if { $i == $IdxUnit } {
		set color red
	    } else {
		set color black
	    }
	    $bmenu\::AddEntry "GidDrawUnit [list [lindex $unitinfo 3]] [list [lindex $unitinfo 4]] $color "
	    incr i
	}
    }

    proc $_GidUnit\::PopupEntry { c i } {
	variable IdxName

	upvar \#0 $IdxName IdxUnit
	if { $i == $IdxUnit } {
	    $c itemconfigure todo -fill red
	} else {
	    $c itemconfigure todo -fill black
	}
    }

    return $_GidUnit
}

proc GidDrawUnit { Numerator Denominator color c } {
#     catch {
# 	font create fontn -family Helvetica -size 10
# 	font create fonts -family Helvetica -size 6
#     }

    set ybase 2

    set lsn [font metrics NormalFont -linespace]
    set lss [font metrics SmallFont -linespace]
    if { [llength $Numerator] > 1 } {
	set ybaseup [expr $ybase + $lsn/2 + $lss]
    } else {
	set ybaseup [expr $ybase + $lsn+2]
    }
    set xindent 7
    set x $xindent
    set power 0
    foreach txt $Numerator {
	if { $power } {
	    set y [expr $ybaseup - $lsn/2 ]
	    set fontname SmallFont
	    set power 0
	} else {
	    set y $ybaseup
	    set fontname NormalFont
	    set power 1
	}
	$c create text $x $y -text $txt -font $fontname -anchor sw -tags {up todo} -fill $color
	incr x [font measure $fontname $txt]
    }
    set xmaxup $x
    set xmax   $x
    if { [set ldeno [llength $Denominator]] } {
	set x $xindent
	if { $ldeno > 1 } {
	    set ybasedown [expr $ybaseup + $lsn/2 + $lss + 4]
	} else {
	    set ybasedown [expr $ybaseup + $lsn + 4]
	}
	set power 0
	foreach txt $Denominator {
	    if { $power } {
		set y [expr $ybasedown - $lsn/2 ]
		set fontname SmallFont
		set power 0
	    } else {
		set y $ybasedown
		set fontname NormalFont
		set power 1
	    }
	    $c create text $x $y -text $txt -font $fontname -anchor sw -tags {down todo} -fill $color
	    incr x [font measure $fontname $txt]
	}
	set xmaxdown $x
	if { $x > $xmax } {
	    set xmax $x
	}
	if { $xmaxup  < $xmax } {
	    $c move up [expr ($xmax - $xmaxup)/2] 0
	} elseif { $xmaxdown < $xmax } {
	    $c move down [expr ($xmax - $xmaxdown)/2] 0
	}
	set yline [expr $ybaseup + 2]
	$c create line $xindent $yline $xmax $yline -tags {line todo} -fill $color
	set ymax [expr $ybasedown + [font metric NormalFont -descent]]
    } else {
	set ymax [expr $ybaseup + [font metric NormalFont -descent]]
    }
    return [list $xmax $ymax]
}