#!/usr/bin/perl

use strict;
use Getopt::Long;
my $output_format = "png";
my $size = 50;
GetOptions("output=s" => \$output_format,
           "size=i" => \$size,
          ) or usage();

my %output_cmd = (
  png => ["pnmtopng"],
  debug => ["cat"],
);
my $output_cmd = $output_cmd{$output_format}
  or die "Unknown output format '$output_format'. Known: ",
  join(", " => sort keys %output_cmd),
  "\n";

chomp(my @in_data = <>);
exit unless @in_data;
my $width = max(map length, @in_data);
my $height = @in_data;
my @out_data = map [(1) x ($width * $size)], 1 .. $height * $size;

open OUT, "|-", @{$output_cmd}
  or die "Couldn't run output command '@$output_cmd': $!";

my $r = 0;
for my $line (@in_data) {
  my $c = 0;
  for my $ch (split //, $line) {
    add_patch(\@out_data, $r, $c, $ch);
    $c++;
  }
  $r++;
}

print_quilt(\*OUT, \@out_data);

sub add_patch {
  my ($Q, $r, $c, $ch) = @_;
  die "Unknown patch identifier '$ch'" unless $ch =~ /^[1234 #\/\\]$/;
  my $border = $ch =~ /[\/\\]/;
  for my $rr (0 .. $size - 1) {
    for my $cc (0 .. $size - 1) {
      my $y = $r * $size + $rr;
      my $x = $c * $size + $cc;
      my $color;
      if ($ch eq "3") {
        $color = ($cc + $rr < $size);
      } elsif ($ch eq "4") {
        $color = $cc > $rr;
      } elsif ($ch eq "1") {
        $color = ($cc + $rr >= $size);
      } elsif ($ch eq "2") {
        $color = $cc <= $rr;
      } elsif ($ch eq "*") {
	$color = 0;
      } elsif ($ch eq " ") {
	$color = 1;
      } elsif ($ch eq "\\") {
	$color = ($cc != $rr);
      } elsif ($ch eq "/") {
	$color = ($cc + $rr != $size - 1);
      } elsif ($ch eq "#") {
	$color = ((3*$rr + $cc) % 5) != 0;
      }
      $color = 0 if $border && ($cc == 0 || $rr == 0 || $cc == $size - 1 || $rr == $size - 1);
#      warn "Setting ($x, $y) to color ", (1-$color), "\n" if $y == 0 && $x == 49;
      $Q->[$y][$x] = 1 - $color; # 0 is white, 1 is black
    }
  }
}

sub print_quilt {
  my ($fh, $Q) = @_;
  printf $fh "P1\n%d %d\n", 0 + @{$Q->[0]}, 0 + @$Q;
  for my $line (@$Q) {
    print $fh join("", @$line), "\n";
  }
}

sub max {
  my ($max, @rest) = @_;
  for (@rest) { $max = $max > $_ ? $max : $_ }
  return $max;
}