pg-svg.pl

#! /usr/bin/perl

use 5.010;
use strict;
use warnings;
use Data::Dump qw/dd dump/;
use DBI;
use SVG;
use File::Temp qw/tempfile/;
use File::Copy qw/move/;

my $pass = '';
my $user = '';
my $host = 'db.schemaverse.com';
# my $pass = '';
# my $user = 'schemaverse';
# my $host = 'localhost';
my $dbh = DBI->connect('dbi:Pg:host='.$host.';database=schemaverse',$user,$pass) or die "$!";

my $compress = 1;
my $s3_backend = 0;
my $write_file = 1;
my $path = '';

my $colors = [qw/1f77b4 aec7e8 ff7f0e ffbb78 2ca02c 98df8a d62728 ff9896 9467bd c5b0d5 8c564b c49c94 e377c2 f7b6d2 7f7f7f c7c7c7 bcbd22 dbdb8d 17becf 9edae5/];
my $luma_threshold = 5;
sub get_luma {
    my $rgb = shift;
    return 0 unless $rgb =~ /[[:xdigit:]]{6}/;
    my ( $r,$g,$b ) = $rgb =~ m/[[:xdigit:]]{2}/g;
    return ( 0.2126 * hex $r ) + ( 0.7152 * hex $g ) + ( 0.0722 * hex $b ); # luma objective
}

my $h = 750;
my $w = $h;
my $legend_w = 200;
my $svg = SVG->new( width => $w+$legend_w, height => $h );
my $map = $svg->group( id => 'map' );
$map->rect( id => 'map-bg', x => 1, y => 1, width => $w, height => $h );
my $legend = $svg->group(
    id => 'legend',
    style => {
        'font-size' => '1.4em',
    },
);
$legend->rect(
    id => 'legend-bg',
    x => $w+1, y => 1,
    width => $legend_w, height => $h,
);
$legend->line(
    id => 'legend-border',
    x1 => $w+1, x2 => $w+1,
    y1 => 1, y2 => $h,
    stroke => 'white',
    'stroke-width' => 1,
);
$legend->image(
    x => $w+1, y => $h-100,
    width => 200, height => 73,
    '-href' => 'https://schemaverse.com/images/schemaverse-logo.png',
    id => 'logo',
);
my $legend_e = $legend->group(
    id => 'entries',
    onmouseover => q/
        ship_hi(evt.target.className.baseVal,1);
        evt.target.style.fontSize = '1.3em';
    /,
    onmouseout  => q/
        ship_hi(evt.target.className.baseVal,0);
        evt.target.style.fontSize = '1.2em';
    /,
);

my $max_tic = $dbh->selectcol_arrayref(q/select last_value from tic_seq;/)->[0];
my $dur = .1;
my $min_dur = 20;
if ( $max_tic * $dur < $min_dur ) {
    $dur = $min_dur / $max_tic;
}
my $round = $dbh->selectcol_arrayref(q/select last_value from round_seq;/)->[0];
my $players = $dbh->selectcol_arrayref(q/
    select player_id from (
        select count(ship_id),ship_id,player_id
        from ship_flight_recorder
        group by ship_id,player_id
        having count(ship_id) > 1
    )a
    group by player_id;
/);
die 'No Players with Valid Moves' unless scalar @$players;

$svg->title(id=>'document-title')->cdata('Schemaverse | Max Tic '.$max_tic.' | Round '.$round);
my $reload = $svg->script(-type=>"text/ecmascript");
$reload->CDATA(qq|
    function Timer(cb, delay) {
        var timer_id, start, remain = delay;
        
        this.pause = function() {
            window.clearTimeout(timer_id);
            remain -= new Date() - start;
        };
        
        this.resume = function() {
            start = new Date();
            timer_id = window.setTimeout(cb, remain);
        };
        
        this.resume();
    }
    var timer = new Timer( function(){
        document.location.reload(true);
    }, |.(1000*($max_tic*$dur)).qq| );
    function ship_hi(name,r) {
        if( r ) {
            r = 2.5;
        }
        else {
            r = 1.125;
        }
        var ships = document
            .getElementById('map')
            .getElementsByClassName(name)[0]
            .getElementsByTagName('circle');
        for ( var i = 0, max = ships.length; i < max; i++ ) {
            ships[i].r.baseVal.value = r;
        }
    };
    function pause() {
        document.documentElement.pauseAnimations();
        var button = document.getElementById('pause');
        button.setAttributeNS(null, 'display', 'none');
        button = document.getElementById('play');
        button.setAttributeNS(null, 'display', 'inline');
    };
    function play() {
        document.documentElement.unpauseAnimations();
        var button = document.getElementById('play');
        button.setAttributeNS(null, 'display', 'none');
        button = document.getElementById('pause');
        button.setAttributeNS(null, 'display', 'inline');
    };
|);
my $clock_g = $svg->group( id => 'clock' );
$clock_g->text(
    id => 'pause',
    x => $w+5, y => $h - 96,
    style => {
        fill => 'white',
        'font-size' => '1.4em',
    },
    onclick => 'pause();timer.pause();',
)->cdata('pause');
$clock_g->text(
    id => 'play',
    x => $w+5, y => $h - 96,
    style => {
        fill => 'white',
        'font-size' => '1.4em',
    },
    display => 'none',
    onclick => 'play();timer.resume();',
)->cdata('play');
$clock_g->text(
    id => 'round',
    x => $w+$legend_w-111, y => $h-12,
    style => {
        fill => 'white',
        'font-size' => '1.4em',
    },
)->cdata(sprintf('Rd: %5s',$round));
for( 0 .. $max_tic ) {
    my $clock = $clock_g->text(
        id => 'clock'.$_,
        x => $w+10,
        y => $h-12,
        visibility => 'hidden',
        style => {
            fill => 'white',
            'font-size' => '2em',
        },
    )->cdata(sprintf('%4s',$_));
    $clock->animate(
        -method => 'attribute',
        attributeName => 'visibility',
        to => 'visible',
        begin => ( $_ * $dur ),
        dur => $dur,
        fill => ( $_ == $max_tic ? 'freeze' : 'remove' ),
    );
}

