#!/usr/bin/perl -w

######################################################################
#                             CARPE DIEM                             #
#               Computer-Assisted Role Playing Engine                #
#           for Diverse Interactive Entertainment Modules            #
#                             v2000.12.04                            #
######################################################################

# Copyright (c)2000-2013, Chris Pressey, Cat's Eye Technologies.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
#  1. Redistributions of source code must retain the above copyright
#     notices, this list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright
#     notices, this list of conditions, and the following disclaimer in
#     the documentation and/or other materials provided with the
#     distribution.
#  3. Neither the names of the copyright holders nor the names of their
#     contributors may be used to endorse or promote products derived
#     from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
# FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE
# COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.

BEGIN
{
  $| = 1;                                     # auto-flush output
  $::version = "v2000.12.04";
  $::universe = $ARGV[0] || die "Need universe name";
  $::username = $ENV{user} || $ENV{USER} || 'user';

  print "Hello $::username!  Loading '$::universe', please wait...\n";

restart_cfg:
  %::setup = ();

  # if carpe.cfg for current OS exists, include it
  if (-r "carpe_$^O.cfg")
  {
    require "carpe_$^O.cfg";
    if ($version ne $::setup{version})
    {
       print "Warning!  Your current configuration file (carpe_$^O.cfg)\n";
       print "contains a different version number ($::setup{version})\n";
       print "than does your copy of carpe.pl ($version).\n\n";
       print "Probable cause: you installed a new version of CARPE DIEM\n";
       print "over an existing, older version.\n\n";
       print "Recomendation: that you exit, delete all the files in this directory,\n";
       print "and re-install the latest version of CARPE DIEM.\n\n";
       print "  a. Exit (with error code 1)\n";
       print "  b. Delete carpe_$^O.cfg and restart\n";
       print "  c. Do nothing (Not Recommended)\n";
       print "Please select (a-c) : ";
       my $f = <STDIN>;
       print "\n";
       chomp $f;
       if    ($f =~ /b/) { unlink "carpe_$^O.cfg"; goto restart_cfg; }
       elsif ($f =~ /c/) { }
       else              { exit(1); }
    }
  } else
  {
    open SETUP, ">carpe_$^O.cfg";
    print SETUP "# this file is automatically generated by carpe.pl when it does not exist\n\n";
    my @k = ('display','color','input');
    my @d = ('display driver','color map','input driver');
    my @o = (['ANSI'],['ANSI16','Mono'],['Teletype']);
    my $i;

    my $c; my $fc = 0;
    foreach $c (@INC)
    {
      if (-r "${c}/Curses.pm")
      {
        $fc = 1; last;
      }
    }

    $o[0] = ['Win32','ANSI'] if $^O eq 'MSWin32' or $^O eq 'cygwin';
    unshift @{$o[0]}, 'Curses' if $fc;
    $o[1] = ['Win32','ANSI16','Mono'] if $^O eq 'MSWin32' or $^O eq 'cygwin';
    unshift @{$o[1]}, 'Curses' if $fc;
    $o[2] = ['POSIX','Teletype'] if $^O eq 'freebsd' or $^O eq 'linux' or $^O eq 'sunos' or $^O eq 'solaris' or $^O =~ /^sco/; # or any of a number of other POSIX systems I'm sure
    $o[2] = ['Win32','Teletype'] if ($^O eq 'MSWin32');
    $o[2] = ['POSIX','Win32','Teletype'] if ($^O eq 'cygwin');
    unshift @{$o[2]}, 'Curses' if $fc;

    print "Welcome to CARPE DIEM, the Computer-Assisted Role Playing Engine!\n\n";
    print "carpe.pl has detected that is has not been run from this location before.\n";
    print "(or you deleted your 'carpe_$^O.cfg' file)\n\n";

    print "Configure the following settings, press Enter or Return for default value:\n";

    for($i=0;$i<=$#k;$i++)
    {
      print "\nChoose your preferred $d[$i] (default is $o[$i][0]):\n";
      my $f; my $ch;
      for($f=1;$f<=$#{$o[$i]}+1;$f++)
      {
        $ch = chr($f+ord('a')-1);
        print "  $ch. $o[$i][$f-1]\n";
      }
      $f--;
      print "Please select (a-$ch) : ";
      $f = <STDIN>;
      chomp $f;
      if ($f !~ /^\s*[a-$ch]/)
      {
        $f = 'a';
      }
      $::setup{$k[$i]} = $o[$i][ord($f)-ord('a')];
      print SETUP '$::setup{', $k[$i], '} = \'', $::setup{$k[$i]}, '\';', "\n";
    }
    print "Screen width (ENTER=80): ";
    $f = <STDIN>;
    chomp $f;
    $::setup{screen_width} = $f || 80;
    print SETUP '$::setup{screen_width} = ', $::setup{screen_width}, ';', "\n";
    print "Screen height (ENTER=25): ";
    $f = <STDIN>;
    chomp $f;
    $::setup{screen_height} = $f || 25;
    print SETUP '$::setup{screen_height} = ', $::setup{screen_height}, ';', "\n";

    print SETUP '$::setup{version} = \'', $version, '\';', "\n";
    print SETUP "\n1;\n";
    close SETUP;
  }

  # set up preferences

  %::pref =
  (
    'wield'         => 'body',
    'bumpactor'     => 'attack',
    'bumpterrain'   => 'nothing',
    'throwspeed'    => 'medium',
    'bodymenu'      => 'full',
    'map_width'     => $::setup{screen_width}-22,
    'map_height'    => $::setup{screen_height}-1,
    'symbols'       => 'ASCII',
    'keymap'        => 'Corona',
    'supplementary' => 'Disabled',
    'browser'       => 'netscape.exe c:/carpe/temp.html',
    'compression'   => 'None',
  );
  $pref{browser} = 'netscape /carpe/temp.html' if $^O ne 'MSWin32';
  $pref{symbols} = 'OEM' if $^O eq 'MSWin32' or
                            $^O eq 'linux' or
                            $^O eq 'freebsd' or
                            $^O eq 'cygwin';
  $pref{symbols} = 'SemiOEM' if ($pref{symbols} eq 'OEM' and $::setup{display} eq 'Curses') or
                            $^O =~ /^sco/i;
  require "${universe}_${username}.prefs" if -r "${universe}_${username}.prefs";
}

# This allows us to keep Console::Virtual in a subrepo located in
# the lib dir of this project
BEGIN
{
  use File::Spec::Functions;
  use File::Basename;
  push @INC, catdir(dirname($0), '..', 'lib', 'console-virtual');
}

use Console::Virtual 2007.1122
     qw(getkey display gotoxy clrscr clreol
        normal inverse bold update_display color);

use _utility;
use _screen;

use Menu;

use Supplement;

use Cloneable;
use Saveable;
use Saleable;

use Fuses;

use Distribution;
use Dice;

use Adj;
use Force;
use Resistances;
use Attack;

use Physical;

use Talent;
use Item;
use Party;
use Actor;
use Terrain;
use Region;
use Encounter;

use _action;

require "$::universe/Distributions.pm";
require "$::universe/Attacks.pm";
require "$::universe/Talent.pm";

require "$::universe/Craftsmanship.pm";
require "$::universe/Weapon.pm";
require "$::universe/Food.pm";
require "$::universe/Wardrobe.pm";
require "$::universe/MagicItem.pm";
require "$::universe/Mineral.pm";
require "$::universe/Tool.pm";

require "$::universe/Monster.pm";
require "$::universe/Animal.pm";

require "$::universe/Guild.pm";

require "$::universe/Happenings.pm";
require "$::universe/Landscape.pm";

require "$::universe/Individuals.pm";

require "$::universe/World.pm";

require "menu/Corona.pm";

sub fix_keymap
{
  $::keymap{$helpkey} = 'help';
  $::keymap{$padmap->[0][0]} = 'move northwest';
  $::keymap{$padmap->[0][1]} = 'move north';
  $::keymap{$padmap->[0][2]} = 'move northeast';
  $::keymap{$padmap->[1][0]} = 'move west';
  $::keymap{$padmap->[1][1]} = 'rest';
  $::keymap{$padmap->[1][2]} = 'move east';
  $::keymap{$padmap->[2][0]} = 'move southwest';
  $::keymap{$padmap->[2][1]} = 'move south';
  $::keymap{$padmap->[2][2]} = 'move southeast';
}

sub preferences
{
  my $option = ''; my $so = '';
  while ($option ne 'OK')
  {
    ::msg("Select your preferences for game operation.");
    $option = Menu->new('label' => ["Wield: $::pref{wield}",
                          "Body:  $::pref{bodymenu}",
                          "Bump:  $::pref{bumpterrain}",
                          "Actor: $::pref{bumpactor}",
                          "Throw: $::pref{throwspeed}",
                          "Char:  $::pref{symbols}",
                          "Key:   $::pref{keymap}",
                          "Sup.M: $::pref{supplementary}",
                          "Compr: $::pref{compression}",
                          "Save Prefs",
                          "OK"], 'erase' => 1)->pick;
    ::clrmsg;
    if($option =~ /^Save/)
    {
      ::msg("Saving ${universe}_${username}.prefs...");
      open PREFS, ">${universe}_${username}.prefs";
      my $k;
      foreach $k (keys %::pref)
      {
        print PREFS '$::pref{', $k, '} = \'', $::pref{$k}, '\';', "\n";
      }
      print PREFS "1;\n";
      close PREFS;
      ::msg("Preferences saved to ${universe}_${username}.prefs successfully.");
    }
    if($option =~ /^Wield/)
    {
      ::msg("Choose which menu appears first when wielding an item.");
      $so = Menu->new('indent'=>1,'label'=>['body','item'])->pick;
      if ($so ne 'Cancel') { $::pref{wield} = $so; }
    }
    if($option =~ /^Body/)
    {
      ::msg("Choose whether menu of body parts is displayed in full or short form.");
      $so = Menu->new('indent'=>1,'label'=>['full','short'])->pick;
      if ($so ne 'Cancel') { $::pref{bodymenu} = $so; }
    }
    if($option =~ /^Actor/)
    {
      ::msg("Choose what to do when moving into the same square as another creature.");
      $so = Menu->new('indent'=>1,'label'=>['nothing','attack','interact','look'])->pick;
      if ($so ne 'Cancel') { $::pref{bumpactor} = $so; }
    }
    if($option =~ /^Bump/)
    {
      ::msg("Choose what to do when trying to move into an apparent obstacle.");
      $so = Menu->new('indent'=>1,'label'=>['nothing','look','bash'])->pick;
      if ($so ne 'Cancel') { $::pref{bumpterrain} = $so; }
    }
    if($option =~ /^Throw/)
    {
      ::msg("Choose animation speed of missile weapons.");
      $so = Menu->new('indent'=>1,'label'=>['slow','medium','fast'])->pick;
      if ($so ne 'Cancel') { $::pref{throwspeed} = $so; }
    }
    if($option =~ /^Char/)
    {
      ::msg("Choose symbol set used to represent world on game map.");
      # TODO: DIR
      $so = Menu->new('indent'=>1,'label'=>['ASCII','OEM','SemiOEM'])->pick;
      if ($so ne 'Cancel') { $::pref{symbols} = $so; %::sc = (); do "sym/$::pref{symbols}.pm"; }
    }
    if($option =~ /^Key/)
    {
      ::msg("Choose keypress mapping used to issue commonly-used commands.");
      # TODO: DIR
      $so = Menu->new('indent'=>1,'label'=>['Corona','Hack','Rogue','Larn','Angband_Roguelike','ADOM'])->pick;
      if ($so ne 'Cancel')
      {
        $::pref{keymap} = $so;
        %::keymap = ();
        %::mnemonic = ();
        do "key/$::pref{keymap}.pm";
        fix_keymap;
      }
    }
    if($option =~ /^Sup/)
    {
      ::msg("Choose manner in which supplementary materials are acquired and provided.");
      $so = Menu->new('indent'=>1,'label'=>['Disabled','Local','Internet','Cached','Browser...'])->pick;
      if ($so ne 'Browser...')
      {
        if ($so ne 'Cancel') { $::pref{supplementary} = $so; }
      } else
      {
        ::clrmsg();
        ::msg("Currently '$::pref{browser}'.");
        ::msg("foo");
        ::clrmsg();
        $::pref{browser} = ::ask("Browser:", 70);
      }
    }
    if($option =~ /^Comp/)
    {
      ::msg("Choose compression used for saved games (not currently implemented.)");
      $so = Menu->new('indent'=>1,'label'=>['None','GNUZip'])->pick;
      if ($so ne 'Cancel') { $::pref{compression} = $so; }
    }
    ::clrmsg;
  }
}

### INITIALIZATION ###

$::quit_flag = 0;
$::repeated_action = '';
$::start_time = ::d(1, (60*24*27*12*4));
$::game_time = $::start_time;
$::moves_without_input = 0;
$::fuses = Fuses->new;

fix_keymap;

require "$::universe/Name.pm";

### MAIN ###

::clrscr;
::game_frame;

require "$::universe/TitleScreen.pm";

my $goahead = 0;
while (not $goahead)
{
  my $option = Menu->new('cancel' => 'Quit',
                         'erase' => 1,
                         'label' => ['New World','Load World','Preferences','Quit'])->pick;
  if ($option eq 'Quit')
  {
    ::normal;
    ::clrscr;
    exit(0);
  } elsif ($option eq 'Preferences')
  {
    preferences();
  } elsif ($option eq 'New World')
  {
    my $i; my $j;
    for($j=0;$j<=$#{$wmap};$j++)
    {
      for($i=0;$i<=$#{$wmap->[$j]};$i++)
      {
        $reg{$wmap->[$j][$i]}->{worldx} = $i;
        $reg{$wmap->[$j][$i]}->{worldy} = $j;
      }
    }

    $pname = ::ask("Enter a name for your party:", 20)
          || $party_name[::d(1,$#party_name+1)-1];

    $party = Party->new($::leader = Actor->roll, $pname);

    ### Set up leader with initial equipment and talents.

    outfit($::leader);
    $goahead = 1;
  } elsif ($option eq 'Load World')
  {
    ::gotoxy(20,15);
    ::display("Loading world...");

    # $leader = whatever

    # $goahead = 1;
  }
}

$leader->{location}->display($leader);
$leader->view('character');
$leader->light();

meta:
if (not $::repeated_action)
{
  ::clrmsg();
  $cmd = '';
  $char = ::getkey();
}

while (not $quit_flag)
{
  ### PROCESS PLAYER MOVE

  $::notice = 0;  # set to true if the leader notices something new

  if ($::repeated_action)
  {
    $cmd = $::repeated_action;
    $char = '';
  }
  if (defined $::leader->{using_talent})
  {
    # ::msg("using talent ($::leader->{using_talent}[0] moves left)");
    $::leader->{using_talent}[0]--;
    if ($::leader->{using_talent}[0] == 0)
    {
      my $t = $::leader->{using_talent}[1];
      ::script $t->{on_perform}, $::leader, $::leader->{using_talent}[2], $t;
      $::leader->{using_talent} = undef;
    }
    goto npc_moves;
  }
  if ($::leader->{incapacitated})  # or sleeping
  {
    goto npc_moves;
  }
  if ($char eq chr(27))
  {
    $char = ::getkey();
    if ($char eq chr(27))
    {
      $cmd = ::main_menu();
      $leader->view;
      goto meta if $cmd eq '';
    } else
    {
      if($char eq '[')
      {
        # ANSI
        $char = ::getkey;
        $cmd = 'move north' if $char eq 'A';
        $cmd = 'move south' if $char eq 'B';
        $cmd = 'move east'  if $char eq 'C';
        $cmd = 'move west'  if $char eq 'D';
      }
    }
  } elsif($char eq $extkey) { $cmd = ::ask("Command: ", 70, '[\S ]'); }
  elsif ($char ne '')
  {
    my $done = 0;
    while (not $done)
    {
      if (not exists $::keymap{$char})
      {
        my $z = $char;
        $z = 'BEL' if ord($z) == 7;
        $z = 'Backspace' if ord($z) == 8;
        $z = 'Tab' if ord($z) == 9;
        $z = 'LF' if ord($z) == 10;
        $z = 'FF' if ord($z) == 12;
        $z = 'CR' if ord($z) == 13;
        $z = '^C' if ord($z) == 3;
        $z = '^Z' if ord($z) == 26;
        ::msg("Key '$z' (" . ord($char) . ") is not currently bound to any command.  Press '$::helpkey' for help.");
        goto meta;
      }
      $cmd = $::keymap{$char};
      $done = 1;
      if ($cmd eq 'extended')
      {
        $char .= ::getkey();
        $done = 0;
      }
    }
  }

  $::redirect = $cmd;
  while ($::redirect)
  {
    $cmd = $::redirect;
    $::redirect = '';

    my @arg = (); my $temp;    # parse out arguments of command
    if ($cmd =~ /^(\w+)\s+/)
    {
      $temp = $';
      $cmd = $1;
      while ($temp =~ /^(\w+)\s*/)
      {
        push @arg, $1;
        $temp = $';
      }
    }

    if (exists $::action{$cmd})
    {
      if (&{$::action{$cmd}}($leader, [@arg]) == 0)
      {
        goto meta;
      }
    } else
    {
      ::msg("Action '$cmd' is not currently implemented.  Press '$::helpkey' for help.");
      goto meta;
    }
  }

  ### PROCESS NPC MOVES

npc_moves:

  if ($leader->screenx < 3 or $leader->screenx > $::pref{map_width}-2 or
      $leader->screeny < 3 or $leader->screeny > $::pref{map_height}-2)
  {
    $leader->{location}->display($leader);
  }

  $leader->light;

  $leader->{location}->tick($leader);
  $::fuses->tick;
  $::game_time++;

  if ($::notice)
  {
    $::notice = 0;
    $::repeated_action = '';
  }
  if(not $quit_flag and
     not defined $::leader->{using_talent} and
     not $::leader->{incapacitated} and
     not $::repeated_action)
  {
    if (not $::pending)
    {
      ::clrmsg(1);
    } else
    {
      ::gotoxy($::setup{screen_width}-1,$::setup{screen_height});
      ::update_display;
    }
    $cmd = '';
    $char = getkey;
    $::moves_without_input = 0;
    clrmsg();
  } else
  {
    $cmd = 'rest';
    $::moves_without_input++;
  }
  if ($::moves_without_input > 100)
  {
    ::msg("Game interrupted after 100 moves without input, select course of action.");
    my @ca = ('Continue', 'Switch Leader', 'Quit Game');
    if ($::repeated_action) { unshift @ca, 'Cancel Repeat'; }
    my $r = Menu->new('erase'=>1,
                      'label'=> [@ca])->pick;
    clrmsg();
    if ($r eq 'Continue' or $r eq 'Cancel')
    {
      $::moves_without_input = 0;
    }
    elsif ($r eq 'Switch Leader')
    {
      $::repeated_action = '';
      $cmd = 'switch_leader';
      $::moves_without_input = 0;
    }
    elsif ($r eq 'Cancel Repeat')
    {
      $::repeated_action = '';
      $cmd = '';
      $char = getkey;
      $::moves_without_input = 0;
    }
    elsif ($r eq 'Quit Game')
    {
      $::quit_flag = 1;
    }
    $::leader->view;
  }
}

::normal;
::clrscr;

### END ###