#!/usr/bin/env perl
use strict;

#############################################################################
# Plack -- Web Server Interface (not the point of this program).
use Plack::Request;
use Plack::Response;
#############################################################################

#############################################################################
# GD.pm -- This is the most common Perl On-The-Fly Graphics lib.
use GD;

# Technically, this isn't needed for Linux... also, CGI.pm will
#   do this for me if it needs to, but it's my silly habit.
binmode STDOUT;

############
# percBox -
#   Creates a left-to right completion box with a percent.
sub percBox
{
    my $opt = shift;
    # Requires Arg1 .. $perc
    my $perc = shift;
    # Optional Arg2 .. $fullwidth
    my $fullwidth = (shift or 200);
    # Optional Arg3 .. $height
    my $height = (shift or 20);
    # Locals...
    my ( $white, $black, $royalblue );
    my ( $wid, $high, $txlow );
    my ( $txcolor, $txstart ) = ( 0, 0 );
    my $pic = 0;

    $perc = "0" if ( 0 == $perc );

    # pic is my GD Image object...
    # Note I pass in the width and height of the image.
    $pic = new GD::Image($fullwidth, $height);

    # Use GD's colorAllocate method to create 
    #   colors to use in my graphic...
    $white = $pic->colorAllocate(255,255,255);
    $black = $pic->colorAllocate(0,0,0);
    $royalblue = $pic->colorAllocate(60,0,200);

    #$wid = int( (($fullwidth-2)*($perc/100)) );

    # Text Color...
    #   There's a really neat effect if you fill 
    #   the entire background with black.  However
    #   while it looks neat, it's not expected...
    #  If I fill my box black, the default text
    #   color would need to be white, instead of
    #   royalblue.
    $txcolor = $royalblue;

    # If, for some odd reason, someone wants something larger
    # than 100, I'm simply going to cut them off...
    if ( $perc > 100 ) {
        $perc = 100; 
    };

    # Calculate how wide the status box should be.
    # $wid = int( ($fullwidth*($perc/100)) );
    $wid = int( (($fullwidth-2)*($perc/100)) );

    # Use GD's rectangle method to create my outline
    $pic->rectangle(0, 0, $fullwidth-1, $height-1, $black);

    # Whole fill.. black.  (notes above and below)
    # I could use GD's fill method to create a black background
    #$pic->fill(1, 1, $black);

    # If I have no width to fill, I don't want to bother.
    if ( 1 <= $wid ) {
    # If whole fill is black, rectangle must be a diff color. 
    #   (white is a cool effect)
        # Use GDs rectable method to create 
        #    the inner status bar.
        $pic->rectangle(1, 1, $wid, $height-2, $black);
        if ( 2 < $wid ) {
            # Use GDs fill method to
            #    finish the inner status bar.
            $pic->fill(2, 2, $royalblue);
        }
    }

    # The percentage area must be at least 30 to 
    #    be able to put text in it.
    if ( 30 < $wid ) {
        if ( 100 == $perc ) {
            # -10 to center 100 is longer than 99
            $txstart = ( $wid * 0.5 ) - 10;
        } else {
            # -8 to center "00%"
            $txstart = ( $wid * 0.5 ) - 8;
        }
        # I can center the text inside the BLUE, so 
        # my text color should change to white.
        $txcolor = $white;
    } elsif ( 10 < ( $fullwidth * 0.5 ) - $wid ) {
        # Can I still center my text within the full box size,
        #   without the encroaching status box reaching me?
        $txstart = ( $fullwidth * 0.5 ) - 8;
    } elsif ( 10 < ( $fullwidth * 0.75 ) - $wid ) {
        # Mabye I can center on the 3/4 mark area without
        #   the encroaching status box reaching me?
        $txstart = ( $fullwidth * 0.75 ) - 8;
    }
    # If txstart is unset (zero) - I won't draw the text.

    if ( 20 <= $height ) {
        # Center the text start in the box height...
        $txlow = ($height * 0.5) - 7;
    } else {
        # If txstart is zero - I won't draw the text.
        $txstart = 0;
    }

    if ( $txstart ) {
        # Use GD's string method to create my text
        $pic->string(gdMediumBoldFont, $txstart, $txlow, 
            "$perc\%", $txcolor);
    }

    $opt->{'type'} = 'image/png';

    # Use GD's png method to print out the PNG version
    #   of my finished graphic.
    $opt->{'body'} = $pic->png;
}

