#! /usr/bin/perl -w

use strict;

my $N=3;
my $N2 = 2*$N;

my $M=(1<<$N2);

my $num =0;
for(my $i=0; $i<$M; $i++) {
    my $str = sprintf "%0${N2}b", $i;
    my $zeroes = scalar($str=~tr/0/0/);
    next unless $zeroes==$N;

    my @sums = get_sums($str);
    my $newstr = flip_bad($str, \@sums);
    next unless defined $newstr;
    my @newsums = get_sums($newstr);

    $str=~tr/01/)(/;
    $newstr=~tr/01/)(/;

    my $file = sprintf "l22-catalan-%02d", $num;
    draw_one($str, \@sums, $newstr, \@newsums, $file);

    $num++;
}


sub draw_one {
    my ($str, $sums, $newstr, $newsums, $file) = @_;

    print STDERR $file, " ", $str, " ", $newstr, "\n";

    my $out;
    open $out, "| jgraph > $file.eps", or die;

    my ($y1, $y2) = (-$N-1, $N-1);
    printf $out "newgraph\nxaxis nodraw size %f yaxis min %d max %d nodraw size %f\n",
     ($N2*2+1)*0.7, $y1, $y2+1, ($N2+1)*0.2;

    draw_sums(0, $sums, $str, $y1, $y2, $out);
    draw_sums($N2+1, $newsums, $newstr, $y1, $y2, $out);

    for(my $y = $y1; $y<=$y2; $y++) {
	printf $out "newstring lgray 0.7 fontsize 14 x %f y %f : %s\n", 
	$N2+0.5, $y, $y;
    }

    close $out;
}

sub draw_sums {
    my ($x, $sums, $str, $y1, $y2, $out) = @_;

    for(my $j=0; $j<length($str); $j++) {
	printf $out "newstring fontsize 20 x %f y %f vjb : %s\n", 
	$x+$j+0.5, $y2+0.5, substr($str, $j, 1);
    }

    for(my $y = $y1; $y<=$y2; $y++) {
	printf $out "newline linethickness %d gray 0.7 pts %d %d %d %d\n",
	($y==0)?4:1, $x, $y, $x+scalar(@$sums)-1, $y;
    }
    
    print $out "newline linethickness 2 gray 0 marktype circle pts\n";
    my $was = 0;
    for(my $j=0; $j<@$sums; $j++) {
	printf $out " %d %d", $x+$j, $sums->[$j];
	if($sums->[$j]<0 && !$was) {
	    $was = 1;
	    #printf "%s %d %d\n", $str, $j, $sums->[$j];
	    print $out "\nnewline linethickness 4 color 1 0 0  marktype circle  pts\n";
	    printf $out " %d %d", $x+$j, $sums->[$j];
	}
    }
    print $out "\n";
}


sub get_sums {
    my ($str) = @_;

    my @a = split '', $str;
    my @sums = (0);
    my $s = 0;
    for(my $j=0; $j<$N2; $j++) {
	$s+=($a[$j]==1)?1:-1;
	push @sums, $s;
    }
    return @sums;
}


sub flip_bad {
    my ($str, $sums) = @_;

    my $first;
    for(my $j=0; $j<@$sums; $j++) {
	if($sums->[$j]<0) {
	    $first = $j;
	    last;
	}
    }
    if(!defined $first) { return; }

    #first is the first negative in sums, 
    #$first-1 is corresponding position in $str,
    #we want to flip starting right after that
    my $newstr = substr($str, $first);
    $newstr =~ tr/01/10/;
    $newstr = substr($str, 0, $first) . $newstr;
    return $newstr;
}
