#---------------------------------------------------------
# Ptk (Parenthesized tk)
#---------------------------------------------------------
# ptk-nodes.tcl
# - complement to ptk.tcl
# - advanced containers
#---------------------------------------------------------

_def_props {
   {kind       outer   inner  nbsons   params    components}
   {switch      packer  packer   varln {var values}   {frame}}
   {toggle      packer  packer   eq2   {var}          {frame}}
}

### SWITCH CONTAINER
#
# diplay a particular son 
# according to the (enumate) value of a var
# warning: ending 'args' is necessary for a callback

interp alias {} ptk::_configure_switch {} ptk::_configure_basic
interp alias {} ptk::_configure_switch_frame {} ptk::_configure_basic
interp alias {} ptk::_configure_toggle {} ptk::_configure_basic
interp alias {} ptk::_configure_toggle_frame {} ptk::_configure_basic


proc ptk::_do_switch { var vals father sons args } {
   ptk::DBG "ptk::do_switch var=$var vals=$vals sons=$sons"
	#TODO not sure if global and/or upvar necessary
   upvar #0 $var cond
	foreach v $vals s $sons {
		if { $v == $cond } then {
      	catch [pack $s -in $father -side top -expand 1 -anchor center -fill both]
		} else {
      	catch [pack unpack $s]
		}
	}
   lower $father
}
proc ptk::_begin_switch { var values opts } {
	# opts is not for main frame
	ptk::DBG "   ptk::_begin_switch $var $values $opts"
	set it [ ptk::push_node frame ]
	return $it
}
proc ptk::_end_switch { var values opts } {
	set it $ptk::cur_node
	set sons $ptk::node_sons($it)
   ptk::DBG "ptk::end_switch var:$var values:$values opts:$opts sons:$sons" 
	# check lengths
	set nbvalues [ llength $values ]
	set nbsons [ llength $sons ]
	if { $nbsons != $nbvalues } then {
		ptk::_error "ptk::_end_switch $nbvalues sons expected, get $nbsons"
	}
	# warning: {} are important to pass lists
   trace variable "$var" w "ptk::_do_switch $var {$values} $it {$sons}"
   ptk::_do_switch $var $values $it $sons
   lower $it
	ptk::pop
}

### TOGGLE CONTAINER similar to switch
### but commanded by a 'Boolean' if the sense of 'if then else':

proc ptk::_do_toggle { cond father son1 son0 args } {
   ptk::DBG "ptk::_do_toggle cond=$cond father=$father son1=$son1 son0=$son0"
	#TODO not sure if global and/or upvar necessary
   upvar #0 $cond x 
	if $x then {
		pack unpack $son0
		pack $son1 -in $father -side top -expand 1 -anchor center -fill both
	} else {
		pack unpack $son1
		pack $son0 -in $father -side top -expand 1 -anchor center -fill both
	}
	lower $father
}

proc ptk::_begin_toggle { var opts } {
	ptk::DBG "   ptk::_begin_toggle $var $opts"
	set it [ ptk::push_node frame ]
	return $it
}

proc ptk::_end_toggle { var opts } {
	### bad idea var must support tcl 'bool' conv
	###ptk::_end_switch $var {1 0} $opts
	set it $ptk::cur_node
	set sons $ptk::node_sons($it)
   ptk::DBG "ptk::end_toggle var:$var opts:$opts sons:$sons" 
	# check lengths
	set nbsons [ llength $sons ]
	if { $nbsons != 2 } then {
		ptk::_error "ptk::_end_toggle 2 sons expected, get $nbsons"
	}
	set son1 [ lindex $sons 0 ]
	set son0 [ lindex $sons 1 ]
   trace variable "$var" w "ptk::_do_toggle $var $it $son1 $son0"
   ptk::_do_toggle $var $it $son1 $son0
	lower $it
	ptk::pop
}

### POPUP CONTAINER
# Within the current node:
# - a frame .it PUSHED
# - a button inside .it.b
# - a toplevel aside .it.pop
#   wich is also PUSHED
# - at end -> must POP twice
_def_props {
   {kind       outer   inner  nbsons   params    components}
   {popup       packer  packer   any   {title}        {button frame}}
}

# configure: 'it' is the (popup) frame
interp alias {} ptk::_configure_popup_frame {} ptk::_configure_basic

# but default compo is the button
proc ptk::_configure_popup_button { it opts } {
	set bb [winfo parent w].but
	eval bbut configure $opts"
}
interp alias {} ptk::_configure_popup {} ptk::_configure_popup_button

proc ptk::invert_popup { toppath } {
   if {"[wm state $toppath]" == "normal"} {
      wm withdraw $toppath
   } else {
      wm deiconify $toppath
	}
	wm positionfrom $toppath user
}

# opts are passed to the button
proc ptk::_begin_popup { title opts } {
	ptk::DBG "   ptk::_begin_popup $title $opts"
	# push toplevel ``inside'' it  
	set it [ ptk::push_node frame ]
	# push toplevel ``inside'' it  
	set top [ ptk::push_node toplevel ]

	wm withdraw $top
	wm positionfrom $top
	wm title $top "$title"
	# prevent the window manager to destroy top
	wm protocol $top WM_DELETE_WINDOW "ptk::invert_popup $top"
	# dismiss button inside top
	[STDW button] $top.dismiss \
		-text "dismiss"\
		-font {helvetica 12 italic} -fg blue \
		-command "ptk::invert_popup $top"
	pack $top.dismiss -in $top -side bottom -expand 0 -anchor center -fill none
	# popup button inside it label "title"
	[STDW button] $it.but \
		-text "$title" \
		-command "ptk::invert_popup $top" \
		-font {helvetica 12 italic} -fg blue
	# opts are passed to the button
	pack $it.but -in $it -side top -expand 1 -anchor center -fill both
	eval "$it.but configure $opts"
	# popup is a col by default
	set ptk::packer_policy($top) { -side top -expand 1 -anchor center -fill both }
	return $top
}

proc ptk::_end_popup { title opts } {
	# cur_node is $it.pop
	# close it as a regular packer
	ptk::_end_packer
	# now cur_node is it, just pop 
	ptk::pop
}


