Skip to content

Instantly share code, notes, and snippets.

@chandeeland

chandeeland/pg-svg.pl

Forked from KWKdesign/schemaverse-svg.pl
Created March 4, 2014 20:39
Download ZIP

Revisions

  1. @KWKdesign KWKdesign revised this gist Mar 4, 2014. 1 changed file with 1 addition and 4 deletions.
    5 changes: 1 addition & 4 deletions pg-svg.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -74,10 +74,6 @@ sub get_luma {
    );

    my $max_tic = $dbh->selectcol_arrayref(q/select last_value from tic_seq;/)->[0];
    unless ( defined $max_tic and $max_tic > 20 ) {
    say 'Too Early, Quitting';
    exit;
    }
    my $dur = .1;
    my $min_dur = 20;
    if ( $max_tic * $dur < $min_dur ) {
    @@ -93,6 +89,7 @@ sub get_luma {
    )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");
  2. @KWKdesign KWKdesign revised this gist Mar 3, 2014. 1 changed file with 62 additions and 10 deletions.
    72 changes: 62 additions & 10 deletions pg-svg.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -9,12 +9,12 @@
    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 $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;
    @@ -74,6 +74,10 @@ sub get_luma {
    );

    my $max_tic = $dbh->selectcol_arrayref(q/select last_value from tic_seq;/)->[0];
    unless ( defined $max_tic and $max_tic > 20 ) {
    say 'Too Early, Quitting';
    exit;
    }
    my $dur = .1;
    my $min_dur = 20;
    if ( $max_tic * $dur < $min_dur ) {
    @@ -93,7 +97,22 @@ sub get_luma {
    $svg->title(id=>'document-title')->cdata('Schemaverse | Max Tic '.$max_tic.' | Round '.$round);
    my $reload = $svg->script(-type=>"text/ecmascript");
    $reload->CDATA(qq|
    setTimeout(function(){
    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) {
    @@ -111,8 +130,41 @@ sub get_luma {
    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,
    @@ -243,8 +295,8 @@ sub get_luma {
    $output = Compress::Zlib::memGzip( $render ) or die "$!";
    $dest .= 'z';
    }
    if ( $s3_backend == 1 ) {
    use Net::Amazon::S3;
    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 = '';
    @@ -261,12 +313,12 @@ sub get_luma {
    content_encoding => 'gzip',
    );
    $object->put($output);
    say $dest;
    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 );
    say $path.$dest;
    print $path.$dest;
    }
  3. @KWKdesign KWKdesign revised this gist Feb 28, 2014. 1 changed file with 35 additions and 7 deletions.
    42 changes: 35 additions & 7 deletions pg-svg.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -20,7 +20,7 @@
    my $compress = 1;
    my $s3_backend = 0;
    my $write_file = 1;
    my $path = q'';
    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;
    @@ -40,7 +40,7 @@ sub get_luma {
    my $legend = $svg->group(
    id => 'legend',
    style => {
    'font-size' => '1.8em',
    'font-size' => '1.4em',
    },
    );
    $legend->rect(
    @@ -61,6 +61,17 @@ sub get_luma {
    '-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;
    @@ -85,6 +96,21 @@ sub get_luma {
    setTimeout(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;
    }
    };
    |);
    my $clock_g = $svg->group( id => 'clock' );
    $clock_g->text(
    @@ -154,22 +180,23 @@ sub get_luma {
    my $scaled = $player % scalar @$colors;
    $player_rgb = $colors->[ $scaled ];
    }

    $legend->text(
    my $text = $legend_e->text(
    id => 'l-'.$player,
    class => $p,
    x => $w+5, y => ( ++$i * 32 ),
    style => {
    fill => '#'.$player_rgb,
    '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) {
    @@ -234,6 +261,7 @@ sub get_luma {
    content_encoding => 'gzip',
    );
    $object->put($output);
    say $dest;
    }
    if( $write_file == 1 and defined $path and $path ne '' ) {
    my ($tmp_fh, $tmp_name) = tempfile();
  4. @KWKdesign KWKdesign revised this gist Feb 28, 2014. 1 changed file with 44 additions and 24 deletions.
    68 changes: 44 additions & 24 deletions pg-svg.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -3,32 +3,31 @@
    use 5.010;
    use strict;
    use warnings;
    #use Data::Dump qw/dd dump/;
    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 $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 = 1;
    my $write_file = 0;
    my $path = '';
    my $s3_backend = 0;
    my $write_file = 1;
    my $path = q'';

    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 = uc shift;
    my $rgb = shift;
    return 0 unless $rgb =~ /[[:xdigit:]]{6}/;
    my ( $r,$g,$b ) = $rgb =~ m/[[:xdigit:]]{2}/g;
    no warnings 'uninitialized';
    return ( 0.2126 * hex $r ) + ( 0.7152 * hex $g ) + ( 0.0722 * hex $b ); # luma objective
    }

    @@ -38,7 +37,12 @@ sub get_luma {
    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' );
    my $legend = $svg->group(
    id => 'legend',
    style => {
    'font-size' => '1.8em',
    },
    );
    $legend->rect(
    id => 'legend-bg',
    x => $w+1, y => 1,
    @@ -55,7 +59,7 @@ sub get_luma {
    x => $w+1, y => $h-100,
    width => 200, height => 73,
    '-href' => 'https://schemaverse.com/images/schemaverse-logo.png',
    id=> 'logo',
    id => 'logo',
    );

    my $max_tic = $dbh->selectcol_arrayref(q/select last_value from tic_seq;/)->[0];
    @@ -118,8 +122,8 @@ sub get_luma {
    string_agg( x, ';' ) x, string_agg( y , ';' ) y
    from (
    select ship_id, tic,
    round( ( ? / ( 2e7 / ( (location[0]+1) + 1e7 ) ) )::numeric, 4 )::text x,
    round( ( ? / ( 2e7 / ( (location[1]+1) + 1e7 ) ) )::numeric, 4 )::text y
    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
    @@ -131,7 +135,7 @@ sub get_luma {

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

    my $p = $dbh->selectcol_arrayref(q/select get_player_username(?);/, undef, $player)->[0];
    @@ -152,37 +156,53 @@ sub get_luma {
    }

    $legend->text(
    id => 'l-'.$player,
    class => $p,
    x => $w+5, y => ( ++$i * 32 ),
    style => {
    fill => '#'.$player_rgb,
    'font-size' => '1.8em',
    },
    )->cdata($p);

    my $svgg = $map->group( id => 'p'.$player );
    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},
    id => 's-'.$_->{s},
    r => 1.125,
    style => {
    'fill' => '#'.$player_rgb,
    }
    );
    my $begin = ( $dur * $_->{start_tic} );
    my $ship_dur = ( $dur * ( $_->{end_tic} - $_->{start_tic} + 1 ) );
    $ship->animate(
    -method => 'attribute',
    attributeName => 'cx',
    values => $_->{x},
    values => join( ';', @$xv ),
    begin=> $begin.'s',
    dur => $ship_dur.'s',
    calcMode => 'linear',
    );
    $ship->animate(
    -method => 'attribute',
    attributeName => 'cy',
    values => $_->{y},
    values => join( ';', @$yv ),
    begin=> $begin.'s',
    dur => $ship_dur.'s',
    calcMode => 'linear',
  5. @KWKdesign KWKdesign revised this gist Feb 27, 2014. 1 changed file with 58 additions and 16 deletions.
    74 changes: 58 additions & 16 deletions pg-svg.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -3,13 +3,26 @@
    use 5.010;
    use strict;
    use warnings;
    # use Data::Dump qw/dump/;
    #use Data::Dump qw/dd dump/;
    use DBI;
    use SVG;
    use List::Util qw/max min/;
    use File::Temp qw/tempfile/;
    use File::Copy qw/move/;

    # https://dl.dropboxusercontent.com/u/94229093/Schemaverse/animate-paths12.svg
    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 = 1;
    my $write_file = 0;
    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 = uc shift;
    @@ -45,15 +58,12 @@ sub get_luma {
    id=> 'logo',
    );

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

    my $colors = [qw/1f77b4 aec7e8 ff7f0e ffbb78 2ca02c 98df8a d62728 ff9896 9467bd c5b0d5 8c564b c49c94 e377c2 f7b6d2 7f7f7f c7c7c7 bcbd22 dbdb8d 17becf 9edae5/];

    my $dur = .1;
    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 (
    @@ -65,7 +75,7 @@ sub get_luma {
    group by player_id;
    /);

    $svg->title(id=>'document-title')->cdata('Schemaverse | Round '.$round.' | Max Tic '.$max_tic);
    $svg->title(id=>'document-title')->cdata('Schemaverse | Max Tic '.$max_tic.' | Round '.$round);
    my $reload = $svg->script(-type=>"text/ecmascript");
    $reload->CDATA(qq|
    setTimeout(function(){
    @@ -91,7 +101,7 @@ sub get_luma {
    fill => 'white',
    'font-size' => '2em',
    },
    )->cdata(sprintf('%4s',( $_ > $max_tic ? $max_tic : $_ )));
    )->cdata(sprintf('%4s',$_));
    $clock->animate(
    -method => 'attribute',
    attributeName => 'visibility',
    @@ -149,7 +159,7 @@ sub get_luma {
    },
    )->cdata($p);

    my $svgg = $svg->group( id => 'p'.$player );
    my $svgg = $map->group( id => 'p'.$player );

    for(@$ships) {
    my $ship = $svgg->circle(
    @@ -160,7 +170,7 @@ sub get_luma {
    }
    );
    my $begin = ( $dur * $_->{start_tic} );
    my $ship_dur = ( $dur * ( $_->{end_tic} - $_->{start_tic} ) );
    my $ship_dur = ( $dur * ( $_->{end_tic} - $_->{start_tic} + 1 ) );
    $ship->animate(
    -method => 'attribute',
    attributeName => 'cx',
    @@ -179,4 +189,36 @@ sub get_luma {
    );
    }
    }
    say $svg->render();
    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';
    }
    if ( $s3_backend == 1 ) {
    use 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);
    }
    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 );
    say $path.$dest;
    }
  6. @KWKdesign KWKdesign revised this gist Feb 26, 2014. 1 changed file with 90 additions and 44 deletions.
    134 changes: 90 additions & 44 deletions pg-svg.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -3,16 +3,47 @@
    use 5.010;
    use strict;
    use warnings;
    use Data::Dump;
    # use Data::Dump qw/dump/;
    use DBI;
    use SVG;
    use List::Util qw/max min/;

    # https://dl.dropboxusercontent.com/u/94229093/Schemaverse/animate-paths8.svg
    # https://dl.dropboxusercontent.com/u/94229093/Schemaverse/animate-paths12.svg

    my $h = 800;
    my $luma_threshold = 5;
    sub get_luma {
    my $rgb = uc shift;
    return 0 unless $rgb =~ /[[:xdigit:]]{6}/;
    my ( $r,$g,$b ) = $rgb =~ m/[[:xdigit:]]{2}/g;
    no warnings 'uninitialized';
    return ( 0.2126 * hex $r ) + ( 0.7152 * hex $g ) + ( 0.0722 * hex $b ); # luma objective
    }

    my $h = 750;
    my $w = $h;
    my $svg = SVG->new(width=>$w,height=>$h);
    $svg->rect( x=>1, y=>1, width=>$w, height=>$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' );
    $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 $pass = '';
    my $user = '';
    @@ -22,10 +53,9 @@
    my $colors = [qw/1f77b4 aec7e8 ff7f0e ffbb78 2ca02c 98df8a d62728 ff9896 9467bd c5b0d5 8c564b c49c94 e377c2 f7b6d2 7f7f7f c7c7c7 bcbd22 dbdb8d 17becf 9edae5/];

    my $dur = .1;
    my $max_tic;
    my $players;
    $max_tic = $dbh->selectcol_arrayref(q/select last_value from tic_seq;/)->[0];
    $players = $dbh->selectcol_arrayref(q/
    my $max_tic = $dbh->selectcol_arrayref(q/select last_value from tic_seq;/)->[0];
    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
    @@ -35,15 +65,33 @@
    group by player_id;
    /);

    $svg->title(id=>'document-title')->cdata('Schemaverse | Round '.$round.' | Max Tic '.$max_tic);
    my $reload = $svg->script(-type=>"text/ecmascript");
    $reload->CDATA(qq|
    setTimeout(function(){
    document.location.reload(true);
    }, |.(1000*($max_tic*$dur)).qq| );
    |);
    my $clock_g = $svg->group( id => 'clock' );
    $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=> 5,
    y=> 20,
    id => 'clock'.$_,
    x => $w+10,
    y => $h-12,
    visibility => 'hidden',
    style=> { fill => 'white' },
    )->cdata($_);
    style => {
    fill => 'white',
    'font-size' => '2em',
    },
    )->cdata(sprintf('%4s',( $_ > $max_tic ? $max_tic : $_ )));
    $clock->animate(
    -method => 'attribute',
    attributeName => 'visibility',
    @@ -71,66 +119,64 @@
    ;
    \);

    my $explode_sth = $dbh->prepare(q\
    select ship_id_1 s, tic
    from my_events
    where 1=1
    and action = 'EXPLODE'
    and player_id_1 = ?
    ;
    \);

    my $i = 0;
    for my $player (@$players) {
    $paths_sth->execute( $w, $h, $player );
    my $r = $paths_sth->fetchall_arrayref({});

    # $explode_sth->execute( $player );
    # my $explode = $explode_sth->fetchall_hashref('s');
    # dd $explode;
    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];
    $player_rgb = $colors->[ $scaled ];
    }

    $legend->text(
    x => $w+5, y => ( ++$i * 32 ),
    style => {
    fill => '#'.$player_rgb,
    'font-size' => '1.8em',
    },
    )->cdata($p);

    my $svgg = $svg->group( id => 'p'.$player );

    for(@$r) {
    for(@$ships) {
    my $ship = $svgg->circle(
    id => 's'.$_->{s},
    r => 1.125,
    style => {
    'fill' => '#'.$player_rgb,
    }
    );
    my $begin = ( $dur * $_->{start_tic} ) . 's';
    my $ship_dur = ( $dur * ( $_->{end_tic} - $_->{start_tic} ) ) . 's';
    my $begin = ( $dur * $_->{start_tic} );
    my $ship_dur = ( $dur * ( $_->{end_tic} - $_->{start_tic} ) );
    $ship->animate(
    -method => 'attribute',
    attributeName => 'cx',
    values => $_->{x},
    begin=> $begin,
    dur => $ship_dur,
    begin=> $begin.'s',
    dur => $ship_dur.'s',
    calcMode => 'linear',
    );
    $ship->animate(
    -method => 'attribute',
    attributeName => 'cy',
    values => $_->{y},
    begin=> $begin,
    dur => $ship_dur,
    begin=> $begin.'s',
    dur => $ship_dur.'s',
    calcMode => 'linear',
    );
    unless( $_->{end_tic} eq $max_tic ) {
    $ship->animate(
    -method => 'attribute',
    attributeName => 'visibility',
    to => 'hidden',
    begin => ( $dur * ( $_->{end_tic} + 1 ) ),
    );
    }
    }
    }
    say $svg->render();
  7. @KWKdesign KWKdesign revised this gist Feb 25, 2014. 1 changed file with 2 additions and 2 deletions.
    4 changes: 2 additions & 2 deletions pg-svg.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -14,8 +14,8 @@
    my $svg = SVG->new(width=>$w,height=>$h);
    $svg->rect( x=>1, y=>1, width=>$w, height=>$h );

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

  8. @KWKdesign KWKdesign revised this gist Feb 25, 2014. 1 changed file with 83 additions and 60 deletions.
    143 changes: 83 additions & 60 deletions pg-svg.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -7,107 +7,130 @@
    use DBI;
    use SVG;

    # https://dl.dropboxusercontent.com/u/94229093/Schemaverse/animate-paths.svg
    # https://dl.dropboxusercontent.com/u/94229093/Schemaverse/animate-paths8.svg

    my $h = 800;
    my $w = $h;
    my $svg = SVG->new(width=>$w,height=>$h);
    $svg->rect( x=>1, y=>1, width=>$w, height=>$h );
    # my $clock = $svg->text( id=>'clock',x=>10,y=>10);
    # $clock->animate(
    # -method => 'attribute',
    # attributeName => ''
    # );

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

    my $colors = [qw/1f77b4 aec7e8 ff7f0e ffbb78 2ca02c 98df8a d62728 ff9896 9467bd c5b0d5 8c564b c49c94 e377c2 f7b6d2 7f7f7f c7c7c7 bcbd22 dbdb8d 17becf 9edae5/];

    my $dur = .1;
    my $max_tic;
    my $players;
    {
    my $dbh = DBI->connect('dbi:Pg:host='.$host.';database=schemaverse',$user,$pass) or die "$!";
    $max_tic = $dbh->selectcol_arrayref(q/select last_value from tic_seq;/)->[0];
    $players = $dbh->selectcol_arrayref(q/
    select player_id from (
    $max_tic = $dbh->selectcol_arrayref(q/select last_value from tic_seq;/)->[0];
    $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;
    /);
    )a
    group by player_id;
    /);

    my $clock_g = $svg->group( id => 'clock' );
    for( 0 .. $max_tic ) {
    my $clock = $clock_g->text(
    id=> 'clock'.$_,
    x=> 5,
    y=> 20,
    visibility => 'hidden',
    style=> { fill => 'white' },
    )->cdata($_);
    $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( ( ? / ( 2e7 / ( (location[0]+1) + 1e7 ) ) )::numeric, 4 )::text x,
    round( ( ? / ( 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 $explode_sth = $dbh->prepare(q\
    select ship_id_1 s, tic
    from my_events
    where 1=1
    and action = 'EXPLODE'
    and player_id_1 = ?
    ;
    \);

    for my $player (@$players) {
    # my $dbh = DBI->connect('dbi:Pg:host='.$host.';database=schemaverse',$user,$pass) or die "$!";
    my $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( ( ? / ( 2e7 / ( (location[0]+1) + 1e7 ) ) )::numeric, 4 )::text x,
    round( ( ? / ( 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
    ;
    \);
    $sth->execute( $w, $h, $player );
    my $r = $sth->fetchall_arrayref({});
    # dd $r;die;
    $paths_sth->execute( $w, $h, $player );
    my $r = $paths_sth->fetchall_arrayref({});

    # $explode_sth->execute( $player );
    # my $explode = $explode_sth->fetchall_hashref('s');
    # dd $explode;

    my $p = $dbh->selectcol_arrayref(q/select get_player_username(?)/, undef, $player)->[0];
    my $player_rgb = $dbh->selectcol_arrayref(q/select coalesce(( select get_player_rgb(?) ),'ffffff');/, undef, $player )->[0];
    # $player_rgb ||= 'ffffff';
    # say qq/$player - $p - $player_rgb/;
    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];
    unless ( defined $player_rgb ) {
    my $scaled = $player % scalar @$colors;
    $player_rgb = $colors->[$scaled];
    }

    my $svgg = $svg->group( id => 'p'.$player );

    for(@$r) {
    # $_ = { # sample row
    # s => 2287,
    # t => "124;126;127;128;129;130;131;132;133;134;135",
    # x => "470.0404;470.0379;467.5728;462.6475;459.8958;459.6714;455.5044;447.6514;442.3548;440.9802;435.8663",
    # y => "283.0890;283.0922;286.2473;292.5514;295.9496;296.2473;297.2093;298.7358;299.7653;300.0077;301.6693",
    # };
    my $xv = [ split ';', $_->{x} ];
    my $yv = [ split ';', $_->{y} ];
    my $ship = $svgg->circle(
    id=>'s'.$_->{s},
    # cx => $xv->[0],
    # cy => $yv->[0],
    id => 's'.$_->{s},
    r => 1.125,
    style=>{
    style => {
    'fill' => '#'.$player_rgb,
    }
    );
    my $begin = ( $dur * $_->{start_tic} ) . 's';
    my $ship_dur = ( $dur * ( $_->{end_tic} - $_->{start_tic} ) ) . 's';
    $ship->animate(
    -method => 'attribute',
    attributeName => 'cx',
    values => $_->{x},
    begin=>( $dur * $_->{start_tic} ) . 's',
    dur => ( $dur * scalar @$xv ) . 's',
    begin=> $begin,
    dur => $ship_dur,
    calcMode => 'linear',
    fill => 'freeze',
    # repeatCount => 'indefinite'
    );
    $ship->animate(
    -method => 'attribute',
    attributeName => 'cy',
    values => $_->{y},
    begin=> ( $dur * $_->{start_tic} ) . 's',
    dur => ( $dur * scalar @$yv ) . 's',
    begin=> $begin,
    dur => $ship_dur,
    calcMode => 'linear',
    fill => 'freeze',
    # repeatCount => 'indefinite'
    );
    unless( $_->{end_tic} eq $max_tic ) {
    $ship->animate(
    -method => 'attribute',
    attributeName => 'visibility',
    to => 'hidden',
    begin => ( $dur * ( $_->{end_tic} + 1 ) ),
    );
    }
    }
    }
    say $svg->render();
  9. @KWKdesign KWKdesign revised this gist Feb 24, 2014. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion pg-svg.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -66,7 +66,7 @@
    my $p = $dbh->selectcol_arrayref(q/select get_player_username(?)/, undef, $player)->[0];
    my $player_rgb = $dbh->selectcol_arrayref(q/select coalesce(( select get_player_rgb(?) ),'ffffff');/, undef, $player )->[0];
    # $player_rgb ||= 'ffffff';
    say qq/$player - $p - $player_rgb/;
    # say qq/$player - $p - $player_rgb/;

    my $svgg = $svg->group( id => 'p'.$player );

  10. @KWKdesign KWKdesign revised this gist Feb 24, 2014. 1 changed file with 44 additions and 20 deletions.
    64 changes: 44 additions & 20 deletions pg-svg.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -13,38 +13,62 @@
    my $w = $h;
    my $svg = SVG->new(width=>$w,height=>$h);
    $svg->rect( x=>1, y=>1, width=>$w, height=>$h );
    # my $clock = $svg->text( id=>'clock',x=>10,y=>10);
    # $clock->animate(
    # -method => 'attribute',
    # attributeName => ''
    # );

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

    my $dur = .1;
    my $max_tic;
    my $players;
    {
    my $dbh = DBI->connect('dbi:Pg:host=localhost;database=schemaverse','schemaverse','') or die "$!";
    my $dbh = DBI->connect('dbi:Pg:host='.$host.';database=schemaverse',$user,$pass) or die "$!";
    $max_tic = $dbh->selectcol_arrayref(q/select last_value from tic_seq;/)->[0];
    $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;
    /);
    }

    my $players = [qw/kwksilver philly deadlock/];
    for my $player (@$players) {
    my $dbh = DBI->connect('dbi:Pg:host=localhost;database=schemaverse',$player,'') or die "$!";
    # my $dbh = DBI->connect('dbi:Pg:host='.$host.';database=schemaverse',$user,$pass) or die "$!";
    my $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( ( ? / ( 2e7 / ( (location_x+1) + 1e7 ) ) )::numeric, 4 )::text x,
    round( ( ? / ( 2e7 / ( (location_y+1) + 1e7 ) ) )::numeric, 4 )::text y
    from my_ships_flight_recorder
    order by ship_id,tic
    )a
    group by ship_id
    having count(*) > 1
    ;
    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( ( ? / ( 2e7 / ( (location[0]+1) + 1e7 ) ) )::numeric, 4 )::text x,
    round( ( ? / ( 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
    ;
    \);
    $sth->execute( $w, $h );
    $sth->execute( $w, $h, $player );
    my $r = $sth->fetchall_arrayref({});
    # dd $r;die;

    my $p = $dbh->selectcol_arrayref(q/select get_player_id(?)/, undef, $player)->[0];
    my $player_rgb = $dbh->selectcol_arrayref(q/select get_player_rgb(get_player_id(?));/, undef, $player )->[0];
    my $p = $dbh->selectcol_arrayref(q/select get_player_username(?)/, undef, $player)->[0];
    my $player_rgb = $dbh->selectcol_arrayref(q/select coalesce(( select get_player_rgb(?) ),'ffffff');/, undef, $player )->[0];
    # $player_rgb ||= 'ffffff';
    say qq/$player - $p - $player_rgb/;

    my $svgg = $svg->group( id => 'p'.$p );
    my $svgg = $svg->group( id => 'p'.$player );

    for(@$r) {
    # $_ = { # sample row
  11. @KWKdesign KWKdesign revised this gist Feb 23, 2014. 1 changed file with 50 additions and 30 deletions.
    80 changes: 50 additions & 30 deletions pg-svg.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -7,36 +7,45 @@
    use DBI;
    use SVG;

    # demo: https://dl.dropboxusercontent.com/u/94229093/Schemaverse/test-paths.svg
    # https://dl.dropboxusercontent.com/u/94229093/Schemaverse/animate-paths.svg

    my $svg = SVG->new(width=>800,height=>800);
    $svg->rect( x=>1, y=>1, width=>800, height=>800 );
    my $h = 800;
    my $w = $h;
    my $svg = SVG->new(width=>$w,height=>$h);
    $svg->rect( x=>1, y=>1, width=>$w, height=>$h );
    my $dur = .1;
    my $max_tic;
    {
    my $dbh = DBI->connect('dbi:Pg:host=localhost;database=schemaverse','schemaverse','') or die "$!";
    $max_tic = $dbh->selectcol_arrayref(q/select last_value from tic_seq;/)->[0];
    }

    my $players = [qw/kwksilver philly deadlock/];
    my $host = 'localhost';
    my $pass = q//;
    for my $player (@$players) {
    my $dbh = DBI->connect('dbi:Pg:host='.$host.';database=schemaverse',$player,$pass) or die "$!";
    my $sth = $dbh->prepare(q"
    select ship_id s, string_agg(tic::text,';') t, string_agg(a.x,';') x, string_agg(a.y,';') y from (
    my $dbh = DBI->connect('dbi:Pg:host=localhost;database=schemaverse',$player,'') or die "$!";
    my $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( ( 800 / ( 2e7 / ( (location_x+1) + 1e7 ) ) )::numeric, 4 )::text x,
    round( ( 800 / ( 2e7 / ( (location_y+1) + 1e7 ) ) )::numeric, 4 )::text y
    round( ( ? / ( 2e7 / ( (location_x+1) + 1e7 ) ) )::numeric, 4 )::text x,
    round( ( ? / ( 2e7 / ( (location_y+1) + 1e7 ) ) )::numeric, 4 )::text y
    from my_ships_flight_recorder
    order by ship_id,tic
    )a
    group by ship_id
    having count(*) > 1
    ;
    ");
    $sth->execute();
    \);
    $sth->execute( $w, $h );
    my $r = $sth->fetchall_arrayref({});

    my $p = $dbh->selectcol_arrayref(q/select get_player_id(?)/, undef, $player)->[0];
    my $player_rgb = $dbh->selectcol_arrayref(q/select get_player_rgb(get_player_id(?));/, undef, $player )->[0];

    my $svgg = $svg->group( id => 'p'.$p );

    for(@$r) {
    # $_ = { # sample row
    # s => 2287,
    @@ -46,23 +55,34 @@
    # };
    my $xv = [ split ';', $_->{x} ];
    my $yv = [ split ';', $_->{y} ];
    my $points = $svgg->get_path(
    x=>$xv,y=>$yv,type=>'polyline'
    );
    my $path = $svgg->path(
    %$points,
    my $ship = $svgg->circle(
    id=>'s'.$_->{s},
    # cx => $xv->[0],
    # cy => $yv->[0],
    r => 1.125,
    style=>{
    'fill' => 'none',
    'stroke' => '#'.$player_rgb,
    'stroke-width' => 1,
    });
    $path->animate(
    attributeName => 'keySplines',
    values => $_->{t},
    dur => '200s',
    calcMode => 'spline',
    repeatCount => 'indefinite'
    'fill' => '#'.$player_rgb,
    }
    );
    $ship->animate(
    -method => 'attribute',
    attributeName => 'cx',
    values => $_->{x},
    begin=>( $dur * $_->{start_tic} ) . 's',
    dur => ( $dur * scalar @$xv ) . 's',
    calcMode => 'linear',
    fill => 'freeze',
    # repeatCount => 'indefinite'
    );
    $ship->animate(
    -method => 'attribute',
    attributeName => 'cy',
    values => $_->{y},
    begin=> ( $dur * $_->{start_tic} ) . 's',
    dur => ( $dur * scalar @$yv ) . 's',
    calcMode => 'linear',
    fill => 'freeze',
    # repeatCount => 'indefinite'
    );
    }
    }
  12. @KWKdesign KWKdesign revised this gist Feb 23, 2014. 1 changed file with 2 additions and 0 deletions.
    2 changes: 2 additions & 0 deletions pg-svg.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -7,6 +7,8 @@
    use DBI;
    use SVG;

    # demo: https://dl.dropboxusercontent.com/u/94229093/Schemaverse/test-paths.svg

    my $svg = SVG->new(width=>800,height=>800);
    $svg->rect( x=>1, y=>1, width=>800, height=>800 );

  13. @KWKdesign KWKdesign revised this gist Feb 23, 2014. 1 changed file with 7 additions and 3 deletions.
    10 changes: 7 additions & 3 deletions pg-svg.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -3,12 +3,10 @@
    use 5.010;
    use strict;
    use warnings;
    # use Data::Dump;
    use Data::Dump;
    use DBI;
    use SVG;

    # demo: https://dl.dropboxusercontent.com/u/94229093/Schemaverse/test-paths.svg

    my $svg = SVG->new(width=>800,height=>800);
    $svg->rect( x=>1, y=>1, width=>800, height=>800 );

    @@ -38,6 +36,12 @@
    my $svgg = $svg->group( id => 'p'.$p );

    for(@$r) {
    # $_ = { # sample row
    # s => 2287,
    # t => "124;126;127;128;129;130;131;132;133;134;135",
    # x => "470.0404;470.0379;467.5728;462.6475;459.8958;459.6714;455.5044;447.6514;442.3548;440.9802;435.8663",
    # y => "283.0890;283.0922;286.2473;292.5514;295.9496;296.2473;297.2093;298.7358;299.7653;300.0077;301.6693",
    # };
    my $xv = [ split ';', $_->{x} ];
    my $yv = [ split ';', $_->{y} ];
    my $points = $svgg->get_path(
  14. @KWKdesign KWKdesign revised this gist Feb 22, 2014. 1 changed file with 2 additions and 0 deletions.
    2 changes: 2 additions & 0 deletions pg-svg.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -7,6 +7,8 @@
    use DBI;
    use SVG;

    # demo: https://dl.dropboxusercontent.com/u/94229093/Schemaverse/test-paths.svg

    my $svg = SVG->new(width=>800,height=>800);
    $svg->rect( x=>1, y=>1, width=>800, height=>800 );

  15. @KWKdesign KWKdesign created this gist Feb 22, 2014.
    61 changes: 61 additions & 0 deletions pg-svg.pl
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,61 @@
    #! /usr/bin/perl

    use 5.010;
    use strict;
    use warnings;
    # use Data::Dump;
    use DBI;
    use SVG;

    my $svg = SVG->new(width=>800,height=>800);
    $svg->rect( x=>1, y=>1, width=>800, height=>800 );

    my $players = [qw/kwksilver philly deadlock/];
    my $host = 'localhost';
    my $pass = q//;
    for my $player (@$players) {
    my $dbh = DBI->connect('dbi:Pg:host='.$host.';database=schemaverse',$player,$pass) or die "$!";
    my $sth = $dbh->prepare(q"
    select ship_id s, string_agg(tic::text,';') t, string_agg(a.x,';') x, string_agg(a.y,';') y from (
    select ship_id, tic,
    round( ( 800 / ( 2e7 / ( (location_x+1) + 1e7 ) ) )::numeric, 4 )::text x,
    round( ( 800 / ( 2e7 / ( (location_y+1) + 1e7 ) ) )::numeric, 4 )::text y
    from my_ships_flight_recorder
    order by ship_id,tic
    )a
    group by ship_id
    having count(*) > 1
    ;
    ");
    $sth->execute();
    my $r = $sth->fetchall_arrayref({});

    my $p = $dbh->selectcol_arrayref(q/select get_player_id(?)/, undef, $player)->[0];
    my $player_rgb = $dbh->selectcol_arrayref(q/select get_player_rgb(get_player_id(?));/, undef, $player )->[0];

    my $svgg = $svg->group( id => 'p'.$p );

    for(@$r) {
    my $xv = [ split ';', $_->{x} ];
    my $yv = [ split ';', $_->{y} ];
    my $points = $svgg->get_path(
    x=>$xv,y=>$yv,type=>'polyline'
    );
    my $path = $svgg->path(
    %$points,
    id=>'s'.$_->{s},
    style=>{
    'fill' => 'none',
    'stroke' => '#'.$player_rgb,
    'stroke-width' => 1,
    });
    $path->animate(
    attributeName => 'keySplines',
    values => $_->{t},
    dur => '200s',
    calcMode => 'spline',
    repeatCount => 'indefinite'
    );
    }
    }
    say $svg->render();