head	1.41;
access;
symbols;
locks; strict;
comment	@# @;


1.41
date	98.01.07.21.34.03;	author esr;	state Exp;
branches;
next	1.40;

1.40
date	98.01.07.19.58.14;	author esr;	state Exp;
branches;
next	1.39;

1.39
date	98.01.01.21.59.43;	author esr;	state Exp;
branches;
next	1.38;

1.38
date	98.01.01.16.21.11;	author esr;	state Exp;
branches;
next	1.37;

1.37
date	97.12.31.23.02.44;	author esr;	state Exp;
branches;
next	1.36;

1.36
date	97.12.31.22.51.53;	author esr;	state Exp;
branches;
next	1.35;

1.35
date	97.12.31.22.47.00;	author esr;	state Exp;
branches;
next	1.34;

1.34
date	97.12.31.22.23.34;	author esr;	state Exp;
branches;
next	1.33;

1.33
date	97.12.31.21.55.44;	author esr;	state Exp;
branches;
next	1.32;

1.32
date	97.12.31.21.38.59;	author esr;	state Exp;
branches;
next	1.31;

1.31
date	97.12.31.21.06.38;	author esr;	state Exp;
branches;
next	1.30;

1.30
date	97.12.31.20.56.27;	author esr;	state Exp;
branches;
next	1.29;

1.29
date	97.12.31.20.54.50;	author esr;	state Exp;
branches;
next	1.28;

1.28
date	97.12.31.19.57.43;	author esr;	state Exp;
branches;
next	1.27;

1.27
date	97.12.31.18.43.08;	author esr;	state Exp;
branches;
next	1.26;

1.26
date	97.12.31.18.36.29;	author esr;	state Exp;
branches;
next	1.25;

1.25
date	97.12.31.18.24.13;	author esr;	state Exp;
branches;
next	1.24;

1.24
date	97.12.31.18.08.56;	author esr;	state Exp;
branches;
next	1.23;

1.23
date	97.12.31.18.06.22;	author esr;	state Exp;
branches;
next	1.22;

1.22
date	97.12.31.17.53.36;	author esr;	state Exp;
branches;
next	1.21;

1.21
date	97.12.31.17.43.43;	author esr;	state Exp;
branches;
next	1.20;

1.20
date	97.12.31.17.42.04;	author esr;	state Exp;
branches;
next	1.19;

1.19
date	97.12.31.17.41.01;	author esr;	state Exp;
branches;
next	1.18;

1.18
date	97.12.31.17.22.11;	author esr;	state Exp;
branches;
next	1.17;

1.17
date	97.12.31.17.19.28;	author esr;	state Exp;
branches;
next	1.16;

1.16
date	97.12.31.17.17.11;	author esr;	state Exp;
branches;
next	1.15;

1.15
date	97.12.31.17.15.42;	author esr;	state Exp;
branches;
next	1.14;

1.14
date	97.12.31.17.12.08;	author esr;	state Exp;
branches;
next	1.13;

1.13
date	97.12.31.16.57.06;	author esr;	state Exp;
branches;
next	1.12;

1.12
date	97.12.31.16.48.51;	author esr;	state Exp;
branches;
next	1.11;

1.11
date	97.12.31.15.49.15;	author esr;	state Exp;
branches;
next	1.10;

1.10
date	97.12.31.15.42.17;	author esr;	state Exp;
branches;
next	1.9;

1.9
date	97.12.31.03.37.17;	author esr;	state Exp;
branches;
next	1.8;

1.8
date	97.12.31.03.33.46;	author esr;	state Exp;
branches;
next	1.7;

1.7
date	97.12.31.03.26.26;	author esr;	state Exp;
branches;
next	1.6;

1.6
date	97.12.30.21.26.44;	author esr;	state Exp;
branches;
next	1.5;

1.5
date	97.12.30.21.06.41;	author esr;	state Exp;
branches;
next	1.4;

1.4
date	97.12.30.20.20.55;	author esr;	state Exp;
branches;
next	1.3;

1.3
date	97.12.30.20.11.50;	author esr;	state Exp;
branches;
next	1.2;

