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

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