#=========================================================================
#	( ${CFGDESI}/objects/rlist.tko ) :
#	----------------------------------
#
# Date	:	20.10.1995
# Last modif.:	xx.08.1996
#
#-------------------------------------------------------------------------
# Explications:
#	If there exists an internal option database named
# "int_config", it uses it.
#=========================================================================

Class Resource {

	public geo_text			"Resource"
	public int_value		""	;# effectiv value to use, consult,...
	public int_value_changed	0	;# flat, = 1 if value was changed (PhM-19.03.97)
	public int_host_class		""	;# designed for the host class
	protected int_hosts_list	""	;# designed to hold all the objects
					 # which references the resource
	common int_occurs		""	;# references all the allocated resources
#	common int_res_name		"---"	;# used to build the effectiv name
	common int_not_known		""

constructor {config} {
  # puts "Resource::constructor ; appenning of -$this-"
  lappend int_occurs $this
  }

destructor { 
  set idx [lsearch $int_occurs $this]
  if {$idx != -1} {
     set int_occurs [lreplace $int_occurs $idx $idx]
     }
  }

method config {config} { }

#=========================================================================
# get : 
#	returns the value of objects
#-------------------------------------------------------------------------

method get { } {
  return $int_value
  }

method get_class { } {
  return $int_host_class
  }

proc get_int_res_name { } {
  return $int_res_name
  }

method take { val } {
  set int_value $val
  }

proc show { } {
  foreach entity [ Resource :: get_occurs ] {
#    puts "$entity's value has host_class [$entity info int_host_class -value] and value [ $entity info int_value -value]"
    }
  }

proc reset_all { } {
  foreach entity [ Resource :: get_occurs ] {
     if { [ Resource :: have_you $entity ] == 0} {
         $entity delete
       } else { }
     }
  set int_occurs ""
  }

#-------------------------------------------------------
# get_occurs :
#	Returns the list of all the Resource entities
# that are allocated. That's why it is a procedure.
#.......................................................

proc get_occurs { } {
  return $int_occurs
  }

proc have_you { {e  ""} } {
  if { $e == "" } {
     return 1;			# false
     }
  foreach one $int_occurs {
    if { $e == $one } {
      return 0;			# true
      }
    }
  return 1;
  }

#-------------------------------------------------------
# save_it :
#	this common class procedure saves all allocated
# resource entities in a given file
#.......................................................

proc save_it { file } {
global Default

  if {[catch {set fp [open $file w]}] == 1} {
#        puts stderr "Sorry, could not write the file ( permission ?)"
        return -1
     }

  foreach entity [Resource :: get_occurs] {

#    if {[$entity get] != ""} {	}	;# old version ICI
    if {[$entity getPub -int_value_changed] == "1"} {

#      puts stderr "ligne => $Default(o,[$entity get_class]) $Default([$entity info class])"

      if { $Default(o,[$entity get_class]) == "FglEntry." \
        && $Default([$entity info class]) == "entryActiveBg" } {
        puts $fp "*entryActiveBg: [$entity get]"

      } elseif {$Default(o,[$entity get_class]) == "FglFrameTask." \
		&& $Default([$entity info class]) == "background" } {
        puts $fp "*defaultBg: [$entity get]"

       } else {

       $entity save_me $entity $fp
#ICI
      }
    } {
#      puts stderr "  ### The entity get is NULL, has no value"
    }
  }
  foreach entity [Resource :: info common int_not_known -value] {
   puts $fp $entity
   }

  close $fp
  }

#-------------------------------------------------------
# save_me :
# This method make each resource notice itself in the 
# data file (locals.tcl or .fgl2crc
#	me : the Resource,
#	fp the file pointer
#.......................................................

method save_me { me fp } {
global Default

#puts stderr "Resource::save_me***: pass in with me = $me"

       puts $fp		\
            "*$Default(o,[$me get_class])$Default([$me info class]): [$me get]"
  }

#-------------------------------------------------------
# load_it :
#	this common class procedure loads all known
# resource entities from a given <file>
#.......................................................


proc load_it { file } {
global Default
set line ""			;# read line

  # puts "hitting $file"
  if {[catch {set f [open $file r]}] == 1} {
#        puts stderr "file not readable"
        return -1
     }
  while { [gets $f line] != -1 } {
#    puts stderr "befor work $line"
    set name ""
    set line_bak $line
    regsub -all "\\*" $line " " line
    regsub -all "\\." $line " " line
    regsub -all "\\+" $line " " line
    regsub -all "\\:" $line " " line

    if { [llength $line] == 0 || [lindex $line 0] == "#" } {
	lappend int_not_known $line_bak
	continue
        }

    if { [llength $line] != 3} {
#         set host_class	"Fgl"
	 set host_class	"Fgl"
	 set class	[lindex $line 0]
	 set value	[lindex $line 1]
#	 puts stderr "class = $class;    value = $value"

	 if { $class == "entryActiveBg" } {
#	   puts stderr "in entryActiveBg"
	   set host_class "FglEntry"
           set class	"entryActiveBg"		;# ici
         } elseif { $class == "defaultBg"} {
           set host_class "FglFrameTask"
           set class "background"
         } elseif { [string match color* $class ] } {
           set host_class "FglColor[string range $class 5 end]"
           set class "foreground"
         } elseif { [string match bgcolor* $class ] } {
           set host_class "FglbgColor[string range $class 7 end]"
           set class "background"
         }
       } else {
         set host_class	[lindex $line 0]
         set class	[lindex $line 1]
         set value	[lindex $line 2]
       }

#    puts stderr "***=> value found : class=$class , host_class=$host_class , value=$value"

    if { ! [info exists  Default($class)] || ![info exists Default(i,$host_class)]} {
#	puts stderr "*** unknown line => $line_bak"
	lappend int_not_known $line_bak
	continue
        }
    
#    puts stderr "*=> $Default($class) $Default(i,$host_class)_[$Default($class) :: info common int_res_name -value]	\
		-int_value $value -int_host_class $Default(i,$host_class) "


    if { $host_class == "FglFrame" && $class == "background" } {
        # this line must be ignored, because FglFrame.background will be
        # regerated with the FglbgColorWhite background ( it must be the same)

        continue
        }

# obj will be the to be created object.

    set obj $Default(i,$host_class)_[$Default($class) :: info common int_res_name -value]
    if {[catch "$Default($class) $obj	\
		-int_value $value -int_host_class $Default(i,$host_class) "] == 1} \
	{
	      $Default(i,$host_class)_[$Default($class) :: info common int_res_name -value]	\
		config -int_value $value
        }

# obj must be considerated as changed, to be resaved at the end of the process.
    $obj setPub -int_value_changed 1

    }
  form display
  update
  
  close $f
  }

proc change_status { } {
  foreach i [Resource :: get_occurs] {
#    puts stderr "$i has change status [$i getPub -int_value_changed]"
    }
  }

#-------------------------------------------------------
# Select a value from a predefined list.
# Arguments :
#	target	: Widget to configure; it is a 4Js- Class
#	class	: Resource
#.......................................................

method select { target attr args } {
global ${this}_qq ${this}_old_qq

  if {[catch {Frame ${this}_f -geo_orientation	"vertical"			\
		-geo_relief		"ridge"			\
		-geo_x [expr [$target getPub -geo_x] + 30]	\
		-geo_y [expr [$target getPub -geo_y] + 10]	\
		-int_moveable		"Y"			\
		-int_geoman		"place_it"
           }] == 1} {
       ${this}_f display
       return 0
       }

  ${this}_f add_member [Label ${this}_f_l -geo_text "-- $geo_text --"	\
		-int_geoman "pack_it"	\
		-geo_relief "raised"	\
		-geo_fill   "x"		\
		-int_moveable "H"]

  Lradio ${this}_lr	\
		-int_moveable		"H"	\
		-geo_relief raised		\
		-geo_int_padx	5		\
		-geo_int_pady	1		\
		-geo_borderwidth	1	\
		-int_geoman	"pack_it"	\
		-int_command	"$this config -int_value \$${this}_qq ; $target display"

#puts stderr "int_values is : $int_values"
  
  foreach entity $int_values {
#   add_member  <member_name>   <label> <variable> <affected_value>
    ${this}_lr add_member ${this}_$entity  "  $entity"  ${this}_qq  $entity
    }
  ${this}_f add_member ${this}_lr

# Initialize with current value
  set ${this}_qq	[$target getPub -geo_[[$target getPro -_$attr] info common int_res_name -value ]]
#  set ${this}_qq	[$target getPub -$attr]
  eval set ${this}_old_qq	$${this}_qq

#-----------------------
  ${this}_f add_member [Rmenu ${this}_fbut -geo_int_expand 1 -geo_relief "flat"]

  ${this}_fbut add_member ${this}_done "  Done  " "$this config -int_value_changed 1 ; ${this}_f delete"

  ${this}_fbut add_member ${this}_fc "  Cancel  " "$this config -int_value \$${this}_old_qq ; ${this}_f delete ; $target display"
#-----------------------

  ${this}_f display [$target getPub -geo_root]
  }

#=======================================================
# This method adds the name of an object entity, to the
# list of each of its resources. So, when one resource
# has changed, it is easier to find out all the objetcs
# which are dependent of it, and have to be refreshed.
# Concerned var :
#	protected int_hosts_list ""
#-------------------------------------------------------
method add_obj_to_rlist { obj } {
  #puts stderr "Resource::add_obj_to_rlist => in"
  lappend int_hosts_list $obj
  #puts stderr "Resource::add_obj_to_rlist => out"
  }

#-------------------------------------------------------
# return method of the hosts' list of the resource.
#-------------------------------------------------------
method get_hosts_rlist { } {
  return $int_hosts_list
  }

}	;# end of class Resource

