view release on metacpan or  search on metacpan

lib/Games/Perlwar/Shell.pm  view on Meta::CPAN

my $pw;
# TODO: add color entry for players and default colors
my @colors = qw( pink lightblue yellow lime maroon purple 
                 olive pink gold red aqua );

my $shell = Term::ShellUI->new(
    commands => {
        load => {
            desc => "load a Perlwar game",
            maxargs => 2,
            proc => \&do_load,
        },
        save => {
            desc => "save the current Perlwar game",
            maxargs => 1,
            proc => \&do_save,
        },
        quit => {
            desc => "exit the shell",
            method => sub { shift->exit_requested(1) },
        },
        q => { syn => 'quit', exclude_from_completion => 1 },
    }
);

### help 
$shell->add_commands({ 
    help => {
        desc => "print list of commands",
        args => sub { shift->help_args(undef, @_); },
        method => sub { shift->help_call(undef, @_); },
    },
    h => { syn => "help", exclude_from_completion=>1},
});

### create
$shell->add_commands({ 
    create => {
        desc => "create a new game",
        proc => \&do_create,
    },
});

### cd, pwd
$shell->add_commands({
    cd => {
        desc => "change working directory",
        proc => \&do_cd,
    },
    pwd => {
        desc => "print current working directory",
        proc => \&do_pwd,
    },
});

### run
$shell->add_commands({
    run => {
        desc => 'run iterations of the game',
        proc => \&do_run,
    }
});

### exec, info
$shell->add_commands({ 
    eval => {
        desc => 'execute arbitrary perl code',
        proc => sub { print eval( join ' ', @_ ), "\n" },
    },
    e => { syn => 'eval', exclude_from_completion => 1 },
    info => { 
        desc => 'game stats',
        proc => \&do_info,
    },
});


$shell->prompt( 'pw> ' );

sub run { $shell->run; }

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub do_info {
    die "no game loaded\n" unless $pw;

    print 'iteration ', $pw->{round}, ' of ', $pw->{conf}{gameLength}, "\n",
          'game status: ', ( $pw->get_game_status || 'ongoing' ), "\n",
          'players', "\n";

    for my $p ( keys %{$pw->{conf}{player}} ) {
        print "\t$p : ", $pw->{conf}{player}{$p}{agents}, "\n";
    }
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub do_create {
    if ( $pw ) {
        my $r = prompt -yes, -d => 'y', 
                 "creating a new game will discard any unsaved information to "
                ."the currently loaded game. do it? [Yn] ";
        return unless $r;
    }

    my $game_name = shift || 'perlwar';
    my $game_dir = "./$game_name";

    print "creating game directories $game_dir..\n";

    mkdir $game_dir or die "couldn't create directory $game_dir: $!\n";
    chdir $game_dir or die "can't chdir to $game_dir: $!\n";

    mkdir "history" or die "couldn't create directory history:$!\n";
    mkdir 'mobil' or die "couldn't create directory mobil:$!\n";

    print "\n\ngame configuration\n";

    my $config_file = IO::File->new( '>configuration.xml' )
        or die "can't create configuration file: $!\n";