my $paths_sth = $dbh->prepare(q\
    select ship_id s, min(tic) start_tic, max(tic) end_tic,
    string_agg( tic::text, ';') t,
    string_agg( x, ';' ) x, string_agg( y , ';' ) y
    from (
        select ship_id, tic,
        round( ( \.$w.q\ / ( 2e7 / ( (location[0]+1) + 1e7 ) ) )::numeric, 4 )::text x,
        round( ( \.$h.q\ / ( 2e7 / ( (location[1]+1) + 1e7 ) ) )::numeric, 4 )::text y
        from ship_flight_recorder
        where player_id = ?
        order by ship_id,tic
    )a
    group by ship_id
    having count(*) > 1
    ;
\);

my $i = 0;
for my $player (@$players) {
    $paths_sth->execute( $player );
    my $ships = $paths_sth->fetchall_arrayref({});

    my $p = $dbh->selectcol_arrayref(q/select get_player_username(?);/, undef, $player)->[0];
    my $player_rgb = $dbh->selectcol_arrayref(q/select get_player_rgb(?::int);/, undef, $player )->[0];
    my $new_color = 0;
    # if ( defined $player_rgb ) {
        # dump ( $p, $player_rgb, get_luma($player_rgb) );
    # }
    unless ( defined $player_rgb ) {
        $new_color = 1;
    }
    elsif ( get_luma($player_rgb) < $luma_threshold ) {
        $new_color = 1;
    }
    if ( $new_color ) {
        my $scaled = $player % scalar @$colors;
        $player_rgb = $colors->[ $scaled ];
    }
    
    my $text = $legend_e->text(
        id => 'l-'.$player,
        class => $p,
        style => {
            'fill' => '#'.$player_rgb,
            'font-size' => '1.4em',
        },
        x => $w+5, y => ( ++$i * 32 ),
    )->cdata($p);

    my $svgg = $map->group(
        id => 'p-'.$player,
        class => $p,
        style => {
            'fill' => '#'.$player_rgb,
        },
    );

    for(@$ships) {
        my $tv = [ split ';', $_->{t} ];
        my $xv = [ split ';', $_->{x} ];
        my $yv = [ split ';', $_->{y} ];
        for ( 0 .. $#$tv ) {
            last unless defined $tv->[$_+1];
            my $gap = $tv->[$_+1] - $tv->[$_];
            if( $gap > 1 ) {
                splice $tv, $_+1, 0, $tv->[$_+1]-1;
                splice $xv, $_+1, 0, $xv->[$_];
                splice $yv, $_+1, 0, $yv->[$_];
            }
        }
        my $ship = $svgg->circle(
            id => 's-'.$_->{s},
            r => 1.125,
        );
        my $begin = ( $dur * $_->{start_tic} );
        my $ship_dur = ( $dur * ( $_->{end_tic} - $_->{start_tic} + 1 ) );
        $ship->animate(
            -method => 'attribute',
            attributeName => 'cx',
            values => join( ';', @$xv ),
            begin=> $begin.'s',
            dur => $ship_dur.'s',
            calcMode => 'linear',
        );
        $ship->animate(
            -method => 'attribute',
            attributeName => 'cy',
            values => join( ';', @$yv ),
            begin=> $begin.'s',
            dur => $ship_dur.'s',
            calcMode => 'linear',
        );
    }
}
my $render = $svg->render();
my $output = $render;
my $dest = 'schemaverse_round'.$round.'.svg';
if ( $compress == 1 and eval "require Compress::Zlib" ) {
    $output = Compress::Zlib::memGzip( $render ) or die "$!";
    $dest .= 'z';
}
say '-' x 20;
if ( defined $s3_backend and $s3_backend == 1 and eval "require Net::Amazon::S3" ) {
    my $aws_access_key_id     = '';
    my $aws_secret_access_key = '';
    my $bucket_name = '';
    my $s3 = Net::Amazon::S3->new({
        aws_access_key_id		=> $aws_access_key_id,
        aws_secret_access_key	=> $aws_secret_access_key,
    });
    my $c = Net::Amazon::S3::Client->new( s3 => $s3 );
    my $b = $c->bucket( name => $bucket_name );
    my $object = $b->object(
        key => 'viz/'.$dest,
        acl_short => 'public-read',
        content_type => 'image/svg+xml',
        content_encoding => 'gzip',
    );
    $object->put($output);
    print $object->uri;
}
if( $write_file == 1 and defined $path and $path ne '' ) {
    my ($tmp_fh, $tmp_name) = tempfile();
    print $tmp_fh $output;
    move( $tmp_name, $path.$dest );
    chmod( 0644, $dest );
    print $path.$dest;
}