#!/usr/bin/perl
# Jumper diagrams
# Copyright (C) 2019 Daniel Beer <dlbeer@gmail.com>
#
# Permission to use, copy, modify, and/or distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

use strict;
use warnings;

########################################################################

package PDF {

my @xrefs = (undef);
my $current_pos;

sub write {
    for my $x (@_) {
	print "$x";
	$current_pos += length $x;
    }
}

sub finish {
    my $root = shift;

    my $n = @xrefs;
    print "xref\n0 $n\n";
    print "0000000000 65535 f\r\n";
    for (my $i = 1; $i < $n; $i++) {
	print sprintf("%010d 00000 n\r\n", $xrefs[$i]);
    }

    print "trailer\n";
    print "<<\n";
    print "/Size $n\n";
    print "/Root $root 0 R\n";
    print ">>\n";
    print "startxref\n$current_pos\n%%EOF\n"
}

sub write_object {
    my $x = shift;
    my $text = shift;

    $xrefs[$x] = $current_pos;
    PDF::write "$x 0 obj\n$text\nendobj\n";
}

sub alloc {
    my $x = @xrefs;

    $xrefs[$x] = $current_pos;
    $x;
}

sub object {
    my $x = alloc;
    my $text = shift;

    write_object $x, $text;
    $x;
}

sub stream {
    my $text = shift;
    my $length = length($text);

    object qq{<<
/Length $length
>>
stream
$text
endstream};
}

}

########################################################################

package PDFDrawing {

use Math::Trig;

my @out;

sub put {
    push @out, join(' ', @_);
    push @out, "\n";
}

# Cubic Bezier approximation of a circle
sub bz_circle {
    my ($cx, $cy, $r) = @_;

    my $n = 4;
    my $dc = (4.0/3)*tan(pi/(2*$n));
    my @xs;
    my @ys;

    for (my $i = 0; $i < 4; $i++) {
	my $r0x = sin($i * 2*pi/$n);
	my $r0y = cos($i * 2*pi/$n);

	my $r3x = sin(($i + 1) * 2*pi/$n);
	my $r3y = cos(($i + 1) * 2*pi/$n);

	my $r1x = $r0x + $dc * $r0y;
	my $r1y = $r0y - $dc * $r0x;

	my $r2x = $r3x - $dc * $r3y;
	my $r2y = $r3y + $dc * $r3x;

	push @xs, $r1x, $r2x, $r3x;
	push @ys, $r1y, $r2y, $r3y;
    }

    for (my $i = 0; $i < @xs; $i++) {
	$xs[$i] = $xs[$i] * $r + $cx;
	$ys[$i] = $ys[$i] * $r + $cy;
    }

    put sprintf("%f %f m", $xs[$#xs], $ys[$#ys]);
    for (my $i = 0; $i < @xs; $i += 3) {
	put sprintf("%f %f %f %f %f %f c",
		       $xs[$i], $ys[$i],
		       $xs[$i + 1], $ys[$i + 1],
		       $xs[$i + 2], $ys[$i + 2]);
    }
}

sub finish {
    my ($w, $h) = @_;

    binmode STDOUT;
    PDF::write "%PDF-1.3\n";

    my $pages = PDF::alloc;
    my $c1 = PDF::stream join('', @out);
    my $p1 = PDF::object qq{<<
/Type /Page
/Resources << >>
/Contents $c1 0 R
/Parent $pages 0 R
>>};

    PDF::write_object $pages, qq{<<
/Type /Pages
/Count 1
/MediaBox[0 0 $w $h]
/Kids[$p1 0 R]
>>};

    my $catalog = PDF::object qq{<<
/Type /Catalog
/Pages $pages 0 R
>>};

    PDF::finish $catalog;
}

}

########################################################################

package main;

my $tmpl = shift // die "Specify a template";
my $size = 10;
my $n = 0;

for my $c (split //, $tmpl) {
    if (($c eq 'o') or ($c eq 'O')) {
	PDFDrawing::put "q 0.75 G" if $c eq 'o';
	PDFDrawing::bz_circle $n * $size + $size / 2, $size / 2, $size / 4;
	PDFDrawing::put "S";
	PDFDrawing::put "Q" if $c eq 'o';
	$n++;
    } elsif ($c eq 'I') {
	my $x1 = $n * $size + $size / 8;
	my $y1 = $size / 8;
	my $y2 = $size * 7 / 8;
	my $x2 = ($n + 2) * $size - $size / 8;

	PDFDrawing::put "$x1 $y1 m";
	PDFDrawing::put "$x2 $y1 l";
	PDFDrawing::put "$x2 $y2 l";
	PDFDrawing::put "$x1 $y2 l";
	PDFDrawing::put "h S";
    }
}

PDFDrawing::finish $size * $n, $size;