#!/usr/bin/perl -w
use strict;
use Curses;#, foiled again!
my $VERSION = (qw$Revision: 1.5 $)[-1];

use constant ROGUELIKE => 0;
use constant ZORKLIKE  => 1;
use constant STATSIZE  => 10;
use vars qw/$or %edges @HALL_DESCS/;
my $resize_executable = "/usr/X11R6/bin/resize";

$SIG{__WARN__} = sub{die shift;};

#create and display screen
use vars qw/%display/;
%display  = &setup(ROGUELIKE);
$SIG{WINCH} = sub {%display = &setup($display{type});&update;$display{main}->refresh;$display{stats}->refresh;};
#create level
$or = &create_level;
my %player = (location=>[20,20],cheat=>0);
my $key = '';
&update;
do {
  $display{stats}->refresh; $display{main}->refresh;
  $key = $display{main}->getch;
  $display{stats}->clrtoeol(1,0);
  if ($key eq '`') {
    if ($display{type} == ZORKLIKE) {
      $display{main}->addstr("Going to roguelike..\n");
      %display = &setup(ROGUELIKE);
      $display{main}->addstr("Now in roguelike mode..\n");
    } else {
      $display{main}->addstr("Going to Zork-like..\n");
      %display = &setup(ZORKLIKE);
      $display{main}->addstr("Now in Zork-like mode..\n");
    }
    &update;
  } elsif ($key eq 'm') {
    $or = &create_level;
    $player{location} = [20,20];
    $player{seen} = {};
    &update;
  } elsif ($key eq 'c') {
    $player{cheat} = 1 - $player{cheat};
    &update;
  } elsif (($key eq 259 or $key eq 274) and &can_go(&occupied(@{$player{location}}),&occupied($player{location}[0],$player{location}[1]-1))) {
    $player{location}[1]--; &update;
  } elsif (($key eq 258 or $key eq 350) and &can_go(&occupied(@{$player{location}}),&occupied($player{location}[0],$player{location}[1]+1))) {
    $player{location}[1]++; &update;
  } elsif (($key eq 260 or $key eq 269) and &can_go(&occupied(@{$player{location}}),&occupied($player{location}[0]-1,$player{location}[1]))) {
    $player{location}[0]--; &update;
  } elsif (($key eq 261 or $key eq 271) and &can_go(&occupied(@{$player{location}}),&occupied($player{location}[0]+1,$player{location}[1]))) {
    $player{location}[0]++; &update;
  } elsif ($key =~ /\d+/ and $key >= 258 and $key <= 350){
    $display{stats}->addstr(1,0,"You can't go that way!");
  } elsif ($key ne -1) {
    $display{stats}->addstr(1,0,"I don't understand that! (What does '$key' mean?)");
  }
  if (occupied(@{$player{location}})->{description} =~ /\bgrue\b/i and rand(1) < 0.1) {
    $display{stats}->clrtoeol(9,0);
    if ($player{cheat}) {
      $display{stats}->addstr(9,0,"You were eaten by a grue; strangely, this doesn't affect you.");
      $display{stats}->refresh;
    } else {
      $display{stats}->addstr(9,0,"You were eaten by a grue.");
      $display{stats}->refresh;
      endwin;
      exit;
    }
  }
} until lc($key) eq 'q';

END {
  endwin;
}

sub can_go {
  my ($s,$e) = @_;
  return 0 if ref $s ne "HASH" or ref $e ne "HASH";
  return 1 if $s == $e;
  return 1 if grep {$_ == $e->{id} and @{$s->{exits}{$_}} == @{$player{location}}} keys %{$s->{exits}};
  return 0;
}

