Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

RGBgradient

by japhy (Canon)
on Mar 15, 2001 at 02:52 UTC ( [id://64535]=sourcecode: print w/replies, xml ) Need Help??
Category: HTML Utilities
Author/Contact Info Jeff japhy Pinyan
Description: Wrote this for work. Creates an iterator to return the next RGB code in a gradient.
# usage:
#   $iter = range(\@fromRGB, \@toRGB, \@weights, $size);

#   my $iter = range(
#     [0,0,0] => [255,255,255],
#     [ (1) x 100 ],
#     255
#   );
#   
#   while (my ($rgb_ref, $width) = $iter->()) { ... }

sub range {
  my ($from,$to,$w,$s) = @_;
  my $i = 0;
  my @steps = map +($to->[$_] - $from->[$_])/$#$w, 0..2;
  my $c = $from;
  my $f = 0;

  $i += $_ for @$w;

  # this (CRUFTILY) converts an array of floats
  # with a sum of X to an array of ints that still
  # has that same sum of X

  $w = [ map {
    my $v = $f + $s*$_/$i;
    $f = $v - int($v);
    int $v
  } @$w ];
  $w->[-1] += $f;

  sub {{
    my $ret = [ @$c ];
    return if !@$w;
    $c = [ map $steps[$_] + $c->[$_], 0..2 ];
    return ($ret, shift @$w) if $w->[0];
    shift @$w, redo;
  }};
}
Replies are listed 'Best First'.
Re: RGBgradient
by grinder (Bishop) on Mar 15, 2001 at 14:40 UTC

    I think you want to

    sub {{ my $ret = [ map {int} @$c ]; ...

    to stop returning floating point back to the caller. Makes for funny HTML otherwise.

    Update: Actually, you're rounding too early.
    $w = [ map { my $v = $f + $s*$_/$i; $f = $v - int($v); $v # not int $v } @$w ]; $w->[-1] += $f;

    The problem is that it works fine for linear gradients, but when you use non-linear gradients the round-off adds up and your iterator poops out before it gets to the end.

    Why would you want to use a non-linear gradient? Because the (in)?famous Netscape Color Cube(TM) is a terrible thing: it lends to much emphasis to highly saturated colors, and as a result there are too few colors to represent the many subtle hues the eye is capable of distinguishing.

    So what I attempted to do was to create a sinusoidal curve, peaking at 1 in the middle of the gradient and dropping to 0 at the ends. That's where I uncovered the int problem. Once I had my weight array the way I wanted it, I plugged it into the iterator, but for some reason that escapes me, I'm not seeing the behaviour I expect. The numbers should climb away quickly from first value in the interval move slowly around the midpoint, and then drop quickly down to the end value.

    It may be that I have completely misunderstood what the weights' purpose. Whatever, here's the code. No, I didn't use CGI, this is a quick hack, not production code.

    use constant PI => 4 * atan2(1,1); my $intervals = 40; my $iterlin = range( [ 0,255,255] => [ 0,255, 0], [(1) x $intervals], $intervals ); my $itersin = range( [ 0,255,255] => [ 0,255, 0], [ map {sin(($_/$intervals)*PI) } 0..$intervals], $intervals ); print qq{<html><head><title>Gradient</title></head> <body bgcolor="#ffffff"><table>\n}; while (my ($rgb_lin, $width) = $iterlin->()) { my ($rgb_sin, $widthsin) = $itersin->(); my $lin = join '', '#', map { sprintf '%02x',$_ } @$rgb_lin; my $sin = join '', '#', map { sprintf '%02x',$_ } @$rgb_sin; print qq{<tr> <td bgcolor="$lin"><tt>$$rgb_lin[0]</tt></td> <td bgcolor="$lin"><tt>$$rgb_lin[1]</tt></td> <td bgcolor="$lin"><tt>$$rgb_lin[2]</tt></td> <td bgcolor="$sin"><tt>$$rgb_sin[0]</tt></td> <td bgcolor="$sin"><tt>$$rgb_sin[1]</tt></td> <td bgcolor="$sin"><tt>$$rgb_sin[2]</tt></td> </tr>}; } print "</table></body></html>\n";

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://64535]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others romping around the Monastery: (2)
As of 2024-04-19 21:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found