empire/empserver
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
empserver/tests/actofgod/geninput.pl
Markus Armbruster 216470a8d5 edit: Implement edit nuke 
Has been "not implemented yet" since the dawn of time.

Signed-off-by: Markus Armbruster <armbru@pond.sub.org>
2014-01-02 14:33:48 +01:00

399 lines
8.1 KiB
Perl
Executable file
Raw Blame History

#!/usr/bin/perl
# Assumed initial state:
# nats POGO, 1..5, $MAXNOC-1
# sects
# x>0,y>0 own 1
# x<-1,y>0 own 2
# x>0,y<0 own 3
# x<-1,y<0 own 0
# all wilderness, rest sea
# owned sectors have 1m 1c
# units cs #0..4, f1 #0..4, sup #0..4, 10kt #0..4, all in 1,-1 owned by 3
use warnings;
use strict;
my $MAXNOC = 99;
my $xmax = 31;
my $ymax = 15;
my $STAT_GOD = 5;
my $INT_MAX = 0x7fffffff;
my $INT_MIN = -$INT_MAX - 1;
my %ef2edit = (
sect => 'l',
ship => 's',
plane => 'p',
land => 'u',
nuke => 'n',
nat => 'c',
);
my %edit2setres = (
i => 'i',
g => 'g',
c => 'o',
f => 'f',
u => 'u',
);
my %edit2setsect = (
o => 'ow',
O => 'ol',
i => 'i',
g => 'g',
c => 'oi',
e => 'e',
M => 'mi',
m => 'mo',
a => 'a',
w => 'w',
f => 'f',
u => 'u',
);
sub edit {
my ($ef, $id, $key, @rest) = @_;
my $args = join(' ', @rest);
print "edit $ef2edit{$ef} $id $key $args\n";
}
sub iedit {
my ($ef, $id, @rest) = @_;
print "edit $ef2edit{$ef} $id\n";
for my $inp (@rest) {
print "$inp\n";
}
print "\n";
}
sub next_id {
my ($ef, $id) = @_;
if ($ef ne 'sect') {
return $id + 1;
}
my ($x, $y) = split /,/, $id;
$x += 2;
return "$x,$y";
}
sub edit_int1 {
my ($ef, $id, $key, $lob, $upb) = @_;
edit($ef, $id, $key, $lob);
$id = next_id($ef, $id);
edit($ef, $id, $key, $lob - 1)
if ($lob > $INT_MIN);
$id = next_id($ef, $id);
edit($ef, $id, $key, $upb);
$id = next_id($ef, $id);
edit($ef, $id, $key, $upb + 1)
if ($upb < $INT_MAX);
}
sub edit_int {
my ($ef, $id, @rest) = @_;
for my $it (@rest) {
edit_int1($ef, $id, @$it);
}
}
sub setres {
my ($id, $key, $val) = @_;
print "setres $key $id $val\n";
}
sub setsect {
my ($id, $key, $val) = @_;
print "setsect $key $id $val\n";
}
sub give {
my ($id, $key, $val) = @_;
print "give $key $id $val\n";
}
sub swaps {
my ($id1, $id2) = @_;
print "swaps $id1 $id2\ny\n";
}
## Sector
# invalid key
edit('sect', '0,0', '@', 0);
setres('0,0', '@', 0);
setsect('0,0', '@', 0);
give('0,0', '@', 0);
# own oldown che_target
for my $key ('o', 'O', 'X') {
edit('sect', '1,7', $key, 0);
edit('sect', '1,7', $key, -1);
edit('sect', '3,7', $key, $MAXNOC - 1);
edit('sect', '3,7', $key, $MAXNOC);
}
edit('sect', '5,7', 'o', 2);
for my $key ('ow', 'ol') {
setsect('7,7', $key, 0);
setsect('7,7', $key, -1);
setsect('9,7', $key, $MAXNOC - 1);
setsect('9,7', $key, $MAXNOC);
}
setsect('11,7', 'ow', 2);
# x,y (copy)
edit('sect', '1,7', 'L', '1,-7');
edit('sect', '3,-7', 'L', '3,-7', 'L', '1,0');
# effic mobil iron gmin fertil oil uran work loyalty che pstage ptime
# fallout avail mines road rail defense
sub sect_int {
for my $it (@_) {
my ($key, $lob, $upb) = @$it;
edit_int1('sect', '1,1', $key, $lob, $upb);
my $rkey = $edit2setres{$key};
if (defined $rkey) {
setres('2,2', $rkey, $lob);
setres('4,2', $rkey, $lob - 1);
setres('6,2', $rkey, $upb);
setres('8,2', $rkey, $upb + 1);
}
my $skey = $edit2setsect{$key};
if (defined $skey) {
setsect('1,3', $skey, $INT_MIN);
setsect('3:7,3', $skey, 1);
setsect('5,3', $skey, $INT_MAX);
setsect('7,3', $skey, -1);
}
}
}
sect_int(
['e', 0, 100],
['m', -127, 127],
['i', 0, 100],
['g', 0, 100],
['f', 0, 100],
['c', 0, 100],
['u', 0, 100],
['w', 0, 100],
['l', 0, 127],
['x', 0, 255],
['p', 0, 4],
['t', 0, 32767],
['F', 0, 9999],
['a', 0, 9999],
['M', 0, 32767],
['R', 0, 100],
['r', 0, 100],
['d', 0, 100],
);
# special case: unowned sector
edit('sect', '-1,-1', 'i', 50);
setres('-1,-1', 'g', 50);
setsect('-1,-1', 'f', 50);
# special case: mines in occupied sector
setsect('1:3,-3', 'ol', 1);
setsect('1,-3', 'mi', 1);
edit('sect', '3,-3', 'M', 1);
# dist
edit('sect', '2,4', 'D', '4,4');
edit('sect', '4,4', 'D', '4,4');
# des newdes
for my $key ('s', 'S') {
edit('sect', '6:8,4', $key, '+');
edit('sect', '6,4', $key, '+');
edit('sect', '8,4', $key, ',');
}
# multiple arguments
edit('sect', '1,5', 'm', 1, 'a', 1);
# interactive edit
iedit('sect', '3,5', 'm 2', 'a 1');
iedit('sect', '5,5', ' ');
iedit('sect', '7:9,5', 'e 1', '', 'e 2');
# give
give('2,6', 'l', $INT_MIN);
give('4:8,6', 'c', 1);
give('6,6', 'c', $INT_MAX);
give('8,6', 'c', -1);
# swapsector
swaps('-2,2', '2,-2');
## Ship, plane, land unit, nuke
for my $ef ('ship', 'plane', 'land', 'nuke') {
# invalid key
edit($ef, 0, '@', 0);
# own
edit($ef, 0, 'O', 0);
edit($ef, 0, 'O', -1);
edit($ef, 1, 'O', $MAXNOC - 1);
edit($ef, 1, 'O', $MAXNOC);
edit($ef, 2, 'O', 2);
edit($ef, 4, 'O', 0, 'O', '3');
# uid (copy)
edit($ef, 3, 'U', 5, 'U', 3);
edit($ef, 0, 'U', 0, 'U', -1);
# x,y
my $key = $ef eq 'plane' ? 'l' : 'L';
edit($ef, 2, $key, '3,-1');
edit($ef, 3, $key, '1,-1');
}
# ship: type
edit('ship', 6, 't', 'lc', 'O', 1, 't', 'lc', 't', 'hc', 'g', 8, 't', 'lc');
# ship: effic mobil tech pstage ptime milit
edit_int('ship', 2, (
['E', 0, 100],
['M', -127, 127],
['T', 0, 32767],
['a', 0, 4],
['b', 0, 32767],
['m', 0, 50],
));
# plane: type
edit('plane', 6, 'T', 'mb', 'O', 1, 'T', 'mb', 'T', 'hb', 'T', 'mb');
# plane: effic mobil range tech
edit_int('plane', 2, (
['e', 0, 100],
['m', -127, 127],
['r', 0, 9],
['t', 50, 32767],
));
# land: type
edit('land', 6, 'T', 'art', 'O', 1, 'T', 'art', 'T', 'hat', 'g', 12,
'T', 'art');
# land: effic mobil tech harden retreat milit
edit_int('land', 2, (
['e', 0, 100],
['M', -127, 127],
['t', 50, 32767],
['F', 0, 127],
['Z', 0, 100],
['m', 0, 25],
));
# nuke: type
edit('nuke', 6, 't', '15kt', 'O', 1, 't', '15kt', 't', '50kt', 't', '15kt');
# nuke: tech
edit_int('nuke', 2, (
['T', 280, 32767],
));
# fleet, wing, army
sub unit_group {
my ($ef, $key) = @_;
edit($ef, 2, $key, '~');
edit($ef, 3, $key, 'a');
}
unit_group('ship', 'F');
unit_group('plane', 'w');
unit_group('land', 'a');
# rpath, rflags
for my $ef ('ship', 'land') {
edit($ef, 2, 'R', '""');
edit($ef, 3, 'R', 'jj');
# Take care to have only valid bits set in final state
edit($ef, 2, 'W', 0, 'W', 1);
edit($ef, 3, 'W', 513, 'W', 1030, 'W', 2);
}
# plane: flags
# Take care to have only valid bits set in final state
edit('plane', 2, 'f', 4);
# carrier
sub unit_carrier {
my ($ef, $key1, $key2) = @_;
edit($ef, 2, $key1, -1, $key1, 9999);
edit($ef, 3, $key1, 3);
edit($ef, 4, $key1, 4, $key2, 4) if defined $key2;
}
unit_carrier('plane', 's', 'y');
unit_carrier('land', 'S', 'Y');
unit_carrier('nuke', 'p');
# special case: move carrier's cargo away
edit('plane', 4, 'l', '5,1');
# special case: load teleports to carrier
edit('land', 4, 'S', 2);
# interactive edit
iedit('ship', 0, 'M 2', 'm 1', 'f 1');
iedit('ship', 0, 'R n', 'R ""');
iedit('plane', 0, 'm 2', 'y -1');
iedit('land', 0, 'M 2', 'Y -1');
iedit('nuke', 0, 'S a', 'p -1');
## Nation
# invalid key
edit('nat', 0, '@', 0);
# btus reserve timeused money
edit_int('nat', 1, (
['b', 0, 640],
['m', 0, 2147483647],
['u', 0, 86400],
['M', -2147483648, 2147483647],
));
# tgms
# Take care to use ones that won't receive further telegrams
edit('nat', 6, 't', -1);
edit('nat', 7, 't', 65536);
# tlev rlev elev hlev
for my $key ('T', 'R', 'E', 'H') {
edit('nat', 1, $key, 3.14);
edit('nat', 2, $key, 100);
edit('nat', 3, $key, -1);
}
# cnam
edit('nat', 1, 'n', 'POGO');
edit('nat', 2, 'n', '2');
edit('nat', 3, 'n', 'drei');
# pnam
edit('nat', 1, 'r', 1);
edit('nat', 2, 'r', '012345678901234567890123456789');
# xcap,ycap xorg,yorg
for my $key ('c', 'o') {
edit('nat', 1, $key, '0,0');
edit('nat', 2, $key, '2,0');
}
# status
# Refs to nats with status 0 are invalid, take care to use
# unreferenced ones for that
edit('nat', 6, 's', 0);
edit('nat', 7, 's', -1);
edit('nat', 4, 's', $STAT_GOD);
edit('nat', 5, 's', $STAT_GOD + 1);
# interactive edit
iedit('nat', 5, 'b 640', 'T 1');
## Epilog: read telegrams (they're not in xdump)
for my $cnum (0, 1, 2, 3, 4, 5, 98) {
print "read $cnum\n";
}
Reference in a new issue View git blame Copy permalink