source: subversion/applications/rendering/tah-heatmap/heatmap-rgb-value.pl @ 34483

Last change on this file since 34483 was 18502, checked in by avar, 10 years ago

Commit test stuff I had in my local SVN

File size: 1.4 KB
RevLine 
[15441]1#!/usr/bin/env perl
2use feature ':5.10';
3use strict;
4use warnings;
5
6my ($arg, $max) = @ARGV;
7if (-f $arg) {
8    open my $fh, "<", $arg or die "Can't open file `$arg': $!";
9    while (<$fh>)
10    {
11        chomp;
12        say rgb_str($max ? ($_ / $max) : $_);
13    }
14} else {
[15449]15    say rgb_str($max ? ($arg / $max) : $arg);
[15441]16}
17
18sub rgb_str
19{
[18502]20    "rgb(" . join(',', heatmap(warp_size_for_heatmap(shift))) . ")";
[15441]21}
22
[18502]23sub warp_size_for_heatmap
24{
25    my $size = shift;
26
27    # FIXME: This results in a very lousy distribution, the map is all
28    # blue
29    my $n = log $size / log $max;
30#    my $n = (log($size)/log(10)) / (log($max)/log(10));
31    #my $n = (($size-$min+1) / $max)**0.2;
32    #my $n = $size / (227879*32);
33
34    return $n;
35}
36
[15441]37# From http://google.com/codesearch/p?hl=en#v85D9_xn8lk/viewcvs.py/gmod/graphbrowse/cgi/graphbrowse%3Frev%3D1.10&q=heat map rgb lang:perl
38sub heatmap {
39    my($v)=@_;
40
41    die "Heatmap input out of range: $v" if $v < 0 || $v > 1;
42
43    my @rgb;
44
45    for my $offset (-0.25,0,0.25) {
46        my $x = $v + $offset;
47        my $y;
48        if ($x <= .125) {
49            $y = 0;
50        } elsif ($x <= .375) {
51            $y = ($x-.125)/.25;
52        } elsif ($x <= .625) {
53            $y = 1;
54        } elsif ($x <= .875) {
55            $y = (.875 - $x )/.25;
56        } else {
57            $y = 0;
58        }
59        push @rgb => $y * 255;
60    }
61    map { int } @rgb;
62}
Note: See TracBrowser for help on using the repository browser.