#------------------------------------------------------------------------
# Compagny	:	4Js
# Developper	:	PM
# Program	:	$PROJET/objects/field.obj
# Date		:	15.05.1995
# Last modif	:	12.05.1995
# Title		:	Description de la classes Field
#------------------------------------------------------------------------

#------------------
# 4Js convenience
#------------------

#======================================================================
#	A Field is a complex set of objects. It's a container in witch
# are put a label, and one or more entries or other widgets.
# An attribut soons gives a list of attributs whitch represents slaves
# objects, in other words, member of this field object. It is used for
# example by the event display, for the function knows what objects have
# to be displayed on this one.
#........................................................................

# Class Field { _name {form ""} {orient horizontal} } {
Class Field {
inherit Frame
global Default
#vars :
	public geo_height		$Default(Field,Height)
	public geo_active_bg		$Default(Widget,ActiveBg)
	public geo_relief		$Default(Field,Relief)
	public geo_padx			$Default(Field,PadX)
	public geo_pady			$Default(Field,PadY)
	public geo_int_padx		$Default(Field,IntPadX)
	public geo_int_pady		$Default(Field,IntPadY)
	public geo_borderwidth		$Default(Field,BorderWidth)
	public geo_text			""
#	public geo_width		0 ;#	$Default(Entry,Width)
#	public geo_lab_font		$Default(Res,Label,Font)
#	public geo_entr_font		$Default(Res,Entry,Font)
	public geo_orientation		"horizontal"

	public int_label_width	$Default(Label,Width)

#Application specifics:
	public int_variable	""
	public int_geoman	"place_it"
	public int_nb_lines	1	;# Standart for a field !!!
					;# can be more if used in an array
	public int_parent	""	;# object were it is member
	public int_ewidth	$Default(Entry,Width)
					;# resizable, do not mistake !!!
					;# Correspond to a screen field length!
	public int_ref		"FORMONLY"	;# reference to DB-field
	public int_noentry	"N"
	public int_upshift	"N"
	public int_default	""

#soons:
	public int_soons	"label entry"	;# please see definition in
						;# class "Widget"
	public int_label	""		;# the label component
	public int_entry	""		;# the entry component

#methodes :
#	set name(meth,create)		{Field}
#	set name(meth,add_entry)  	"Add_Entry $_name"
#	set name(meth,set_width)	"Set_F_Entry_Width $_name"
#	set name(meth,incr_lines)	"$name(meth,incr_lines); F_Incr_Lines $_name"
#	set name(meth,decr_lines)	"$name(meth,decr_lines); F_Decr_Lines $_name"
#	set name(meth,define)	"$name(meth,define) ; Define_Field $_name"
#	set name(meth,refresh)	"$name(meth,refresh); Refresh_Field $_name"
#	set name(meth,destroy)	"Destroy_Field $_name ; $name(meth,destroy)"
#	set name(meth,save_in_res)	"Save_Field_In_Res $_name"
#	set name(meth,save_in_per)	"Save_Field_In_Per $_name"
#	set name(meth,init_resize)	"Init_Resize_Pad $_name"

constructor { config } {
  }

#-----------------------------------------------------------------------
# Define_Field:
#	This function is used to define the object in his integrality. But
# because it isn't a low level object, there cannot be used tk-instructions
#	A field is typically a label plus an entry. But for futher use, it is
# possible to define more entries. This is why there is an attribut <nb_lines>
# who specifys the number of entity. For a normal field, <nb_lines> will
# allways be 1. But for arrays..... please see class Array.
# Please see french explainations in $DOC/define.txt
#........................................................................

method define { } {
global $int_variable

#  [$this info inherit]::define
  Frame::define

# upvar #0  $name(geo,lab_font) l_font
# upvar #0  $name(geo,entr_font) e_font

  init_resize

  if {$geo_text != ""} {
	Label [set int_label l_$this]			\
		-int_parent	$this			\
		-geo_width	$int_label_width 	\
		-geo_padx	$geo_int_padx	 	\
		-geo_pady	$geo_int_pady 		\
		-geo_text	$geo_text 		\
		-int_moveable	"N"			\
		-int_geoman	"pack_it"
	if { $int_show_attr != "N"} {
		$int_label config -int_show_attr "H"
		}
	} else {
	  set int_label ""
#	  set lab ""		;# necessary for the following
	}

  set int_entry ""	;# reinitialisation to be sure
				;# for ex, for the copying function.

  for {set i 1} {$i <= $int_nb_lines } {incr i} {
  	set entr $this$i
  	add_entry $entr $i
  	}

  if { $geo_orientation == "horizontal"} {
	  set geo_attach "top"
	  if {$int_label != ""}		{ $int_label config -geo_attach "left"}
	  foreach entr $int_entry	{ $entr config -geo_attach "left" }
	} else {
	  set geo_attach "left"
	  if {$int_label != ""}		{ $int_label config -geo_attach "top"}
	  foreach entr $int_entry	{ $entr config -geo_attach "top" }
	}
# puts "Define_Field: Quelle est la valeur ??? $int_variable"
  }	;# end of define


#-----------------------------------------------------------------------
# Add_Entry :
# Parameters:	name of object Field,
#		name of object Entry, or alias....
#		indice of entry, for variable name calculation.
# Returns:	nothing
#........................................................................

method add_entry { entr i } {

  set _ref [lindex $int_entry 0]

  Entry $entr	\
	-int_parent	$this			\
	-int_show_attr	"H"			\
	-int_moveable	"N"			\
	-geo_width	$int_ewidth		\
	-int_geoman	"pack_it"		\
	-geo_padx	$geo_int_padx		\
	-geo_pady	$geo_int_pady

#  puts "Define_Field: Quelle est la variable ??? $int_variable "

   if { $int_nb_lines != 1 } {
	  set tmp [string trim $int_variable ) ]
	  append tmp	",$i)"
	  $entr config -int_variable $tmp
	} else {
	  $entr config -int_variable $int_variable
	}

  lappend int_entry $entr

#  If the field belongs to an array, then do the following

  if { [$int_parent info class] == "Array" } {
#	$entr init_ch_lines
	}

# puts "Define_Field: Sa valeur par default ??? $name(int,default)"

#  set $entri(int,variable) $name(int,default)
  $entr config -int_variable $int_default
  }

}	;# end of class
#-----------------------------------------------------------------------
# Refresh_Field :
#	Prise de tete c'te functoch !!!!!
# Parameters: name of object of class field
#.......................................................................

