### Copyright (C) 1995-1997 Jesper K. Pedersen
### This program is free software; you can redistribute it and/or modify
### it under the terms of the GNU General Public License as published by
### the Free Software Foundation; either version 2 of the License, or
### (at your option) any later version.
###
### This program is distributed in the hope that it will be useful,
### but WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
### GNU General Public License for more details.
###
### You should have received a copy of the GNU General Public License
### along with this program; if not, write to the Free Software
### Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

set __colorSet 0

######################################################################
# This function create a color scale window.
# The arguments are as follows:
# rgbList      : a list of list with four elements: the
#                color name the r,g,b values.
# defaultColor : the default color with a format as: #FF0FAA, or as
#                a name from the rgbList.
# greyScaled   : a boolean which indicate wether the
#                element only shall display grey scaled colors
# The function will first return when the window disapear.
# The return value is a list were the first argument is a color, and the
# second determine wether the color should be edited in greyscaled.
# Iff a value is selected in the listbox, the name will be returned
# otherwise the RGB value will be returned.
# Iff the cancel button is pressed, the value given as argument will
# be returned.
######################################################################
proc ColorWidget {rgbList defaultColor greyScaled} {
  global __greyscaled __colorMap __result __language
  set labels "$__language(color,1) $__language(color,2) $__language(color,3)"
  set __result ""
  toplevel .scale
  grabSet .scale

  ### calculate the defaultColor
  if {[regexp {\#([0-9ABCDEF][0-9ABCDEF])([0-9ABCDEF][0-9ABCDEF])([0-9ABCDEF][0-9ABCDEF])$} $defaultColor all r g b] } {
    set rgb [list [htoi $r] [htoi $g] [htoi $b]]
  } else {
    set defaultColor [string tolower $defaultColor]
    set defaultColorIndex 0
    set found 0
    foreach color $rgbList {
      if {[lindex $color 0] == $defaultColor} {
        set rgb [lindex $color 1]
        set found 1
        break
      }
      incr defaultColorIndex
    }
    ### This should only happend if a system save file says something about
    ### a font, which isn't installed on the system
    if {!$found} {
      set defaultColorIndex 0
      set rgb [lindex [lindex $rgbList 0] 1]
    }
  }

  ### The test label with the actual color
  ### The double frame is needed otherwise the border will flicker
  pack [frame .scale.frame -bd 4 -relief sunken] -pady 10
  frame .scale.frame.test -width 300 -height 100
  pack  .scale.frame.test
  bind .scale.frame.test <1> testClosestColor
  
  ### seperator line
  frame .scale.line1 -height 0.1c -relief sunken -bd 1
  pack .scale.line1 -fill x -expand 1 -pady 20
  
  ### Creating the scales
  for {set i 0} {$i < 3} {incr i} {
    pack [frame .scale.$i]
    label .scale.$i.label -text "[lindex $labels $i]:\t"
    scale .scale.$i.scale -from 0 -to 255 -orient horizontal -length 10c \
        -command setColor
    pack .scale.$i.label .scale.$i.scale -side left -anchor s
    .scale.$i.scale set [lindex $rgb $i]
  }

  ### Seperator line
  frame .scale.line2 -height 0.1c -relief sunken -bd 1
  pack .scale.line2 -fill x -expand 1 -pady 20

  ### The grey scale check button
  checkbutton .scale.grey -text "Grey scaled" -variable __greyscaled \
      -command {
        if {$__greyscaled} {
          bindtags .scale.lb.box None
          bindtags .scale.lb.scroll None
          .scale.lb.box configure -foreground grey -selectforeground black \
            -selectbackground white
        } else {
          bindtags .scale.lb.box {Listbox .scale.lb.box .}
          bindtags .scale.lb.scroll {Scrollbar .scale.lb.scroll}
          .scale.lb.box configure -foreground black -selectforeground white \
              -selectbackground black
        }
      }
  pack .scale.grey -anchor w

  ### The listbox for the colors
  pack [frame .scale.lb]
  listbox .scale.lb.box -yscrollcommand ".scale.lb.scroll set" -width 45
  scrollbar .scale.lb.scroll -command ".scale.lb.box yview"
  pack .scale.lb.box .scale.lb.scroll -side left -fill y

  ### inserting elements into the listbox
  set __colorMap $rgbList
  foreach color $rgbList {
    set name [lindex $color 0]
    .scale.lb.box insert end $name
  }
  
  ### setting the defaults
  set __greyscaled $greyScaled
  if {[info exists defaultColorIndex]} {
    update
    .scale.lb.box selection set $defaultColorIndex
    .scale.lb.box yview $defaultColorIndex
  }

  ### binding the scroll commands
  bind .scale.lb.box <1> {
    setColorAtPos [.scale.lb.box nearest %y]
  }
  bind .scale.lb.box <B1-Motion> {
    setColorAtPos [.scale.lb.box nearest %y]
  }

  ### The buttons
  pack [frame .scale.buttons]  -fill x
  button .scale.buttons.ok -text OK -command colorOk
  button .scale.buttons.cancel -text CANCEL -command colorCancel
  pack .scale.buttons.ok .scale.buttons.cancel -padx 5 -side left

  ### wait until the ok or cancel button has been presed.
  tkwait window .scale
  if {$__result == ""} {
    return [list $defaultColor $greyScaled]
  } else {
    return [list $__result $__greyscaled]
  }
}
######################################################################
# This function is called when the ok button is pressed
######################################################################
proc colorOk {} {
  global __result __colorMap
  if {[.scale.lb.box curselection] != ""} {
    set __result [lindex [lindex $__colorMap [.scale.lb.box curselection]] 0]
  } else {
    set r [itoh [.scale.0.scale get]]
    set g [itoh [.scale.1.scale get]]
    set b [itoh [.scale.2.scale get]]
    set __result "\#$r$g$b"
  }
  grab release .scale
  destroy .scale
}
######################################################################
# This function is called when the cancel button is pressed
######################################################################
proc colorCancel {} {
  global __result
  grab release .scale
  set __result ""
  destroy .scale
}
######################################################################
# This function set the color to the color of the element in the
# listbox at index 'index'. It furher more updates the scales.
# This function is called when an element is selected in the listbox
######################################################################
proc setColorAtPos {index} {
  global __colorMap __colorSet
  set elm [lindex $__colorMap $index]
  set rgb [lindex $elm 1]
  set r [lindex $rgb 0]
  set g [lindex $rgb 1]
  set b [lindex $rgb 2]
  set __colorSet 1
  .scale.0.scale set $r
  .scale.1.scale set $g
  .scale.2.scale set $b
  .scale.frame.test configure -bg "#[itoh $r][itoh $g][itoh $b]"
  update idletasks
  set __colorSet 0
}
######################################################################
# This function set the color to the color of the scales
# iff the greyscaled options isn't set. Iff it's set, the scales
# and the palete is set to the color of rgb='index,index,index'
######################################################################
proc setColor {index} {
  global __greyscaled __colorSet
  if {$__colorSet} {
    return
  }
  if {$__greyscaled} {
    .scale.frame.test configure \
        -bg "#[itoh $index][itoh $index][itoh $index]"
    for {set i 0} {$i < 3} {incr i} {
      .scale.$i.scale set $index
    }
  } else {
    set r [itoh [.scale.0.scale get]]
    set g [itoh [.scale.1.scale get]]
    set b [itoh [.scale.2.scale get]]
    .scale.frame.test configure -bg "#$r$g$b"
  }
  .scale.lb.box  selection clear 0 end
}
######################################################################
# This function converts the output from the showrgb program to
# a list which can be use by the color widget
######################################################################
proc showRgb2list {} {
  global setup
  set path [auto_execok showrgb]
  if {$path != 0 && $path != ""} {
    set names {}
    set lines [split [exec showrgb] "\n"]
    foreach line $lines {
      set r [lindex $line 0]
      set g [lindex $line 1]
      set b [lindex $line 2]
      set name [string tolower [lrange $line 3 end]]
      set color($name) [list $r $g $b]
    }

    set colors [lsort [array names color]]
    foreach name $colors {
      lappend names [list $name $color($name)]
    }
    return $names
  } else {
    return ""
  }
}
######################################################################
# This function compares two string case insensitive.
# OBSOLETE!
######################################################################
proc caseInsensitiveMatch {string1 string2} {
  set length1 [string length $string1]
  set length2 [string length $string2]
  if {$length1 < $length2} {
    set min $length1
  } else {
    set min $length2
  }

  for {set i 0} {$i < $min} {incr i} {
    set c1 [string index $string1 $i]
    set c2 [string index $string2 $i]
    if {[charLess $c1 $c2]} {
      return -1
    }
    if {[charLess $c2 $c1]} {
      return 1
    }
  }
  if {$length1 < $length2} {
    return -1
  }
  if {$length1 > $length2} {
    return 1
  }
  return 0
}
######################################################################
# This function compares two letters case insensitice
######################################################################
proc charLess {c1 c2} {
  set chars "aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ"
  set i1 [string first $c1 $chars ]
  set i2 [string first $c2 $chars]
  return [expr $i1 < $i2]
}

######################################################################
# This function return the color name which is closest to a given
# rgb value
######################################################################
proc findClosestColor {rgb {colorList "NONE"}} {
  if {![regexp {\#([0-9ABCDEF][0-9ABCDEF])([0-9ABCDEF][0-9ABCDEF])([0-9ABCDEF][0-9ABCDEF])$} $rgb all rh gh bh]} {
    error "Internal error: $rgb didn't match pattern"
  }
  
  set r [htoi $rh]
  set g [htoi $gh]
  set b [htoi $bh]
  
  global __colorMap __closestColor
  set minDist 200000
  set minName ""
  set index 0
  set minIndex 0
  if {$colorList == "NONE"} {
    set colorMap $__colorMap
  } else {
    set colorMap $colorList
  }
   
  
  foreach color $colorMap {
    set name [lindex $color 0]
    set _r [lindex [lindex $color 1] 0]
    set _g [lindex [lindex $color 1] 1]
    set _b [lindex [lindex $color 1] 2]
    set dr [expr $r - $_r]
    set dg [expr $g - $_g]
    set db [expr $b - $_b]
    set dist [expr $dr * $dr + $dg * $dg + $db * $db]
    if {$dist < $minDist} {
      set minDist $dist
      set minName $name
      set r_ $_r
      set g_ $_g
      set b_ $_b
      set minIndex $index
    }
    incr index
  }
  set __closestColor [list $minIndex $r_ $g_ $b_]
  return $minName
}

######################################################################
# This function search for the closes color to the one selected with
# the scales. When it has found one, the element in the listbox
# is selected
######################################################################
proc testClosestColor {} {
  global __closestColor __origColor __colorSet

  set current_r [.scale.0.scale get]
  set current_g [.scale.1.scale get]
  set current_b [.scale.2.scale get]
  set __colorSet 1
  if {[info exists __closestColor]} {
    set closest_index [lindex $__closestColor 0]
    set closest_r [lindex $__closestColor 1]
    set closest_g [lindex $__closestColor 2]
    set closest_b [lindex $__closestColor 3]
    
    set orig_r [lindex $__origColor 0]
    set orig_g [lindex $__origColor 1]
    set orig_b [lindex $__origColor 2]

    if {$current_r == $orig_r &&
              $current_g == $orig_g &&
              $current_b == $orig_b} {
      .scale.0.scale set $closest_r
      .scale.1.scale set $closest_g
      .scale.2.scale set $closest_b
      .scale.frame.test configure \
          -bg "#[itoh $closest_r][itoh $closest_g][itoh $closest_b]"
      .scale.lb.box selection set $closest_index
      .scale.lb.box yview $closest_index
    } elseif {$current_r == $closest_r &&
        $current_g == $closest_g &&
        $current_b == $closest_b} {
      .scale.0.scale set $orig_r
      .scale.1.scale set $orig_g
      .scale.2.scale set $orig_b
      .scale.frame.test configure \
          -bg "#[itoh $orig_r][itoh $orig_g][itoh $orig_b]"
      .scale.lb.box  selection clear 0 end
    } else {
      findClosestColor "\#[itoh $current_r][itoh $current_g][itoh $current_b]"
      set __origColor [list $current_r $current_g $current_b]
      .scale.0.scale set [lindex $__closestColor 1]
      .scale.1.scale set [lindex $__closestColor 2]
      .scale.2.scale set [lindex $__closestColor 3]
      .scale.frame.test configure \
          -bg "#[itoh $current_r][itoh $current_g][itoh $current_b]"
      .scale.lb.box selection set [lindex $__closestColor 0]
      .scale.lb.box yview [lindex $__closestColor 0]
    }
  } else {
    findClosestColor "\#[itoh $current_r][itoh $current_g][itoh $current_b]"
    set __origColor [list $current_r $current_g $current_b]
    .scale.0.scale set [lindex $__closestColor 1]
    .scale.1.scale set [lindex $__closestColor 2]
    .scale.2.scale set [lindex $__closestColor 3]
    .scale.frame.test configure \
        -bg \#[itoh [lindex $__closestColor 1]][itoh [lindex $__closestColor 2]][itoh [lindex $__closestColor 3]]
    .scale.lb.box selection set [lindex $__closestColor 0]
    .scale.lb.box yview [lindex $__closestColor 0]
  }
  update
  set __colorSet 0
}