From 469e3ffa8a775e8a6dd731b99a37582b521be9e4 Mon Sep 17 00:00:00 2001 From: mdiluzio Date: Sat, 20 Dec 2014 15:35:19 +0000 Subject: [PATCH 1/6] Add a Random player, simply does random commands on each turn Remove simplePlayer in favor of new randomPlayer, which uses new ttrts.pm module --- ttrts.pm | 179 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 179 insertions(+) create mode 100644 ttrts.pm diff --git a/ttrts.pm b/ttrts.pm new file mode 100644 index 0000000..7e9fdbf --- /dev/null +++ b/ttrts.pm @@ -0,0 +1,179 @@ +#! /usr/bin/perl +use strict; +use warnings; + +# Get information about a unit from it's descriptor +sub getUnit +{ + return ($_[0] =~ /UNIT:(\d+) tm:(\d+) vs:([^ ]+) dr:([^ ]+) ps:\[(\d+),(\d+)\]/); +} + +# Get the units from a turn file +sub GetUnitsForTurn +{ + my $turnFile = shift; + + # Open the turn file + open (my $TURNHANDLE, '<', $turnFile) or die "Could not open '$turnFile' $!"; + + # Skip the header information + my $headerLine = <$TURNHANDLE>; + my $sizeLine = <$TURNHANDLE>; + my $turnLine = <$TURNHANDLE>; + ( <$TURNHANDLE> =~ /~~~~/ ) or die "Gamestate file did not match expected format"; + + my @units; + while( my $unitLine = <$TURNHANDLE> ) + { + chomp $unitLine; + push(@units,$unitLine); + } + + close $TURNHANDLE; + + return @units; +} + +# Get information from the header for this turn +sub GetHeaderForTurn +{ + my $turnFile = shift; + + # Open the turn file + open (my $TURNHANDLE, '<', $turnFile) or die "Could not open '$turnFile' $!"; + + # Pull in the header information + my $headerLine = <$TURNHANDLE>; + chomp $headerLine; + my $sizeLine = <$TURNHANDLE>; + chomp $sizeLine; + my $turnLine = <$TURNHANDLE>; + chomp $turnLine; + + my ($gameName) = ( $headerLine =~ /===== ([^ ]+) =====/ ); + my ($gameX,$gameY) = ( $sizeLine =~ /SIZE:\[(\d+),(\d+)\]/ ); + + ( <$TURNHANDLE> =~ /~~~~/ ) or die "Gamestate file did not match expected format"; + + close $TURNHANDLE; + + return ($gameName,$gameX,$gameY); +} + +# Get units from a specific team +sub getUnitsOnTeam +{ + my $theTeam = shift; + my @allUnits = @_; + my @myUnits; + + for my $unit (@allUnits) + { + my ($unitTeam) = $unit =~ /tm:(\d+)/; + if ( $unitTeam == $theTeam ) + { + push(@myUnits,$unit); + } + } + + return @myUnits; +} + +sub GetTurnFile +{ + my $turn = shift; + my $turnFile = "Turn_TURN.txt"; + $turnFile =~ s/TURN/$turn/; + return $turnFile; +} + +sub GetCommandFile +{ + my $turn = shift; + my $team = shift; + my $cmdFileName = "Turn_TURN_Team_TEAM.txt"; + $cmdFileName =~ s/TURN/$turn/; + $cmdFileName =~ s/TEAM/$team/; + return $cmdFileName; +} + +# Output the commands file +sub OutputCommandsFile +{ + my $turn = shift; + my $team = shift; + my $commands = shift; + + # Get output file + our $cmdFileName = GetCommandFile($turn,$team); + + if (! -e $cmdFileName) + { + open(my $cmdFile, '>', $cmdFileName) or die "Couldn't open '$cmdFileName' $!"; + print $cmdFile $commands; + close $cmdFile; + + printf "Outputted $cmdFileName\n"; + printf "$commands"; + } + else + { + open(my $cmdFile, '<', $cmdFileName) or die "Couldn't open '$cmdFileName' $!"; + my $old_commands = do { <$cmdFile> }; + + printf "Replaying $cmdFileName\n"; + printf "$old_commands"; + } +} + +# Print a game map +sub PrintGameMap +{ + my $gameX = shift; + my $gameY = shift; + my @units = @_; + + my @map; + + # Fill with blanks + for my $x (0 .. $gameX-1) + { + for my $y (0 .. $gameY-1) + { + $map[$x][$y] = "-"; + } + } + + # Fill with units + for my $unit (@units) + { + my ($id,$tm,$vs,$dr,$psx,$psy) = getUnit($unit); + + $tm += 31; + $vs = "\e[".$tm."m".$vs."\e[0m"; + + $map[$psx][$psy] = $vs; + } + + # Print whole map bottom left is 0,0 + for my $y ( reverse 0 .. $gameY-1 ) + { + for my $x (0 .. $gameX-1) + { + printf($map[$x][$y]); + } + printf("\n"); + } +} + +# Wait for a file to exist +sub WaitForFile +{ + my $file = $_[0]; + while( ! -e $file ) + { + select(undef, undef, undef, 0.01); + } +} + +return 1; \ No newline at end of file From b0af969b2968d5330e908ac92699cc8384b2d620 Mon Sep 17 00:00:00 2001 From: mdiluzio Date: Sat, 20 Dec 2014 17:17:04 +0000 Subject: [PATCH 2/6] Update to 0.0.1 version system for main ttrts client and check versions --- ttrts.pm | 41 +++++++++++++++++++++++++++++++++-------- 1 file changed, 33 insertions(+), 8 deletions(-) diff --git a/ttrts.pm b/ttrts.pm index 7e9fdbf..9479e9c 100644 --- a/ttrts.pm +++ b/ttrts.pm @@ -2,6 +2,9 @@ use strict; use warnings; +our $ttrts_perlai_versioncompat_major = 0; +our $ttrts_perlai_versioncompat_minor = 0; + # Get information about a unit from it's descriptor sub getUnit { @@ -17,16 +20,21 @@ sub GetUnitsForTurn open (my $TURNHANDLE, '<', $turnFile) or die "Could not open '$turnFile' $!"; # Skip the header information - my $headerLine = <$TURNHANDLE>; - my $sizeLine = <$TURNHANDLE>; - my $turnLine = <$TURNHANDLE>; - ( <$TURNHANDLE> =~ /~~~~/ ) or die "Gamestate file did not match expected format"; + my $num = 0; + while( !( <$TURNHANDLE> =~ /~~~~/ ) ) + { + $num++; + $num > 20 and die "gamestate file did not reach ~~~~ line within 10 lines"; + } my @units; while( my $unitLine = <$TURNHANDLE> ) { chomp $unitLine; - push(@units,$unitLine); + if( !($unitLine eq "END") ) + { + push(@units,$unitLine); + } } close $TURNHANDLE; @@ -34,6 +42,19 @@ sub GetUnitsForTurn return @units; } +# Check version numbers against ttrts.pm version +sub checkVersion +{ + my $version_major = shift; + my $version_minor = shift; + if( ($version_major != $ttrts_perlai_versioncompat_major) + or ($version_minor != $ttrts_perlai_versioncompat_minor) ) + { + printf "ttrts.pm version does not match with this ttrts version\n"; + die "ttrts.pm = v$ttrts_perlai_versioncompat_minor.$ttrts_perlai_versioncompat_major ttrts = v$version_major.$version_minor"; + } +} + # Get information from the header for this turn sub GetHeaderForTurn { @@ -45,15 +66,18 @@ sub GetHeaderForTurn # Pull in the header information my $headerLine = <$TURNHANDLE>; chomp $headerLine; + my $nameLine = <$TURNHANDLE>; + chomp $nameLine; my $sizeLine = <$TURNHANDLE>; chomp $sizeLine; my $turnLine = <$TURNHANDLE>; chomp $turnLine; - my ($gameName) = ( $headerLine =~ /===== ([^ ]+) =====/ ); - my ($gameX,$gameY) = ( $sizeLine =~ /SIZE:\[(\d+),(\d+)\]/ ); + my ($version_major,$version_minor) = ( $headerLine =~ /==== ttrts v(\d+)\.(\d+)\.\d+ ====/ ); + checkVersion $version_major,$version_minor; - ( <$TURNHANDLE> =~ /~~~~/ ) or die "Gamestate file did not match expected format"; + my ($gameName) = ( $nameLine =~ /NAME:(.+)/ ); + my ($gameX,$gameY) = ( $sizeLine =~ /SIZE:\[(\d+),(\d+)\]/ ); close $TURNHANDLE; @@ -111,6 +135,7 @@ sub OutputCommandsFile { open(my $cmdFile, '>', $cmdFileName) or die "Couldn't open '$cmdFileName' $!"; print $cmdFile $commands; + print $cmdFile "END"; close $cmdFile; printf "Outputted $cmdFileName\n"; From 19623c67119cc90cc2156430a0feb85b162b12f9 Mon Sep 17 00:00:00 2001 From: mdiluzio Date: Sat, 20 Dec 2014 17:33:36 +0000 Subject: [PATCH 3/6] Update version to match with compatible ttrts version --- ttrts.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ttrts.pm b/ttrts.pm index 9479e9c..eb588ba 100644 --- a/ttrts.pm +++ b/ttrts.pm @@ -3,7 +3,7 @@ use strict; use warnings; our $ttrts_perlai_versioncompat_major = 0; -our $ttrts_perlai_versioncompat_minor = 0; +our $ttrts_perlai_versioncompat_minor = 1; # Get information about a unit from it's descriptor sub getUnit From ac9ed13be8a5ce9ace858339d05f38d72cf99d09 Mon Sep 17 00:00:00 2001 From: mdiluzio Date: Mon, 22 Dec 2014 20:03:31 +0000 Subject: [PATCH 4/6] Update using player instead of team and matching new file formats --- ttrts.pm | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/ttrts.pm b/ttrts.pm index eb588ba..3cf0820 100644 --- a/ttrts.pm +++ b/ttrts.pm @@ -8,7 +8,7 @@ our $ttrts_perlai_versioncompat_minor = 1; # Get information about a unit from it's descriptor sub getUnit { - return ($_[0] =~ /UNIT:(\d+) tm:(\d+) vs:([^ ]+) dr:([^ ]+) ps:\[(\d+),(\d+)\]/); + return ($_[0] =~ /UNIT:(\d+) pl:(\d+) vs:([^ ]+) dr:([^ ]+) ps:\[(\d+),(\d+)\]/); } # Get the units from a turn file @@ -84,17 +84,17 @@ sub GetHeaderForTurn return ($gameName,$gameX,$gameY); } -# Get units from a specific team -sub getUnitsOnTeam +# Get units from a specific player +sub getUnitsOnPlayer { - my $theTeam = shift; + my $thePlayer = shift; my @allUnits = @_; my @myUnits; for my $unit (@allUnits) { - my ($unitTeam) = $unit =~ /tm:(\d+)/; - if ( $unitTeam == $theTeam ) + my ($unitplayer) = $unit =~ /pl:(\d+)/; + if ( $unitplayer == $thePlayer ) { push(@myUnits,$unit); } @@ -114,10 +114,10 @@ sub GetTurnFile sub GetCommandFile { my $turn = shift; - my $team = shift; - my $cmdFileName = "Turn_TURN_Team_TEAM.txt"; + my $player = shift; + my $cmdFileName = "Player_PLAYER_Turn_TURN.txt"; $cmdFileName =~ s/TURN/$turn/; - $cmdFileName =~ s/TEAM/$team/; + $cmdFileName =~ s/PLAYER/$player/; return $cmdFileName; } @@ -125,11 +125,11 @@ sub GetCommandFile sub OutputCommandsFile { my $turn = shift; - my $team = shift; + my $player = shift; my $commands = shift; # Get output file - our $cmdFileName = GetCommandFile($turn,$team); + our $cmdFileName = GetCommandFile($turn,$player); if (! -e $cmdFileName) { @@ -172,10 +172,10 @@ sub PrintGameMap # Fill with units for my $unit (@units) { - my ($id,$tm,$vs,$dr,$psx,$psy) = getUnit($unit); + my ($id,$pl,$vs,$dr,$psx,$psy) = getUnit($unit); - $tm += 31; - $vs = "\e[".$tm."m".$vs."\e[0m"; + $pl += 31; + $vs = "\e[".$pl."m".$vs."\e[0m"; $map[$psx][$psy] = $vs; } From f9ee646c93ba3d03f00065f24ee39c93163cda23 Mon Sep 17 00:00:00 2001 From: mdiluzio Date: Mon, 22 Dec 2014 20:05:30 +0000 Subject: [PATCH 5/6] Update to be compatible with 0.2 --- ttrts.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ttrts.pm b/ttrts.pm index 3cf0820..8acdf17 100644 --- a/ttrts.pm +++ b/ttrts.pm @@ -3,7 +3,7 @@ use strict; use warnings; our $ttrts_perlai_versioncompat_major = 0; -our $ttrts_perlai_versioncompat_minor = 1; +our $ttrts_perlai_versioncompat_minor = 2; # Get information about a unit from it's descriptor sub getUnit From b50c838f2896014a4f23f7dbc00916ce92dd54e3 Mon Sep 17 00:00:00 2001 From: mdiluzio Date: Mon, 29 Dec 2014 21:59:59 +0000 Subject: [PATCH 6/6] Large refactor and addition of new features in line with 0.3.0 --- ttrts.pm | 223 +++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 159 insertions(+), 64 deletions(-) diff --git a/ttrts.pm b/ttrts.pm index 8acdf17..6dc279e 100644 --- a/ttrts.pm +++ b/ttrts.pm @@ -3,50 +3,97 @@ use strict; use warnings; our $ttrts_perlai_versioncompat_major = 0; -our $ttrts_perlai_versioncompat_minor = 2; +our $ttrts_perlai_versioncompat_minor = 3; -# Get information about a unit from it's descriptor -sub getUnit +our $headerDelimiter="~~~~"; + +our $VERBOSE = $ENV{"VERBOSE"}; + +# Format of the a gamestate header +our $headerFormatter = qr/==== ttrts v(\d+)\.(\d+)\.(\d+)+ ==== +NAME:(.+) +SIZE:\[(\d+),(\d+)\] +TURN:(\d+) +(WALL:.*?) +$headerDelimiter/; + +# Formatter for coords +our $coordFormatter = qr/\[\d+,\d+\]/; + +# Format of a unit descriptor +our $unitFormatterNonCapture = qr/UNIT:\d+ pl:\d+ vs:[^ ]+ dr:[^ ]+ ps:\[\d+,\d+\]\n?/; + +# Format of a unit descriptor +our $unitFormatter = qr/UNIT:(\d+) pl:(\d+) vs:([^ ]+) dr:([^ ]+) ps:\[(\d+),(\d+)\]\n?/; + +# Get x and y +sub getPositionsXandYString { - return ($_[0] =~ /UNIT:(\d+) pl:(\d+) vs:([^ ]+) dr:([^ ]+) ps:\[(\d+),(\d+)\]/); + return (shift =~ /\[(\d+),(\d+)\]/); } -# Get the units from a turn file -sub GetUnitsForTurn +# Get all positions +sub getPositionStringsFromLine { - my $turnFile = shift; + return (shift =~ /$coordFormatter/gm ); +} - # Open the turn file - open (my $TURNHANDLE, '<', $turnFile) or die "Could not open '$turnFile' $!"; - - # Skip the header information - my $num = 0; - while( !( <$TURNHANDLE> =~ /~~~~/ ) ) - { - $num++; - $num > 20 and die "gamestate file did not reach ~~~~ line within 10 lines"; - } +# Get information about a unit from it's descriptor +sub getUnitInfo +{ + return (shift =~ /$unitFormatter/); +} - my @units; - while( my $unitLine = <$TURNHANDLE> ) +# Get set of units from a string +sub GetUnitStringsFromGamestate +{ + my $gamestate = shift; + + my @units = ( $gamestate =~ /$unitFormatterNonCapture/gm ); + + foreach my $unit (@units) { - chomp $unitLine; - if( !($unitLine eq "END") ) - { - push(@units,$unitLine); - } + chomp($unit); } - close $TURNHANDLE; - return @units; } +# in the format $major,$minor,$patch,$name,$sizex,$sizey,$turn,$invalidpositions+ +sub GetGameInfoFromGamestate +{ + my $header = shift; + (! defined $header) and die "GetGameInfoFromGamestate was not passed valid header parameter"; + + my @info = ($header =~ /$headerFormatter/ ); + + return @info; +} + +# Get the units from a turn file +sub GetUnitStringsFromFile +{ + my $turnFile = shift or die "GetUnitStringsFromFile needs file parameter"; + + # Read in the whole file method from http://www.perlmonks.org/?node_id=1952 + my $text; + { + local $/=undef; + open FILE, $turnFile or die "Couldn't open file: $!"; + $text = ; + close FILE; + } + + return GetUnitStringsFromGamestate($text); +} + # Check version numbers against ttrts.pm version -sub checkVersion +sub verifyVersion { my $version_major = shift; + (! defined $version_major) and die "verifyVersion needs version_major parameter"; my $version_minor = shift; + (! defined $version_minor) and die "verifyVersion needs version_minor parameter"; if( ($version_major != $ttrts_perlai_versioncompat_major) or ($version_minor != $ttrts_perlai_versioncompat_minor) ) { @@ -55,40 +102,34 @@ sub checkVersion } } + # Get information from the header for this turn -sub GetHeaderForTurn +sub GetGameInfoFromFile { - my $turnFile = shift; + my $turnFile = shift or die "GetGameInfoFromFile needs turnFile parameter"; - # Open the turn file - open (my $TURNHANDLE, '<', $turnFile) or die "Could not open '$turnFile' $!"; - - # Pull in the header information - my $headerLine = <$TURNHANDLE>; - chomp $headerLine; - my $nameLine = <$TURNHANDLE>; - chomp $nameLine; - my $sizeLine = <$TURNHANDLE>; - chomp $sizeLine; - my $turnLine = <$TURNHANDLE>; - chomp $turnLine; + # Read in the whole file method from http://www.perlmonks.org/?node_id=1952 + my $text; + { + local $/=undef; + open FILE, $turnFile or die "Couldn't open file: $!"; + $text = ; + close FILE; + } - my ($version_major,$version_minor) = ( $headerLine =~ /==== ttrts v(\d+)\.(\d+)\.\d+ ====/ ); - checkVersion $version_major,$version_minor; + my @info = GetGameInfoFromGamestate($text); + verifyVersion @info; - my ($gameName) = ( $nameLine =~ /NAME:(.+)/ ); - my ($gameX,$gameY) = ( $sizeLine =~ /SIZE:\[(\d+),(\d+)\]/ ); - - close $TURNHANDLE; - - return ($gameName,$gameX,$gameY); + return @info; } # Get units from a specific player -sub getUnitsOnPlayer +sub GetPlayerUnits { my $thePlayer = shift; + (! defined $thePlayer) and die "GetPlayerUnits needs player parameter"; my @allUnits = @_; + (! @allUnits) and die "GetPlayerUnits needs units parameters"; my @myUnits; for my $unit (@allUnits) @@ -103,18 +144,21 @@ sub getUnitsOnPlayer return @myUnits; } -sub GetTurnFile +sub GetTurnFileName { my $turn = shift; + (! defined $turn) and die "GetTurnFileName needs turn parameter"; my $turnFile = "Turn_TURN.txt"; $turnFile =~ s/TURN/$turn/; return $turnFile; } -sub GetCommandFile +sub GetCommandFileName { my $turn = shift; + (! defined $turn) and die "GetCommandFileName needs turn parameter"; my $player = shift; + (! defined $player) and die "GetCommandFileName needs player parameter"; my $cmdFileName = "Player_PLAYER_Turn_TURN.txt"; $cmdFileName =~ s/TURN/$turn/; $cmdFileName =~ s/PLAYER/$player/; @@ -125,11 +169,13 @@ sub GetCommandFile sub OutputCommandsFile { my $turn = shift; + (! defined $turn) and die "OutputCommandsFile needs turn parameter"; my $player = shift; - my $commands = shift; + (! defined $player) and die "OutputCommandsFile needs player parameter"; + my $commands = shift or die "OutputCommandsFile needs commands parameter"; # Get output file - our $cmdFileName = GetCommandFile($turn,$player); + our $cmdFileName = GetCommandFileName($turn,$player); if (! -e $cmdFileName) { @@ -138,25 +184,41 @@ sub OutputCommandsFile print $cmdFile "END"; close $cmdFile; - printf "Outputted $cmdFileName\n"; + $VERBOSE and printf "Outputted $cmdFileName\n"; printf "$commands"; } else { - open(my $cmdFile, '<', $cmdFileName) or die "Couldn't open '$cmdFileName' $!"; - my $old_commands = do { <$cmdFile> }; + # Read in the whole file method from http://www.perlmonks.org/?node_id=1952 + my $text; + { + local $/=undef; + open FILE, $cmdFileName or die "Couldn't open file: $!"; + $text = ; + close FILE; + } + + $text =~ s/\nEND//; printf "Replaying $cmdFileName\n"; - printf "$old_commands"; + printf "$text\n"; } } # Print a game map -sub PrintGameMap +sub PrintGameFromGamestateString { - my $gameX = shift; - my $gameY = shift; - my @units = @_; + my $gamestateString = shift or die "PrintGameFromGamestateString needs string parameter"; + + my @info = GetGameInfoFromGamestate($gamestateString); + my @units = GetUnitStringsFromGamestate($gamestateString); + + # $major,$minor,$patch,$name,$sizex,$sizey,$turn,$invalidpositions+ + my $gameX = $info[4]; + my $gameY = $info[5]; + + # Shift into info to where the invalid positions are stored + my @invalids = getPositionStringsFromLine($info[7]); my @map; @@ -169,10 +231,17 @@ sub PrintGameMap } } + # Fill in all invalid coordinates + foreach my $coord (@invalids) + { + my @invalidPos = getPositionsXandYString($coord); + $map[$invalidPos[0]][$invalidPos[1]] = "~"; + } + # Fill with units for my $unit (@units) { - my ($id,$pl,$vs,$dr,$psx,$psy) = getUnit($unit); + my ($id,$pl,$vs,$dr,$psx,$psy) = getUnitInfo($unit); $pl += 31; $vs = "\e[".$pl."m".$vs."\e[0m"; @@ -191,10 +260,36 @@ sub PrintGameMap } } +# Print a game map +sub PrintGameFromFile +{ + my $turnFile = shift or die "PrintGameFromFile needs file parameter"; + + # Read in the whole file method from http://www.perlmonks.org/?node_id=1952 + my $text; + { + local $/=undef; + open FILE, $turnFile or die "Couldn't open file: $!"; + $text = ; + close FILE; + } + + PrintGameFromGamestateString($text); +} + +# Print a turn +sub PrintGameMapForTurn +{ + my $turn = shift; + (! defined $turn) and die "PrintGameMapForTurn needs turn parameter"; + $turn = GetTurnFileName($turn); + PrintGameFromFile( $turn ); +} + # Wait for a file to exist sub WaitForFile { - my $file = $_[0]; + my $file = shift or die "WaitForFile needs file parameter"; while( ! -e $file ) { select(undef, undef, undef, 0.01);