METHODE Refresh_Field { _name } {
upvar #0 $_name name
global $name(int,variable)
global $name(int,parent)
# upvar #0 $name(geo,entr_font) e_font
# upvar #0 $name(geo,lab_font) l_font

if {$name(geo,orientation) == "horizontal"} {
	if { $name(geo,attach) == "top" } {
		set exe_geo {}
	   } else {
		set exe_geo {call entr reset_geo}
 		set name(geo,attach) "top"
	   }
	set attach "left"
   } else {
	if { $name(geo,attach) == "left" } {
		set exe_geo {}
	   } else {
		set exe_geo {call entr reset_geo}
		set name(geo,attach) "left"
	   }
	set attach "top"
   }

# Reconsideration of the label, exist, does not exist, ...?

if {$name(int,label) != ""} {			;# the label exists
   if {$name(geo,text) != ""} {			;# the label is kept
#	puts "$_name a existe, il existe toujours"
	set lab $name(int,label)	;# =>reconfiguration of label
	global $lab
	if { $exe_geo != "" } {
		call ${lab} reset_geo
		}
	set ${lab}(geo,width)	$name(int,label_width)
	set ${lab}(geo,padx)	$name(geo,int_padx)
	set ${lab}(geo,pady)	$name(geo,int_pady)
	set ${lab}(geo,text)	$name(geo,text)
	set ${lab}(int,geoman)	"pack_it"
	} else {				;# the label is lost
	  global $name(int,label)
	    # puts "$_name a existe, il n'existe plus"
	    # puts "son label est $name(int,label)"
	  call $name(int,label) destroy	;# =>suppression of label
	  set name(int,label)	""
	  set lab		""
	  }
   } else {					;# the label does not exist
	if {$name(geo,text) != ""} {	;# the label is set
#	  puts "$_name n'a pas existe, il existe maintenant"
	  set name(int,label)	[set lab [Init_Label _l_$_name $name(int,name)]]
					;# =>creation of the label
	  set exe_geo {call entr reset_geo}
		;# in this case, must be made too.
	  global $lab
	  set ${lab}(geo,width)	$name(int,label_width)
	  set ${lab}(geo,padx)	$name(geo,padx)
	  set ${lab}(geo,pady)	$name(geo,pady)
	  set ${lab}(geo,text)	$name(geo,text)
	  set ${lab}(int,geoman)	"pack_it"
	} else {				;# the label is not set
#	  puts "$_name n'a pas existe, il n'existe toujours pas"
	  set name(int,label)	""		;# =>ignoration of the label
	  set lab		""
	}
   }

# reconfiguration of the existing things

set i 1
set nb_entry [llength $name(int,entry)]
foreach _entr $name(int,entry) {;# at this moment, the number of entry
				;# can be different than (int,nb_lines)
	global $_entr
	upvar #0  $_entr entr
	eval $exe_geo	;# reset_geo in the case the orientation has changed

	set entr(geo,width)	$name(int,ewidth)
#	puts "Refresh_Field: expand of >$_entr< is >$entr(geo,expand)<"
	set entr(geo,attach)	$attach

	set entr(geo,padx)	$name(geo,int_padx)
	set entr(geo,pady)	$name(geo,int_pady)
	set entr(geo,font)	$name(geo,entr_font)

#	puts "Refresh_Field: Quelle est la variable ??? $name(int,variable)"
	if { $nb_entry == 1 || $name(int,nb_lines) == 1 } {
#	   puts "Refresh_Field: if faut recalculer la variable"
	   if {$name(int,nb_lines) != 1} {
		set entr(int,variable)	[string trim $name(int,variable) ) ]
		append entr(int,variable)	",$i)"
		} else {
		set entr(int,variable) $name(int,variable)
		}
	   } ;# else {
#	   puts "Refresh_Field: if ne faut pas recalculer la variable"
#	   }

#	puts "Refresh_Field: Sa valeur par default ??? $name(int,default)"
	set $entr(int,variable) $name(int,default)
#	puts "Refresh_Field: Sa nouvelle valeur est ??? [set [set ${entr}(int,variable)]]"
	incr i
	}


