#!/usr/bin/perl -w

use strict;
use PDF::API2;

my $input = shift;

open(INPUT, "<$input");

my @space;
foreach(<INPUT>) {
    if( m/^R/ ) { # we only like lines starting with R
	#which row?
	m/^R(\d*)\:\s*(.*)$/;
	my $row = $1;
	my $pattern = $2;
	crochet($pattern,$row);
    } else {
	# throw non-rows (comments, notes, ?) away for now.
    }
}
close(INPUT);


# OUTPUT
my $leni = @space;
my $lenj = @{$space[0]};

my $pdf = PDF::API2->new;
my $page = $pdf->page();
my $s = 100;
$page->mediabox($s*$lenj+$s,$s*$leni+$s);
my $g = $page->gfx();

my $firstlen;
my @indexes = 0 .. $#space;
my $x = $s*0.5;
my $y = $s*$leni+$s*0.5;
for my $i ( reverse @indexes ) {
    my $lenj = @{$space[$i]};
    if(!$firstlen) {
	$firstlen = $lenj;
    } else {
	if($firstlen != $lenj) {
	    print "********** row length mismatch! **********\n";
	}
    }
    my @jndexes = 0 .. $#{ $space[$i] };
    for my $j ( reverse @jndexes ) {
      SWITCH: for ($space[$i][$j]) {
	  /s/ && do {     
	      $g->strokecolor("#FF0000");
	      $g->fillcolor("#FF0000");
	      $g->circle($x,$y,$s*0.628);
	      $g->stroke();
	      $g->endpath();
	      last;};
	  /S/ && do {
	      $g->strokecolor("#0000FF");
	      $g->fillcolor("#0000FF");	      
	      $g->circle($x,$y,$s*0.628);
	      $g->stroke();
	      $g->endpath();
	      last;};
	  /l/ && do { 
	      $g->strokecolor("#FF0000");
	      $g->fillcolor("#880000");	      
	      $g->ellipse($x,$y-0.5*$s,$s*0.38,$s);
	      $g->fillstroke();
	      $g->endpath();
	      last;};
	  /L/ && do { 
	      $g->strokecolor("#0000FF");
	      $g->fillcolor("#000088");	      	      
	      $g->ellipse($x,$y-0.5*$s,$s*0.38,$s);
	      $g->fillstroke();
	      $g->endpath();
	      last;};
	  die "unknown value in space array\n";
      }
	$x += $s;
    }
    $y -= $s;
    $x = $s*0.5;
}

#output the pdf
print $pdf->stringify();
$pdf->end;
exit;


sub crochet {
    my $pattern = shift;
    my $row = shift;
    if($row == 1) {
	$pattern =~ m/chain\s(\d+)/;
	my $cols = $1 - 1;
	my @tmprow;
	for(my $x=0; $x<$cols; $x++) {
	    push(@tmprow, 's'); #CHEATING, forced MC sc row
	}
	$space[0] = [ @tmprow ];
    } else {
	$pattern = expand($pattern);
	my @tmprow = crochet_row($pattern);
	$space[$row-1] = [ @tmprow ];   
    }
}

sub expand {
    my $pattern = shift;
    while( $pattern =~ s/\((.*?)\)x(\d+)/repeat($1, $2)/e ) {}
    return($pattern);
}


sub repeat {
    my $reppat = shift;
    my $repnum = shift;
    my $delim = "";
    my $expanded = "";
    if($reppat =~ m/\;/) {
	$delim = ";";
    } else {
	$delim = ",";
    }   
    for(my $x=0; $x<$repnum; $x++) {
	$expanded .= $reppat;
	if($x==$repnum-1) {
	    $expanded .= " ";
	} else {
	    $expanded .= $delim." ";
	}
    }
    return($expanded);
}

sub crochet_row {
    my $pattern = shift;
    my @tmprow;
    $pattern =~ s/join\ //g;
    $pattern =~ s/sc\ in\ next\ sc/1sc/g;
    $pattern =~ s/sc\ in\ next\ //g;
    $pattern =~ s/in\ 1st\ /1/g;
    $pattern =~ s/\ sc/sc/g;
    $pattern =~ s/\,//g;
    $pattern =~ s/\s+/\ /g;
    $pattern =~ s/\sCC/CC/g;
    $pattern =~ s/\sMC/MC/g;
    $pattern =~ s/fo\.//g;
    if($pattern =~ m/\;/ ) {
	my @colorsubpat = $pattern =~ m/.*?\;/g;
	foreach my $subpat (@colorsubpat) {
	    push(@tmprow, stitch(substr($subpat,0,2),substr($subpat,3)));
	}
    } else {
	    push(@tmprow, stitch(substr($pattern,0,2),substr($pattern,3)));
	
    }

    $pattern =~ m//g;
    return @tmprow;
}

sub stitch {
    my $color = shift;
    my $pattern = shift;
    my @stitches;
    $pattern =~ s/\;//g;
    $pattern =~ s/\,//g;
    foreach my $repstitch (split /\s/,$pattern) {
	$repstitch =~ m/(\d+)(.*)/;
	my $reps = $1;
	my $stitch = $2;
	my $out = "";
	if($color eq 'MC') {
	    if($stitch eq 'sc') {
		$out = 's';
	    } elsif($stitch eq 'ldc') {
		$out = 'l'
		}
	} elsif($color eq 'CC') {
	    if($stitch eq 'sc') {
		$out = 'S';
	    } elsif($stitch eq 'ldc') {
		$out = 'L'
		}	    
	} else {
	    print "had a stitch with no color $color $pattern!\n";
	}
	for(my $x=0; $x<$reps; $x++) {
	    push @stitches, $out;
	}
    }
    return @stitches;
}