#=======================================================
# class rNumber :
#	This class was made for its select method, thar is
# standard for all Objects of type numeric.
#-------------------------------------------------------

Class rNumber {
inherit Resource
	public geo_text		"rNumber"
	protected int_values	"0 1 2 3 4 5 6 7 8 9 10"

#-------------------------------------------------------

method select { target attr args } {
global val old_val

  Frame ${this}_f -geo_orientation	"vertical"			\
		-geo_relief		"ridge"				\
		-geo_int_padx		3				\
		-geo_int_pady		3				\
		-geo_borderwidth	2				\
		-geo_x [expr [$target getPub -geo_x] + 30]	\
		-geo_y [expr [$target getPub -geo_y] + 10]	\
		-int_moveable		"Y"				\
		-int_geoman		"place_it"

    ${this}_f add_member [Label ${this}_label -geo_text " Please enter the Value for $geo_text"		\
				-int_geoman "pack_it"]

#  add_member  <member_name>   <label> <variable> <affected_value>
    ${this}_f add_member [
		Entry ${this}_entry -int_variable val -int_geoman "pack_it"]

# Initialize with current value
# set val	[$target getPub -$attr]
  set val	[$target getPub -geo_[[$target getPro -_$attr] info common int_res_name -value ]]
#  puts stderr "*** val recoit $val"
  set old_val	$val

#-----------------------
  ${this}_f add_member [Rmenu ${this}_fbut -geo_int_expand 1 -geo_relief "flat"]

  ${this}_fbut add_member ${this}_ok "  OK  " "$this config -int_value \$val ; $this config -int_value_changed 1; ${this}_f delete ; $target display"
  
  ${this}_fbut add_member ${this}_apply "  Apply  " "$this config -int_value \$val ; $target display"

  ${this}_fbut add_member ${this}_fc "  Cancel  " "$this config -int_value \$old_val ; $target display ; ${this}_f delete" 

  ${this}_entry set_binding <KeyPress-Return> " ${this}_ok invoke "
  ${this}_entry set_binding <KeyPress-Escape> " ${this}_fc invoke "
#-----------------------
  ${this}_f display [$target getPub -geo_root]

  } ;# end of method rNumber::select

}	;# end of class rNumber