# $perc = int(rand(100) + 1);
sub dumpPage {
    my $opt = shift;
    my $req = $opt->{'req'};

    my $dumpenv = q{};
    foreach my $etag ( keys %{$opt->{'env'}} ) {
        $dumpenv .= qq{$etag\t= } . $opt->{'env'}->{$etag} . qq{\n};
    }
    $dumpenv .= qq{\n\n} . q{WANTED = } . $opt->{'wanted'} . qq{\n};

    # Present an HTML that will increment on click...
    my $me = q{/cgi-bin/percent.cgi};

    $opt->{'type'} = 'text/html';
    $opt->{'body'} = <<"PAGE";
<!DOCTYPE html>
<html lang="en">
<head>
    <title>TextXML.cgi</title>

    <meta charset="UTF-8" />
    <meta name="viewport" content="width=device-width, initial-scale=1" />

<script>
    var i = 1;
    imNow = new Image(); imNow.src = '$me/250x30/' + 0;
    imNext = new Image(); imNext.src = '$me/250x30/' + i;
    function inc() {
        p = i;
        if ( isNaN(i) ) {
            i = 0;
            p = 0;
        }
        else if ( 100 <= i ) {
            i = 0;
            p = 100;
        }
        else {
            i = 1 + i;
        }
        imNow.src = imNext.src;
        imNext.src = '$me/250x30/' + i;
        document.getElementById('from').innerHTML = '$me/250x30/' + p;
        document.images.graph.src=imNow.src;
    }
</script>
</head>
<body>
    <h1>Test</h1>
    <p>
    The image from 
    &quot;<span id="from">$me/250x30/0</span>&quot;:
    </p>
    <p>
    <img name="graph" alt="graph" src="$me/250x30/0" onClick="inc()">
    </p>
<!--
$dumpenv
  -->
</body>
</html>
PAGE
}

my $app = sub {
    my $opt = {};
    $opt->{'env'} = shift;
    $opt->{'type'} = 'text/html';
    my $req = Plack::Request->new($opt->{'env'});
    my $res = Plack::Response->new(200);
    $opt->{'req'} = $req;

    my $perc;
    my ( $sz, $wid, $high );
    my $wanted = $req->path_info();

    $wanted =~ s{^https?://}{};     # Remove domain (in case it is there)
    $wanted =~ s{^www\.}{};
    $wanted =~ s{^home\.}{};
    $wanted =~ s{^s\.}{};
    $wanted =~ s{^r\.}{};
    $wanted =~ s{^vollink\.com/}{/};
    $wanted =~ s{^vollink\.nyc/}{/};
    $wanted =~ s{^voll\.ink/}{/};
    $wanted =~ s{/cgi-bin}{};       # Remove expected pathing (probably there)
    $wanted =~ s{/percent.cgi}{};
    $wanted =~ s{/*$}{};

    my $opt->{'wanted'} = $wanted;

    if ( $wanted eq q// ) {
        # Nobody wants anything, they are either testing (maybe),
        #   or they are don't know what they are doing, let
        #   them play...
        dumpPage($opt);
    }
    else {
        $wanted =~ s/^\///;

        ($sz, $perc) = split /\//, $wanted;

        if ( $perc ne q// ) {
            ($wid, $high) = split /x/, $sz;
        } elsif ( $sz ne q// ) {
            $perc = $sz;
        }

        $wid = 200 unless ($wid);
        $high = 20 unless ($high);

        percBox($opt, $perc, $wid, $high);
    }
    $res->content_type( $opt->{'type'} );
    $res->body( $opt->{'body'} );
    return $res->finalize();
};

#############################################################################
# THIS runs at startup.  Things that only need to be done once.
#############################################################################
INIT: {
    return $app;
}

# vim: sw=4 ts=4
# End percent.cgi.pl