git.pond.sub.org Git - empserver/blob - tests/actofgod/geninput.pl

   1 #!/usr/bin/perl
   2
   3 # Assumed initial state:
   4 # nats POGO, 1..5, $MAXNOC-1
   5 # sects
   6 #     x>0,y>0   own 1
   7 #     x<-1,y>0  own 2
   8 #     x>0,y<0   own 3
   9 #     x<-1,y<0  own 0
  10 #     all wilderness, rest sea
  11 #     owned sectors have 1m 1c
  12 # units 5 cs #0..4, 5 f1 #0..4, 5 sup #0..4, all in 1,-1 owned by 3
  13
  14 use warnings;
  15 use strict;
  16
  17 my $MAXNOC = 99;
  18 my $xmax = 31;
  19 my $ymax = 15;
  20 my $STAT_GOD = 5;
  21 my $INT_MAX = 0x7fffffff;
  22 my $INT_MIN = -$INT_MAX - 1;
  23
  24 my %ef2edit = (
  25     sect => 'l',
  26     ship => 's',
  27     plane => 'p',
  28     land => 'u',
  29     nuke => 'n',
  30     nat => 'c',
  31 );
  32
  33 my %edit2setres = (
  34     i => 'i',
  35     g => 'g',
  36     c => 'o',
  37     f => 'f',
  38     u => 'u',
  39 );
  40
  41 my %edit2setsect = (
  42     o => 'ow',
  43     O => 'ol',
  44     i => 'i',
  45     g => 'g',
  46     c => 'oi',
  47     e => 'e',
  48     M => 'mi',
  49     m => 'mo',
  50     a => 'a',
  51     w => 'w',
  52     f => 'f',
  53     u => 'u',
  54 );
  55
  56 sub edit {
  57     my ($ef, $id, $key, @rest) = @_;
  58     my $args = join(' ', @rest);
  59     print "edit $ef2edit{$ef} $id $key $args\n";
  60 }
  61
  62 sub iedit {
  63     my ($ef, $id, @rest) = @_;
  64     print "edit $ef2edit{$ef} $id\n";
  65     for my $inp (@rest) {
  66         print "$inp\n";
  67     }
  68     print "\n";
  69 }
  70
  71 sub next_id {
  72     my ($ef, $id) = @_;
  73     if ($ef ne 'sect') {
  74         return $id + 1;
  75     }
  76     my ($x, $y) = split /,/, $id;
  77     $x += 2;
  78     return "$x,$y";
  79 }
  80
  81 sub edit_int1 {
  82     my ($ef, $id, $key, $lob, $upb) = @_;
  83     edit($ef, $id, $key, $lob);
  84     $id = next_id($ef, $id);
  85     edit($ef, $id, $key, $lob - 1)
  86         if ($lob > $INT_MIN);
  87     $id = next_id($ef, $id);
  88     edit($ef, $id, $key, $upb);
  89     $id = next_id($ef, $id);
  90     edit($ef, $id, $key, $upb + 1)
  91         if ($upb < $INT_MAX);
  92 }
  93
  94 sub edit_int {
  95     my ($ef, $id, @rest) = @_;
  96     for my $it (@rest) {
  97         edit_int1($ef, $id, @$it);
  98     }
  99 }
 100
 101 sub setres {
 102     my ($id, $key, $val) = @_;
 103     print "setres $key $id $val\n";
 104 }
 105
 106 sub setsect {
 107     my ($id, $key, $val) = @_;
 108     print "setsect $key $id $val\n";
 109 }
 110
 111 sub give {
 112     my ($id, $key, $val) = @_;
 113     print "give $key $id $val\n";
 114 }
 115
 116 sub swaps {
 117     my ($id1, $id2) = @_;
 118     print "swaps $id1 $id2\ny\n";
 119 }
 120
 121 ## Sector
 122
 123 # invalid key
 124 edit('sect', '0,0', '@', 0);
 125 setres('0,0', '@', 0);
 126 setsect('0,0', '@', 0);
 127 give('0,0', '@', 0);
 128
 129 # own oldown che_target
 130 for my $key ('o', 'O', 'X') {
 131     edit('sect', '1,7', $key, 0);
 132     edit('sect', '1,7', $key, -1);
 133     edit('sect', '3,7', $key, $MAXNOC - 1);
 134     edit('sect', '3,7', $key, $MAXNOC);
 135 }
 136 edit('sect', '5,7', 'o', 2);
 137 for my $key ('ow', 'ol') {
 138     setsect('7,7', $key, 0);
 139     setsect('7,7', $key, -1);
 140     setsect('9,7', $key, $MAXNOC - 1);
 141     setsect('9,7', $key, $MAXNOC);
 142 }
 143 setsect('11,7', 'ow', 2);
 144
 145 # x,y (copy)
 146 edit('sect', '1,7', 'L', '1,-7');
 147 edit('sect', '3,-7', 'L', '3,-7', 'L', '1,0');
 148
 149 # effic mobil iron gmin fertil oil uran work loyalty che pstage ptime
 150 # fallout avail mines road rail defense
 151 sub sect_int {
 152     for my $it (@_) {
 153         my ($key, $lob, $upb) = @$it;
 154         edit_int1('sect', '1,1', $key, $lob, $upb);
 155         my $rkey = $edit2setres{$key};
 156         if (defined $rkey) {
 157             setres('2,2', $rkey, $lob);
 158             setres('4,2', $rkey, $lob - 1);
 159             setres('6,2', $rkey, $upb);
 160             setres('8,2', $rkey, $upb + 1);
 161         }
 162         my $skey = $edit2setsect{$key};
 163         if (defined $skey) {
 164             setsect('1,3', $skey, $INT_MIN);
 165             setsect('3:7,3', $skey, 1);
 166             setsect('5,3', $skey, $INT_MAX);
 167             setsect('7,3', $skey, -1);
 168         }
 169     }
 170 }
 171 sect_int(
 172     ['e', 0, 100],
 173     ['m', -127, 127],
 174     ['i', 0, 100],
 175     ['g', 0, 100],
 176     ['f', 0, 100],
 177     ['c', 0, 100],
 178     ['u', 0, 100],
 179     ['w', 0, 100],
 180     ['l', 0, 127],
 181     ['x', 0, 255],
 182     ['p', 0, 4],
 183     ['t', 0, 32767],
 184     ['F', 0, 9999],
 185     ['a', 0, 9999],
 186     ['M', 0, 32767],
 187     ['R', 0, 100],
 188     ['r', 0, 100],
 189     ['d', 0, 100],
 190 );
 191
 192 # special case: unowned sector
 193 edit('sect', '-1,-1', 'i', 50);
 194 setres('-1,-1', 'g', 50);
 195 setsect('-1,-1', 'f', 50);
 196
 197 # special case: mines in occupied sector
 198 setsect('1:3,-3', 'ol', 1);
 199 setsect('1,-3', 'mi', 1);
 200 edit('sect', '3,-3', 'M', 1);
 201
 202 # dist
 203 edit('sect', '2,4', 'D', '4,4');
 204 edit('sect', '4,4', 'D', '4,4');
 205
 206 # des newdes
 207 for my $key ('s', 'S') {
 208     edit('sect', '6,4', $key, '+');
 209     edit('sect', '6,4', $key, '+');
 210     edit('sect', '8,4', $key, '+');
 211     edit('sect', '8,4', $key, ',');
 212 }
 213
 214 # multiple arguments
 215 edit('sect', '1,5', 'm', 1, 'a', 1);
 216
 217 # interactive edit
 218 iedit('sect', '3,5', 'm 2', 'a 1');
 219 iedit('sect', '5,5', ' ');
 220
 221 # give
 222 give('2,6', 'l', $INT_MIN);
 223 give('4:8,6', 'c', 1);
 224 give('6,6', 'c', $INT_MAX);
 225 give('8,6', 'c', -1);
 226
 227 # swapsector
 228 swaps('-2,2', '2,-2');
 229
 230 ## Ship, plane, land unit
 231
 232 for my $ef ('ship', 'plane', 'land') {
 233     # invalid key
 234     edit($ef, 0, '@', 0);
 235     # own
 236     edit($ef, 0, 'O', 0);
 237     edit($ef, 0, 'O', -1);
 238     edit($ef, 1, 'O', $MAXNOC - 1);
 239     edit($ef, 1, 'O', $MAXNOC);
 240     edit($ef, 2, 'O', 2);
 241     # uid (copy)
 242     edit($ef, 3, 'U', 5, 'U', 3);
 243     edit($ef, 0, 'U', 0, 'U', -1);
 244     # x,y
 245     my $key = $ef eq 'plane' ? 'l' : 'L';
 246     edit($ef, 2, $key, '3,-1');
 247     edit($ef, 3, $key, '1,-1');
 248 }
 249
 250 # ship: effic mobil tech pstage ptime milit
 251 edit_int('ship', 2, (
 252     ['E', 0, 100],
 253     ['M', -127, 127],
 254     ['T', 0, 32767],
 255     ['a', 0, 4],
 256     ['b', 0, 32767],
 257     ['m', 0, 50],
 258 ));
 259
 260 # plane: effic mobil range tech
 261 edit_int('plane', 2, (
 262     ['e', 0, 100],
 263     ['m', -127, 127],
 264     ['r', 0, 9],
 265     ['t', 50, 32767],
 266 ));
 267
 268 # land: effic mobil tech harden retreat milit
 269 edit_int('land', 2, (
 270     ['e', 0, 100],
 271     ['M', -127, 127],
 272     ['t', 50, 32767],
 273     ['F', 0, 127],
 274     ['Z', 0, 100],
 275     ['m', 0, 25],
 276 ));
 277
 278 # fleet, wing, army
 279 sub unit_group {
 280     my ($ef, $key) = @_;
 281     edit($ef, 2, $key, '~');
 282     edit($ef, 3, $key, 'a');
 283 }
 284 unit_group('ship', 'F');
 285 unit_group('plane', 'w');
 286 unit_group('land', 'a');
 287
 288 # rpath, rflags
 289 for my $ef ('ship', 'land') {
 290     edit($ef, 2, 'R', '""');
 291     edit($ef, 3, 'R', 'jj');
 292     # Take care to have only valid bits set in final state
 293     edit($ef, 2, 'W', 0, 'W', 1);
 294     edit($ef, 3, 'W', 513, 'W', 1030, 'W', 2);
 295 }
 296
 297 # plane: flags
 298 # Take care to have only valid bits set in final state
 299 edit('plane', 2, 'f', 4);
 300
 301 # carrier
 302 sub unit_carrier {
 303     my ($ef, $skey, $pkey) = @_;
 304     edit($ef, 2, $skey, -1, $skey, 9999);
 305     edit($ef, 3, $skey, 3);
 306     edit($ef, 4, $skey, 4, $pkey, 4);
 307 }
 308 unit_carrier('plane', 's', 'y');
 309 unit_carrier('land', 'S', 'Y');
 310
 311 # interactive edit
 312 iedit('ship', 0, 'M 2', 'm 1', 'f 1');
 313 iedit('ship', 0, 'R n', 'R ""');
 314 iedit('plane', 0, 'm 2', 'y -1');
 315 iedit('land', 0, 'M 2', 'Y -1');
 316
 317 ## Nation
 318
 319 # invalid key
 320 edit('nat', 0, '@', 0);
 321
 322 # btus reserve timeused money
 323
 324 edit_int('nat', 1, (
 325     ['b', 0, 640],
 326     ['m', 0, 2147483647],
 327     ['u', 0, 86400],
 328     ['M', -2147483648, 2147483647],
 329 ));
 330
 331 # tgms
 332 # Take care to use ones that won't receive further telegrams
 333 edit('nat', 6, 't', -1);
 334 edit('nat', 7, 't', 65536);
 335
 336 # tlev rlev elev hlev
 337 for my $key ('T', 'R', 'E', 'H') {
 338     edit('nat', 1, $key, 3.14);
 339     edit('nat', 2, $key, 100);
 340     edit('nat', 3, $key, -1);
 341 }
 342
 343 # cnam
 344 edit('nat', 1, 'n', 'POGO');
 345 edit('nat', 2, 'n', '2');
 346 edit('nat', 3, 'n', 'drei');
 347
 348 # pnam
 349 edit('nat', 1, 'r', 1);
 350 edit('nat', 2, 'r', '012345678901234567890123456789');
 351
 352 # xcap,ycap xorg,yorg
 353 for my $key ('c', 'o') {
 354     edit('nat', 1, $key, '0,0');
 355     edit('nat', 2, $key, '2,0');
 356 }
 357
 358 # status
 359 # Refs to nats with status 0 are invalid, take care to use
 360 # unreferenced ones for that
 361 edit('nat', 6, 's', 0);
 362 edit('nat', 7, 's', -1);
 363 edit('nat', 4, 's', $STAT_GOD);
 364 edit('nat', 5, 's', $STAT_GOD + 1);
 365
 366 # interactive edit
 367 iedit('nat', 5, 'b 640', 'T 1');
 368
 369 ## Epilog: read telegrams (they're not in xdump)
 370 for my $cnum (0, 1, 2, 3, 4, 5, 98) {
 371     print "read $cnum\n";
 372 }