#!/usr/bin/perl -w use Tk; use strict; require "./color_model"; my ($main, $pi2); $main = MainWindow->new(); $main->{l} = $main->Label(-width=>20, -height=>10); $main->{l}->pack(-fill=>"both"); $main->{l}->bind("", [\&OnMotion, Ev('x'), Ev('y')]); $main->{l}->bind("", ["configure", -bg=>"black"]); $main->{l}->bind("", \&ShowOff); $main->{l}->focus; $pi2 = atan2(1, 0) * 4; MainLoop(); #================================================================= sub OnMotion { my ($w, $x, $y) = @_; $x = $x/$w->width*2 - 1; $y = 1 - $y/$w->height*2; my ($th) = atan2($y, $x) / $pi2; $th += 1 if $th < 0; my ($r) = sqrt($x*$x + $y*$y); $r = 1 if $r > 1; $w->configure(-bg=>sprintf("#%02x%02x%02x", &HSBtoRGB($th, $r, 255))); } sub ShowOff { my ($w) = @_; my ($n) = 24; for (my $i=0; $i<$n; ++$i) { $w->configure(-bg=>sprintf("#%02x%02x%02x", &HSBtoRGB($i/$n, 1, 255))); $w->idletasks; $w->after(50); } }