if {$lab != ""} {
	set ${lab}(geo,attach) $attach
	set ${lab}(geo,font)	$name(geo,lab_font)
	}

# Reconfiguration of the entry (ies) 

if { $name(int,nb_lines) < [llength $name(int,entry)] } {
		# there are too much entries... suppression of the lasts.
	set count $name(int,nb_lines)
	set old_count [llength $name(int,entry)]
	for {set z $count} {$z < $old_count} {incr z} {
		set _entr [lindex $name(int,entry) $z]
		global $_entr
		call $_entr destroy
		}
	set name(int,entry)	\
		[lrange $name(int,entry) 0 [expr $name(int,nb_lines) - 1]]
   } else {
		# we need to create some new entries...
	set count [llength $name(int,entry)]
	incr count
	for {set i $count} {$i <= $name(int,nb_lines)} {incr i} {
		set _entr $_name$i
#		puts "Creation of $entr"
		global $_entr
		call name add_entry $_entr $i
		}
   }

}

#-----------------------------------------------------------------------
# Set_F_Entry_Width :
#.......................................................................

METHODE Set_F_Entry_Width { _name value } {
global $_name
upvar #0 $_name name

# puts "Set_F_Entry_Width: passage name is >$_name<, value is >$value<"
set name(int,ewidth)		$value
call $_name display ;# (ne) FAIT (plus) BOUCLER
}