#=======================================================
# class rColor :
#-------------------------------------------------------

Class rColor {
inherit Resource

	public geo_text		"rColor"
	public int_text_named	0	;# =1 if color code has to be its name
					;# =0 if we want to have hex-code

constructor {config} { }

method get { } {
global Default

  if { $int_text_named == 1 } {		;# color by name
      if { [string index $int_value 0] != "#" } {
             return $int_value
         } else {
             return $int_value
         }
    } else {
      if { [string index $int_value 0] == "#" } {	;# color by its code
             return $int_value
         } else {
             if {[info exists Default(Color,$int_value)]} {
#	         puts stderr "value given is $Default(Color,$int_value)"
	         return $Default(Color,$int_value)
		} else {
                 if {$int_value != ""} {
		    puts stderr ">$int_value< color value not defined"
                   }
		 return $int_value
		}
         }
    }
  }

method select {  wid args } {
# puts "On attaque la couleur du font avec $wid"
#  fglConfigColor $wid background dUmMy 300 300 $this
  fglConfigColor .wcolpal $wid $this 300 300 { b 1 22 1 3 }
  }
}	;# end of class rColor

#=======================================================
# class rHeight :
#-------------------------------------------------------

Class rHeight {
inherit rNumber
	public geo_text		"Height"
	common	int_res_name	"height"
	protected int_values	"10 20 30 40 50 60 70 100 200 300 400 500"

constructor {config} { }

}	;# end of class rHeight

