#------------------------------------------------------------------------ # 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 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 " set curX %X set curY %Y # puts \"Init_Resize_Pad: bind Meta-Button-1 for <$this>\" " bind $geo_widget " 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 " " } } ;# end of class Container #----------------------------------------------------------------------- # Init_C_Chg_NbLines : #....................................................................... METHODE Init_C_Chg_NbLines { _name } { #global $_name upvar #0 $_name name # call name set_binding "puts \"Increment lines\" " call name set_binding "call $_name incr_lines" # call name set_binding "puts \"Decrement lines\" " call name set_binding "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 } } #==========================================================================