# menucanvas.tcl --
#
#        Este fichero implementa el código Tcl para manejar un menu
#        de canvas. El usuario es responsable de pintar als entradas.
#
# Copyright (c) 2000 CIMNE
#

package provide MenuCanvas 0.1

namespace eval MenuCanvas {
    namespace export CreateInstance

    variable LastInstance -1

    proc DumpAlive { } {
	WarnWinText [namespace children :: Menu*]
    }
}

proc MenuCanvas::CreateInstance {} { 
    variable LastInstance

    incr LastInstance
    
    set _MenuCanvas ::MenuCanvas$LastInstance
    namespace eval $_MenuCanvas {
	namespace export Create InitWidgets GetButton GetCurrentIdx Enabled Disabled
	
	variable  Button       ""
	variable  TopLevel     ""
	variable  ScrWin       ""
	variable  ScrFrm       ""
	variable  Frame        ""
	variable  SelWidth     0
	variable  Height       0
	variable  OldFocus     ""
	variable  SelColor     ""
	variable  EvOnSelect   ""
	variable  PostCmd      ""
	variable  PopupCmd     ""
	variable  NumOptions   0
	variable  CurrentIdx   -1
	variable  State        1
    }


    proc $_MenuCanvas\::Enabled {} {
	variable State 1
    }

    proc $_MenuCanvas\::Disabled {} {
	variable State 0
    }

    proc $_MenuCanvas\::GetButton {} {
	variable Button

	return $Button
    }

    proc $_MenuCanvas\::GetCurrentIdx {} {
	variable CurrentIdx

	return CurrentIdx
    }

    proc $_MenuCanvas\::InitWidgets {} {
	variable  Button
	variable  TopLevel
	variable  SelWidth     0
	variable  Height       0
	variable  NumOptions   0
	variable  CurrentIdx   -1
	
	$Button delete all
	catch {
	    destroy $TopLevel
	}
    }
    
    proc $_MenuCanvas\::FillTopLevel {} {
	variable PostCmd
	
	eval $PostCmd [namespace current]
	ReconfigureCanvas
    }
    
    proc $_MenuCanvas\::Create { w _OnSelect _PostCmd _PopupCmd} {
	variable  Button       $w
	variable  EvOnSelect   $_OnSelect
	variable  PostCmd      $_PostCmd
	variable  PopupCmd     $_PopupCmd
	variable  TopLevel     $Button.tl
	variable  State        1

	# ------ Creo el boton/canvas de la unidad ------
	
	canvas $Button -bd 1
	
	# ------ Eventos del boton/canvas ------
	
	::bind $Button <Enter>           [namespace code "Enter"]
	::bind $Button <Leave>           [namespace code "Leave"]
	::bind $Button <ButtonPress-1>   [namespace code "Popup"]
	::bind $Button <ButtonRelease-1> [namespace code "Enter"]

	::bind $Button <Destroy> +[namespace code "Destroy %W" ]
	
	return $Button
    }

    proc $_MenuCanvas\::Destroy { W } {

	#incr MenuCanvas::LastInstance -1
	namespace delete [namespace current]
    }
    
    proc $_MenuCanvas\::Enter { } {
	variable Button
	variable State
	
	if $State {
	    $Button configure -relief raised
	}
    }

    proc $_MenuCanvas\::Leave { } {
	variable Button
	variable State
	
	if $State {
	    $Button configure -relief flat
	}
    }

    proc $_MenuCanvas\::CreateTopLevel {} {
	variable Button
	variable TopLevel
	variable ScrWin      ""
	variable ScrFrm
	variable Frame
	variable NumOptions  0
	variable Height      0
	variable SelWidth    0
	
	# ------ Menu toplevel ---------
	
	
	toplevel $TopLevel -cursor arrow
	wm overrideredirect $TopLevel 1
	wm transient $TopLevel [winfo toplevel $Button]
	wm group $TopLevel [winfo toplevel $Button]
	wm withdraw $TopLevel
	
	bind $TopLevel <1> [namespace code Unmap]
	bind $TopLevel <Escape> [namespace code Unmap]

	#set ScrWin [ScrolledWindow $TopLevel.sw -relief raised -bd 1]
	#set ScrFrm [ScrollableFrame $ScrWin.f -areawidth 0]
	#$ScrWin setwidget $ScrFrm
	#set Frame [$ScrFrm getframe]

	set Frame $TopLevel.f
	frame $Frame -bd 1 -relief raised
    
	#::bind $Frame <Enter> "MenuCanvas::OnEnter"
	#::bind $Frame <Leave> "MenuCanvas::OnLeave"
	
	FillTopLevel
	update 
	pack $Frame -fill both -expand yes

	#pack $ScrWin -fill both -expand yes
    }

    proc $_MenuCanvas\::Unmap { } {
	variable TopLevel

	grab release $TopLevel
	wm withdraw $TopLevel
    }

    proc $_MenuCanvas\::Popup { } {
	variable Button
	variable TopLevel
	variable State
	variable Frame
	variable PopupCmd

	if !$State {
	    return
	}
	
	$Button configure -relief sunken
	if { ![winfo exists $TopLevel] } {
	    CreateTopLevel
	}
	if { [winfo ismapped $TopLevel] } {
	    wm withdraw $TopLevel
	    catch {
		grab release $TopLevel
	    }
	} else {
	    set i 0
	    foreach chl [winfo children $Frame] {
		eval [list $PopupCmd $chl $i]
		incr i
	    }
	    set x  [winfo rootx  $Button]
	    set y  [winfo rooty  $Button]
	    set sy [winfo height $Button]
	    wm geometry         $TopLevel +$x\+[expr $y+$sy]
	    update idletasks
	    wm deiconify        $TopLevel
	    raise $TopLevel
	    update
	    OnMoveUp 1
	    grab -global $TopLevel
	}
    }

    proc $_MenuCanvas\::ReconfigureCanvas { } {
	variable Frame
	variable SelWidth
	variable NumOptions
	
	for {set i 0} {$i < $NumOptions} {incr i} {
	    pack $Frame.c$i -fill x -expand yes
	    $Frame.c$i configure -width $SelWidth
	}
    }

    proc $_MenuCanvas\::OnEnter {} {
	variable OldFocus   [focus]
    }

    proc $_MenuCanvas\::OnLeave {} {
	variable OldFocus
	
	focus $OldFocus
    }

    proc $_MenuCanvas\::OnCanvasFocusOut { c } {
	$c configure -relief flat
    }
    
    proc $_MenuCanvas\::OnCanvasFocusIn { c } {
	
	$c configure -relief raised -bd 1
    }

    proc $_MenuCanvas\::OnEnterCanvas { c } {

	focus -force $c
    }

    proc $_MenuCanvas\::OnSelectCanvas { idx } {
	variable TopLevel
	variable EvOnSelect
	variable CurrentIdx

	# ----- Oculto el menu -----

	Unmap

	set CurrentIdx $idx

	eval  $EvOnSelect [namespace current] $idx
    }
    
    proc $_MenuCanvas\::OnMoveUp { idx } {
	variable Frame
	variable NumOptions
	
	if { $idx == 0 } {
	    set next [expr $NumOptions-1]
	} else {
	    set next [expr $idx-1]
	}
	OnEnterCanvas $Frame.c$next
    }

    proc $_MenuCanvas\::OnMoveDown { idx } {
	variable Frame
	variable NumOptions
	
	set next $idx
	incr next
	if { $next == $NumOptions } {
	    set next 0
	}
	OnEnterCanvas $Frame.c$next
    }

    proc $_MenuCanvas\::AddEntry { ScriptDraw } {
	variable Frame
	variable NumOptions
	variable SelWidth
	
	set idx $NumOptions
	incr NumOptions
	set c $Frame.c$idx
	canvas $c
	set cgeo [eval $ScriptDraw $c]
	set xmax [lindex $cgeo 0]
	set ymax [lindex $cgeo 1]
	if { $xmax > $SelWidth } {
	    set SelWidth $xmax
	}
	
	$c configure -height $ymax
	::bind $c <Enter>    [namespace code "OnEnterCanvas     $c"]
	::bind $c <FocusOut> [namespace code "OnCanvasFocusOut  $c"]
	::bind $c <FocusIn>  [namespace code "OnCanvasFocusIn   $c"]
	::bind $c <Button-1> [namespace code "OnSelectCanvas    $idx"]
	::bind $c <ButtonRelease-1> [namespace code "OnSelectCanvas    $idx"]
	::bind $c <Up>       [namespace code "OnMoveUp          $idx"]
	::bind $c <Down>     [namespace code "OnMoveDown        $idx"]
	::bind $c <Return>   [namespace code "OnSelectCanvas    $idx"]
    }

    return $_MenuCanvas
}
