# This software is distributed under the Lesser General Public License
#
# widgets/colorbutton.tcl
#
# color button widget
#
#------------------------------------------ CVS
#
# CVS Headers -- The following headers are generated by the CVS
# version control system. Note that especially the attribute
# Author is not necessarily the author of the code.
#
# $Source: /home/br/CVS/graphlet/lib/graphscript/widgets/colorbutton.tcl,v $
# $Author: forster $
# $Revision: 1.6 $
# $Date: 1999/03/01 16:58:39 $
# $Locker:  $
# $State: Exp $
#
#------------------------------------------ CVS
#
# (C) University of Passau 1995-1999, Graphlet Project
#     Author: Michael Forster

package provide Colorbutton 1.0
package require Flatbutton

namespace eval ::Colorbutton {

    namespace export create

    image create bitmap ::Colorbutton::down -data {
	\#define _width 10
	\#define _height 12
	static unsigned char _bits[] = {
	    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
	    0xfe, 0x01, 0xfc, 0x00, 0x78, 0x00, 0x30, 0x00,
	    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
	};
    }

    Widget::create_type Colorbutton \
	-options {
 	    -variable		variable	Variable	{}
	} \
	-resources {
	    borderWidth			2
	    relief			sunken
	    highlightThickness		1
	    color.takeFocus		1
	    but.relief			raised
	    but.borderWidth		2
	    but.highlightThickness	0	       
	    but.takeFocus		0
	    but.image			::Colorbutton::down
	    but.menu.tearOff		0
	} \
	-forward_options {
	    frame {
		highlightbackground highlightthickness relief
	    }
	    but {
		state
	    }
	    { frame but } { bd borderwidth }
	} \
	-forward_commands {
	} \
	-commands {
	    open Colorbutton::open
	    close Colorbutton::close
	}
    
    variable predefined_colors
    set predefined_colors {
	\#0000ff \#00ff00 \#00ffff \#ff0000 \#ff00ff \#ffff00
	\#000099 \#009900 \#009999 \#990000 \#990099 \#999900
	\#000000 \#333333 \#666666 \#999999 \#cccccc \#ffffff
    }
    
    variable userdefined_colors 
    set userdefined_colors {
	\#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff
	\#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff
	\#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff
    }

    proc create { cb args } {

	# creation
	
	Widget::create Colorbutton $cb

	pack [button $cb.but] \
	    -side right \
	    -fill y -expand false

	pack [frame $cb.color] \
	    -side right \
	    -fill both -expand true

	# initialization
	
	eval Widget::init Colorbutton $cb $args

	# bindings
	
	trace var [$cb cget -variable] w \
	    [namespace code "ev_variable_changed $cb ;\#"]

	bind $cb.but <Button-1>	[namespace code "ev_Button-1 $cb"]

	return $cb
    }

    proc open { cb } {
	variable predefined_colors
	variable userdefined_colors
	variable ::GT::IS::_Options
	variable _Images

	# create widgets
	
	set bd [$cb cget -bd]
	
	set var [$cb cget -variable]
	set drop [toplevel $cb.drop -bd $bd -relief raised]

	set img_colors [GT::luniq [concat \
				       $predefined_colors \
				       $userdefined_colors \
				      ]]
	
	foreach color $img_colors {
	    set img [image create photo colorbutton/$color]
	    $img put black -to 0 0 16 16
	    $img put $color -to 1 1 15 15
	    lappend _Images($cb) $img
	}
	
	set count 0
	foreach colors { predefined_colors userdefined_colors } {
	    foreach color [set $colors] {

		set but $drop.c$count
		
		grid [Flatbutton::create $but \
			  -image colorbutton/$color \
			  -highlightthickness 0 \
			  -command "set $var $color; $cb close" \
			 ] \
		    -row [expr $count/6] \
		    -column [expr $count%6]

		incr count
	    }

	    grid [frame $drop.sep$colors \
		      -relief $_Options(sunken) \
		      -bd 1 -height 2 \
		     ] \
	    - - - - - -sticky nwse -pady 2

	    incr count 6
	}

	grid [Flatbutton::create $drop.other \
		  -text "Other..." \
		  -highlightthickness 0 \
		  -command [namespace code "color_selector $cb; $cb close"] \
		 ] \
	    - - - - - -sticky news

 	# dropdown geometry
	
 	set ht [$cb cget -highlightthickness]
 	set drop_bd [$drop cget -bd]
	
 	set w [expr 6*20 + 2*$drop_bd]

 	set x [expr [winfo rootx $cb] + [winfo width $cb] - $w - $ht]
 	set y [expr [winfo rooty $cb] - $ht + [winfo height $cb]]

	wm geometry $drop +${x}+${y}

 	# window manager settings
	
	wm overrideredirect $drop 1
	focus $drop
	update idletasks
	grab -global $drop

 	# bindings
	
  	bind $drop <ButtonPress>	[namespace code "ev_ButtonPress $cb %W"]
  	bind $drop <Key-Escape> 	[namespace code "close $cb; break"]
    }

    
    proc close { cb } {
	variable _Images

	foreach img $_Images($cb) {
	    image delete $img
	}
	
	destroy $cb.drop
    }
    
    proc ev_Button-1 { cb } {
	
	if [winfo exists $cb.drop] {
	    $cb close
	} elseif { [$cb cget -state] != "disabled" } {
	    $cb open
	}

	return -code break
    }
    
    proc ev_ButtonPress { cb W } {
	if { $W == "$cb.drop" } {
	    close $cb
	}
    }

    proc ev_variable_changed { cb } {

	upvar \#0 [$cb cget -variable] color

	if { $color == {} } {
	    $cb.color configure -bg [lindex [$cb.color configure -bg] 3]
	} else {
	    $cb.color configure -bg $color
	}
    }

    proc color_selector { cb } {

	upvar \#0 [$cb cget -variable] var
	
	set new_color [::GT::color_selector \
			   -default $var \
			   -parent $cb.drop \
			   -center parent \
			   -predefcolors [namespace current]::predefined_colors \
			   -usercolors [namespace current]::userdefined_colors \
		      ]

	if { $new_color != {} } {
	    set var $new_color
	}
    }
    
}

#---------------------------------------------------------------------------
#   Set emacs variables
#---------------------------------------------------------------------------
# ;;; Local Variables: ***
# ;;; mode: tcl ***
# ;;; tcl-indent-level: 4 ***
# ;;; End: ***
#---------------------------------------------------------------------------
#   end of file
#---------------------------------------------------------------------------
