#ifdef Perl; "
"; !"; sub Constant ($) {}; sub Headline ($) { $x=$_[0]; $x =~ s/\^/\n/g; print $x; } sub Story ($) { print $_[0]; } #"
#endif;

Constant Story "Obfuscated Perl Competition";
Constant Headline "^An interactive adventure in source-code obscurity.^";

#Include "Parser";  Constant Code          "Just Another Inform Hacker
";!"; sub with (@) { return @_; }          "who really
  !"; sub Object (@) { }                   "ought to
  !"; sub EmptyRoom {} sub Desk {}         "know better
  !"; sub initial { print "\n$_[0]\n> "; } "than this.
  !"; sub description { print "\n$_[1]\n$_[0]\n"; } "
  !"; sub short_name {} sub has($) {};

Object EmptyRoom
  with
    description
         "The walls are white.",
    short_name "EMPTY ROOM",
  has light;

Object Desk
EmptyRoom
  with
    initial
         "This is the desk where you are supposed to be working on your entry
for the Obfuscated Perl Competition.  But your mind keeps slipping
back to that text adventure you were working on before...",
    short_name "Desk",
  has static;

#Include "VerbLib"; [ Initialise; location = EmptyRoom; ];  global winmsg "You write an entry that compiles in both Perl and Inform.
";!";

#Include "Grammar"; [ FinishSub; deadflag=2; print_ret winmsg, "
      "; ];

Verb 'write' 'entry' -> Finish;
Verb 'win'           -> Finish;
Verb 'finish'        -> Finish;

end;

";

$debug=0;

push @grammar, [['quit'],             'Quit'];
push @grammar, [['write', 'entry'],   'Finish'];
push @grammar, [['win'],              'Finish'];
# I could do more, but I do not have the gumption to reproduce
# the entire Inform standard library grammar here.  Besides,
# my parser can't handle most of it, and the Perl object model
# is not up to the more advanced stuff.  (Inform is very OO.)

%verb =
  (
   Quit => sub { exit 0; },
   Finish => sub {
     print "You write an entry that compiles in both Perl and Inform.\n\n *** You Have Won ***\n\n"; exit 0;
   },
   # I don't have the gumption to reproduce the entire Inform verb library here, either.
  );

sub gramerr {
  my ($tok,$gram) = @_;
  if ($tok>$besterr) {
    $besterr=$tok; $bestgram=$gram;
  }
}

while (<STDIN>) {
  @token=split/\s+/,$_;
  $besterr=0;
  foreach $g (@grammar) {
    last if ($besterr==999);
    if ($debug>1) { print "Considering grammar line: @$g:  "; }
    @gramline = @$g;
    $gramtoken= @{gramline[0]};
    $gramverb = @gramline[1];
    $mismatch=0;
    $t=0;
    while ($t<scalar @$gramtoken and $mismatch==0 and $besterr<999) {
      if ($debug>2) {  print "  [token $t: $token[$t] vs $$gramtoken[$t]]"; }
      if ((not defined $token[$t]) or ($token[$t] !~ $$gramtoken[$t])) {
	gramerr($t+1, $g);  $mismatch++; if ($debug>2) {print "mismatch\n";}}
      if (not $mismatch) {
	if ($debug>2) { print "matches so far\n";}
	if ($t+1==scalar@$gramtoken) {
	  $bestgram=$g; $besterr=999;
	  if ($debug>2) { print "matches fully\n"; }}}
      $t++; }}
  if ($besterr==999) {
    $g=$bestgram;
    @gramline = @$g;
    $gramtoken= @{gramline[0]};
    $gramverb = @gramline[1];
    if ($debug) { print "Calling routine for $gramverb\n";  }
    &{$verb{$gramverb}};
  } else {
    # This is horrifically weak, but this is an exercise in
    # merging two computer languages, not in natural language
    # parsing, and anyway I'm not a genius like Graham Nelson.
    if ($besterr<2) {
      print "What do you mean by $token[0]"; }
    else {
      print "What do you want to";
      $g=$bestgram;
      @gramline = @$g;
      $gramtoken= @{gramline[0]};
      $gramverb = @gramline[1];
      foreach (0..($besterr-1)) {
	print " " . $token[$_];
      }
    }
    print "?\n> ";
  }
}

##</code><code>##

sub H{$_=shift;while($_){$c=0;while(s/^2//){$c++;}s/^4//;$
v.=(' ','|','_',"\n",'\\','/')[$c]}$v}sub A{$_=shift;while
($_){$d=hex chop;for(1..4){$pl.=($d%2)?4:2;$d>>=1}}$pl}$H=
"16f6da116f6db14b4b0906c4f324";print H(A($H)) # -- jonadab