#!/usr/local/bin/owish -f
# This upper line is not changeable. Please make eventually a symbolic
# to confdesi, which should then be called.
#
# link to the real path of the program. Or change it directly here.
#=========================================================================
#       ConfigDaisy     ( ${CFGDESI}/confdesi.tko ) :
#       ---------------------------------------------
#
# Date  :       16.10.1995
#
#-------------------------------------------------------
# Explications:
#       The ConfigDaisy tool has to manage the resources database. It
# reads a file witch contains a list of definitions, that it has to
# manipulate, and when finished, it write this new information bak
# into the same file.
#       The ConfigDaisy is made up with a menu line on the top (menu),
# and a work area (form), on witch the objects appear.
#=========================================================================

#====================================================================
#       Standard definitions
# These definitions are independant of the place where
# the files are.
# Code segment copyed from $FGLDIR/desi/oprojet/stdini.tcl.
# is THE reference.
#....................................................................

set itclGlobalScope 1           ;# general method scope handling
set oldcurX -1
set oldcurY -1

global wtk_version

set fglgui 4
catch {set fglgui $env(FGLGUI)}

if { ! [info exist wtk_version] } {
   if {![info exists env(FGLDIR)]} {
       set env(FGLDIR) "/wtkclt"
     }
  } else {
    set env(FGLDIR) [pwd]
  }

if {![info exists env(HOME)]} {
     set env(HOME) "[getwindowsdirectory]"
  }

# puts stderr "env(FGLDIR) = $env(FGLDIR)"
# puts stderr "env(HOME) = $env(HOME)"

#source $env(FGLDIR)/desi/lib/init.tcl
source $env(FGLDIR)/desi/lib/fglglob.def
fglInitColor
source $env(FGLDIR)/desi/oprojet/objects/all
source $env(FGLDIR)/desi/confdesi/objects/all

#--------------------------------------------------------------------
# #*** end std definitions***#
#--------------------------------------------------------------------

#=======================================================
#-------------------------------------------------------

