#!/usr/local/bin/perl5 -w
# converts Across Lite crossword-puzzle file to PostScript or text.
# usage: puz2ps xwname.puz
# output to xwname.ps, xwname.solved.ps, xwname.clues
# Eli Brandt 2/97

#use diagnostics;
use English;

# v0.0  2/97	initial release.
$version = "v0.0 eub 2/97";

# globals:
# $x_size
# $y_size	dimensions.
# @grid		2-d array, '.' or solution.
# @gridb	boolean: space? (vs. black)
# @across_x, 
# @across_y	clue position,
# @across_n	number,		(monotonic)
# @across_clue	and text.
# @down_*	same for down.
# $title,
# $author,
# $copyright	header strings.

$xw_scale = 15;                 # square size (pts.)
$xw_line = 0.5;                 # line width (pts.)
$tag_size = 0.35;               # tag text size.
$tag_hofs = 0.05;
$tag_vofs = 0.35;               # tag position from top-left of square.
$solution_size = 0.8;
$solution_vofs = 0.18;          # letter posn from bottom.
$pg_width = 8.5;
$pg_height = 11;                # page size (in.)
$pg_margin = 0.5;               # margin
#$pg_cluex_min = 1.0;            # minimum clue-column width

# page layout:
#   __________________________________            _   _
#  |_|______________________________|_|  > margin  |   |
#  | |title etc.        |  xword    | |            | cluey1
#  | |__________________|  grid     | |           _|   |    
#  | |17|clue |42|clue  |           | |                | cluey2
#  | |  |foo  |43|clue  |           | |                |
#  | |18|clue |  |bar   |___________| |               _|
#  | |  |     |  |      |           | |
#   
#     \______/ \/
#      cluex    cluenumx
#
#    |____cluecols1_____|_cluecols2_|
#

### main
$ac = @av = @ARGV;
usage()  if $ac!=1;
$puzname = default_extension($av[0], ".puz");

read_puz($puzname);
#spew_test();
spew_ps($puzname);

##########

sub read_puz($)  {
    my($puzname) = @_;

    open(PUZ, $puzname)  or die("gimme puzzle file!");

    seek(PUZ, 0x2c, 0);
    $x_size = ord(getc(PUZ));
    $y_size = ord(getc(PUZ));
    my $size = $x_size*$y_size;

    seek(PUZ, 0x34, 0);
    my $gridstr="";
    read(PUZ, $gridstr, $size);

    seek(PUZ, 0x34 + 2*$size, 0);
    $RS = "\0";
    $title = <PUZ>;	chop($title);
    $author = <PUZ>;	chop($author);
    $copyright = <PUZ>;	chop($copyright);

    my @allclues;
    @allclues = ();
    while (1)  {
        $clue = <PUZ>;
        chomp($clue);
        last unless $clue;

        push(@allclues, $clue);
    }

    close(PUZ);

    gen_grid($gridstr);
    gen_clue_posns();
    gen_clue_text(@allclues);
};

sub gen_grid($)  {
    my($gridstr) = @_;

    my(@grid1) = split //, $gridstr;
    while (@grid1)  {
        my(@row) = splice(@grid1, 0, $x_size);
        push @grid,  [@row];
        push @gridb, [map { $_ ne "." } @row];
    }
};

sub gen_clue_posns()  {
    my $nclue=0;
    my $did_across;

    for $y (0 .. $y_size-1)  {
        for $x (0 .. $x_size-1)  {
#            print "[$grid[$y][$x]]";
            if (!black_p($x,$y))  {
#                print "\t\t($x, $y)\n";
                $did_across = 0;
                if (black_p($x-1, $y))  {
                    ++$nclue;
#                    print "A $nclue  ($x, $y)\n";
                    push(@across_x, $x);
                    push(@across_y, $y);
                    push(@across_n, $nclue);
                    ++$did_across;
                }
                if (black_p($x, $y-1))  {
                    ++$nclue if !$did_across;
#                    print "D $nclue  ($x, $y)\n";
                    push(@down_x, $x);
                    push(@down_y, $y);
                    push(@down_n, $nclue);                    
                }
            }
        }
    }    
};

