# ibisa - Image-Based Identification/Search for Archaeology
# Copyright (C) 2008, 2009 Anthony Beurive'

# 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 3 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, see <http://www.gnu.org/licenses/>.
#----------------------------------------------------------------------

package provide color 1.0
package require Tk

# FIXME: just for random colors.
::tcl::mathfunc::srand 2

namespace eval ::color {
}

proc ::color::rgb {color args} {
    scan [winfo rgb . $color] "%d %d %d" r g b

    if {[llength $args] == 0} {
        return [format "#%04x%04x%04x" $r $g $b]
    }

    set rvar [lindex $args 0]
    set gvar [lindex $args 1]
    set bvar [lindex $args 2]

    uplevel [subst {
        set $rvar $r
        set $gvar $g
        set $bvar $b
    }]
}

proc ::color::random {} {
    format #%06x [expr {int(rand() * 0xFFFFFF)}]
}

proc ::color::reverse {color} {
    rgb $color r g b
    set r [expr 65535 - $r]
    set g [expr 65535 - $g]
    set b [expr 65535 - $b]
    return [format "#%04x%04x%04x" $r $g $b]
}

proc ::color::closer {color1 color2 {factor 0.25}} {
    rgb $color1 r1 g1 b1
    rgb $color2 r2 g2 b2
    set r [expr round($r1 + ($r2 - $r1) * $factor)]
    set g [expr round($g1 + ($g2 - $g1) * $factor)]
    set b [expr round($b1 + ($b2 - $b1) * $factor)]
    return [format "#%04x%04x%04x" $r $g $b]
}

proc ::color::further {color1 color2 {factor 0.25}} {
    return [closer $color1 [reverse $color2] $factor]
}

proc ::color::darker {color {factor 0.25}} {
    return [closer $color black $factor]
}

proc ::color::brighter {color {factor 0.25}} {
    return [closer $color white $factor]
}