sub update {
  for my $q ($player{location}[0]-1..$player{location}[0]+1) {
    for my $r ($player{location}[1]-1..$player{location}[1]+1) {
      $player{seen}{"$q,$r"}=1;
    }
  }
  if ($display{type} == ROGUELIKE) {
    $display{main}->clrtobot(1,0);
    for my $room (@{$or->{contents}}) {
      for my $x ($room->{location}[0][0]..$room->{location}[1][0]) {
	for my $y ($room->{location}[0][1]..$room->{location}[1][1]) {
	  $display{main}->addstr($y+1,$x+1,'#') if $player{cheat} or defined $player{seen}{"$x,$y"};
	}
      }
    }
    $display{main}->addstr($player{location}[1]+1,$player{location}[0]+1,'@');
    $display{stats}->clrtobot(3,0);
    $display{stats}->addstr(3,0,&occupied(@{$player{location}})->{description});
    $display{main}->move(1,0);
  } else {
    my (@exits,@cont,%dir); @dir{"0-1","01","10","-10"} = qw/North South East West/;
    for ([0,-1],[0,1],[1,0],[-1,0]) {
      my ($s,$e) = (&occupied(@{$player{location}}),&occupied($player{location}[0]+$_->[0],$player{location}[1]+$_->[1]));
      if ($s == $e) {
	push @cont,$dir{$_->[0].$_->[1]};
      } elsif (&can_go($s,$e)) {
	push @exits,$dir{$_->[0].$_->[1]}
      }
    }
    $display{main}->addstr("\n".&occupied(@{$player{location}})->{description}."\n");
    $display{main}->addstr("The hallway continues to the ".join(' and ',@cont).".\n") if @cont;
    $display{main}->addstr("Exits: @exits\n") if @exits;
  }
}

sub setup {
  my $type = shift @_;
  if (defined $display{type}) {
    $display{stats}->delwin;
    $display{main}->delwin;
    endwin;
  }
  for (qx"$resize_executable") {
    next unless /^(\w+)=(.*);/;
    $ENV{$1} = $2;
  }
  refresh if defined $display{type};
  my $main = new Curses $ENV{LINES}-(STATSIZE+1), $ENV{COLUMNS}, 0, 0;
  $main->clear;
  $main->leaveok;
  $main->keypad(1);
  noecho;
  if ($type == ZORKLIKE) {
    $main->idlok;
    $main->scrollok(1);
    $main->setscrreg(1, $ENV{LINES}-(STATSIZE+2));
  }
  $main->addstr(&center(' Spork! ',fill=>'*'));

  my $stats= new Curses STATSIZE, $ENV{COLUMNS}, $ENV{LINES}-(STATSIZE+1), 0 or die "Can't make stats window!";
  $stats->clear;
  $stats->leaveok;
  $stats->addstr(&center(' Info ',fill=>'-'));
  $stats->addstr(0,5,$type==ZORKLIKE?"(Zork )":"(Rogue)");

  return (type=>$type,stats=>$stats,main=>$main);
}

sub center {
  my %args = (fill=>' ',width=>$ENV{COLUMNS},'string',@_?@_:'');
  $args{string} .= $args{fill} unless ($args{width}-length($args{string})) % 2 == 0;
  $args{string} = "$args{fill}$args{string}$args{fill}" while length $args{string} < $args{width};
  return $args{string};
}

sub create_level {
  $display{main}->clrtobot(1,0);
  $or = {contents=>[],
             type=>"room",
	     location=>[[0,0],[40,40]],
	    };
  @edges{qw/01 10 0-1 -10 void/} = ([],[],[],[],[]);
  make_hallway(20,20,1,0);
  while (@{$or->{contents}} < 40) {
    my @directions = grep {@{$edges{$_}} and /\d/} keys %edges;
    my ($dx,$dy) = $directions[rand @directions] =~ /(-?\d)(-?\d)/;
    my (@edge) = @{$edges{"$dx$dy"}[rand @{$edges{"$dx$dy"}}]};

    make_hallway($edge[0],$edge[1],$dx,$dy);
    %edges = &del_dups;
  }
  $or->{edges} = {%edges};
  return $or;
}

sub del_dups {
  my %used;
  for my $edge (keys %edges) {
    for (@{$edges{$edge}}) {
      $used{$_->[0].",".$_->[1]} += $edge=~/\d/?1:2;

      if ($edge =~ /\d/ and ref (my $exit_to = &occupied($_->[0],$_->[1])) eq "HASH") {
	$or->{contents}[$exit_to->{id}]{'exits'}{$_->[2]} = [$_->[0],$_->[1]];
      }
    }
  }
  for (keys %used) {
    if (my $target = &occupied(split/,/)) {
      $used{$_}++;
    }
  }
  for (keys %edges) {
    next unless /\d/;
    $edges{$_} = [grep {$used{$_->[0].",".$_->[1]} == 1} @{$edges{$_}}]
  }
  $edges{void} = [map {[split/,/]} grep {$used{$_} > 1} keys %used];
  return %edges;
}