sub black_p($$)  {
    my($x, $y) = @_;
    return ($x<0 or $y<0 or !$gridb[$y][$x]);
};

sub gen_clue_text(@)  {
    my @clues = @_;

    my ($n, $a_idx, $d_idx, $clue) = (0, 0, 0, 0);
    my $across_count = @across_n;
    my $down_count = @down_n;   # XXX: these should be superfluous
    my $bignum = 999;           # bigger than any clue number

    while ($clue = $clues[$n++])  {
        my $a_n = $a_idx >= @across_n ? $bignum : $across_n[$a_idx];
        my $d_n = $d_idx >= @down_n ? $bignum : $down_n[$d_idx];
#        print "a_n=$a_n d_n=$d_n clue=|$clue|\n";
        if ($a_n and !$d_n or ($a_n <= 3))  {
            print "";
        }
        if ($a_n and !$d_n or $a_n <= $d_n)  {
            push(@across_clue, $clue);
            $a_idx++;
        } else  {
            push(@down_clue,   $clue);
            $d_idx++;
        }
    }
};

##### output

sub spew_ps($)  {
    my($puzname) = @_;

    my $basename = strip_extension($puzname);
    my $psname = "$basename.ps";
    $solvedname = "$basename.solved.ps";
    open(PS, ">$psname")        or die;
    open(SOLV, ">$solvedname")  or die;
    open(CLUES, ">$basename.clues")  or die;

    my (@square_tag, $n);
    for $n (0 .. @across_x-1)  {
#        print "a $across_n[$n]: ($across_x[$n], $across_y[$n])\n";
        $square_tag[$across_y[$n]][$across_x[$n]] = $across_n[$n];
    }
    for $n (0 .. @down_x-1)  {
#        print "d $down_n[$n]: ($down_x[$n], $down_y[$n])\n";
        $square_tag[$down_y[$n]][$down_x[$n]] = $down_n[$n];
    }

#    test_grid(\@square_tag);

    ps_header(*PS);
    ps_header(*SOLV);
    ps_tags(*PS, \@square_tag);
    ps_solution(*SOLV);
    ps_layout(*PS);
    ps_footer(*PS);
    ps_footer(*SOLV);

    ps_clues(*CLUES);

    close(PS);
    close(SOLV);
};

sub test_grid(\@)  {
    my $sqtag = shift;

    my ($x, $y);
    for $y (0 .. $y_size-1)  {
        for $x (0 .. $x_size-1)  {
            if ($gridb[$y][$x])  {
                my $tag;
                if ($tag = $sqtag->[$y][$x])  {
                    printf("[%3d]", $tag);
                } else  {
                    print "[   ]";
                }
            } else  { print "[###]"; }
        }
        print "\n";
    }
};

sub ps_header(*)  {
    my $ps = shift;

    print $ps qq{%!PS-Adobe-2.0
%%Creator: puz2ps $version
%%Pages: 1

save
/text-font /Times-Roman findfont def
/bold-font /Times-Bold findfont def
/sans-font /Helvetica findfont def

/blacken {	% filled square upwards of point
	1 0 rlineto  0 1 rlineto  -1 0 rlineto
	closepath fill
} def

/xsize $x_size def
/ysize $y_size def

/hline {  xsize 0 rlineto stroke  } def		% from left
/vline {  0 ysize rlineto stroke  } def		% from top

/hlines {  0 1 ysize {0 exch moveto hline} for  } def
/vlines {  0 1 ysize {0      moveto vline} for  } def	% lower left at origin
/grid   { hlines vlines } def

/xwscale { $xw_scale dup scale  $xw_line $xw_scale div setlinewidth }  def
}; # end qq

    print $ps "/b { moveto blacken } def\n";
    print $ps "/blacks {\n";

    my ($x, $y);
    for $y (0 .. $y_size-1)  {
        for $x (0 .. $x_size-1)  {
            my $y2 = $y_size - $y - 1;
            print $ps "\t$x $y2 b" if !$gridb[$y][$x];
        }
        print $ps "\n";
    }

    print $ps "} def\n\n";
};