1.2
date	97.12.30.19.33.25;	author esr;	state Exp;
branches;
next	1.1;

1.1
date	97.12.30.19.11.48;	author esr;	state Exp;
branches;
next	;


desc
@@


1.41
log
@Better pattern analysis.
@
text
@#!/usr/bin/perl
#
# anthologize -- convert an image scatter to structured notation
#
# Takes a collection of #P blocks with offsets and translates it
# to offsetless P blocks and an #I list.  Can recognize and coalesce
# identical blocks, or blocks that are the same modulo X- or Y-axis reflection.

# Number of successive blank lines that triggers a breakup of a picture
# into two subpictures that are analyzed separately.
$run_sensitivity = 1;

# List of patterns we can recognize by name.
# Any orientation of these will do.  They're
# not used for shape recognition, as that
# has to be relative to a seen sub-rectangle.
%known = 
(
 "***\n",				"blinker",
 "**\n*\n",				"elbow",
 "**\n**\n",				"block",
 "..*\n*.*\n.**\n",			"glider",
 "*\n.**\n**\n",			"glider2", 
 ".****\n*...*\n....*\n...*\n",		"lwss",
 "..**\n**.**\n****\n.**\n",		"lwss2",
 ".*****\n*....*\n.....*\n....*\n",	"mwss",
 "...**\n***.**\n*****\n.***\n",	"mwss2",
 ".....*\n......*\n*.....*\n.******\n",	"hwss",
 "....**\n****.**\n******\n.****\n",	"hwss2",
 "*\n***\n...*\n..**\n",		"eater",
 "*.**\n**.*\n",			"snake",
 ".*\n*.*\n**\n",			"boat",
 "**\n.**\n**\n*\n",			"bheptomino",
 ".*\n***\n",				"tee",
);

my(%assoc, $thispattern, $xoffset, $yoffset, $pushback);

$n = 1;
while (<STDIN>)
{
    push(@@header, $_);
    last if /^$/;
}