Class ConfigDaisy {
inherit Container
global  Default
global  env

	public  geo_root        "."
	public  geo_relief      "flat"
	public  geo_orientation "none"
	public  int_geoman      ""      ;# case "." must be taken as geo_widget
	public  int_soons       "menu form palette"
	public  int_menu        ""
	public  int_form        ""
	public  int_palette     ""
	public  int_file        "$env(HOME)/.fgl2crc"
	public  int_file_read   "N"     ;# "Y" if we can save without ask file name

#=======================================================
#
#-------------------------------------------------------

constructor { config } {
global  int_config      ;# an internal option database
global  Default auto_path env fglgui wtk_version

  if { ! [info exists  wtk_version] } {
	set int_file "$env(HOME)/.fgl2crc"
     } else {
	set int_file "[getwindowsdirectory]/locals.tcl"
     }

  wm title . "Configuration manager"
  wm geometry . +100+50

  set int_form	  [ Frame form -geo_width 600 -geo_height 350 \
			-int_geoman pack_it -int_moveable "N"   \
			-geo_pady 2 \
			-geo_attach top ]

  set int_menu    [Frame _mbar -geo_relief "raised"     \
			-geo_attach "top" ]

  set int_palette [Frame colpal -geo_relief "raised"    \
			-geo_width 300  \
			-geo_height 1   \
			-geo_fill x     \
			-geo_attach top ]


# OBJECT :
#  $int_menu add_member olist "Objects..." {    \
#               OList objlist ;                 \
#               objlist display .cfd.form.  }
  }

#=======================================================
#
#-------------------------------------------------------

method define { } {
global Default

 option add *Background $Default(Color,LightCyan3) 100
 option add *activeBackground $Default(Color,LightCyan3) 100
 option add *activeForeground gray100 100
 option add *Foreground gray10 100

  set geo_widget "."    ;# will be lost, it's in the case of "." main root.
#  Frame::define         ;# this line would then be commented.
  set geo_widget .

  $int_menu config -geo_root "." \
		   -geo_root ${geo_widget}.
  $int_menu define

  set mbar [$int_menu getPub -geo_widget]
  menubutton ${mbar}.file -text File -underline 0 -menu ${mbar}.file.menu -bg $Default(Button,Bg)

	menu ${mbar}.file.menu
	${mbar}.file.menu add command -label New -command "$this reset_all "
	${mbar}.file.menu add command -label Open -command "$this ask_file read"
	${mbar}.file.menu add command -label Save -command "$this save_it"
	${mbar}.file.menu add command -label "Save to" -command "$this ask_file save"
#       ${mbar}.file.menu add command -label Help -command {puts stdout "No help"}
	${mbar}.file.menu add separator
	${mbar}.file.menu add command -label Exit -command {puts stdout "Bye bye" ; exit}

  menubutton ${mbar}.objects -text Widget -underline 0  -menu ${mbar}.objects.menu -bg $Default(Button,Bg)

	menu ${mbar}.objects.menu
#       ${mbar}.objects.menu add command -label Widget  -command { catch {rDefault fglW1} ; fglW1 display [form getPub -geo_widget]. }
#       ${mbar}.objects.menu add separator
	${mbar}.objects.menu add cascade -label Label   -menu ${mbar}.objects.menu.label

		menu ${mbar}.objects.menu.label
		${mbar}.objects.menu.label add command -label Label     -command { catch {rLabel fglL1} ; fglL1 display [form getPub -geo_widget].}
		${mbar}.objects.menu.label add separator
#               ${mbar}.objects.menu.label add command -label Comment   -command {puts stdout "no Comment"}
		${mbar}.objects.menu.label add command -label Message   -command {catch {rMessage fglM1} ;fglM1 display [form getPub -geo_widget].}
		${mbar}.objects.menu.label add command -label Error     -command {catch {rError fglER1} ;fglER1 display [form getPub -geo_widget].}
#               ${mbar}.objects.menu.label add command -label "display At"      -command {puts stdout "no displayAt"}
		${mbar}.objects.menu.label add command -label Line      -command {catch {rLine fglLI1} ;fglLI1 display [form getPub -geo_widget].}
#               ${mbar}.objects.menu.label add separator
#               ${mbar}.objects.menu.label add command -label All       -command {puts stdout "no All"}

        ${mbar}.objects.menu add cascade -label "Attributes"   -menu ${mbar}.objects.menu.attr

		menu ${mbar}.objects.menu.attr
		${mbar}.objects.menu.attr add command -label "All attributes"	-command "$this create_allattr" 
                ${mbar}.objects.menu.attr add separator
		${mbar}.objects.menu.attr add command -label "Blink"		-command "$this create_attr FglBlink 1 "
		${mbar}.objects.menu.attr add command -label "Blink Bold"	-command "$this create_attr FglBlinkBold 2"
		${mbar}.objects.menu.attr add command -label "Blink Reverse"	-command "$this create_attr FglBlinkRev 3"
		${mbar}.objects.menu.attr add command -label "Blink Underline"	-command "$this create_attr FglBlinkUnder 4"
		${mbar}.objects.menu.attr add command -label "Blink Bold Reverse" -command "$this create_attr FglBlinkBoldRev 5"
		${mbar}.objects.menu.attr add command -label "Blink Bold Underline" -command "$this create_attr FglBlinkBoldUnder 6"
		${mbar}.objects.menu.attr add command -label "Blink Bold Reverse Underline" -command "$this create_attr FglBlinkBoldRevUnder 7"
		${mbar}.objects.menu.attr add command -label "Blink Reverse Underline" -command "$this create_attr FglBlinkRevUnder 8"
		${mbar}.objects.menu.attr add command -label "Bold"		-command "$this create_attr FglBold 9"
		${mbar}.objects.menu.attr add command -label "Bold Reverse"	-command "$this create_attr FglBoldRev 10"
		${mbar}.objects.menu.attr add command -label "Bold Underline"	-command "$this create_attr FglBoldUnder 11"
		${mbar}.objects.menu.attr add command -label "Bold Reverse Underline" -command "$this create_attr FglBoldRevUnder 12"
		${mbar}.objects.menu.attr add command -label "Reverse"		-command "$this create_attr FglRev 13"
		${mbar}.objects.menu.attr add command -label "Reverse Underline" -command "$this create_attr FglRevUnder 14"
		${mbar}.objects.menu.attr add command -label "Underline"	-command "$this create_attr FglUnder 15"
#		${mbar}.objects.menu.attr add command -label "Invisible"	-command "$this create_attr FglInvisible 16"

        ${mbar}.objects.menu add cascade -label "Colors"   -menu ${mbar}.objects.menu.color

          menu ${mbar}.objects.menu.color
          ${mbar}.objects.menu.color add command -label "Foreground" -command "$this create_allcolor 190 "
          ${mbar}.objects.menu.color add command -label "Background" -command "$this create_allcolor 330 bg "

	${mbar}.objects.menu add cascade -label Button -menu ${mbar}.objects.menu.button
		menu ${mbar}.objects.menu.button
#               ${mbar}.objects.menu.button add command -label Button   -command { catch {rButton fglB1} ; fglB1 display [form getPub -geo_widget].}
#               ${mbar}.objects.menu.button add separator
		${mbar}.objects.menu.button add command -label "Menu Button" -command { catch {rButtonMenu fglBM1} ; fglBM1 display [form getPub -geo_widget].}
		${mbar}.objects.menu.button add command -label "Horizontal Title Menu" -command { catch {rHorMenuTitle fglHTM1} ; fglHTM1 display [form getPub -geo_widget].}
                ${mbar}.objects.menu.button add separator
		${mbar}.objects.menu.button add command -label "Key Button" -command { catch {rButtonKey fglBK1} ; fglBK1 display [form getPub -geo_widget].}
		${mbar}.objects.menu.button add command -label "Key BMP" -command { catch {rBmpKey fglBMPK1} ; fglBMPK1 display [form getPub -geo_widget].}
                ${mbar}.objects.menu.button add separator
		${mbar}.objects.menu.button add command -label "Radiobutton" -command { rRadBut fglRB1 ; fglRB1 display [form getPub -geo_widget].}
		${mbar}.objects.menu.button add command -label "Checkbutton" -command { rCheckBut fglCB1 ; fglCB1 display [form getPub -geo_widget].}
#               ${mbar}.objects.menu.button add separator
#               ${mbar}.objects.menu.button add command -label All      -command {puts stdout "no All"}

	${mbar}.objects.menu add cascade -label Field -menu ${mbar}.objects.menu.entry
		menu ${mbar}.objects.menu.entry
		${mbar}.objects.menu.entry add command -label Field     -command { catch {rEntry fglE1} ; fglE1 display [form getPub -geo_widget]. }
		${mbar}.objects.menu.entry add separator
		${mbar}.objects.menu.entry add command -label "Screen record"   -command { catch {rListbox fglLB1 } ; fglLB1 display [form getPub -geo_widget]. }
                ${mbar}.objects.menu.entry add separator
		${mbar}.objects.menu.entry add command -label "Canvas"   -command { catch {rCanvas fglCNV1 } ; fglCNV1 display [form getPub -geo_widget]. }
#               ${mbar}.objects.menu.entry add command -label All       -command {puts stdout "no All"}

#       ${mbar}.objects.menu add cascade -label Prompt -menu ${mbar}.objects.menu.prompt
#               menu ${mbar}.objects.menu.prompt
#               ${mbar}.objects.menu.prompt add command -label Prompt   -command {puts stdout "no Prompt"}
#               ${mbar}.objects.menu.prompt add separator
#               ${mbar}.objects.menu.prompt add command -label "Prompt Label" -command {puts stdout "no LabelPrompt"}
#               ${mbar}.objects.menu.prompt add command -label "Prompt Entry" -command {puts stdout "no LabelEntry"}
#               ${mbar}.objects.menu.prompt add separator
#               ${mbar}.objects.menu.prompt add command -label All      -command {puts stdout "no All"}

	${mbar}.objects.menu add command -label ScrollBar       -command { catch {rScrollbar fglSB1} ; fglSB1 display [form getPub -geo_widget]. }

	${mbar}.objects.menu add cascade -label 4GL-Windows -menu ${mbar}.objects.menu.frame
		menu ${mbar}.objects.menu.frame
		${mbar}.objects.menu.frame add command -label "4GL-Window" -command {catch {r4glFrame fglF1} ; fglF1 display [form getPub -geo_widget]. }

#		${mbar}.objects.menu.frame add separator
		${mbar}.objects.menu.frame add command -label "Screen"  -command "catch \"$int_form add_member [rFrameTask fglFT1]\" ; fglFT1 display \[$int_form getPub -geo_widget\]. " 
		${mbar}.objects.menu.frame add command -label "Menu Window" -command "catch \"$int_form add_member [rMenuFrame fglMF1]\" ; fglMF1 display \[$int_form getPub -geo_widget\]. "
		${mbar}.objects.menu.frame add command -label "Prompt Window" -command "catch \"$int_form add_member [rPromptFrame fglPF1]\" ; fglPF1 display \[$int_form getPub -geo_widget\]. "
		${mbar}.objects.menu.frame add command -label "Keys Window" -command "catch \"$int_form add_member [rKeyFrame fglKF1]\" ; fglKF1 display \[$int_form getPub -geo_widget\]. " 
#               ${mbar}.objects.menu.frame add separator
#               ${mbar}.objects.menu.frame add command -label All       -command {puts stdout "no All"}

        ${mbar}.objects.menu add command \
                -label "Help Tip" \
                -command { catch { rTip fglTIP1 } ; fglTIP1 display [form getPub -geo_widget]. }

  menubutton ${mbar}.help -text Help -underline 0  -menu ${mbar}.help.menu -bg $Default(Button,Bg)
	menu ${mbar}.help.menu
        ${mbar}.help.menu add command -label Version             -command "$this show_version"

  pack ${mbar}.file  ${mbar}.objects ${mbar}.help -side left
  tk_menuBar ${mbar} ${mbar}.file ${mbar}.objects ${mbar}.help
  update
  focus ${mbar}
  wm geometry . ""
  }

#=======================================================
#
#
#-------------------------------------------------------

method create_attr { class no } {
# PhM: may be should in Attribute CLASS
   catch {$class fglAttr$no -geo_x 5 -geo_y [expr ($no - 1) * 22 + 5]} ;
   fglAttr$no display [form getPub -geo_widget].
}

method create_allattr { } {
global wtk_version
   set i 1
if { [info exist wtk_version] } {
     catch {[$int_form getPub -geo_widget] config -cursor "IDC_ICON"}
   } else {
     catch {[$int_form getPub -geo_widget] config -cursor "watch"}
   }
   update
   foreach class { FglBlink FglBlinkBold FglBlinkRev FglBlinkUnder \
                   FglBlinkBoldRev FglBlinkBoldUnder FglBlinkBoldRevUnder \
                   FglBlinkRevUnder FglBold FglBoldRev FglBoldUnder \
                   FglBoldRevUnder FglRev FglRevUnder FglUnder } {
      create_attr $class $i
      incr i
   }
   if { [info exist wtk_version] } {
     catch {[$int_form getPub -geo_widget] config -cursor "IDC_ARROW"}
   } else {
     catch {[$int_form getPub -geo_widget] config -cursor "top_left_arrow"}
   }
}

#=======================================================
#
#
#-------------------------------------------------------

method create_color { class no posx  {add ""} } {
   catch {$class fgl${add}Color$no -geo_x $posx -geo_y [expr ($no - 1) * 22 + 5]}
   fgl${add}Color$no display [form getPub -geo_widget].
}

method create_allcolor { posx {add ""} } {
global wtk_version
   set i 1
   if { [info exist wtk_version] } {
     catch {[$int_form getPub -geo_widget] config -cursor "IDC_ICON"}
   } else {
     catch {[$int_form getPub -geo_widget] config -cursor "watch"}
   }
   update
   foreach class { White Black Yellow Magenta Red Cyan Green Blue } {
      create_color Fgl${add}Color$class $i $posx $add
      incr i
   }
   if { [info exist wtk_version] } {
     catch {[$int_form getPub -geo_widget] config -cursor "IDC_ARROW"}
   } else {
     catch {[$int_form getPub -geo_widget] config -cursor "top_left_arrow"}
   }
}

#=======================================================
# ask_file :
#       or how to load a file with the known option
# database entries
# Parameteres:
# - afterDoing =        - read or,
#                       - save.
#-------------------------------------------------------

method ask_file { {afterDoing "read"} } {
global wtk_version
  global filename
  set filename $int_file

   if { [info exist wtk_version] } {
     catch {[$int_form getPub -geo_widget] config -cursor "IDC_ICON"}
   } else {
     catch {[$int_form getPub -geo_widget] config -cursor "watch"}
   }
  update
  set wid [$int_form getPub -geo_widget]
  Frame f -int_geoman "place_it" -geo_x 15 -geo_y 50    \
		-geo_int_padx 5 -geo_int_pady 5         \
		-geo_borderwidth 2                      \
		-geo_relief "ridge"

  f add_member [Label fl -geo_root $wid.f.                      \
		-geo_text "Please enter the file name :"        \
		-int_geoman "pack_it"]

  f add_member [Entry fe -geo_root $wid.f. 	\
			-int_variable filename  \
			-geo_width 30		\
			-int_geoman "pack_it"]

  if { $afterDoing == "read" } {
	set afterDoing "read_file"
     } else {
	set afterDoing "save_it"
     }

  f add_member [Rmenu fbut -geo_int_expand 1 -geo_relief "flat"]

  fbut add_member fb "  OK  " "$this config -int_file_read \"Y\" \
					-int_file \$filename ;	\
					$this $afterDoing ;     \
					f delete  "
  fbut add_member fc "  Cancel  " " f delete " 

  fe set_binding <KeyPress-Return> { fb invoke }
  fe set_binding <KeyPress-Escape> { fc invoke }

  f display $wid.
  focus [fe getPub -geo_widget]
   if { [info exist wtk_version] } {
     catch {[$int_form getPub -geo_widget] config -cursor "IDC_ARROW"}
   } else {
     catch {[$int_form getPub -geo_widget] config -cursor "top_left_arrow"}
   }
  }

#=======================================================
#       Here will be set the internal option database
# named "int_config".
#-------------------------------------------------------

method read_file { {filename ""} } {
global int_config
global wtk_version

   if { [info exist wtk_version] } {
     catch {[$int_form getPub -geo_widget] config -cursor "IDC_ICON"}
   } else {
     catch {[$int_form getPub -geo_widget] config -cursor "watch"}
   }
  update
  if {$filename != ""} {
     set int_file $filename
    }
#  puts "$this::read_file => >$int_file<"
  Resource :: load_it $int_file
   if { [info exist wtk_version] } {
     catch {[$int_form getPub -geo_widget] config -cursor "IDC_ARROW"}
   } else {
     catch {[$int_form getPub -geo_widget] config -cursor "top_left_arrow"}
   }
  }

#=======================================================
#
#-------------------------------------------------------

method save_it { {filename  ""}} {
  if {$filename != ""} {
    set int_file $filename
    }
#  puts "$this::save_it => $int_file"
  if { $int_file_read == "N"} {
       ask_file "save"
     } else {
       Resource :: save_it $int_file
     }
  }

method reset_all { } {
   Resource :: reset_all
   rWidget :: reset_all
   }

#=======================================================
#
#-------------------------------------------------------

method get_version { } {
global env

  if {[catch {set f [open "$env(FGLDIR)/desi/VERSION" r]}] == 1} {
        puts stderr "file not readable"
        return "no_product_version"
     } else {
  	return [gets $f]
     }
  }

#=======================================================
#
#-------------------------------------------------------

method show_version { } {

  Frame ver -int_geoman "place_it" -geo_x 15 -geo_y 50    \
		-geo_int_padx 5 -geo_int_pady 5         \
		-geo_borderwidth 2                      \
		-int_moveable "Y"                      \
		-geo_relief "ridge"

# -geo_root $wid.f.
  ver add_member [Label v_fl      \
	-geo_text " Configuration Manager " \
	-int_geoman "pack_it"]

  ver add_member [Label v_fl2      \
	-geo_text "version : [$this get_version]" \
	-int_geoman "pack_it"]

  ver add_member [Button v_fb -geo_text "  OK  " -int_command " ver delete  " \
	-int_geoman "pack_it"]
  ver display [$int_form getPub -geo_widget].

  }

}       ;# end of class ConfigDaisy
#=======================================================

ConfigDaisy cfd
cfd display .
cfd display