#-----------------------------------------------------------------------
#	The following two functions are executed immediately after the
# function Incr_Lines (Decr_Lines), in the same event <incr_lines> (or
# <decr_lines> ). A Field must do the same thing as a normal Container
# (Frame), but in case it is member of an array, it has to informe its
# parent.
#.......................................................................

#.......................................................................
# F_Incr_Lines :
#.......................................................................

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

if { $name(int,parent) != "" } {
	global $name(int,parent)
	call $name(int,parent) incr_lines
	}
}

#.......................................................................
# F_Decr_Lines :
#.......................................................................

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

if { $name(int,parent) != "" } {
	global $name(int,parent)
	call $name(int,parent) decr_lines
	}
}

#.......................................................................
# Destroy_Field :
#	This methode must be executed bevor the standard Destroy methode
# from the Widget class.
#.......................................................................

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

if { $name(int,parent) != "" } {	;# here is meaned an array...
	global $name(int,parent)
	call $name(int,parent) decr_lines
	}
}

#-----------------------------------------------------------------------
# Save_Field_In_Res :
# Parameter:	_name:	name of field to save
#		f :	file descriptor
#.......................................................................

METHODE Save_Field_In_Res  { _name f } {
global $_name
upvar #0 $_name name

	puts $f ""
	puts $f "FIELD $_name	[set name(int,ref)]"
	puts $f "	= X [set name(geo,x)]"
	puts $f "	= Y [set name(geo,y)]"
	puts $f "	= Int_PadX [set name(geo,int_padx)]"
	puts $f "	= Int_PadY [set name(geo,int_pady)]"

	if { $name(geo,text) != ""} {
		puts $f "	= LABEL \"$name(geo,text)\""}
	if { $name(int,default) != ""} {
		puts $f "	= DEFAULT \"$name(int,default)\"" }
#	if { $name(int,ewidth) != $Default(Field,Width)} {
		puts $f "	= LENGTH $name(int,ewidth)"
#		}
	if { $name(int,noentry) == "Y"} {
		puts $f "	= NOENTRY" }
	if { $name(int,upshift) == "Y"} {
		puts $f "	= UPSHIFT" }
	if { $name(geo,orientation) == "vertical"} {
		puts $f "	= VERTICAL" }
#	if { $name(geo,relief) != $Default(Field,Relief)} {
		puts $f "	= RELIEF $name(geo,relief)"
#		}
}

#-----------------------------------------------------------------------
# Save_Field_In_Per :
#	Not implemented yet
#.......................................................................

METHODE Save_Field_In_Per  { _name f } {
global $_name
upvar #0 $_name name

	puts $f ""
	puts $f "FIELD $entity	[set name(int,ref)]"
	puts $f "	= X [set name(geo,x)]"
	puts $f "	= Y [set name(geo,y)]"

	if { $name(geo,text) != ""} {
		puts $f "	= LABEL \"$name(geo,text)\""}
	if { $name(int,default) != ""} {
		puts $f "	= DEFAULT \"$name(int,default)\"" }
	if { $name(int,ewidth) != $Default(Field,Width)} {
		puts $f "	= LENGTH $name(int,ewidth)" }
	if { $name(int,noentry) == "Y"} {
		puts $f "	= NOENTRY" }
	if { $name(int,upshift) == "Y"} {
		puts $f "	= UPSHIFT" }
	if { $name(geo,orientation) == "vertical"} {
		puts $f "	= VERTICAL" }
#	if { $name(geo,relief) != $Default(Field,Relief)} {
		puts $f "	= RELIEF $name(geo,relief)"
#		}
}
#======================================================================