#
# Date	:	18.10.1995
# Maj   : Independant version
#
# Explications :
# Because we want to use fonctions defined in the fgl2c.tcl file,
# we need to define some global variables.
# 


############################################################################


set tC(old) -1
set tC(curr) -1
set tC(1,first) ""
set tC(1,last) ""
set tC(nb) -1
set tC(exist) 0
set tC(wid) ""
set tC(frame) ""

################################################################################
## proc fglInitColor : Initialisation of Color name:
##                       Search rgb.txt file
## Parameters :
##  none
## Returnings :
##  none
################################################################################

proc fglInitColor { } {
  global Default env tC

  if { ! [info exists env(FGLDIR) ] } {
    puts stderr "fglInitColor: Environment variable FGLDIR must be set."
    return 0
  } else {
   set fgldir $env(FGLDIR)
  }

##################################
# Source the color.def if exists #
##################################
  if { ! [catch { set fout [open $fgldir/desi/etc/color.def r]}] } {
    close $fout
    source $fgldir/desi/etc/color.def
    return 1
  }

  if { [catch { set fout [open $fgldir/desi/etc/color.def w]} msg] } {
    puts stderr "fglInitColor: $msg"
    return 0
  }
  
  #############################################
  # Else create it with definition in rgb.txt #
  #############################################
  set mustopen 1
  if { [catch { set fin [open $fgldir/desi/etc/rgb.txt r]}] \
   &&  [catch { set fin [open $fgldir/etc/rgb.txt r]}] } {
    set mustopen 0
  }

  if { $mustopen && [catch { set fin [open /usr/lib/X11/rgb.txt r]}] } {
    puts stderr "fglInitColor: Cannot read \"rgb.txt\" file."
  }

  set tC(nb) 0
  set oldColor "bibi"
  while { [gets $fin line] >= 0 } {
    if { [string match \[!#\]* "$line"] } {
      continue
    }
    if { [set nb [llength $line]] < 4 } {
      puts stderr "fglInitColor: Bad syntax in file \"rgb.txt\"."
      return 0
    }
    set r    [format "%02x" [lindex $line 0]]
    set g    [format "%02x" [lindex $line 1]]
    set b    [format "%02x" [lindex $line 2]]
    if { $nb == 4 } {
      set name [lindex $line 3]
    } else {
      set name ""
      foreach partname [lrange $line 3 end] {
        set name "$name$partname"
      }
    }
    if { $oldColor != "$r$g$b" } {
      set oldColor "$r$g$b"
      puts $fout "set Default(Color,$name)\t#$oldColor\nset tC(name,$tC(nb))\t$name"
      incr tC(nb)
    }
  }
  puts $fout "set tC(nb) $tC(nb)"
  
    
 close $fin
 close $fout
 source $fgldir/desi/etc/color.def
 return 1
}

################################################################################
## proc fglConfigColor : Selection of the color attribut
## Parameters :
##  widPath : Widget path or "" for standard or "new" each time of calling
##  widConf : can be:
##                 - Name of the Widget 
##                 - "" to use the standard configuration
##                 - To redraw the standard configuration
##  resource: Resource to reconfigure
##  x       : Position x 
##  y       : Position y 
##  specif  : { [l(istbox)|b(utton)] nbline nbcol height width }
## Returnings :
##  none
################################################################################

proc fglConfigColor { widPath widConf resource y x specif } {

  global tC fglgui Default

  if { $tC(nb) == -1 } {
    if { ![fglInitColor] } {
      return
    }
  } elseif { $tC(nb) == 0 } {
    puts stderr "fglConfigColor: No existing colors."
    return
  } elseif { [llength $specif] != 5 } {
    puts stderr "fglConfigColor: Bad format of \"specif\" parameters."
    return
  }


  if { $widPath == "new" || $widPath == "" } {
    set tC(wid) ".color1"
    set tC(frame)  $tC(wid).f
    set tC(destroy) 0
    set extern 0
    if { $widPath == "new" } {
      set tC(destroy) 1
      set tC(exist) 0
      catch { destroy $tC(wid) }
    }
  } else {
    set tC(destroy) 0
    set tC(wid) $widPath
    set tC(frame) $widPath
    set extern 1
  }

  set tC(widConf) $widConf
  set tC(resource) $resource

  if { ! $tC(exist) } {
    if { ! $extern } {
      toplevel $tC(wid)
      wm geometry $tC(wid) +${x}+${y}
      wm title $tC(wid) "Choose a color"
      label $tC(wid).label -text "Wait a few seconds, please..."
      pack  $tC(wid).label -side top
      frame $tC(frame)
      pack $tC(frame)
    }
  } else {
    focus $tC(wid)
  }
  
  if { ! $tC(exist) } {
    set tC(type)   [lindex $specif 0]
    set tC(nbline) [lindex $specif 1]
    set tC(nbcol)  [lindex $specif 2]
    set tC(height) [lindex $specif 3]
    set tC(width)  [lindex $specif 4]
  }
  set nbPerPage [expr $tC(nbline) * $tC(nbcol) ]
  
  set colorhexa [$tC(resource) getPub -int_value]
  set tC(colorhexa) #b4cdcd
  set tC(colorname) LightCyan3

  if { ! $tC(exist) } {
    set tC(nbpg) 0
    set tC(0,first) 0
    set currPage 0
    for {set i 0 } { $i < $tC(nb) } { incr i } {
      set name $tC(name,$i)
      if { $i != 0 && [expr [expr $i + 1] % $nbPerPage ] == 0 } {
        set tC($tC(nbpg),last) $i
        incr tC(nbpg)
        set tC($tC(nbpg),first) [expr $i + 1]
      }
      if { ( $tC(old) != - 1 && $tC(old) == $i ) \
       || ( $tC(old) == -1 \
         && ( $colorhexa == $Default(Color,$name) || $colorhexa == $name ) ) } {
        set currPage $tC(nbpg)
      }
      if { $colorhexa == $Default(Color,$name) || $colorhexa == $name } {
         set tC(curr) $i
         set tC(colorhexa) $Default(Color,$name)
         set tC(colorname) $name
      }
    }
    set tC($tC(nbpg),last) [expr $tC(nb) - 1 ]
    incr tC(nbpg)
  } else {
    set currPage 0
    for {set i 0 } { $i < $tC(nb) } { incr i } {
      set name $tC(name,$i)
      if { $colorhexa == $Default(Color,$name) || $colorhexa == $name } {
         set tC(curr) $i
         set tC(colorhexa) $Default(Color,$name)
         set tC(colorname) $name
         break
      }
    }
  }

# foreach a [lsort [array names tC]] {
#   puts stderr "($tC(nbpg),$tC(nb))$a = $tC($a)"
# }

 if { ! $tC(exist) } {
   fglColorInitPage $currPage $tC(nbpg)
   fglColorPage $currPage -1 $tC(nbpg)
 } else {
   fglColorState normal
   fglColorPage $tC(lastPage) $tC(lastPage) $tC(nbpg)
 }
if { ! $tC(exist) && ! $extern } {
  destroy  $tC(wid).label		;# c'est le message d'attente
}
set tC(active) 1
update
set tC(exist) 1
}

set oldTypeButton ""
################################################################################
## proc fglColorInitPage : Initialisation of a first page
## Parameters :
##  ixPage  : Index of Page
##  nbPage  : number of page
## Returnings :
##  none
################################################################################

proc fglColorInitPage { ixPage nbPage } {

  global tC tkOrgButtons fglgui oldTypeButton

  if { $fglgui == 4 } {
    set oldTypeButton $tkOrgButtons
    set tkOrgButtons 1
  }

  set w $tC(frame)

  set f  $w.fbut
  frame $f
  pack  $f -side top

  if { $nbPage > 1 } {
    if { $ixPage == [expr $nbPage - 1] } {
      set next 0
      set prev [expr $ixPage - 1]
    } elseif { $ixPage == 0 } {
      set next 1
      set prev [expr $nbPage - 1]
    } else {
      set next [expr $ixPage + 1]
      set prev [expr $ixPage - 1]
    }
    button $f.oc2 -text "  Next  "\
            -command "fglColorPage $next $ixPage $nbPage"
    button $f.oc1 -text "  Prev  "\
            -command "fglColorPage $prev $ixPage $nbPage"
    button $f.oc3 -text "  Done  "\
            -command "set tC(old) \$tC(curr); fglCfgAttrib 2 {}; \$tC(resource) setPub -int_value_changed 1 "
    pack $f.oc1 $f.oc2 $f.oc3 -side left
  }

  if { $tC(nbcol)*$tC(width) <= 20 } {
    set f ${f}next
    frame $f
    pack  $f -side top
  }

  button $f.ca -text "  Cancel  " \
               -command "fglCfgAttrib 1 {}"
  pack $f.ca -side left

  if { $tC(colorhexa) != "novalue" } {
    button $f.cu -activebackground $tC(colorhexa) \
                 -background $tC(colorhexa) \
                 -activeforeground black \
                 -foreground black \
                 -text "  Old  " \
                 -command "set tC(old) \$tC(curr)
                           fglCfgAttrib 1 {}"
    pack $f.cu -side left
  }

  if { $tC(type) == "l" } {
    set f  $tC(frame).fbutl
    frame $f
    pack  $f -side top
    for {set i 0 } { $i < $tC(nbcol)} {incr i} {
      listbox $f.$i -geometry $tC(width)x$tC(nbline) \
                     -borderwidth 0
#                    -borderwidth 1 -background black
      pack $f.$i -side left -anchor n
      bind $f.$i <B1-Motion> { }
      for {set j 0 } { $j < $tC(nbline)} {incr j} {
        $f.$i insert 0 "    "
      }
    }
  }
}

################################################################################
## proc fglColorState : Active /Desactive Color configuration
## Parameters :
##  state  : 
## Returnings :
##  none
################################################################################

proc fglColorState { state } {

  global tC 

  set w $tC(frame)
  set f  $w.fbut

  $f.oc1 config -text "  Prev  " -state $state
  $f.oc2 config -text "  Next  " -state $state
  $f.oc3 config -text "  Done  " -state $state
  if { $tC(nbcol)*$tC(width) <= 20 } {
    set f ${f}next
  }
  $f.ca  config -text "  Cancel  " -state $state
  $f.cu  config -text "  Old  " -state $state
  if { $state == "normal" } {
    $f.cu config -text "  Old  " -activebackground $tC(colorhexa) \
                   -background $tC(colorhexa) 
  }

}

################################################################################
## proc fglColorPage : Display one page of color
## Parameters :
##  ixPage  : Index of Page
##  nbPage  : number of page
##  OldPage : number of old page
##  name    : Name of the second dimension of the array cWnd
## Returnings :
##  none
################################################################################

proc fglColorPage { ixPage oldPage nbPage } {

  global tC tkOrgButtons fglgui  oldTypeButton Default

###########################
# Frame of dialog buttons #
###########################

  set tC(lastPage) $ixPage
  set w $tC(frame)
  set f $w.fbut

#################################
# Config. next and prev buttons #
#################################
  if { $nbPage > 1 } {
    if { $ixPage == [expr $nbPage - 1] } {
      set next 0
      set prev [expr $ixPage - 1]
    } elseif { $ixPage == 0 } {
      set next 1
      set prev [expr $nbPage - 1]
    } else {
      set next [expr $ixPage + 1]
      set prev [expr $ixPage - 1]
    }
    $f.oc1 configure -text "  Prev  " \
            -command "fglColorPage $next $ixPage $nbPage"
    $f.oc2 configure -text "  Next  " \
            -command "fglColorPage $prev $ixPage $nbPage"
  }

  if { $tC(type) == "l" } {
    set f  $w.fbutl
    for {set i 0 } { $i < $tC(nbcol)} {incr i} {
      bind $f.$i <1> "set no \[expr $tC($ixPage,first) \
                            + $tC(nbcol)*\[%W nearest %y\] + $i\]
                      set tC(curr) \$no;
                      set col \$tC(name,\$no)
                      fglCfgAttrib 0 \$col"
                      
#                      $w.cname configure -text \"\$col\" \
#                                         -background \"\$col\"
    }
  }

  set nb 0
  set nbf 0
  #####################
  # Config the colors #
  #####################
  set nuline -1
  for {set i $tC($ixPage,first)} { $i <= $tC($ixPage,last) } {incr i} {
    set col $Default(Color,$tC(name,$i))
    set nu [expr $nb % $tC(nbcol)]
    if { $tC(type) == "l" } {
      if { $nu == 0 } {
        incr nuline 
      }
      $f.$nu recolor $nuline black $col
      if { $tC(destroy) } {
        if { $tC(old) == $i } {
          $f.$nu replace $nuline Old
        } {
          $f.$nu replace $nuline ""
        }
      }
    } else {
      if { $nu == 0 } {
        incr nbf
        set f  $w.f${nbf}
        if { $oldPage == - 1  || ! [winfo exists $f] } {
          frame $f
          pack  $f -side top -anchor n
        }
      }
      if { $oldPage == -1 || ! [winfo exists $f.b${nb}] } {
        button $f.b${nb} -activebackground $col \
                         -background $col \
                         -height $tC(height) \
                         -width  $tC(width) \
                         -borderwidth 1 \
                         -command "set tC(curr) $i;\
                                   fglCfgAttrib 0 $col"
#                                   $w.cname configure -text \"$col\" \
#                                                -background \"$col\"
        pack $f.b${nb} -side left -anchor w
      } {
        $f.b${nb} configure -activebackground $col \
                         -background $col \
                         -command "set tC(curr) $i;\
                                   fglCfgAttrib 0 $col"
#                             $w.cname configure -text \"$tC(name,$i)\" \
#                                                -background \"$col\"
      }
      if { $tC(destroy) } {
        if { $tC(old) == $i } {
          $f.b${nb} configure -text "Old"
        } {
          $f.b${nb} configure -text ""
        }
      }
    }
    incr nb
  }

#  if { $oldPage == -1 || ! [winfo exists $w.cname] } {
#     catch {label $w.cname -text "$tC(colorname)" -background "$tC(colorhexa)" } msg
#     
#     catch {pack $w.cname -side top -anchor n }
#  }


  if { $fglgui == 4 } {
    set tkOrgButtons $oldTypeButton
  }
}


################################################################################
## proc fglCfgAttrib : Action after button-1 or db-button-1 in list of attributes
## Parameters :
##  type  : TRUE if cancel
##  colorhexa: new value
## Returnings :
##  none
################################################################################

proc fglCfgAttrib { type colorhexa } {

  global Default tC

  if { ! $tC(active) } {
    return
  }

  if { $type } {
    if { $type == 1 } {
      $tC(resource) setPub -int_value $tC(colorhexa)
    }
    set tC(active) 0
    if { $tC(destroy) } {
      catch {destroy $tC(wid)}
    } else {
      fglColorState disabled
    }
  } elseif { $colorhexa != "" } {
    $tC(resource) setPub -int_value $colorhexa
  }

#  $tC(widConf) refresh		;# it's too old now. The following is better.

				# 23.01.1997
  foreach wid [$tC(resource) get_hosts_rlist] {
     $wid refresh
  }

}