git.sesse.net Git - nms/blob - web/mygraph.pl

   1 #! /usr/bin/perl -T
   2 use strict;
   3 use warnings;
   4 use GD;
   5 use POSIX;
   6 use Time::Zone;
   7
   8 sub blendpx {
   9         my ($gd, $x, $y, $r, $g, $b, $frac) = @_;
  10         my ($ro, $go, $bo) = $gd->rgb($gd->getPixel($x, $y));
  11
  12         # workaround for icky 256-color graphs
  13         $frac = int($frac * 32) / 32;
  14
  15         my $rn = $ro * (1.0 - $frac) + $r * $frac;
  16         my $gn = $go * (1.0 - $frac) + $g * $frac;
  17         my $bn = $bo * (1.0 - $frac) + $b * $frac;
  18
  19         $gd->setPixel($x, $y, $gd->colorResolve($rn, $gn, $bn));
  20 }
  21
  22 # Standard implementation of Wu's antialiased line algorithm.
  23 sub wuline {
  24         my ($gd, $x1, $y1, $x2, $y2, $r, $g, $b, $a) = @_;
  25         $x1 = POSIX::floor($x1);
  26         $x2 = POSIX::floor($x2);
  27         $y1 = POSIX::floor($y1);
  28         $y2 = POSIX::floor($y2);
  29
  30         if (abs($x2 - $x1) > abs($y2 - $y1)) {
  31                 # x-directional
  32                 if ($y2 < $y1) {
  33                         ($x2, $y2, $x1, $y1) = ($x1, $y1, $x2, $y2);
  34                 }
  35
  36                 my $y = POSIX::floor($y1);
  37                 my $frac = $y1 - $y;
  38                 my $dx = ($x2 > $x1) ? 1 : -1;
  39                 my $dy = ($y2 - $y1) / abs($x2 - $x1);
  40
  41                 for (my $x = $x1; $x != $x2 + $dx; $x += $dx) {
  42                         blendpx($gd, $x, $y, $r, $g, $b, $a * (1.0 - $frac));
  43                         blendpx($gd, $x, $y + 1, $r, $g, $b, $a * $frac);
  44                         $frac += $dy;
  45                         if ($frac > 1) {
  46                                 $frac -= 1;
  47                                 ++$y;
  48                         }
  49                 }
  50         } else {
  51                 # y-directional
  52                 if ($x2 < $x1) {
  53                         ($x2, $y2, $x1, $y1) = ($x1, $y1, $x2, $y2);
  54                 }
  55                 my $x = POSIX::floor($x1);
  56                 my $frac = $x1 - $x;
  57                 my $dy = ($y2 > $y1) ? 1 : -1;
  58                 my $dx = ($x2 - $x1) / abs($y2 - $y1);
  59
  60                 for (my $y = $y1; $y != $y2 + $dy; $y += $dy) {
  61                         blendpx($gd, $x, $y, $r, $g, $b, $a * (1.0 - $frac));
  62                         blendpx($gd, $x + 1, $y, $r, $g, $b, $a * $frac);
  63                         $frac += $dx;
  64                         if ($frac > 1) {
  65                                 $frac -= 1;
  66                                 ++$x;
  67                         }
  68                 }
  69         }
  70 }
  71
  72 sub makegraph {
  73         my $xoffset = 70;
  74         my ($width, $height, $min_x, $max_x, $min_y, $max_y, $tickgran) = @_;
  75
  76         # Create our base graph
  77         my $graph = new GD::Image($width, $height, 1);
  78         my $white = $graph->colorAllocate(255, 255, 255);
  79         $graph->fill(0, 0, $white);
  80
  81         my $gray = $graph->colorAllocate(230, 230, 255);
  82         my $black = $graph->colorAllocate(0, 0, 0);
  83
  84         $::xs = ($width - ($xoffset+2)) / ($max_x - $min_x);
  85         $::ys = ($height - 33) / ($min_y - $max_y);
  86
  87         # Hour marks
  88         for my $i ($xoffset+1..$width-2) {
  89                 if (((($i-($xoffset+1)) / $::xs + $min_x) / 3600) % 2 == 1) {
  90                         $graph->line($i, 0, $i, $height - 1, $gray);
  91                 }
  92         }
  93
  94         # Hour text
  95         for my $i (0..23) {
  96                 my @bounds = GD::Image::stringFT(undef, $black, "/usr/share/fonts/truetype/msttcorefonts/Arial.ttf", 10, 0, 0, 0, $i);
  97                 my $w = $bounds[2] - $bounds[0];
  98
  99                 # Determine where the center of this will be
 100                 my $starthour = POSIX::fmod(($min_x + Time::Zone::tz_local_offset()) / 3600, 24);
 101                 my $diff = POSIX::fmod($i - $starthour + 24, 24);
 102
 103                 my $center = ($diff * 3600 + 1800) * $::xs;
 104
 105                 next if ($center - $w / 2 < 1 || $center + $w / 2 > $width - ($xoffset+2));
 106                 $graph->stringFT($black, "/usr/share/fonts/truetype/msttcorefonts/Arial.ttf", 10, 0, $xoffset + $center - $w / 2, $height - 6, $i);
 107         }
 108
 109         #
 110         # Y lines; we want max 11 of them (zero-line, plus five on each side, or
 111         # whatever) but we don't want the ticks to be on minimum 50 (or
 112         # whatever $tickgran is set to). However, if there would be
 113         # really really few lines, go down an order of magnitude and try
 114         # again.
 115         #
 116         my $ytick;
 117         do {
 118                 $ytick = ($max_y - $min_y) / 11;
 119                 $ytick = POSIX::ceil($ytick / $tickgran) * $tickgran;
 120                 $tickgran *= 0.1;
 121         } while (($max_y - $min_y) / $ytick < 4);
 122
 123         for my $i (-11..11) {
 124                 my $y = ($i * $ytick - $max_y) * $::ys + 10;
 125                 next if ($y < 2 || $y > $height - 18);
 126
 127                 if ($i == 0) {
 128                         wuline($graph, $xoffset, $y, $width - 1, $y, 0, 0, 0, 1.0);
 129                         wuline($graph, $xoffset, $y + 1, $width - 1, $y + 1, 0, 0, 0, 1.0);
 130                 } else {
 131                         wuline($graph, $xoffset, $y, $width - 1, $y, 0, 0, 0, 0.2);
 132                 }
 133
 134                 # text
 135                 my $traf = 8 * ($i * $ytick);
 136                 my $text;
 137                 if ($traf >= 500_000_000) {
 138                         $text = (sprintf "%.1f Gbit", ($traf/1_000_000_000));
 139                 } elsif ($traf >= 500_000) {
 140                         $text = (sprintf "%.1f Mbit", ($traf/1_000_000));
 141                 } else {
 142                         $text = (sprintf "%.1f kbit", ($traf/1_000));
 143                 }
 144
 145                 my @bounds = GD::Image::stringFT(undef, $black, "/usr/share/fonts/truetype/msttcorefonts/Arial.ttf", 10, 0, 0, 0, $text);
 146                 my $w = $bounds[2] - $bounds[0];
 147                 my $h = $bounds[1] - $bounds[5];
 148
 149                 next if ($y - $h/2 < 2 || $y + $h/2 > $height - 12);
 150                 $graph->stringFT($black, "/usr/share/fonts/truetype/msttcorefonts/Arial.ttf", 10, 0, ($xoffset - 4) - $w, $y + $h/2, $text);
 151         }
 152
 153         # Nice border(TM)
 154         $graph->rectangle($xoffset, 0, $width - 1, $height - 1, $black);
 155
 156         return $graph;
 157 }
 158
 159 sub plotseries {
 160         my ($graph, $xvals, $yvals, $r, $g, $b, $min_x, $max_y) = @_;
 161         my $xoffset = 70;
 162
 163         my @xvals = @{$xvals};
 164         my @yvals = @{$yvals};
 165
 166         my $x = $xvals[0];
 167         my $y = $yvals[0];
 168         for my $i (1..$#xvals) {
 169                 next if ($::xs * ($xvals[$i] - $x) < 2 && $::ys * ($yvals[$i] - $y) > -2);
 170
 171                 wuline($graph, ($x-$min_x) * $::xs + $xoffset + 1, ($y-$max_y) * $::ys + 10,
 172                                 ($xvals[$i]-$min_x) * $::xs + $xoffset + 1, ($yvals[$i]-$max_y) * $::ys + 10, $r, $g, $b, 1.0);
 173                 $x = $xvals[$i];
 174                 $y = $yvals[$i];
 175         }
 176 }
 177
 178 1;