while (<STDIN>)
{
  redo:
    if (/^#P ([0-9-]*) ([0-9-]*)/)
    {
	my($name, $try, $include, $height, $width, @@name, $runsize);

	$xoffset = $1;
	$yoffset = $2;
	if ($pushback) {
	    $thispattern = $pushback;
	    $height = 1;
	    $width = length(pushback);
	    undef $pushback;
	} else {
	    $thispattern = "";
	    $height = $width = 0;
	}
	while (<STDIN>)
	{
	    last if (/^[^.*]/);

	    # If this is the end of a run of blank picture lines,
	    # push back the nonblank line and a faked-up picture header.
	    if (substr($thispattern, -2) eq ".\n" && $_ ne ".\n") {
		for ($runsize = 1; $runsize <= $height; $runsize++) {
		    last if (substr($thispattern, -(2 * $runsize)) ne (".\n" x $runsize));
		}
		$runsize--;
		if ($runsize >= $run_sensitivity) {
		    $pushback = $_;
		    $thispattern = substr($thispattern, 0, -(2 * $runsize));
		    my($newyoffset) = $yoffset + $height; 
		    $height -= $runsize;
		    $_ = "#P $xoffset $newyoffset\n";
		    last;
		}
	    }

	    $thispattern .= $_;
	    $height++;
	    $width = length($_) if length($_) > $width;
	}
	$width--;

        @@parts = split("\n", $thispattern);
	while (grep(substr($_, 0, 1) eq '.', @@parts) == $height) {
	    grep($_ = substr($_, 1), @@parts);
	    $width--;
	    $xoffset++;
	}
	$thispattern = join("\n", @@parts) . "\n";

	@@match = &derive(\%assoc, $thispattern, $xoffset, $yoffset, $width, $height);
	$include = $match[1];
	if (!$include) {
	    @@match = &derive(\%known, $thispattern, $xoffset, $yoffset, $width, $height);
	    if ($match[0]) {
		$name = $match[0];
	    } else {
		$name = "fragment-$n";
		$n++;
	    }
	    $assoc{$thispattern} = "$name";
	    push(@@lines, "#B :$name\n");
	    push(@@lines, "#K " . $ARGV[0] . "\n") if @@ARGV;
	    push(@@lines, "#P\n");
	    push(@@lines, $thispattern);
	    push(@@lines, "#E\n\n");
	    $include = sprintf("#I :%-12s %3d %3d 0  1 0\n",$name,$xoffset,$yoffset)
	}

	push(@@contents, $include);

	goto redo;
    }
    else
    {
	push(@@lines, $_);
    }
}

print @@header, @@lines, @@contents, "\n## Pattern ends here.\n";

sub derive
# Try to recognize a pattern block from the given association list.
{
    my($assoc, $pattern, $xoffset, $yoffset, $width, $height) = @@_;
    my($match, $rot1, $rot2, $rot3);

    if (($match = $$assoc{$pattern})) {
	return(($match, sprintf("#I :%-12s %3d %3d 0  1 0\n",$match,$xoffset,$yoffset)));
    } 
    if (($match = $$assoc{&xreflect($pattern)})) {
	$yoffset += ($height-1);
	return(($match, sprintf("#I :%-12s %3d %3d 0 -1 0\n",$match,$xoffset,$yoffset)));
    } 
#    $rot1 = &rotate($pattern, $width, $height);
#    if (($match = $$assoc{$rot1})) {
#	$yoffset += ($height-1);
#	return(($match, sprintf("#I :%-12s %3d %3d 3  1 0\n",$match,$xoffset,$yoffset)));
#    }
    if (($match = $$assoc{&xreflect($rot1)})) {
	$xoffset += ($width-1);
	$yoffset += ($height-1);
	return(($match, sprintf("#I :%-12s %3d %3d 3 -1 0\n",$match,$xoffset,$yoffset)));
    }
    $rot2 = &rotate($rot1, $height, $width);
    if (($match = $$assoc{$rot2})) {
	$xoffset += ($width-1);
	$yoffset += ($height-1);
	return(($match, sprintf("#I :%-12s %3d %3d 2  1 0\n",$match,$xoffset,$yoffset)));
    }
#    if (($match = $$assoc{&xreflect($rot2)})) {
#	$xoffset += ($width - 1);
#	$yoffset += ($height-1);
#	return(($match, sprintf("#I :%-12s %3d %3d 2 -1 0\n",$match,$xoffset,$yoffset)));
#    }
    $rot3 = &rotate($rot2, $width, $height);
    if (($match = $$assoc{$rot3})) {
	$xoffset += ($width - 1);
	return(($match, sprintf("#I :%-12s %3d %3d 1  1 0\n",$match,$xoffset,$yoffset)));
    }
#    if (($match = $$assoc{&xreflect($rot3)})) {
#	$xoffset += ($width - 1);
#	return(($match, sprintf("#I :%-12s %3d %3d 1 -1 0\n",$match,$xoffset,$yoffset)));
#    }

    return(undef);
}

sub xreflect 
# Reflect a pattern around its X axis
{
    my($pattern) = @@_;
    my($reversed);

    grep($reversed = "$_\n$reversed", split("\n", $pattern));
    return($reversed);

}

sub rotate
# Rotate a pattern clockwise
{
    my($pattern, $width, $height) = @@_;
    my (@@rotated, @@parts, $i, $j);

    @@parts = split("\n", $pattern);
    grep($_ = $_ . ("." x ($width - length($_))), @@parts);
    for ($i = $height - 1; $i >= 0; $i--) {
	for ($j = 0; $j < $width; $j++) {
	    @@rotated[$j] .= substr($parts[$i], $j, 1);
	}
    }

    grep($_ = &strip($_), @@rotated);
    $pattern = join("\n", @@rotated) . "\n";
    return($pattern)
}

sub strip
# Strip extraneous dots off the ends of all pattern lines
{
    my($pattern) = @@_;
    while (substr($pattern, -1, 1) eq '.') {
	$pattern = substr($pattern, 0, -1);
    }

    return($pattern);
}
@


1.40
log
@Recognize mwss.
@
text
@d32 3
a34 1

@


1.39
log
@Reflect and rotate case doesn't work.
@
text
@d29 1
@


1.38
log
@This version works.
@
text
@d140 5
a144 5
    $rot1 = &rotate($pattern, $width, $height);
    if (($match = $$assoc{$rot1})) {
	$yoffset += ($height-1);
	return(($match, sprintf("#I :%-12s %3d %3d 3  1 0\n",$match,$xoffset,$yoffset)));
    }
@


1.37
log
@Verified rot1 + flip case.
@
text
@a16 3
# Note: it's unsafe to try and recognize blinkers,
# as their two phases will end up getting mapped
# to the same name.
d19 1
d22 1
a22 1
# "..*\n*.*\n.**\n",			"glider",
@


1.36
log
@Recognize heavyweight spaceships.
@
text
@d147 5
a151 4
#    if (($match = $$assoc{&xreflect($rot1)})) {
#	$yoffset += ($height-1);
#	return(($match, sprintf("#I :%-12s %3d %3d 3 -1 0\n",$match,$xoffset,$yoffset)));
#    }
@


1.35
log
@Recognize snakes.
@
text
@d30 1
@


1.34
log
@We've verified that rot3 is recognized.
@
text
@d31 2
@


1.33
log
@Breeder4 breaks this.
@
text
@d24 1
a24 1
 "..*\n*.*\n.**\n",			"glider",
d159 5
a163 5
#    $rot3 = &rotate($rot2, $width, $height);
#    if (($match = $$assoc{$rot3})) {
#	$xoffset += ($width - 1);
#	return(($match, sprintf("#I :%-12s %3d %3d 1  1 0\n",$match,$xoffset,$yoffset)));
#    }
@


1.32
log
@X-stripping.
@
text
@d17 3
a21 1
 "***\n",				"blinker",
d30 1
@


1.31
log
@Cleanup.
@
text
@d84 8
@


1.30
log
@This version also works.
@
text
@d9 3
a11 5
while (<STDIN>)
{
    push(@@header, $_);
    last if /^$/;
}
d35 6
d61 2
a62 2
	    # If this is the end of a bunch of blank picture lines,
	    # push back 
d68 1
a68 1
		if ($runsize >= 2) {
@


1.29
log
@This version works.
@
text
@d66 1
@


1.28
log
@Next step.
@
text
@d59 1
a59 1
	    if (0 && substr($thispattern, -2) eq ".\n" && $_ ne ".\n") {
d66 1
a67 1
		    my($newyoffset) = $yoffset + $runsize - 1; 
@


1.27
log
@We can do name recognition.
@
text
@d32 1
a32 1
my(%assoc, $thispattern, $xoffset, $yoffset);
d40 1
a40 1
	my($name, $try, $include, $height, $width, @@name);
d44 9
a52 2
	$thispattern = "";
	$height = $width = 0;
d55 18
a72 2
	    last if (/^[^.*]/)
;
@


1.26
log
@We can do name recognition.
@
text
@d16 3
a18 1
# Any orientation of these will do.
d24 2
a25 1
 "..*\n*.*\n.**\n",			"glider", 
d28 2
d63 1
a63 1
		$name = $n;
@


1.25
log
@We can do name recognition.
@
text
@d15 2
d19 6
a24 1
    "**\n*\n", "elbow",
@


1.24
log
@This seems to work too.
@
text
@d15 4
d47 8
a54 2
	    $assoc{$thispattern} = "$n";
	    $name = $n;
a59 1
	    $n++;
@


1.23
log
@This seems to work too.
@
text
@d24 1
a24 1
	my($name, $try, $include, $height, $width);
d67 1
a67 1
# Try to recognize a pattern block
@


1.22
log
@This appears to work.
@
text
@d40 2
a41 1
	$include = &derive(\%assoc, $thispattern, $xoffset, $yoffset, $width, $height);
d73 1
a73 1
	return(sprintf("#I :%-12s %3d %3d 0  1 0\n",$match,$xoffset,$yoffset));
d77 1
a77 1
	return(sprintf("#I :%-12s %3d %3d 0 -1 0\n",$match,$xoffset,$yoffset));
d82 1
a82 1
	return(sprintf("#I :%-12s %3d %3d 3  1 0\n",$match,$xoffset,$yoffset));
d86 1
a86 1
#	return(sprintf("#I :%-12s %3d %3d 3 -1 0\n",$match,$xoffset,$yoffset));
d92 1
a92 1
	return(sprintf("#I :%-12s %3d %3d 2  1 0\n",$match,$xoffset,$yoffset));
d97 1
a97 1
#	return(sprintf("#I :%-12s %3d %3d 2 -1 0\n",$match,$xoffset,$yoffset));
d102 1
a102 1
#	return(sprintf("#I :%-12s %3d %3d 1  1 0\n",$match,$xoffset,$yoffset));
d106 1
a106 1
#	return(sprintf("#I :%-12s %3d %3d 1 -1 0\n",$match,$xoffset,$yoffset));
d109 1
a109 1
    return("");
@


1.21
log
@This version works.
@
text
@d40 1
a40 1
	$include = &derive($thispattern, $xoffset, $yoffset, $width, $height);
d68 1
a68 1
    my($pattern, $xoffset, $yoffset, $width, $height) = @@_;
d71 1
a71 1
    if (($match = $assoc{$pattern})) {
d74 1
a74 1
    if (($match = $assoc{&xreflect($pattern)})) {
d79 1
a79 1
    if (($match = $assoc{$rot1})) {
d83 1
a83 1
#    if (($match = $assoc{&xreflect($rot1)})) {
d88 1
a88 1
    if (($match = $assoc{$rot2})) {
d93 1
a93 1
#    if (($match = $assoc{&xreflect($rot2)})) {
d99 1
a99 1
#    if (($match = $assoc{$rot3})) {
d103 1
a103 1
#    if (($match = $assoc{&xreflect($rot3)})) {
@


1.20
log
@This version works.
@
text
@d87 6
a92 6
#    $rot2 = &rotate($rot1, $height, $width);
#    if (($match = $assoc{$rot2})) {
#	$xoffset += ($width-1);
#	$yoffset += ($height-1);
#	return(sprintf("#I :%-12s %3d %3d 2  1 0\n",$match,$xoffset,$yoffset));
#    }
@


1.19
log
@This version works.
@
text
@d78 5
a82 5
#    $rot1 = &rotate($pattern, $width, $height);
#    if (($match = $assoc{$rot1})) {
#	$yoffset += ($height-1);
#	return(sprintf("#I :%-12s %3d %3d 3  1 0\n",$match,$xoffset,$yoffset));
#    }
@


1.18
log
@This works.
@
text
@d78 5
a82 5
    $rot1 = &rotate($pattern, $width, $height);
    if (($match = $assoc{$rot1})) {
	$yoffset += ($height-1);
	return(sprintf("#I :%-12s %3d %3d 3  1 0\n",$match,$xoffset,$yoffset));
    }
d87 6
a92 6
    $rot2 = &rotate($rot1, $height, $width);
    if (($match = $assoc{$rot2})) {
	$xoffset += ($width-1);
	$yoffset += ($height-1);
	return(sprintf("#I :%-12s %3d %3d 2  1 0\n",$match,$xoffset,$yoffset));
    }
@


1.17
log
@This works.
@
text
@d98 1
a98 1
    $rot3 = &rotate($rot1, $width, $height);
@


1.16
log
@This version works.
@
text
@d87 6
a92 6
    $rot2 = &rotate($pattern, $height, $width);
#    if (($match = $assoc{$rot2})) {
#	$xoffset += ($width - 1);
#	$yoffset += ($height-1);
#	return(sprintf("#I :%-12s %3d %3d 2  1 0\n",$match,$xoffset,$yoffset));
#    }
d98 1
a98 1
    $rot3 = &rotate($pattern, $width, $height);
@


1.15
log
@This version works.
@
text
@d79 4
a82 4
#    if (($match = $assoc{$rot1})) {
#	$yoffset += ($height-1);
#	return(sprintf("#I :%-12s %3d %3d 3  1 0\n",$match,$xoffset,$yoffset));
#    }
@


1.14
log
@This version works.
@
text
@d78 1
a78 1
#    $rot1 = &rotate($pattern, $width, $height);
d87 1
a87 1
#    $rot2 = &rotate($pattern, $height, $width);
d98 1
a98 1
#    $rot3 = &rotate($pattern, $width, $height);
@


1.13
log
@This version is known good.
@
text
@d50 1
a50 2
	    $include = "#I :$name   $xoffset $yoffset 0 0 0\n";

d72 1
a72 1
	return("#I :$match   $xoffset $yoffset 0  1 0\n");
d76 1
a76 1
	return("#I :$match   $xoffset $yoffset 0 -1 0\n");
d81 1
a81 1
#	return("#I :$match   $xoffset $yoffset 3  1 0\n");
d85 1
a85 1
#	return("#I :$match   $xoffset $yoffset 3 -1 0\n");
d91 1
a91 1
#	return("#I :$match   $xoffset $yoffset 2  1 0\n");
d96 1
a96 1
#	return("#I :$match   $xoffset $yoffset 2 -1 0\n");
d101 1
a101 1
#	return("#I :$match   $xoffset $yoffset 1  1 0\n");
d105 1
a105 1
#	return("#I :$match   $xoffset $yoffset 1 -1 0\n");
@


1.12
log
@This version works.
@
text
@d79 5
a83 5
    $rot1 = &rotate($pattern, $width, $height);
    if (($match = $assoc{$rot1})) {
	$yoffset += ($height-1);
	return("#I :$match   $xoffset $yoffset 3  1 0\n");
    }
d88 6
a93 6
    $rot2 = &rotate($pattern, $height, $width);
    if (($match = $assoc{$rot2})) {
	$xoffset += ($width - 1);
	$yoffset += ($height-1);
	return("#I :$match   $xoffset $yoffset 2  1 0\n");
    }
d99 5
a103 5
    $rot3 = &rotate($pattern, $width, $height);
    if (($match = $assoc{$rot3})) {
	$xoffset += ($width - 1);
	return("#I :$match   $xoffset $yoffset 1  1 0\n");
    }
@


1.11
log
@This does rotation correctly.
@
text
@d70 1
a70 1
    my($match);
d73 3
a75 2
	return("#I :$match   $xoffset $yoffset 0 0 0\n");
    } elsif (($match = $assoc{&xreflect($pattern)})) {
d78 12
a89 1
    } elsif (($match = $assoc{&yreflect($pattern, $width)})) {
d91 10
a100 6
	return("#I :$match   $xoffset $yoffset 2 -1 0\n");
    } elsif (($match = $assoc{&yreflect(&xreflect($pattern, $height), $width)})) {
	$xoffset += ($width - 1);
	$yoffset += ($height - 1);
	return("#I :$match   $xoffset $yoffset 2 0 0\n");
    } elsif (($match = $assoc{&rotate($pattern, $width, $height)})) {
d102 1
a102 3
	return("#I :$match   $xoffset $yoffset 1 0 0\n");
    } else {
	return("");
d104 6
d113 1
a122 26
sub yreflect 
# Reflect a pattern around its Y axis
{
    my($pattern, $width) = @@_;
    my(@@parts) = split("\n", $pattern);

    grep($_ = $_ . ("." x ($width - length($_))), @@parts);
    grep($_ = &strip(&reverse($_)), @@parts);

    $pattern = join("\n", @@parts) . "\n";

    return($pattern);
}

sub reverse
# Reverse a string
{
    my($pattern) = @@_;
    my($reversed);

    for ($i = length($pattern); $i > 0; $i--) {
	$reversed .= substr($pattern, $i - 1, 1);
    }
    return($reversed);
}

d124 1
a124 1
# Rotate a string
a128 1
print "Before rotation ($width, $height): !!!\n$pattern???\n";
a138 1
print "After rotation: !!!\n$pattern???\n";
@


1.10
log
@This version seems to work.
This seems to work.
@
text
@d84 1
a84 1
    } elsif (($match = $assoc{&diagflip($pattern, $width, $height)})) {
d86 1
a86 1
	return("#I :$match   $xoffset $yoffset 3 -1 0\n");
d128 2
a129 2
sub diagflip
# Diagflip a string
d132 1
a132 1
    my (@@diagflipped, @@parts, $i, $j);
d134 1
a134 1
print "Before flip ($width, $height): !!!\n$pattern???\n";
d137 1
a137 1
    for ($i = 0; $i < $height; $i++) {
d139 1
a139 1
	    @@diagflipped[$j] .= substr($parts[$i], $j, 1);
d143 3
a145 2
    $pattern = &strip(join("\n", @@diagflipped) . "\n");
print "After flip: !!!\n$pattern???\n";
@


1.9
log
@This works.
@
text
@d44 1
a44 1
	    push(@@lines, "#B $name\n");
d84 4
a87 1
   } else {
d125 21
a145 1
    return $reversed
@


1.8
log
@This version works.
@
text
@d7 1
a7 1
# identical blocks, or blocks that are the same modulo X-axis reflection.
d80 5
a84 1
    } else {
@


1.7
log
@This version works.
@
text
@d77 3
d95 36
@


1.6
log
@This appears to be correct.
@
text
@d16 1
a16 1
my(%assoc, %lengths, $thispattern, $xoffset, $yoffset);
d24 1
a24 1
	my($name, $try, $include, $length);
a27 1
	$length = 0;
d29 1
a29 1
	$length = 0;
d32 2
a33 1
	    last if (/^[^.*]/);
d35 2
a36 1
	    $length++;
d38 1
d40 1
a40 1
	$include = &derive($thispattern, $xoffset, $yoffset);
a42 1
	    $lengths{$n} = $length;
d69 1
a69 1
    my($pattern, $xoffset, $yoffset) = @@_;
d75 1
a75 1
	$yoffset += ($lengths{$match} - 1);
@


1.5
log
@This version doesn't get y offsets right.
@
text
@d16 1
a16 1
my(%assoc, $thispattern, $offsets);
d22 1
a22 1
    if (/^#P/)
d24 1
a24 1
	my($name, $try, $include);
d26 3
a28 1
	$offsets = substr($_, 3, -1);
d30 1
d35 1
d38 1
a38 1
	$include = &derive($thispattern, $offsets);
d41 1
d49 1
a49 1
	    $include = "#I :$name   $offsets 0 0 0\n";
d68 1
a68 1
    my($pattern, $offsets) = @@_;
d72 1
a72 1
	return("#I :$match   $offsets 0 0 0\n");
d74 2
a75 1
	return("#I :$match   $offsets 0 -1 0\n");
a89 1

@


1.4
log
@This can recognize exact matches.
@
text
@d4 4
d18 1
a18 1
$n = 0;
d45 1
d61 1
d66 1
a66 2
    $match = $assoc{$pattern};
    if ($match) {
d68 2
d74 12
@


1.3
log
@First versionthat does part recognition.
@
text
@d20 1
a20 1
	my($name, $try);
d30 2
a31 4
	$try = $assoc{$thispattern};
	if ($try) {
	    $name = $try;
	} else {
d40 1
d43 1
a43 1
	push(@@contents, "#I :$name   $offsets 0 0 0\n");
d55 12
a66 1

@


1.2
log
@First step towards name recognition.
@
text
@d12 2
d20 1
a20 3
	my($offsets) = substr($_, 3, -1);
	my($thispattern) = "";
	my($name);
d22 2
d30 14
a43 1
	$name = $n;
a44 8
	push(@@lines, "#B $name\n");

	push(@@lines, "#K " . $ARGV[0] . "\n") if @@ARGV;
	push(@@lines, "#P\n");
	push(@@lines, $thispattern);
	push(@@lines, "#E\n\n");

	$n++;
a51 1
	
@


1.1
log
@Initial revision
@
text
@d15 1
d18 14
a31 4
	push(@@lines, "#E\n\n") if $n;
	chop $_;
	push(@@contents, "#I :$n   " . substr($_, 3) . " 0 0 0\n");
	push(@@lines, "#B $n\n");
d34 3
d38 2
d48 1
a48 1
print @@header, @@lines, "#E\n\n", @@contents, "\n## Pattern ends here.\n";
@