#=======================================================
# class rPadX :
#-------------------------------------------------------

Class rPadX {
inherit rNumber
	public geo_text		"Pad X"
	common	int_res_name	"padx"

constructor {config} { }

}	;# end of class rPadX

#=======================================================
# class rPadY :
#-------------------------------------------------------

Class rPadY {
inherit rNumber
	public geo_text		"Pad Y"
	common	int_res_name	"pady"

constructor {config} { }
}	;# end of class rPadY

#=======================================================
# class rRPad :
#-------------------------------------------------------
Class rRPad {
inherit rNumber
	public geo_text		"Right Padding"
	public int_host_class	"rListbox"	;# designed for the host class
	common	int_res_name "rPad"
constructor {config} { }
}	;# end of class rRPad for entries
#=======================================================
# class rEntryPadY :
#-------------------------------------------------------

Class rEntryPadY {
inherit rNumber
	public geo_text		"Entry Pad Y"
	public int_host_class	"rEntry"	;# designed for the host class
	common	int_res_name "pady"
constructor {config} { }
}	;# end of class rEntryPadY for entries

#=======================================================
# class rWidth :
#-------------------------------------------------------

Class rWidth {
inherit rNumber
	public geo_text		"Width "
	common	int_res_name	"width"
	protected int_values	"10 20 30 40 50 60 70 100 200 300 400 500"

constructor {config} { }

}	;# end of class rWidth

#=======================================================
# class rActiveBg :
#-------------------------------------------------------

Class rActiveBg {
inherit rColor
	public geo_text		"Active Bg "
	common	int_res_name	"active_bg"
constructor {config} { }
}	;# end of class rActiveBg

#=======================================================
# class rActiveFg :
#-------------------------------------------------------

Class rActiveFg {
inherit rColor
	public geo_text		"Active Fg"
	common	int_res_name	"active_fg"
constructor {config} { }
}	;# end of class rActiveFg

#=======================================================
# class RdisabledFg :
#-------------------------------------------------------

Class rDisabledFg {
inherit rColor
	public geo_text		"Disabled Fg"
	common	int_res_name	"disabled_fg"
constructor {config} { }
}	;# end of class rDisabledFg

#=======================================================
# class rReverseBg :
#-------------------------------------------------------

Class rReverseBg {
inherit rColor
	public geo_text		"Reverse Bg "
	common	int_res_name	"reverse_bg"
constructor {config} { }
}	;# end of class rReverseBg

#=======================================================
# class rSelectedBg :
#-------------------------------------------------------

Class rSelectedBg {
inherit rColor
	public geo_text		"Selected Bg "
	common	int_res_name	"selected_bg"
constructor {config} { }
}	;# end of class rSelectedBg

#=======================================================
# class rExportSelection :
#-------------------------------------------------------

Class rExportSelection {
inherit Resource
	public geo_text		"Export Selection "
	common	int_res_name	"export_selection"
constructor {config} { }
}	;# end of class rExportSelection

#=======================================================
# class rSelectMode :
#-------------------------------------------------------

Class rSelectMode {
inherit Resource
	public geo_text		"Selection Mode "
	common	int_res_name	"select_mode"
constructor {config} { }
}	;# end of class rSelectMode

#=======================================================
# class rSelectedFg :
#-------------------------------------------------------

Class rSelectedFg {
inherit rColor
	public geo_text		"Selected Fg "
	common	int_res_name	"selected_fg"
constructor {config} { }
}	;# end of class rSelectedBg

#=======================================================
# class rBackground :
#-------------------------------------------------------

