# $File: //member/autrijus/AIBots/lib/Games/AIBots.pm $ $Author: autrijus $ # $Revision: #3 $ $Change: 692 $ $DateTime: 2002/08/17 09:29:13 $ require 5.005; package Games::AIBots; $Games::AIBots::VERSION = '0.03'; use strict; use integer; use Games::AIBot; use File::Glob; =head1 NAME Games::AIBots - An improved clone of A.I.Wars in Perl =head1 VERSION This document describes version 0.03 of Locale::Maketext::Fuzzy. =head1 SYNOPSIS In the command line: % aibots # with Tk, displays the GUI % aibots map bot1 bot2... # run the game % aibots -h # show help Programatically: use Games::AIBots; Games::AIBots::init_sound($flag); Games::AIBots::init_console(); # Games::AIBots::init_gui(); # requires Tk Games::AIBots::init_arg($map, @bots); Games::AIBots::init_map(); Games::AIBots::do_loop($rounds); =head1 DESCRIPTION This module exists exclusively for the purpose of the F script bundled in the distribution. Please see L for an explanation of the game's mechanics, rules and tips. =cut # ===================== # Constants Declaration # ===================== # Global variables my ($Console, @Flash, $Top, $Canvas, $DFrame1, $DFrame2, $UFrame, $Btn_play, $Btn_stop, $Btn_tempo, $Btn_watch, $Btn_sound, $Btn_about, $Lbl_info, $Dlg_about, @Snodes); my (@Btn_arg, @Arg, @Bots, $Board, $Running, $Tick, $FirstBot, $Watch, %Buffer, %Wav, $Sound, $Music, %Mines, %Teamvar, $GUI, $MPlayer, %Flash, %Color, %UserCmd, $Continue, $Msglog); my @Mnu_arg = map {''} (0..9); use vars qw/$Mask/; # Game Settings my ($Max_ammo, $Max_life, $Max_fuel) = (30, 10, 2500); my ($Vault_ammo, $Flag_ammo, $Flag_fuel) = (20, 30, 350); my ($Cloak_fuel, $Cloak_ammo, $Score_adj) = (10, 2, 20); my ($Tick_delay, $Scan_range, $Scan_list) = ( 160, 5, 'space wall fence flag mine vault friend enemy' ); my ($Cols, $Rows, $Tile_width, $Tile_height) = (40, 25, 18, 18); my $Path = $ENV{'Path_AIBots'} || (__FILE__ =~ /^(.+)\.pm$/ ? $1 : '.'); # Object list my %Obj = ( '1' => 'spawn', '2' => 'spawn', '3' => 'spawn', '4' => 'spawn', '5' => 'spawn', '6' => 'spawn', '7' => 'spawn', '8' => 'spawn', '9' => 'spawn', '@' => 'spawn', '.' => 'space', '#' => 'wall', '+' => 'fence', 'P' => 'flag', 'O' => 'mine', 'A' => 'vault', '^' => 'bot8', 'v' => 'bot2', '<' => 'bot4', '>' => 'bot6', 'n' => 'bot8c', 'u' => 'bot2c', '[' => 'bot4c', ']' => 'bot6c', '*' => 'snode', '=' => 'wall', # '*' => 'marsh', ); # Damage source table my ($Verb, $DmgS, $DmgN, $BurnS, $BurnN, $ScrS, $ScrN, $CostF, $CostA) = (0..8); my %Weapon = ( 'bazookah' => ['scorched', 60, 90, 6, 9, 300, 500, 300, 10], 'bazookas' => ['splashed', 40, 70, 4, 7, 200, 400 ], 'grenadeh' => ['shredded', 40, 70, 9, 12, 300, 500, 200, 5], 'grenades' => ['splashed', 20, 50, 1, 4, 100, 200 ], 'vaults' => ['impacted', 30, 30, 3, 3, 200, 200 ], 'energyh' => ['zapped', 10, 10, 0, 0, 0, 0, 0, 0], 'energys' => ['zapped', 20, 20, 2, 2, 100, 100 ], 'destructh' => ['shattered', -1, -1, 0, 0, 0, 0 ], 'destructs' => ['zapped', -1, -1, 1, 1, 50, 50 ], 'mineh' => ['trapped', 50, 50, 5, 5, 400, 400, 0, 2], 'flagh' => ['overloaded',50, 50, 0, 0, 0, 0 ], 'laserh' => ['burnt', 20, 50, 2, 5, 80, 200, 0, 1], ); # Message template my %Msg = ( 'damage' => "%s is %s by %s %s (%d dmg).", 'death' => "%s is killed %s!", 'hit' => "%s discovers a %s.", 'end' => "*** Game Over ***", 'winner' => "*** Winner: %s | Team %s ***", ); my @BG = ( map {substr($_, length($Path) + 6, -4) } <$Path/pics/background*.gif> ); my $BGidx = 0; $SIG{__DIE__} = $SIG{INT} = sub {$MPlayer->Kill(0) if $MPlayer}; # ======================= # Initialization Routines # ======================= # $success = init_console(); sub init_console { if ($^O eq 'MSWin32') { require Win32::Console; $Console = Win32::Console->new() or return; } else { require Term::ANSIScreen; $Console = Term::ANSIScreen->new() or return; } %Color = ( '.' => $main::FG_BROWN, '#' => $main::FG_LIGHTRED, '+' => $main::FG_RED, 'P' => $main::FG_LIGHTMAGENTA, 'O' => $main::FG_LIGHTBLUE, 'A' => $main::FG_LIGHTGREEN, '*' => $main::FG_BLACK, '=' => $main::FG_LIGHTRED, ); $Console->Attr($main::FG_WHITE); } # $success = init_gui(); sub init_gui { my @lparam = (-background => '#8484ff', -foreground => 'black'); # toplevel window $Top = MainWindow->new( -title => "AI Bots v$Games::AIBots::VERSION", -width => ($Cols + 1) * $Tile_width, -height => ($Rows + 1) * $Tile_height, ); $Top->bind('', sub { $Running = 0; $MPlayer->Kill(0) if $MPlayer }); $Top->bind('', \&Games::AIBots::btn_watch); $Top->bind('', \&Games::AIBots::btn_stop); $Top->bind('', \&Games::AIBots::btn_sound); $Top->bind('', \&Games::AIBots::btn_tempo); $Top->bind('', sub {&Games::AIBots::btn_tempo for (1..2)}); $Top->bind('', \&Games::AIBots::btn_about); $Top->bind('', \&Games::AIBots::btn_play); $Top->bind('', sub { eval{ $Top->Close() }; exit }); # cache pictures foreach (<$Path/pics/*.gif>) { my $pic = substr($_, length($Path) + 6, -4); $Obj{$pic} = $pic; $Top->Photo($pic, '-format' => 'gif', '-file' => $_); } $Dlg_about = $Top->DialogBox( @lparam, -title => 'Anarchistic Independent Robots', -default_button => 'Anarchy!', -buttons => ['Anarchy!'], ); $Dlg_about->Label( @lparam, -text => "AI Bots v$Games::AIBots::VERSION", -font => ['helvetica', 32, 'bold'] )->pack(-side => 'top', -fill => 'x', -expand => 'x'); $Dlg_about->resizable(0, 0); my $frame = $Dlg_about->Frame(@lparam)->pack(-side => 'top', -fill => 'x'); $frame->Label( @lparam, -font => ['helvetica', 12, 'bold'], -text => "Developed by Autrijus Tang (autrijus\@autrijus.org).\n". "Idea from A.I.Wars (http://www.tacticalneurotics.com/).\n". "This game is free software under the Perl License.\n" )->pack(-side => 'right', -expand => 'y'); # window layout $Top->resizable(0, 0); $Top->Icon('-image' => 'aibots'); $DFrame2 = $Top->Frame(@lparam, -bd => 3, -relief => 'ridge')->pack(-side => 'bottom', -fill => 'x'); $DFrame1 = $Top->Frame(@lparam, -bd => 3, -relief => 'ridge')->pack(-side => 'bottom', -fill => 'x'); $UFrame = $Top->Frame(@lparam, -bd => 3, -relief => 'ridge')->pack(-side => 'top', -fill => 'x'); my @nparam = (-background => 'black', -foreground => '#8484ff', -activebackground => '#202050', -activeforeground => '#8484ff'); $Btn_sound = $UFrame->Button(@nparam, -relief => 'ridge', -image => ($Sound ? 'sound' : 'mute'), -command => \&Games::AIBots::btn_sound, -state => ($Sound ? 'normal' : 'disabled'))->pack(-side => 'right', -padx => 2); $Btn_tempo = $UFrame->Button(@nparam, -relief => 'ridge', -image => 'normal', -command => \&Games::AIBots::btn_tempo)->pack(-side => 'right', -padx => 2); $Btn_stop = $UFrame->Button(@nparam, -relief => 'groove', -image => 'stop', -command => \&Games::AIBots::btn_stop, -state => 'disabled')->pack(-side => 'right', -padx => 2); $Btn_play = $UFrame->Button(@nparam, -relief => 'groove', -image => 'play', -command => \&Games::AIBots::btn_play)->pack(-side => 'right', -padx => 2); $Btn_watch = $UFrame->Button( @nparam, -relief => 'ridge', -font => ['helvetica', 10, 'bold'], -disabledforeground => '#8484ff', -highlightthickness => 0, -borderwidth => 0, -bd => 3, -width => 10, -command => \&Games::AIBots::btn_watch )->pack(-side => 'left', -padx => 2, -ipadx => 0, -ipady => 0); $Lbl_info = $UFrame->Label(-foreground => 'black', -background => '#8484ff', -font => ['Courier', 9, 'bold'], -anchor => 'w')->pack(-side => 'left', -fill => 'x', -expand => 'x', -padx => 2); my @bparam = (-background => '#a04444', -font => ['helvetica', 8]); $Top->Balloon(@bparam)->attach($Btn_sound, -balloonmsg => "[S]ound"); $Top->Balloon(@bparam)->attach($Btn_watch, -balloonmsg => "[W]atch"); $Top->Balloon(@bparam)->attach($Btn_tempo, -balloonmsg => "[T]empo"); $Top->Balloon(@bparam)->attach($Btn_stop, -balloonmsg => "[H]alt"); $Top->Balloon(@bparam)->attach($Btn_play, -balloonmsg => "[P]lay/Pause"); $Btn_arg[0] = $DFrame1->Button( @nparam, -image => 'wall', -relief => 'ridge', -state => 'normal', -command => sub { $BGidx = ($BGidx + 1) % scalar @BG; $Canvas->itemconfigure('background', -image => $BG[$BGidx]); # return unless $Board; # foreach my $y (1..$Rows) { # print "\n", substr($Board, ($y - 1) * $Cols, $Cols); # } # print "\r"; } )->pack(-side => 'left', -padx => 2); $Top->Balloon(@bparam)->attach($Btn_arg[0], -balloonmsg => "Change background"); $Mnu_arg[0] = $DFrame1->Optionmenu( -font => ['helvetica', 9, 'bold'], -background => '#a04444', -foreground => '#8484ff', -variable => \$Arg[0], -options => ['', map {substr($_, length($Path) + 6, -4)} <$Path/maps/*.map>], -command => sub { ding('select'); init_map() if $GUI and not defined $Running; Games::AIBots::init_arg(); }, )->pack(-side => 'left'); # $Mnu_arg[0]->bind('', sub { # $Mnu_arg[0]->configure(-options => ['', map {substr($_, length($Path) + 6, -4)} <$Path/maps/*.map>]); # }); $Top->Balloon(@bparam)->attach($Mnu_arg[0], -balloonmsg => "Select Map"); my @mparam = (-font => ['helvetica', 9], -background => '#a04444', -foreground => '#8484ff', -options => ['', map {substr($_, length($Path) + 6, -4)} <$Path/bots/*.bot>], -command => sub {Games::AIBots::init_arg()} ); foreach my $arg (1..9) { $Btn_arg[$arg] = ($arg < 5 ? $DFrame1 : $DFrame2)->Button( @nparam, -image => 'bot8', -relief => 'ridge', -state => 'disabled', -command => sub { ding('select'); $Watch->{'id'} = $arg; Games::AIBots::bot_watch($Bots[$arg-1]); ding('toggle'); } )->pack(-side => 'left', -padx => 2); $Top->bind("", sub { $Watch->{'id'} = $arg; Games::AIBots::bot_watch($Bots[$arg-1]); ding('toggle'); }); $Top->Balloon(@bparam)->attach($Btn_arg[$arg], -balloonmsg => "Watch #$arg"); $Mnu_arg[$arg] = ($arg < 5 ? $DFrame1 : $DFrame2)->Optionmenu(@mparam, -variable => \$Arg[$arg])->pack(-side => 'left'); $Mnu_arg[$arg]->bind('', sub { $Mnu_arg[$arg]->configure(-options => ['', map {substr($_, length($Path) + 6, -4)} <$Path/bots/*.bot>]); }); $Top->Balloon(@bparam)->attach($Mnu_arg[$arg], -balloonmsg => "Select #$arg"); } $Btn_about = $DFrame2->Button( @nparam, -bd => 3, -font => ['helvetica', 10], -relief => 'ridge', -image => 'anarchy', -command => \&Games::AIBots::btn_about, )->pack(-side => 'right', -padx => 2); $Top->Balloon(@bparam)->attach($Btn_about, -balloonmsg => "About AIBots"); # board canvas $Canvas = $Top->Canvas( -width => ($Cols + 1) * $Tile_width - 6, -height => ($Rows + 1) * $Tile_height - 6, -relief => 'ridge', )->pack(-side => 'top'); return $GUI = 1; } # $success = init_sound($music) sub init_sound { no strict 'subs'; $Sound = 1; return unless ($^O eq 'MSWin32'); require Win32::Sound; require Win32::Process; # my $vol = Win32::Sound::Volume(); # Win32::Sound::Volume("0%"); foreach (<$Path/wavs/*.wav>) { $Wav{substr($_, length($Path) + 6, -4)} = $_; # Win32::Sound::Play($_, 1); } # Win32::Sound::Volume($vol); return unless $_[0]; foreach my $path (split(/;+/, $ENV{'Path'})) { $path .= "\\" if substr($path, -1) ne "\\"; if (-e $path.'mplay32.exe') { Win32::Process::Create($MPlayer, $path.'mplay32.exe', "mplay32 /play /rewind $Path\\wavs\\aibots.mid", 0, (NORMAL_PRIORITY_CLASS | CREATE_NO_WINDOW), "." ); $Music = 1; } } } sub init_arg { my $sum; if (@_) { $Arg[$_] = shift(@_) || '' for (0..(scalar @Mnu_arg)); return; } for ((2..(scalar @Mnu_arg))) { if ($Arg[$_] and !$Arg[$_-1]) { $Arg[$_-1] = $Arg[$_]; $Arg[$_] = ''; } } for (1..(scalar @Mnu_arg)) { $sum++ if $Arg[$_]; } $Btn_play->configure(-state => (($Arg[0] and ($sum >= 2)) ? 'normal' : 'disabled')) if $GUI; } # $botcount = init_game(@bots) sub init_game { @Bots = %Buffer = %Mines = (); $Running = $Tick = 0; foreach my $file (@Arg[1..$#Arg]) { next unless $file; my $bot = Games::AIBot->new("$Path/bots/$file.bot"); push @Bots, $bot; $bot->{'id'} = scalar @Bots; $bot->{'name'} = ucfirst($file); $bot->{'pic'} = lc($file); $bot->{'burn'} = 1; $bot->{'score'} = 0; $bot->{'h'} = int(rand(4) + 1) * 2; $bot->{'max_fuel'} = $bot->{'fuel'} = $Max_fuel; $bot->{'max_ammo'} = $bot->{'ammo'} = $Max_ammo; $bot->{'max_life'} = $bot->{'life'} = $Max_life; $bot->{'lastcmd'} = ''; @{$bot}{'shield', 'cloak', 'laymine'} = (0,0,0); do { @{$bot}{'x', 'y'} = (int(rand($Cols) + 1), int(rand($Rows) + 1)) } while (obj_at(@{$bot}{'x', 'y'}) ne ((index($Board, $bot->{'id'}) > -1) ? $bot->{'id'} : (index($Board, '@') > -1) ? '@' : '.')); bot_draw($bot); } if ($GUI) { $_->configure(-state => 'disabled', -background => '#8484ff') foreach @Mnu_arg; $Btn_watch->configure(-state => 'normal'); $Btn_arg[$_]->configure(-state => ($Arg[$_] ? 'normal' : 'disabled')) for (1..$#Btn_arg); } $Board =~ s/[\@\*\d]/./g; $FirstBot = int(rand(scalar @Bots)); @{$Watch}{'x', 'y', 'id'} = @{$Bots[$Mask ? $#Bots : $FirstBot]}{'x', 'y', 'id'}; obj_draw(@{$Watch}{'x', 'y'}, 'watch', '_watch', 1); bot_watch($Bots[$Watch->{'id'}]); if ($Console) { $Console->Cursor(43, 22); $Console->Write('[h]alt [q]uit [s]ound [p]lay/pause'); $Console->Attr($main::BG_BLUE); $Console->Attr($main::FG_YELLOW); $Console->Cursor(40, 23); $Console->Write(' Autrijus Tang '); $Console->Attr($main::FG_WHITE); } return scalar @Bots; } # $map = init_map($mapname) sub init_map { %Flash = @Snodes = (); $Board = '.' x ($Cols * $Rows); if ($GUI) { $Canvas->delete('all'); $Canvas->createImage( ($Cols + 1) * $Tile_width / 2, ($Rows + 1) * $Tile_height / 2, -image => $BG[$BGidx], -tag => 'background', ); $Btn_watch->configure(-state => 'disabled'); $_->configure(-state => 'disabled') foreach @Btn_arg; $Btn_arg[0]->configure(-state => 'normal'); } elsif ($Console) { $Console->Cls; $Console->Cursor(40, 0); $Console->Attr($main::BG_BLUE); $Console->Attr($main::FG_YELLOW); $Console->Write(" -=[AI Bots v$Games::AIBots::VERSION]=- "); $Console->Attr($main::FG_WHITE); } return unless $Arg[0]; init_rndmap($Arg[0]) if $Arg[0] eq 'random'; open _, "$Path/maps/$Arg[0].map" or die "$!: $Path/maps/$Arg[0].map"; my $y = 0; while (my $line = <_>) { chomp $line; next if substr($line, 0, 2) eq '# '; if ($line =~ /^=background[\s\t]+(.+)/) { $Canvas->itemconfigure('background', -image => $1) if $GUI; } elsif ($line =~ /^=bot(\d)[\s\t]+(.+)/) { $Arg[$1] = $2 if -e "$Path/bots/$2.bot"; } elsif ($line =~ /^=snode[\s\t]+(\d+)[\s\t]*,[\s\t]*(\d+)/) { push @Snodes, {'x' => $1, 'y' => $2}; obj_draw($1, $2, '*', '_snode'); } elsif ($line =~ /^=sound[\s\t]+(.+)/) { ding($1); } elsif (length($line) eq $Cols) { $y++; foreach my $x (1 .. $Cols) { my $char = substr($line, $x-1, 1); obj_draw($x, $y, $char, ($Obj{$char} =~ /^(?:spawn|snode)/) ? "_$Obj{$char}" : '') if (exists($Obj{$char})); push @Snodes, {'x' => $x, 'y' => $y} if $Obj{$char} eq 'snode'; } } } close _; return $Arg[0]; } # init_rndmap($mapname) sub init_rndmap { my $rnd = 'PAO####+++' . ('.' x 120); open _, ">$Path/maps/$_[0].map"; foreach my $y (1 .. $Rows) { foreach my $x (1 .. $Cols) { print _ substr($rnd, int(rand(length($rnd))), 1); } print _ "\n"; } close _; } # =========================================================================== # Button callbacks # =========================================================================== sub btn_tempo { $Tick_delay = (((sqrt(sqrt($Tick_delay / 10)) + 1) % 3) + 1) ** 4 * 10; $Btn_tempo->configure( -image => ('slow', 'fast', 'normal')[ sqrt(sqrt($Tick_delay / 10)) % 3 ] ) if $GUI; ding('toggle'); } sub btn_play { (ding('game_begin'), init_map(), init_game()) unless defined($Running); $Running = not $Running; if ($GUI) { $Btn_stop->configure(-state => 'normal'); $Btn_play->configure(-image => $Running ? 'pause' : 'play'); $Top->after($Tick_delay / (scalar @Bots), \&Games::AIBots::tick_bot) if $Running; } } sub btn_stop { $Running = 0; $Btn_stop->configure(-state => 'disabled') if $GUI; $_->{'fuel'} = 0 foreach (@Bots); btn_play(); } sub btn_watch { $Watch->{'id'} = ($Watch->{'id'} % scalar @Bots) + 1; bot_watch($Bots[$Watch->{'id'}]); ding('toggle'); } sub btn_sound { # return unless defined $Sound; $Sound = not $Sound; $Btn_sound->configure(-image => ($Sound ? 'sound' : 'mute')) if $GUI; if ($Sound) { init_sound($Music); } else { $MPlayer->Kill(0) if $MPlayer; } ding('toggle'); } sub btn_about { my $tmp = $Running; $Running = 0; ding('anarchy'); $Dlg_about->Show(); if ($Running = $tmp) { $Running = 0; btn_play(); } } # =========================================================================== # Drawing routines # =========================================================================== sub obj_draw { my ($x, $y, $type, $tag, $flash, $step) = @_; if ($GUI) { $Canvas->createImage( ($x * $Tile_width), ($y * $Tile_height), '-image' => $Obj{$type}, '-tags' => [$type.($step || ''), $tag || "$x:$y"], ) if (defined($Obj{$type}) and $Obj{$type} ne 'space' and $type ne '='); } obj_set($x, $y, $type, $flash); } sub obj_erase { my ($x, $y) = @_; $Canvas->delete("$x:$y") if $GUI; obj_set($x, $y, '.'); } sub obj_at { my ($x, $y) = @_ or return; return '=' if $x < 1 or $y < 1 or $x > $Cols or $y > $Rows; return substr($Board, ($y - 1) * $Cols + $x - 1, 1); } sub obj_flash { my ($obj, $x, $y, $step) = @_; $obj .= $step if $step; ding('flash', $obj); if ($GUI and $Top->state eq 'normal') { if (exists($Flash{$obj})) { $Canvas->itemconfigure($obj, -state => 'normal'); obj_move(@{$Flash{$obj}}, $x, $y, $_[0], $obj, 1); } else { obj_draw($x, $y, $_[0], '_flash', 1, $_[3]); } $Flash{$obj} = [$x, $y]; } } sub obj_move { my ($ox, $oy, $nx, $ny, $obj, $tag, $flash, $onwatch) = @_; if (!$flash) { if ($Mask and $onwatch) { local $Mask; obj_set($ox, $oy, '.') unless obj_at($ox, $oy) eq 'O'; } else { obj_set($ox, $oy, '.') unless obj_at($ox, $oy) eq 'O'; } if ($Console and $onwatch) { $Console->Attr($main::FG_LIGHTCYAN); obj_set($nx, $ny, $obj); $Console->Attr($main::FG_WHITE); } else { bot_fill($Bots[-1]) unless !$Mask or $Bots[-1]{dead}; obj_set($nx, $ny, $obj); } } $Canvas->move($tag, ($nx-$ox) * $Tile_width, ($ny-$oy) * $Tile_height) unless (!$GUI or $nx == $ox and $ny == $oy); if (!$Buffer{$tag} or $Buffer{$tag} ne $Obj{$obj}) { $Canvas->itemconfigure($tag, '-image' => $Obj{$obj}) if $GUI; $Buffer{$tag} = $Obj{$obj}; } } sub obj_set { my ($x, $y, $obj, $flash) = @_; if ($flash) { push @Flash, ($x, $y, obj_at($x, $y)); } else { substr($Board, ($y - 1) * $Cols + $x - 1, 1) = $obj unless $flash; } if ($Console) { if ($Mask) { my $bot = $Bots[$Watch->{id}-1]; return if $Obj{$obj} eq 'flag' or $Obj{$obj} eq 'mine'; return unless ($x == $bot->{x} and $y == $bot->{y}) or ($x == $bot->{enemy_x} and $y == $bot->{enemy_y}) or ($x == $bot->{friend_x} and $y == $bot->{friend_y}) or ($x == $bot->{bumped_x} and $y == $bot->{bumped_y}); } $Console->Cursor($x - 1, $y - 1, 0, 0); $Console->Attr($Color{$obj}) if exists($Color{$obj}); $Console->Write($flash ? ' ' : $Obj{$obj} eq 'spawn' ? '.' : $obj); $Console->Attr($main::FG_WHITE) if exists($Color{$obj}); } } # ============ # Bot Handling # ============ sub bot_draw { my $bot = shift; obj_draw(@{$bot}{'x', 'y'}, bot_char($bot), "_bot$bot->{'id'}"); obj_draw(@{$bot}{'x', 'y'}, ($bot->{'shield'} ? 'shield' : 'noshield'), "_bots$bot->{'id'}", 1); } sub bot_char { my $bot = shift; my $obj = $bot->{'h'} . ($bot->{'cloak'} ? 'c' : ''); my $char = ($bot->{'cloak'} ? qw/n ] u [/ : qw/^ > v {'h'})]; $Obj{$char} = $Obj{$bot->{'pic'}.$obj} || "bot$obj"; return $char; } sub bot_at { my ($x, $y) = @_; foreach my $bot (@Bots) { next if $bot->{'dead'}; return $bot if ($bot->{'x'} == $x and $bot->{'y'} == $y); } } sub bot_id { my $bot = shift or return; return join('-', @{$bot}{'name', 'id'}); } sub bot_watch { my $bot = shift; return unless $bot and ($bot->{'id'} == $Watch->{'id'} or $Console); obj_move(@{$Watch}{'x', 'y'}, @{$bot}{'x', 'y'}, 'watch', '_watch', 1); my $msg = sprintf("Score:%d Ammo:%d Life:%d Fuel:%d [%s]", @{$bot}{qw/score ammo life fuel lastcmd/}); if ($GUI and !@_) { $Btn_watch->configure(-text => bot_id($bot)); $Lbl_info->configure(-text => $msg); } else { $msg = '{'.bot_id($bot).'} '.$msg; if ($Console) { return if $Mask; if ($bot->{'id'} == $Watch->{'id'}) { $Console->Attr($main::FG_LIGHTCYAN); } $Console->Cursor(40, $bot->{'id'} * (4 - int((scalar @Bots) / 3))); $Console->Write(substr($msg, 0, index($msg, ' Fuel')).(' ' x (40 - index($msg, ' Fuel')))); $Console->Cursor(42, 1 + $bot->{'id'} * (4 - int((scalar @Bots) / 3))); $Console->Write(substr($msg, index($msg, 'Fuel')).(' ' x (70 - length($msg)))); $Console->Attr($main::FG_WHITE); } else { print $msg, (' ' x (79 - length($msg))), "\r"; } } @{$Watch}{'x', 'y'} = @{$bot}{'x', 'y'}; } sub bot_fill { my $bot = shift; @{$bot}{qw/enemy_x enemy_y enemy_h enemy_l snode_x snode_y friend_x friend_y friend_h friend_l botcount/} = (); foreach my $other (@Bots) { next if $other->{'dead'}; $bot->{'botcount'}++; next if $other->{'id'} == $bot->{'id'} or $other->{'cloak'}; my $rel = bot_scan($bot, @{$other}{'x', 'y'}); if ($bot->_nearst($rel) > $bot->_distance(@{$other}{'x', 'y'})) { @{$bot}{"${rel}_x", "${rel}_y", "${rel}_h", "${rel}_l"} = @{$other}{qw/x y h life/}; } } foreach my $snode (@Snodes) { if ($bot->_nearst('snode') > $bot->_distance(@{$snode}{'x', 'y'})) { @{$bot}{'snode_x', 'snode_y'} = @{$snode}{'x', 'y'}; } } if ($bot->_onnode()) { $bot->{'fuel'}++ if $bot->{'fuel'} < $Max_fuel and !(($Tick / scalar @Bots) % 5); $bot->{'ammo'}++ if $bot->{'ammo'} < $Max_ammo and !(($Tick / scalar @Bots) % 10); $bot->{'life'}++ if $bot->{'life'} < $Max_life and !(($Tick / scalar @Bots) % 15); } return $bot; } sub bot_damage { my ($bot, $type, $owner, $adj) = @_; return if $bot->{'dead'}; # no good whipping a dead horse $type .= 'h' unless exists($Weapon{$type}); my $dmg = $Weapon{$type}[$bot->{'shield'} ? $DmgS : $DmgN] * $Max_life / 100 + ($adj || 0); return unless $dmg > 0; display('damage', bot_id($bot), $Weapon{$type}[$Verb], ($owner ? bot_id($owner)."'s" : 'a'), substr($type, 0, -1), $dmg); $bot->{'life'} -= $dmg; $bot->{'burn'} += $Weapon{$type}[$bot->{'shield'} ? $BurnS : $BurnN]; $owner->{'score'} += $Weapon{$type}[$bot->{'shield'} ? $ScrS : $ScrN] - (($adj || 0) * $Weapon{$type}[$bot->{'shield'} ? $ScrS : $ScrN] / $Weapon{$type}[$bot->{'shield'} ? $DmgS : $DmgN]) if ($owner and $owner->{'id'} != $bot->{'id'} and !$owner->{'team'} or $owner->{'team'} ne $bot->{'team'}); if ($bot->{'life'} <= 0) { $bot->{'dead'} = 1; $bot->{'lastcmd'} = '** Dead **'; display('death', bot_id($bot), ($owner ? ('by '. ($owner == $bot ? 'itself' : bot_id($owner))) : '')); $Canvas->delete("_bot$bot->{'id'}") if $GUI; $Canvas->delete("_bots$bot->{'id'}") if $GUI; obj_draw(@{$bot}{'x', 'y'}, ($type eq 'destructh') ? '.' : 'P'); } return $dmg; } sub bot_hit { my ($bot, $obj) = @_; obj_erase(@{$bot}{'x', 'y'}); display('hit', bot_id($bot), $obj); if ($obj eq 'mine') { obj_flash('explode', @{$bot}{'x', 'y'}); bot_damage($bot, $obj, $Mines{join(':', @{$bot}{'x', 'y'})}); } elsif ($obj eq 'flag') { if ($bot->{'life'} == $Max_life) { obj_flash('explode', @{$bot}{'x', 'y'}); bot_damage($bot, $obj); } else { $bot->{'life'} = $Max_life; $bot->{'ammo'} += $Flag_ammo; $bot->{'fuel'} += $Flag_fuel; ding('hit', $obj); } } elsif ($obj eq 'vault') { $bot->{'ammo'} += $Vault_ammo; ding('hit', $obj); } } sub bot_ready { my ($bot, $type) = @_; $type .= 'h' unless exists($Weapon{$type}); return ($bot->{'fuel'} >= $Weapon{$type}[$CostF] and $bot->{'ammo'} >= $Weapon{$type}[$CostA]); } sub bot_pay { my ($bot, $type, $amount) = @_; $amount *= $bot->{'burn'} if $type eq 'fuel'; return if $amount > $bot->{$type}; return $bot->{$type} -= $amount; } sub bot_scan { my ($bot, $x, $y) = @_; if (my $other = bot_at($x, $y)) { return (($bot->{'team'} and $other->{'team'} eq $bot->{'team'}) ? 'friend' : 'enemy'); } else { return $Obj{obj_at($x, $y)}; } } # =========================================================================== # Movement Handling # =========================================================================== sub tick_bot { no strict; my $bot = $Bots[($FirstBot + $Tick++) % scalar @Bots]; if ($GUI) { $Top or exit; $Canvas->itemconfigure('_flash', -state => 'hidden'); $Top->configure('-title' => "AI Bots v$Games::AIBots::VERSION (Tick: $Tick)") if $Running; } elsif ($Console) { no integer; $Console->Cursor(43, 21); $Console->Write(sprintf("[1-%1d][w]atch [t]empo: %4s [%5d]", scalar @Bots, ('slow', 'fast', 'norm')[ sqrt(sqrt($Tick_delay / 10)) % 3 ] , $Tick)); select(undef, undef, undef, ((sqrt($Tick_delay / 10)) / (scalar @Bots) / 12) ) unless $Mask; } tick_check() or return; tick_missile($_) foreach (@{$bot->{'missiles'}}); if ($bot->{'dead'}) { bot_watch($bot) unless $Continue; goto &tick_bot; } $bot->{'fuel'}-- if $bot->{'fuel'} > 0 and !(($Tick / scalar @Bots) % 10); my $old = { %{bot_fill($bot)} }; unless (@{$bot->{'queue'}}) { my @cmds; if ($Console and $Mask and $bot->{'id'} == $Watch->{'id'}) { @cmds = user_tick($bot); } else { @cmds = $bot->tick(); } my @passable = qw/pic stack state var queue author team name line/; @{$old}{@passable} = @{$bot}{@passable}; %{$bot} = %{$old}; # $bot->{'var'}{'teamvar'} = $Teamvar{$bot->{'team'}}; $bot->{'bumped'} = ''; $bot->{'bumped_x'} = 0; $bot->{'bumped_y'} = 0; $bot->{'found'} = ''; push @{$bot->{'queue'}}, @cmds if @cmds; } $_ = lc(shift @{$bot->{'queue'}}); # print $bot->{'id'},": $_\n"; if (/^(scan)[\s\t]+(longrange|front|right|left|perimeter|cross|corner)$/ || /^(turn)[\s\t]+(left|right)$/ || /^(move)[\s\t]+(forward|backward)$/ || /^(fire)[\s\t]+(laser|bazooka|energy)$/ || /^(fire)[\s\t]+(grenade)([\s\t]+[\d\'\"]+)?$/ || /^(scan)[\s\t]+(gps)[\s\t]+(\d+)[\s\t]*,[\s\t]*(\d+)$/ || /^(scan)[\s\t]+(position|relative) ([12346789])$/ || /^(disable)[\s\t]+(shield|laymine|cloak)$/ || /^(enable)[\s\t]+(shield|laymine|cloak)$/ || /^(attempt)[\s\t]+(repair|destruct)$/ || /^(beam)[\s\t]+(command|fuel|ammo)\s+(.+)$/ || /^(toggle)[\s\t]+(shield|laymine|cloak)$/ ) { $bot->{'lastcmd'} = join(' ', ucfirst($1), substr($_, $-[2])); &{"cmd_$1"}($bot, $2, $3, $4) or @{$bot->{'queue'}} = grep {$_ eq $bot->{'lastcmd'}} @{$bot->{'queue'}};; bot_watch($bot) unless $Continue;; } elsif ($_) { warn "Malformed command $_ from ".$bot->{'id'}.", state ".$bot->{'state'}; } $bot->{'dead'} = 1 if $bot->{'life'} <= 0; unless ($bot->{'dead'}) { tick_cloak($bot); obj_move(@{$old}{'x', 'y'}, @{$bot}{'x', 'y'}, bot_char($bot), "_bot$bot->{'id'}", 0, ($bot->{'id'} eq $Watch->{'id'})); obj_move(@{$old}{'x', 'y'}, @{$bot}{'x', 'y'}, $bot->{'shield'} ? 'shield' : 'noshield', "_bots$bot->{'id'}", 1); } $Top->after($Tick_delay / (scalar @Bots), \&Games::AIBots::tick_bot) if $GUI and $Running; } sub tick_missile { my $missile = shift; return if $missile->{'dead'}; my $bot = $missile->{'bot'}; my ($dx, $dy) = delta($missile->{'h'}, 'front'); my $tag = "_missile$bot->{'id'}:$missile->{'id'}"; if (bot_at(@{$missile}{'x', 'y'}) and $missile->{'age'} or obj_at($missile->{'x'} += $dx, $missile->{'y'} += $dy) ne '.' or ++$missile->{'age'} >= $missile->{'range'}) { detonate($bot, $missile->{'type'}, @{$missile}{'x', 'y'}); $missile->{'dead'}++; $Canvas->delete($tag) if $GUI; } elsif ($missile->{'age'} > 1) { obj_move($missile->{'x'} - $dx, $missile->{'y'} - $dy, @{$missile}{'x', 'y'}, $missile->{'type'}.$missile->{'h'}, $tag, 1); } else { obj_draw(@{$missile}{'x', 'y'}, $missile->{'type'}.$missile->{'h'}, $tag, 1); } } sub tick_cloak { my $bot = shift; return unless $bot->{'cloak'}; if ($bot->{'fuel'} >= $Cloak_fuel and bot_pay($bot, ammo => $Cloak_ammo)) { $bot->{'fuel'} -= $Cloak_fuel; } else { $bot->{'cloak'} = 0; } } sub tick_check { my (%alive, $hasfuel, $missiles); return if !$Running; foreach my $bot (@Bots) { $alive{$bot->{'team'} || bot_id($bot)}++ unless $bot->{'dead'}; $hasfuel++ unless $bot->{'dead'} or $bot->{'fuel'} <= 0; foreach my $missile (@{$bot->{'missiles'}}) { $missiles++ unless $missile->{'dead'}; } } if (!$missiles and (scalar keys(%alive) <= 1) or !$hasfuel) { # Game Over display('end'); my %TScore; foreach my $bot (@Bots) { $bot->{'score'} += 50 * $bot->{'life'}; $bot->{'score'} -= $bot->{'burn'}; $bot->{'score'} += 500 / $alive{$bot->{'team'} || bot_id($bot)} unless $bot->{'dead'} or (scalar keys(%alive) > 1); $TScore{$bot->{'team'} || bot_id($bot)} += $bot->{'score'} || 0; $bot->{'lastcmd'} = '**End**'; } my @BScore = sort {$b->{'score'} <=> $a->{'score'}} @Bots; my @TScore = sort {$TScore{$b} <=> $TScore{$a}} keys(%TScore); if ($GUI) { $Btn_stop->configure(-state => 'disabled'); $Btn_play->configure(-image => 'play'); $_->configure(-state => 'normal', -background => '#a04444') foreach @Mnu_arg; $Top->configure('-title' => "AI Bots v$Games::AIBots::VERSION [Winner:".bot_id($BScore[0])." | Team ".$TScore[0]."] (Tick: $Tick)"); $Watch->{'id'} = $BScore[0]->{'id'}; bot_watch($BScore[0]); } foreach my $bot (@BScore) { $Watch->{'id'} = $bot->{'id'}; bot_watch($bot, 1); print "\n" unless $Console and $^O ne 'MSWin32'; } $Running = undef; ding('game_over'); display('winner', bot_id($BScore[0]), $TScore[0]); } return $Running; } # =========================================================================== # Bot Commands # =========================================================================== sub cmd_attempt { my ($bot, $action) = @_; if ($action eq 'repair') { return if $bot->{'shield'} or $bot->{'life'} >= $Max_life; if (!int(rand(10))) { $bot->{'life'}++; obj_flash('repair', @{$bot}{'x', 'y'}); } elsif (!int(rand(20))) { $bot->{'burn'}++; obj_flash('explode', @{$bot}{'x', 'y'}); } } elsif ($action eq 'destruct') { my $dmg = $bot->{'life'} * 100 / $Max_life; @{$Weapon{'destructh'}}[$DmgS, $DmgN, $BurnS, $BurnN] = ($dmg, $dmg, $dmg / 10, $dmg / 10); @{$Weapon{'destructs'}}[$DmgS, $DmgN, $BurnS, $BurnN, $ScrS, $ScrN] = ($dmg, $dmg, $dmg / 10, $dmg / 10, $dmg * 5, $dmg * 5); detonate($bot, 'destruct', @{$bot}{'x', 'y'}); } return 1; } sub cmd_beam { my ($bot, $type, $param) = @_; my ($x, $y) = delta($bot->{'h'}, 'back'); $x += $bot->{'x'}; $y += $bot->{'y'}; if (my $other = bot_at($x, $y)) { return unless $other->{'h'} + $bot->{'h'} == 10; ding('beam'); if ($type eq 'command') { unshift(@{$other->{'queue'}}, $param); } elsif ($type eq 'fuel' or $type eq 'ammo') { $param = -($other->{$type}) if $param < -($other->{$type}); $param = $bot->{$type} if $param > $bot->{$type}; $bot->{$type} += $param; $other->{$type} -= $param; } } return 1; } sub cmd_disable { my ($bot, $switch) = @_; $bot->{$switch} = 0; return 1; } sub cmd_enable { my ($bot, $switch) = @_; $bot->{$switch} = 1; return 1; } sub cmd_toggle { my ($bot, $switch) = @_; $bot->{$switch} = 1 - $bot->{$switch}; return 1; } sub cmd_fire { my ($bot, $type, $range) = @_; # check ammo & fuel requisites return if (not bot_ready($bot, $type)); bot_pay($bot, ammo => $Weapon{$type.'h'}[$CostA]); $bot->{'fuel'} -= $Weapon{$type.'h'}[$CostF]; ding('fire', $type); if ($type eq 'energy') { detonate($bot, $type, @{$bot}{'x', 'y'}); } elsif ($type eq 'bazooka' or $type eq 'grenade') { if ($bot->{'shield'}) { # self explode! $bot->{'shield'} = 0; detonate($bot, $type, @{$bot}{'x', 'y'}); $bot->{'shield'} = 1; } else { # new missile my $missile = { 'x' => $bot->{'x'}, 'y' => $bot->{'y'}, 'h' => $bot->{'h'}, 'range' => $range || (($Cols > $Rows) ? $Cols : $Rows), 'type' => $type, 'bot' => $bot, }; push @{$bot->{'missiles'}}, $missile; $missile->{'id'} = $#{$bot->{'missiles'}}; tick_missile($missile); } } elsif ($type eq 'laser') { my ($x, $y) = @{$bot}{'x', 'y'}; my ($dx, $dy) = delta($bot->{'h'}, 'front'); my $dir = ($bot->{'h'} == 8 or $bot->{'h'} == 2) ? 'v' : 'h'; foreach my $step (1 .. $Weapon{$type.'h'}[$DmgN] / 10) { my $obj = $Obj{obj_at($x += $dx, $y += $dy)}; (obj_flash($type.$dir, $x, $y), next) if ($obj eq 'space'); obj_flash($type, $x, $y); obj_erase($x, $y) if ($obj eq 'fence'); (detonate($bot, $obj, $x, $y), obj_erase($x, $y)) if ($obj eq 'vault'); my $other = bot_at($x, $y) or last; ding('dmg', $type) if bot_damage($other, $type, $bot, 1 - $step); last; } } elsif ($type eq 'mine') { $Mines{join(':', @{$bot}{'x', 'y'})} = $bot; obj_draw(@{$bot}{'x', 'y'}, 'O'); } return 1; } sub cmd_move { my ($bot, $dir) = @_; my ($x, $y) = delta($bot->{'h'}, ($dir eq 'forward') ? 'front' : 'back'); $x += $bot->{'x'}; $y += $bot->{'y'}; if (obj_at($x, $y) =~ /^[.OPA]$/) { bot_pay($bot, fuel => 1) or return; substr($Board, ($bot->{'y'} - 1) * $Cols + $bot->{'x'} - 1, 1) = '.'; cmd_fire($bot, 'mine') if ($bot->{'laymine'}); @{$bot}{'x', 'y'} = ($x, $y); bot_hit($bot, $Obj{obj_at($x, $y)}) if (obj_at($x, $y) ne '.'); } else { $bot->{'bumped'} = bot_scan($bot, $x, $y); @{$bot}{'bumped_x', 'bumped_y'} = ($x, $y); return; } return 1; } sub cmd_scan { my ($bot, $type) = splice(@_, 0, 2); my ($x, $y) = @{$bot}{'x', 'y'}; if ($type eq 'gps') { obj_flash('scang', @_); $bot->{'found'} = bot_scan($bot, @_); } elsif ($type eq 'perimeter') { obj_flash('scanp', $x, $y); $bot->{'found'} = (sort {index($Scan_list, $b) <=> index($Scan_list, $a)} bot_scan($bot, $x-1, $y-1), bot_scan($bot, $x-1, $y), bot_scan($bot, $x-1, $y+1), bot_scan($bot, $x, $y-1), bot_scan($bot, $x , $y+1), bot_scan($bot, $x+1, $y-1), bot_scan($bot, $x+1, $y), bot_scan($bot, $x+1, $y+1), )[0]; } elsif ($type eq 'cross') { obj_flash('scancr', $x, $y); $bot->{'found'} = (sort {index($Scan_list, $b) <=> index($Scan_list, $a)} bot_scan($bot, $x-1, $y), bot_scan($bot, $x, $y-1), bot_scan($bot, $x+1, $y), bot_scan($bot, $x, $y+1), )[0]; } elsif ($type eq 'corner') { obj_flash('scanco', $x, $y); $bot->{'found'} = (sort {index($Scan_list, $b) <=> index($Scan_list, $a)} bot_scan($bot, $x-1, $y-1), bot_scan($bot, $x-1, $y+1), bot_scan($bot, $x+1, $y-1), bot_scan($bot, $x+1, $y+1), )[0]; } elsif ($type eq 'position' or $type eq 'relative') { my $pos = shift; if ($type eq 'relative') { $pos =~ tr/12346789/74182963/ if ($bot->{'h'} eq '6'); $pos =~ tr/12346789/98764321/ if ($bot->{'h'} eq '2'); $pos =~ tr/12346789/36928147/ if ($bot->{'h'} eq '4'); } $x += 1 - ((9 - $pos) % 3), $y += 1 - int(($pos-1) / 3), $bot->{'found'} = bot_scan($bot, $x, $y); obj_flash('scang', $x, $y); } elsif ($type eq 'longrange') { cmd_scandir($bot, 'front', ($Cols > $Rows) ? $Cols : $Rows); } else { cmd_scandir($bot, $type, $Scan_range); } return 1; # scan could be used as no-op } sub cmd_scandir { my ($bot, $dir, $range) = @_; my ($x, $y) = @{$bot}{'x', 'y'}; my ($dx, $dy) = delta($bot->{'h'}, $dir); foreach my $step (1 .. $range) { obj_flash($step == 1 ? 'scan'.$bot->{'h'} : 'scan', $x += $dx, $y += $dy, $step); return 1 unless ($bot->{'found'} = bot_scan($bot, $x, $y)) eq 'space'; } return; } sub cmd_turn { my ($bot, $dir) = @_; return unless bot_pay($bot, fuel => 1); $bot->{'h'} = (qw/8 6 2 4/)[(index('8624', $bot->{'h'}) + (($dir eq 'left') ? 3 : 1)) % 4]; return 1; } # =========================================================================== # Utilities # =========================================================================== sub detonate { my ($bot, $type, $x, $y) = @_; obj_flash($Obj{$type}, $x, $y) unless $Obj{$type} and $Obj{$type} eq 'vault'; # detonation on spot if (my $other = bot_at($x, $y)) { bot_damage($other, $type, $bot); } elsif (my $obj = $Obj{obj_at($x, $y)}) { if ($obj eq 'fence') { obj_erase($x, $y); } elsif ($obj eq 'vault') { obj_erase($x, $y); detonate($bot, $obj, $x, $y); } } # splash damage $type .= 's'; foreach my $dx (-1 .. 1) { foreach my $dy (-1 .. 1) { next if $dx == 0 and $dy == 0; my $obj = $Obj{obj_at($x + $dx, $y + $dy)} or next; $x += $dx; $y += $dy; if (my $other = bot_at($x, $y)) { bot_damage($other, $type, $bot); } elsif ($obj eq 'vault') { obj_erase($x, $y); obj_flash('explode', $x, $y); detonate($bot, 'vault', $x, $y); } elsif ($type eq 'destructs') { obj_erase($x, $y) if ($obj eq 'flag' or $obj eq 'mine' or $obj eq 'fence'); } elsif ($type eq 'energys') { obj_erase($x, $y) if ($obj eq 'flag' or $obj eq 'mine'); } else { obj_erase($x, $y) if ($obj eq 'fence'); } $x -= $dx; $y -= $dy; } } } sub delta { my ($head, $dir) = @_; $dir ||= 'front'; $head =~ tr/8624/0123/ if $dir eq 'front'; $head =~ tr/8624/1230/ if $dir eq 'right'; $head =~ tr/8624/2301/ if $dir eq 'back'; $head =~ tr/8624/3012/ if $dir eq 'left'; return ($head % 2) * (2 - $head), (($head + 1) % 2) * ($head - 1); } sub display { return if $Continue; my $msg = shift; $msg = sprintf "[%5s] $Msg{$msg}", $Tick, @_; $msg .= (' ' x (79 - length($msg))); if ($Console and (!$Mask or $Bots[-1]{dead})) { $Console->Cursor(0, 24); $Console->Write($msg . (' ' x (79 - length($msg)))); } if ($Console and $^O ne 'MSWin32') { $Msglog .= "$msg\n"; } else { print $msg, "\n"; } } sub ding { return unless $Sound; if (exists($Wav{join('_', @_)})) { Win32::Sound::Play($Wav{join('_', @_)}, 1); } elsif ($Console and ($_[1] eq 'destruct' or $_[0] eq 'hit' or $_[0] eq 'fire')) { print chr(7); } } sub do_loop { $Continue = shift; if ($GUI) { $Top->focusForce; Tk::MainLoop(); } else { require Term::ReadKey; ding('game_begin'); # init_map(); init_game(); $Running = 1; Term::ReadKey::ReadMode(4); while (1) { while (my($x, $y, $obj) = splice(@Flash, 0, 3)) { obj_set($x, $y, $obj); } tick_bot() if $Running; $Console->Display() if $Console; next if $Mask and $Running and not $Bots[-1]{dead}; my $key = Term::ReadKey::ReadKey( ($Running or $Continue) ? -1 : 10 ) or $Continue or next; if ($key eq 'h') { $_->{'fuel'} = 0 foreach (@Bots); tick_check(); } elsif ($key ge '0' and $key le '9') { $Watch->{'id'} = $key; Games::AIBots::bot_watch($Bots[$key-1]); ding('toggle'); } elsif ($key eq 'q') { $Console->Cursor(0, 24) if $Console; print $Msglog; exit; } elsif ($key eq 's') { btn_sound(); } elsif ($key eq 'w') { btn_watch(); } elsif ($key eq 't') { btn_tempo(); } elsif ($key eq 'T') { btn_tempo(); btn_tempo(); } elsif ($key eq ' ' or $key eq 'p' or !$Running and $Continue) { # $Continue--; btn_play(); } } } } %UserCmd = ( k => 'move forward', j => 'move backward', h => 'turn left', l => 'turn right', b => 'fire bazooka', g => 'fire grenade', G => sub { 'fire grenade '.int(Term::ReadKey::ReadKey(0)) }, z => 'fire energy', x => 'fire laser', c => 'toggle cloak', s => 'toggle shield', m => 'toggle laymine', K => 'scan front', H => 'scan left', L => 'scan right', J => 'scan perimeter', I => 'scan longrange', U => 'scan cross', O => 'scan corner', P => sub { 'scan position '.int(Term::ReadKey::ReadKey(0)) }, R => sub { 'scan relative '.int(Term::ReadKey::ReadKey(0)) }, r => 'attempt repair', d => 'attempt destruct', q => sub { $Console->Cursor(0, 24) if $Console; print $Msglog; exit; } ); sub user_tick { die "User tick support for non-console mode: Not Yet." unless $Console; my $bot = shift; my $msg = sprintf( "Score:%d Ammo:%d Life:%d Fuel:%d [%s]", @{$bot}{qw/score ammo life fuel lastcmd/} ); if ($bot->{bumped}) { obj_set(@{$bot}{'bumped_x', 'bumped_y'}, obj_at(@{$bot}{'bumped_x', 'bumped_y'})); } $Console->Attr($main::FG_LIGHTCYAN); $Console->Cursor(40, 4); $Console->Write(substr($msg, 0, index($msg, ' Fuel')).(' ' x (40 - index($msg, ' Fuel')))); $Console->Cursor(42, 5); $Console->Write(substr($msg, index($msg, 'Fuel')).(' ' x (70 - length($msg)))); $msg = $bot->{shield} ? '[S]' : '[s]'; $msg .= $bot->{laymine} ? '[M]' : '[m]'; $msg .= $bot->{cloak} ? '[C]' : '[c]'; $msg .= " Bump:$bot->{bumped}" if $bot->{bumped}; $msg .= " Scan:$bot->{found}" if $bot->{found}; $msg .= " Enem:$bot->{enemy_l}" if $bot->{enemy_l}; $msg .= " Frnd:$bot->{friend_l}" if $bot->{friend_l}; $Console->Cursor(42, 6); $Console->Write($msg . (' ' x (38 - length($msg)))); $Console->Attr($main::FG_WHITE); $Console->Cursor(0, 0); my $key; while (not defined $key or not exists $UserCmd{$key}) { $key = Term::ReadKey::ReadKey(0); } my $cmd = $UserCmd{$key}; if ($bot->{enemy_x} and $Console) { $Console->Cursor($bot->{enemy_x} - 1, $bot->{enemy_y} - 1, 0, 0); $Console->Write(' '); } return ref($cmd) eq 'CODE' ? &{$cmd} : $cmd; } 1; =head1 SEE ALSO L, L =head1 AUTHORS Autrijus Tang Eautrijus@autrijus.orgE Files under the F directory was contributed by students in the autonomous learning experimnetal class, Bei'zheng junior high school, Taipei, Taiwan. =head1 COPYRIGHT Copyright 2001, 2002 by Autrijus Tang Eautrijus@autrijus.orgE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut