color4.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:27 2010 from color4.pl 2007/02/14 7.6 KB.

#!/perl -w
#  *NAME* color4.pl
# AIM: To take an X,Y, and convert to a color ...
###use strict;
use warnings;
use Math::Trig;
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $outfile = 'temp.'.$0.'.txt';
open_log($outfile);
prt( "$0 ... Hello, World ...\n" );
my $htmfile = 'temp.'.$0.'.htm';
my $writehtm = 1;
# debug
my $dbg1 = 0;   # debug output from mousMoved function
my $dbg2 = 0;   # debug output from rgb2hex function
my $dbg3 = 0;   # debug output from hsv2rgb function
my $dbg4 = 0;   # debug output from end of hsv2rgb function
my $maxy = 256;
my $maxx = 256;
my $step = 2;
my $xwid = 14;
my $yhgt = 14;
my @threec = (1,2,3);
my @cr = mouseMoved( 100, 100 );
my $cnt = scalar @cr;
prt( "Got count $cnt ... $cr[3] ...\n" );
@cr = mouseMoved( 128, 168 );
$cnt = scalar @cr;
prt( "Got count $cnt ... $cr[3] ...\n" );
@cr = mouseMoved( 129, 168 );
$cnt = scalar @cr;
prt( "Got count $cnt ... $cr[3] ...\n" );
###hexColorArray(\@cr);
my $wh = " width=\"$xwid\" height=\"$yhgt\" ";
if ($writehtm) {
   my ($HF, $msg, $clr, $psn);
   open $HF, ">$htmfile" or mydie( "ERROR: Unable to open $htmfile ...\n" );
   html_begin($HF);
   my $hdr = "Generate grid - $maxx x $maxy, step $step";
   prt( "$hdr ...\n" );
   print $HF "<hr>\n";
   print $HF "<h1>$hdr</h1>\n";
   print $HF "<table border=\"0\" cellpadding=\"0\" cellspacing=\"0\" summary=\"$hdr\">\n";
   my ($x, $y);
   for ($y = 0; $y <= $maxy; $y += $step) {
      print $HF "<tr>\n";
      for ($x = 0; $x <= $maxx; $x += $step) {
         @cr = mouseMoved( $x, $y );
         $clr = $cr[3];
         $psn = sprintf("%3d,%3d ", $x, $y);
         ##$msg = "<td bgcolor=\"$clr\">$psn</td>\n";
         if ($clr ne "#FFFFFF") {
            #$msg = "<td bgcolor=\"#666666\">.</td>\n";
            $msg = "<td $wh bgcolor=\"$clr\">.</td>\n";
         } else {
            $msg = "<td $wh>x</td>";
         }
         print $HF $msg;
         # check extreems are ALL WHITE
         if (($x == 0)||($x == 256)) {
            if ($clr ne "#FFFFFF") {
               prt( $msg );
            }
         }
      }
      print $HF "</tr>\n";
   }
   print $HF "</table>\n";
   html_end($HF);
   close $HF;
   system( $htmfile );
}
close_log($outfile,1);
exit(0);
sub html_begin {
   my ($f) = shift;
   print $f <<"EOF";
<html>
<head>
<title>$htmfile</title>
<style type="text/css">
<!-- /* Style Definitions */
body {
margin:1cm 1cm 1cm 1cm;
}
p {
margin:0cm;
padding:0cm
}
-->
</style>
</head>
<body>
<h1>$htmfile</h1>
EOF
}
sub html_end {
   my ($f) = shift;
   print $f <<"EOF";
</body>
</html>
EOF
}
# function webRounder(c,d) {//d is the divisor
sub webRounder {   # (c,d) {//d is the divisor
   my ($c, $d) = @_;   #//safe divisor is 51, smart divisor is 17 
   my $thec = "#";
   my $max = 3;
   my $cnt = scalar @{$c};
   prt( "Count in array reference = $cnt ...\n" );
   if ($cnt < $max) {
      $max = $cnt;
   }
   for (my $i = 0; $i < $max; $i++) {
      my $num = round( ${$c}[$i+4] / $d) * $d; #//use saved rgb value
      my $numc = "$num";
      if ( length($numc) < 2) {
         $numc = "0" . $numc;
      }
      $thec .= $numc;
   }
   return $thec;
}
# function hexColorArray(c) { //now takes string hex value with #
sub hexColorArray {
   my ($c) = shift;   #//now takes string hex value with #
   my $rgb = ${$c}[3];
   $threec[2] = $rgb;
   prt( "RGB value [$rgb] ...\n" );
    $threec[1] = webRounder(\@{$c},17);
    $threec[0] = webRounder(\@{$c},51);
}
sub rgb2hex {   # (rgbary) {
   my ($ar) = shift;
   my @cary = ();   # new Array;
   my ($i, $j);
   for ($j = 0; $j < 7; $j++) {
      push(@cary, $j);
   }
   $cary[3] = "#";
   for ($i = 0; $i < 3; $i++) {
      my $val = ${$ar}[$i];
      $cary[$i] = uc(sprintf("%2.2x", $val));   # parseInt(rgbary[i]).toString(16);
      if ( length($cary[$i]) < 2 ) {
         $cary[$i] = "0" . $cary[$i];
      }
      $cary[3] .= $cary[$i];
      $cary[ $i + 4 ] = $val; # ${$ar}[$i]; #//save dec values for later
   }
   # // function returns hex color as an array of three two-digit strings
   # // plus the full hex color and original decimal values
   if ($dbg2) {
      prt( "Got " );
      foreach my $v (@cary) {
         prt( "[$v] " );
      }
      prt( " in color array ...\n" );
   }
   return @cary;
}
#// HSV conversion algorithm adapted from easyrgb.com
sub hsv2rgb {
   my ($Hdeg, $S, $V) = @_;
   prt( "hsv2rgb: Hdeg = $Hdeg, sat = $S, val = $V ...\n" ) if ($dbg3);
   my ($R, $G, $B, $var_r, $var_g, $var_b, $i);
   my $H = $Hdeg/360;   #// convert from degrees to 0 to 1
   if ($S == 0) {   #// HSV values = From 0 to 1
      $R = $V * 255; #// RGB results = From 0 to 255
      $G = $V * 255;
      $B = $V * 255;
   } else {
      my $var_h = $H * 6;
      my $var_i = int( $var_h ); #//Or ... var_i = floor( var_h )
      my $var_1 = $V * (1 - $S);
      my $var_2 = $V * (1 - $S * ($var_h - $var_i));
      my $var_3 = $V * (1 - $S * (1 - ($var_h-$var_i) ) );
      if ($var_i == 0 ) {
         $var_r = $V;
         $var_g = $var_3;
         $var_b = $var_1;
      } elsif ($var_i == 1 ) {
         $var_r = $var_2;
         $var_g = $V;
         $var_b = $var_1;
      } elsif ($var_i == 2 ) {
         $var_r = $var_1;
         $var_g = $V;
         $var_b = $var_3;
      } elsif ($var_i == 3 ) {
         $var_r = $var_1;
         $var_g = $var_2;
         $var_b = $V;
      } elsif ($var_i == 4 ) {
         $var_r = $var_3;
         $var_g = $var_1;
         $var_b = $V;
      } else {
         $var_r = $V;
         $var_g = $var_1;
         $var_b = $var_2;
      }
      $R = round($var_r * 255); #//RGB results = From 0 to 255
      $G = round($var_g * 255);
      $B = round($var_b * 255);
   }
   my @arr = ();
   push(@arr,$R);
   push(@arr,$G);
   push(@arr,$B);
   return @arr;
}
sub mouseMoved {
   my ($x, $y) = @_;
   prt( "$x,$y " ) if ($dbg1);
   my @rgb = ();
   if ($x >= 296) {
      prt( "out of range!\n" ) if ($dbg1);
      @rgb = (0,0,0);
      return rgb2hex(\@rgb);
   }
   if ($y > 256) {
      prt( "out of range!\n" ) if ($dbg1);
      @rgb = (0,0,0);
      return rgb2hex(\@rgb);
   }
   my ($i);
   my ($sat, $val);
   my $cartx = $x - 128;
    my $carty = 128 - $y;
    my $cartx2 = $cartx * $cartx;
    my $carty2 = $carty * $carty;
   my $cartxs = ($cartx < 0)?-1:1;
    my $cartys = ($carty < 0)?-1:1;
    my $cartxn = $cartx/128;            #//normalize x
    my $rraw = sqrt($cartx2 + $carty2); #//raw radius
    my $rnorm = $rraw/128;              #//normalized radius
    if ($rraw == 0) {
      $sat = 0;
      $val = 0;
      @rgb = (0,0,0);
      #for ($i = 0; $i < 3; $i++) {
      #   push(@rgb, 0);
      #}
      prt( "hypotenuse is ZERO = #000000\n" ) if ($dbg1);
   } else {
      my $arad = acos($cartx/$rraw);  #//angle in radians 
        my $aradc = ($carty >= 0) ? $arad : (2 * pi) - $arad; #//correct below axis
        my $adeg = 360 * $aradc / (2 * pi); #//convert to degrees
      if ($rnorm > 1) {    #// outside circle
            $sat = 1;
            $val = 1;
         @rgb = (255,255,255);
         #for ($i = 0; $i < 3; $i++) {
         #   push(@rgb, 255);
         #}
         prt( "outside circle = #FFFFFF\n" ) if ($dbg1);
      } elsif ($rnorm >= 0.5) {
         #//else rgb = hsv2rgb(adeg,1,1);
         $sat = 1 - (($rnorm - 0.5) * 2 );
            $val = 1;
         prt( "rnorm >= 0.5 = hsv2rgb($adeg,$sat,$val)\n" ) if ($dbg1);
         @rgb = hsv2rgb($adeg,$sat,$val);
       } else {
         $sat = 1;
            $val = $rnorm * 2;
         prt( "else = hsv2rgb($adeg,$sat,$val)\n" ) if ($dbg1);
            @rgb = hsv2rgb($adeg,$sat,$val);
      }
   }
   if ($dbg4) {
      my $clr = "#";
      my $msg = "$x,$y = rgb ";
      foreach my $n (@rgb) {
         $msg .= "[$n] ";
         $clr .= uc(sprintf("%2.2x", $n));
      }
      $msg .= " $clr";
      if ($clr ne "#FFFFFF") {
         prt( "$msg\n" );
      }
   }
   my @c = rgb2hex(\@rgb);
   #hexColorArray(\@c);
   return @c;
}
sub floor { ($_[0]<0) ? -int -$_[0]+1 : int $_[0] } 
sub ceil { ($_[0]<0) ?  -int -$_[0] : int $_[0]+1 } 
sub round { ($_[0]>0) ?  int $_[0]+0.5 : int $_[0]-0.5 } 
# eof

index -|- top

checked by tidy  Valid HTML 4.01 Transitional