#------------------------------------------------------------------------
# Compagny	:	4Js
# Developper	:	PM
# Program	:	$PROJET/objects/containe.obj
# Last modif	:	13.10.1995
# Title		:	Description des classes de base
#------------------------------------------------------------------------
# Explication :   
#	Displaying is assumed by the methode Display_Container, called by
# the display event of the object. Define_Container creates the graphical
# object, with root window and so on. But only the Pack_Container (and
# eventually the Place_Container- ) -methodes can display it on screen.
# So Display_Container is tk-independant.
# The display event is called with optionnaly root parameter (in this case,
# the actually object root is lost and replaced with the new), but the
# define, pack_it, place_it are without root parameter, because it is
# assumed that the root is already known. 
#======================================================================

Class Container {
inherit Widget
	global Default
#vars :
	public geo_int_padx	0
	public geo_int_pady	0
	public geo_int_fill	"none"
	public geo_int_expand	0
	public geo_orientation	"vertical"	;# vertical, horizontal, or none
	public int_members	{}		;# null when initialized
	public int_soons	"members" ;# members is always soon, expected
						;# by the <display> method.
	public geo_width	$Default(Container,Width)
	public geo_height	$Default(Container,Height)
	public geo_padx	1
	public geo_pady	1
	public geo_relief	$Default(Container,Relief)
	public geo_borderwidth	2

constructor {config} {
#	puts "Doing Container::constructor"
  }

destructor {
  # puts "Container::destructor, au passage pour $this"
  foreach soon_type $int_soons {
     foreach entity [set int_$soon_type] {
	# puts stderr "Container::destructor, appel du fils $entity"
	$entity delete
	}
     }
  }

#-----------------------------------------------------------------------
# Define_Container :
#........................................................................

method define  { } {
  if { $geo_orientation == "horizontal"} {
	set attach "left"
    } elseif { $geo_orientation == "vertical" } {
	        set attach "top"
              } else {
                set attach ""
              }
                
  if { $attach != "" } {
    foreach entity $int_soons {
	  foreach soon [set int_$entity] {
		  $soon config -geo_padx $geo_int_padx \
		               -geo_pady $geo_int_pady \
		               -geo_attach $attach
		  }
	  }
    } else {
    foreach entity $int_soons {
	  foreach soon [set int_$entity] {
		  $soon config -geo_padx $geo_int_padx \
		               -geo_pady $geo_int_pady
		  }
	  }
    }
  }
#-----------------------------------------------------------------------
# Refresh_Container :
#........................................................................

method refresh  { } {
  define
  }
#-----------------------------------------------------------------------
# Supp_Soon :
#........................................................................

method supp_soon  { soon {type "members"} } {
#  puts "Supp_Soon_Container: Suppression of $soon, not implemented yet"
  }

#-----------------------------------------------------------------------
# Display_Container :
#	Complement of the Display_Widget method
#........................................................................

method display { {root .} } {

  Widget::display $root

  foreach entity $int_soons {
	# puts "list of sous bazard pour $entity : [set int_$entity]"
	foreach soon [set int_$entity] {
		# puts stderr "Display_Container: display of soon >$soon<, with root $geo_widget"
		$soon display $geo_widget.
		}
	}
  }

#-----------------------------------------------------------------------
# Add_Soon :
#........................................................................

method add_soon  { soon {type "members"} } {

#  set ${soon}(int,parent)	$_name
  $soon config -int_parent	$this
  lappend int_$type $soon
  }

#-----------------------------------------------------------------------
# Add_Member :
#........................................................................

method add_member  { member } {

  # puts stderr "set parent for $member on $this"
  $member config -int_parent	$this
  lappend int_members $member
  }

#------------------------------------------------------------------------
# Init_Resize_Pad :
#	Defines the bindings necessary to resize dynamically container
# on screen.  Is specially used for forms objects. That's why, it was
# tested if the object is being designed :
#		( if ${name}(int,being_designed) == "Y" )
# Parameters :	name of objects
# Return :	nothing, only resize object.
# Global variables used :	curX, curY
# Data changed :	${name}(geo,width) ${name}(geo,height)
#			of each object
#........................................................................

method init_resize_pad { } {
  global Default

  global curX, curY

  bind $geo_widget <Meta-Button-1> "
	set curX %X
	set curY %Y
#	puts \"Init_Resize_Pad: bind Meta-Button-1 for <$this>\"
	"

  bind $geo_widget <Meta-B1-Motion> "
	set X \[expr  %X - \$curX \]
	set Y \[expr  %Y - \$curY \]
	$this config -geo_int_padx \[expr \[ $this getPub -geo_int_padx \] + \$X\]
	$this config -geo_int_pady \[expr \[ $this getPub -geo_int_pady \] + \$Y\]
#	incr ${name}(geo,int_padx)	\$X
#	incr ${name}(geo,int_pady)	\$Y
	$this $int_geoman
	set curX %X
	set curY %Y
	"

  bind $geo_widget <Meta-ButtonRelease-1> " "
  }
}	;# end of class Container

#-----------------------------------------------------------------------
# Init_C_Chg_NbLines :
#.......................................................................

METHODE Init_C_Chg_NbLines  { _name } {
#global $_name
upvar #0 $_name name

# call name set_binding <Shift-Button-1> "puts \"Increment lines\" "
call name set_binding <Shift-Button-1>	"call $_name incr_lines"

# call name set_binding <Shift-Button-3> "puts \"Decrement lines\" "
call name set_binding <Shift-Button-3>	"call $_name decr_lines"

foreach memb $name(int,soons) {
	foreach entity $name(int,$memb) {
		global $entity
#		puts "Init_C_Chg_NbLines: initialising $entity from $name(int,name)"
		call $entity init_ch_lines
		}
	}
}


#-----------------------------------------------------------------------
# Incr_Lines :
#........................................................................

METHODE Incr_Lines  { _name } {
upvar #0 $_name name

incr name(int,nb_lines)
# call name display
}

#-----------------------------------------------------------------------
# Decr_Lines :
#........................................................................

METHODE Decr_Lines  { _name } {
upvar #0 $_name name

if { $name(int,nb_lines) > 0 } {
	incr name(int,nb_lines) -1
#	call name display
	}
}
#==========================================================================