sub occupied {
  my ($x,$y) = @_;
  return -1 if $x < $or->{location}[0][0] or $x > $or->{location}[1][0];  # X max and min from OverRoom
  return -1 if $y < $or->{location}[0][1] or $y > $or->{location}[1][1];  # Y max and min from OverRoom
  for (@{$or->{contents}}) {
    return $_ if ($x >= $_->{location}[0][0] and $x <= $_->{location}[1][0])
             and ($y >= $_->{location}[0][1] and $y <= $_->{location}[1][1]);
  }
  return 0;
}

sub edge {
  my ($x,$y) = @_;
  for (keys %edges) {
    return 1 if grep {$_->[0] == $x and $_->[1] == $y} @{$edges{$_}};
  }
  return 0;
}

sub make_hallway {
  my ($x,$y,$dx,$dy) = @_;
  my ($ml,$l,$ec) = (int rand(4)+4,0,0);
  $l++ while (!occupied($x+$l*$dx,$y+$l*$dy) and ($l <= 1 or !edge($x+($l-1)*$dx,$y+($l-1)*$dy)) and $l < $ml);
  my $ex = $x+($l-1)*$dx; my $ey = $y+($l-1)*$dy;
  return undef if $l < 3;
  my $id = @{$or->{contents}};
  ($x,$ex) = ($ex,$x) if ($ex < $x);
  ($y,$ey) = ($ey,$y) if ($ey < $y);
  push @{$or->{contents}}, {type=>"hallway",
			    location=>[[$x,$y],[$ex,$ey]],
			    exits=>{},
			    id=>$id,
			    description=>$HALL_DESCS[rand @HALL_DESCS]
			   };
  for my $d ($x..$ex) {
    push @{$edges{'01'}}, [$d,$ey+1,$id];
    push @{$edges{'0-1'}},[$d,$y-1,$id];
  }
  for my $d ($y..$ey) {
    push @{$edges{'10'}}, [$ex+1,$d,$id];
    push @{$edges{'-10'}},[$x-1,$d,$id];
  }
  return $id;
}

BEGIN {
  @HALL_DESCS   =   ("  You are in a poorly-lit hallway.  Dim light is given off by\n".
		     "widely-spaced sputtering torches.  The gloom seems to press in\n".
		     "on you.",

		     "  You stand in a cramped sewer pipe.  Dim light filters down\n".
		     "from overhead grates, shining off of substances which you would\n".
		     "rather not recognize.  The smell is oppressive.",

		     "  The rough-hewn walls and low ceiling signal that you have\n".
		     "entered a section of abandoned mineshaft.  The wind whistles\n".
		     "eerily past your head, filling the tunnel with a low moaning.",

		     "  The proud race that carved these tunnels knew its stonemasonry;\n".
		     "the walls are square and well-decorated with elaborate carvings,\n".
		     "while concealing the incredible strength of the stone.",

		     "  It is dark.  You move carefully to avoid being eaten by a grue.",

		     "  You stride through hallways whose walls crawl with strange green\n".
		     "scribbles.  You have a strange urge to wear sunglasses while\n".
		     "inside and request 'guns, lots of guns.'",

		     "  The passageway is awash in cheese.  You are forced to swim\n".
		     "through it to get past.  As you do so, you spy an elusive babelfish\n".
		     "between a wheel of Brie and some Cheddar.",

		     "  You are in a maze of twisty passages, all alike.",

		     "  The hallway is lined with glowing images of sporks.  They brighten\n".
		     "as you approach and dim after you have passed.  You are in awe of\n".
		     "the intensity of the sporkishness of this place.",

		     "  The passage is lined with mumbling boulders.  They shout\n".
		     "obscenities at you as you step on them.",

		     "  You're wandering through a maze of manpages.  All of them ignore\n".
		     "you, assume you already know what they tell you, don't provide good\n".
		     "instructions, and have bad breath.  Curse you, curses!",
		    );
}