Class rBackground {
inherit rColor
	public geo_text		"Background "
	common	int_res_name "bg"
constructor {config} { }

#-------------------------------------------------------
# save_me (local in the subclass) :
# This method make each resource of class rBackground,
# notice itself in the data file (locals.tcl or .fgl2crc)
# derived from the method defined uppon in the Resource class.
#	me : the Resource,
#	fp the file pointer
#.......................................................

method save_me { me fp } {
global Default

#puts stderr "rBackground::save_me***: pass in with me = $me"

  if { [string match *color* $Default(o,[$me get_class]) ] } {
#	  puts stderr "#### pass 1"
#          puts stderr "entity is $me"
#          puts stderr "$Default(o,[$me get_class]) is $Default(o,[$me get_class])"

          puts $fp "*$Default(o,[$me get_class]): [$me get]"

       if { $me == "FglbgColorWhite_bg" } {
#          puts stderr "I am FglbgColorWhite_bg"
#          puts stderr "#### pass 2"

          puts $fp "*FglFrame.$Default([$me info class]): [$me get]"
         }

     } {
     
#       puts stderr "#### pass 3"

       puts $fp		\
            "*$Default(o,[$me get_class])$Default([$me info class]): [$me get]"
       }
     }

}	;# end of class rBackground

#=======================================================
# class rEntryActiveBg :
#-------------------------------------------------------

Class rEntryActiveBg {
inherit rColor
	public geo_text		"Entry ActiveBg"
	public int_host_class	"rEntry"	;# designed for the host class
	common	int_res_name "entry_active_bg"
constructor {config} { }
}	;# end of class rActiveBg for entries


#=======================================================
# class rDefaultBackground :
#-------------------------------------------------------

Class rDefaultBg {
inherit rColor
	public geo_text		"Default Bg "
	common	int_res_name "default_bg"
constructor {config} { }
}	;# end of class rDefaultBackground

#=======================================================
# class rHighlightBackground :
#-------------------------------------------------------

Class rHighlightBackground {
inherit rColor
	public geo_text		"Highlight Bg "
	common	int_res_name "highlight_bg"
constructor {config} { }
}	;# end of class rHighlightBackground

#=======================================================
# class rForeground :
#-------------------------------------------------------

Class rForeground {
inherit rColor
	public geo_text		"Foreground "
	common	int_res_name	"fg"

constructor {config} { }

#-------------------------------------------------------
# save_me (local in the subclass) :
# This method make each resource of class rForeground
# notice itself in the data file (locals.tcl or .fgl2crc)
# derived from the method defined uppon in the Resource class.
#	me : the Resource,
#	fp the file pointer
#.......................................................

method save_me { me fp } {
global Default

#  puts stderr "rForeground::save_me***: pass in with me = $me"

  if { [string match *color* $Default(o,[$me get_class]) ] } {
#	  puts stderr "#### pass 1"
#          puts stderr "entity is $me"
#          puts stderr "$Default(o,[$me get_class]) is $Default(o,[$me get_class])"

          puts $fp "*$Default(o,[$me get_class]): [$me get]"
     } {
     
#       puts stderr "#### pass 3"

       puts $fp		\
            "*$Default(o,[$me get_class])$Default([$me info class]): [$me get]"
       }
  }
}	;# end of class rForeground

#=======================================================
# class rDefaultFg :
#-------------------------------------------------------

Class rDefaultFg {
inherit rColor
	public  geo_text	"Default Fg "
	common	int_res_name	"default_fg"

constructor {config} { }
}	;# end of class rDefaultFg

#=======================================================
# class rRelief :
#-------------------------------------------------------

Class rRelief {
inherit Resource
	public geo_text		"Relief "
	common	int_res_name "relief"

	protected int_values	"raised sunken flat groove ridge"
		;# Possible values of relief

constructor {config} { }
}	;# end of class rRelief

#=======================================================

#=======================================================
# class rBorderWidth :
#
#-------------------------------------------------------

Class rBorderWidth {
inherit Resource
	public geo_text		"Borderwidth "
	protected int_values	"0 1 2 3 4"
	common	int_res_name	"borderwidth"

constructor {config} { }
}	;# end of class rSelectedBorderWidth
#=======================================================

#=======================================================
# class rSelectedBorderWidth :
#
#-------------------------------------------------------

Class rSelectedBorderWidth {
inherit rBorderWidth
	public geo_text		"Selected Borderwidth "
	common	int_res_name	"selected_bw"

constructor {config} { }
}	;# end of class rSelectedBorderWidth
#=======================================================