#! /usr/bin/wish
#
# tclgamma.tcl - TCL/TK -interface for adjusting gamma under XFree86 with xgamma
# Copyleft 2002-2003 Tommi Saviranta <tsaviran@cs.helsinki.fi>
#
# 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., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
#
# Version: tclgamma.tcl v0.1.3  18-May-2003  tsaviran@cs.helsinki.fi


global rg
global bg
global gg

set rg 1.4; set bg 1.4; set gg 1.4;

set gamma [open "| ./wrap.sh" r]
set gammadata [read $gamma]
close $gamma
scan $gammadata "%s %s %f, %s %f, %s %f" u0 u1 rg u2 gg u3 bg


proc init {} {
	global rg gg bg

	wm title . "tcl/tk gamma 2.0"

	set gammarpic [image create photo -file red.ppm]
	set gammagpic [image create photo -file green.ppm]
	set gammabpic [image create photo -file blue.ppm]
	set gammatpic [image create photo -file grey.ppm]

	frame .gamma

	frame .gamma.red
	frame .gamma.red.up
	label .gamma.red.up.pic -image $gammarpic
	scrollbar .gamma.red.up.bar -command "red"
	Rset $rg
	pack .gamma.red.up.bar -fill y -side right
	pack .gamma.red.up.pic -side left
	pack .gamma.red.up -side top
	
	frame .gamma.red.down
	label .gamma.red.down.lab -text "r:"
	entry .gamma.red.down.ent -relief sunken -width 5 -textvariable rg
	pack .gamma.red.down.ent -side right
	pack .gamma.red.down -side bottom

	frame .gamma.green
	frame .gamma.green.up
	label .gamma.green.up.pic -image $gammagpic
	scrollbar .gamma.green.up.bar -command "green"
	Gset $gg
	pack .gamma.green.up.bar -fill y -side right
	pack .gamma.green.up.pic -side left
	pack .gamma.green.up -side top
	
	frame .gamma.green.down
	label .gamma.green.down.lab -text "r:"
	entry .gamma.green.down.ent -relief sunken -width 5 -textvariable gg
	pack .gamma.green.down.ent -side right
	pack .gamma.green.down -side bottom

	frame .gamma.blue
	frame .gamma.blue.up
	label .gamma.blue.up.pic -image $gammabpic
	scrollbar .gamma.blue.up.bar -command "blue"
	Bset $bg
	pack .gamma.blue.up.bar -fill y -side right
	pack .gamma.blue.up.pic -side left
	pack .gamma.blue.up -side top
	
	frame .gamma.blue.down
	label .gamma.blue.down.lab -text "r:"
	entry .gamma.blue.down.ent -relief sunken -width 5 -textvariable bg
	pack .gamma.blue.down.ent -side right
	pack .gamma.blue.down -side bottom

	frame .gamma.grey
	frame .gamma.grey.up
	label .gamma.grey.up.pic -image $gammatpic
	pack .gamma.grey.up.pic -side left
	pack .gamma.grey.up -side top

	frame .gamma.grey.down
	button .gamma.grey.down.but -text "Quit" -command { destroy . }
	pack .gamma.grey.down.but
	pack .gamma.grey.down -side bottom
	
	pack .gamma.red .gamma.green .gamma.blue .gamma.grey -side left
	pack .gamma
}



# Red component
proc red {args} {
	eval R$args
}

proc Rmoveto {fraction} {
	global rg
	set rel [ expr 3.85 - ($fraction * 3.9 + 0.1) ]
	Rset $rel
}

proc Rscroll {n units} {
	global rg
	Rset [ expr $rg - $n / 50.0 ]
}

proc Rset {newval} {
	global rg
	if {$newval < 0.1} {set newval 0.1} elseif {$newval > 10.0} {set newval 10.0}
	set rg $newval
	set f0 [ expr 0.9 - ($newval - 0.1) / 3.9 ]
	.gamma.red.up.bar set [ expr $f0 ] [ expr $f0 + 0.10]
	exec xgamma -q -rgamma $newval
}

# Green component
proc green {args} {
	eval G$args
}

proc Gmoveto {fraction} {
	global gg
	set rel [ expr 3.85 - ($fraction * 3.9 + 0.1) ]
	Gset $rel
}

proc Gscroll {n units} {
	global gg
	Gset [ expr $gg - $n / 50.0 ]
}

proc Gset {newval} {
	global gg
	if {$newval < 0.1} {set newval 0.1} elseif {$newval > 10.0} {set newval 10.0}
	set gg $newval
	set f0 [ expr 0.9 - ($newval - 0.1) / 3.9 ]
	.gamma.green.up.bar set [ expr $f0 ] [ expr $f0 + 0.10]
	exec xgamma -q -ggamma $newval
}


# Blue component
proc blue {args} {
	eval B$args
}

proc Bmoveto {fraction} {
	global bg
	set rel [ expr 3.85 - ($fraction * 3.9 + 0.1) ]
	Bset $rel
}

proc Bscroll {n units} {
	global bg
	Bset [ expr $bg - $n / 50.0 ]
}

proc Bset {newval} {
	global bg
	if {$newval < 0.1} {set newval 0.1} elseif {$newval > 10.0} {set newval 10.0}
	set bg $newval
	set f0 [ expr 0.9 - ($newval - 0.1) / 3.9 ]
	.gamma.blue.up.bar set [ expr $f0 ] [ expr $f0 + 0.10]
	exec xgamma -q -bgamma $newval
}

init