sub ps_tags($\@)  {
    my ($ps, $sqtag) = @_;

    print $ps "/s { moveto show } def\n";
    print $ps "/tags {\n\tsans-font\n\t$tag_size scalefont\n\tsetfont\n";

    my ($x, $y, $tag);
    for $y (0 .. $y_size-1)  {
        for $x (0 .. $x_size-1)  {
            if ($tag = $sqtag->[$y][$x])  {
                my $xpos = $x + $tag_hofs;
                my $ypos = $y_size - $y - $tag_vofs;
                print $ps "\t($tag) $xpos $ypos s\n";
            }
        }
    }

    print $ps "} def\n\n";
};

sub ps_solution(*)  {
    my $ps = shift;

    print $ps "/centerx { dup stringwidth pop 2 div neg 0 rmoveto } def\n";
    print $ps "/s { moveto centerx show } def\n";

    my ($x, $y, $letter);
    for $y (0 .. $y_size-1)  {
        print $ps "/s$y {";
        for $x (0 .. $x_size-1)  {
            if ("." !~ ($letter = $grid[$y][$x]))  {
                my $xpos = $x + 0.5;
                my $ypos = $y_size - $y - 1 + $solution_vofs;
                print $ps " ($letter) $xpos $ypos s";
            }
        }
        print $ps "} def\n\n";
    }

    print $ps "/soln {\n\tsans-font\n\t$solution_size scalefont\n\tsetfont";
    for $y (0 .. $y_size-1)  {
        print $ps " s$y";    # piecemeal to avoid stack overflow
    }
    print $ps "\n} def\n\n";

    my $xtrans = 72*$pg_width/2  - $x_size*$xw_scale/2;
    my $ytrans = 72*$pg_height/2 - $y_size*$xw_scale/2;
    print $ps "gsave\n $xtrans $ytrans translate\n";
    print $ps "xwscale grid blacks soln\ngrestore\n";
};

sub ps_layout(*)  {
    my $ps = shift;

    my $xtrans = 72*($pg_width  - $pg_margin) - $x_size*$xw_scale;
    my $ytrans = 72*($pg_height - $pg_margin) - $y_size*$xw_scale;
    print $ps "\ngsave\n$xtrans $ytrans translate\n";
    print $ps "xwscale grid blacks tags\ngrestore\n";
};

sub ps_footer(*)  {
    my $ps = shift;

    print $ps "\nshowpage\n";
    print $ps "restore\n";
};

sub ps_clues(*)  {
    my $clues = shift;

    print $clues "$title\n";
    print $clues "$author\n";
    print $clues "$copyright\n";

    print $clues "\nAcross:\n";
    ps_cluearr($clues, \@across_n, \@across_clue);

    print $clues "\nDown:\n";
    ps_cluearr($clues, \@down_n, \@down_clue);
};

sub ps_cluearr(*\@\@)  {
    my ($clues, $clnum, $cltext) = @ARG;

    my $n;
    for ($n=0; $n < @$clnum; ++$n)  {
        printf $clues ("%3d ", $clnum->[$n]);
        print  $clues "$cltext->[$n]\n";
    }
};

sub usage()  {
    print STDERR qq{
usage: puz2ps <puzfile>
Converts an Across-format xword.puz file to three files:
    xword.ps            the puzzle grid (PostScript).
    xword.solved.ps     the solution.
    xword.clues         the clues (text).
If I ever finish the PS column code, the clues will go into xword.ps.

puz2ps $version
};
    exit(1);
};

##### util

sub default_extension($$)  {
    my($str, $ext) = @_;

    $str .= $ext  if ($str !~ m!\.[^/]*$!);
    return $str;
};

sub strip_extension($)  {
    my $str = shift;

    $str =~ s!\.[^/]*$!!;
    return $str;
};

sub chomp_and_ret($)  {
    my $str = shift;

    print "str: $str\n";
    chomp($str);
    return $str;
};


sub eprint(@)  {
    print STDERR @ARG;
};