dirkobot/gnuplot/mkdata.pl

#!/usr/bin/perl

use strict;
use warnings;
use autodie;

use JSON;
use Data::Dumper;
use Digest::MD5 qw/md5_hex/;
use DateTime::Format::ISO8601;
use DateTime;

my $DAT;

my $path = "/home/ryan/workspace/dirkbot/gnuplot/data/";

#WHEE
use YAML qw/LoadFile/;

my $resdb;
my %rectangles;

sub make_color {
  "#".substr(md5_hex(join(".",@_)), 0,6);
}

sub make_rects {
  for my $resk (keys %{$resdb->{Residences}}) {
    my $resi = $resdb->{Residences}{$resk};
    my $rw = $resi->{Permissions}{World};

    for my $areak (keys %{$resi->{Areas}}) {
      my ($rx, $ry, $lx, $ly) = @{$resi->{Areas}{$areak}}{qw/Z1 X1 Z2 X2/};
#      print "$rw.$resk.$areak $rx : $lx :: $ry : $ly\n";
      $rectangles{$rw} .= "set object rectangle from $lx, $ly to $rx, $ry behind fc rgb \"".make_color($resk)."\" fs solid 1.0 border lw 0\n";
    };
  }
}

sub mark_rects
{
  my $w = shift;
  my @areas;
    for my $resk (keys %{$resdb->{Residences}}) {
    my $resi = $resdb->{Residences}{$resk};
    my $rw = $resi->{Permissions}{World};
    next if $rw ne $w;
    my $area = 0;
    my $center = [];
 
    for my $areak (keys %{$resi->{Areas}}) {
      my ($rx, $ry, $lx, $ly) = @{$resi->{Areas}{$areak}}{qw/Z1 X1 Z2 X2/};
      $center = [($rx+$lx)/2, ($ly+$ry)/2] if $area == 0; # use the first area for center
      $center = [($rx+$lx)/2, ($ly+$ry)/2] if $areak eq "main"; # redo it if we have a main!
      $area += abs($rx - $lx) * abs($ry-$ly);
    };
    push @areas, {key => $resk, area => $area, center => $center};
  };

  my @s = sort {$b->{area} <=> $a->{area}} @areas;
  print $w, "::", $_->{key}, " = ", $_->{area}, "\n" for (@s);
  for my $r (@s[0..10]) {
#    print Dumper($r);
    $rectangles{$w} .= qq[set label "$r->{key}" at $r->{center}[0],$r->{center}[1]\n];
  }
}

sub loadres
{
  $resdb = LoadFile("../var/res.yml");
}

loadres();
make_rects();
for (qw/main anathema/) {
  mark_rects($_);
}

#DATA
sub make_data {
  my ($w, $f) = @_;
  my %sizes = (
  anathema => [2000,2000,1920,1080],
  main     => [3500,3500,1920,1080],
  "-some-other-bogus-world-" => [10,10,20,20],
  main_nether => [500,500,1280,720],);  
  my %maps = (
    anathema => q[plot 'maps/anathema.rgb' binary array=(4000,4000) flipy format='%uchar' with rgbimage],
        main => q[plot 'maps/main.rgb'     binary array=(7000,7000) flipy format='%uchar' with rgbimage],
  "-some-other-bogus-world-" => "",
  main_nether => "",
  );

  unless ($DAT) {
   local $/;
   $DAT = <DATA>;
  }
  my $r = $DAT;
  $r =~ s/%YSIZED/$sizes{$w}[3]/g;
  $r =~ s/%YSIZE/$sizes{$w}[1]/g;
  $r =~ s/%XSIZED/$sizes{$w}[2]/g;
  $r =~ s/%XSIZE/$sizes{$w}[0]/g;
  $r =~ s|%DATA|dataout/$f-$w.dat|g;
  $rectangles{$w} = "" unless $rectangles{$w};
  $r =~ s/%RECT/$rectangles{$w}/g;
  $r =~ s/%WORLD/$maps{$w}/g;
  return $r;
}

#MAIN

my @files;
opendir(my $dh, $path);
while(readdir $dh) {
  push @files, $_ if (/json$/);
}
closedir($dh);

#my %world;
my %files;
my %ftime;

for my $f (@files) {
  open(my $fh, "<", $path.$f);
  my $json = <$fh>;
  close($fh);
  $json =~ s|/\*[^*]+\*/||;
  my $scalar = decode_json $json;
#  print Dumper $scalar;
  $ftime{$f} = 0+@{$scalar->{players}};
  for my $p (@{$scalar->{players}}) {
    my ($x, $y, $z, $world, $name) = @{$p}{qw/x y z world name/};

    push @{$files{$f}{$world}}, [$z, $x, $y, $name];
#                           'account' => 'ranga21',
#                           'world' => 'main',
#                           'armor' => 0,
#                           'name' => 'ranga21',
#                           'x' => '-26.8191754241616',
#                           'health' => 16,
#                           'y' => '6',
#                           'type' => 'player',
#                           'z' => '47.211890914009'
  }
}

open(my $fh3, ">", "dataout/player-time.dat");
for my $k (sort keys %ftime) {
  my ($t) = ($k=~/(\d\d\d\d-\d\d-\d\dT\d\d:\d\d:\d\d)/g);
  print $fh3 $t," ",$ftime{$k},"\n";
};
close($fh3);
die;
for my $f (keys %files) {
  for my $w (keys %{$files{$f}}) {
    open(my $fh, ">", "dataout/$f-$w.dat");
    for my $p (@{$files{$f}{$w}}) {
      print $fh join(" ", @$p), "\n";
    }
    close($fh);
    my $dat = make_data($w, $f);
    open(my $fh2, ">", "dataout/$f-$w.plot");
    print $fh2 $dat;
    close($fh2);
    open(my $ph, "|gnuplot > img/$f-$w.png");
    print $ph $dat;
    close($ph);
#system("gnuplot < $w.plot > $w.png");
  }
}

__DATA__
set terminal png size %XSIZED,%YSIZED
set xr [%XSIZE:-%XSIZE]
set yr [%YSIZE:-%YSIZE]
%RECT
#%WORLD
set pointsize 5.0
plot "%DATA" with points