home *** CD-ROM | disk | FTP | other *** search
/ synchro.net / synchro.net.tar / synchro.net / main / BBS / GEO.ZIP / GEOP.BAK < prev    next >
Encoding:
Text File  |  2003-06-05  |  26.4 KB  |  834 lines
  1. program GEOPOLITIK; {v 1.0}
  2.  
  3. {$I COMMON.PAS}
  4.  
  5. type {I considered any variables without comments to be self evident}
  6.     bigstring=string[160];
  7.     namstring=string[25];
  8.     force=array[1..4] of real;
  9.     percent=real;
  10.     index=record
  11.            devel,credit:real;
  12.     end;
  13.     area=record
  14.            nombre:namstring; {name}
  15.            comm:array[1..6] of index; {commodity development levels}
  16.            men,wandc:real; {woman and children}
  17.            rebels:force;
  18.            controller:integer;
  19.     end;
  20.     country=record
  21.            controller:namstring;
  22.            nombre:namstring;
  23.            military:force;
  24.            nukes:array[1..5] of real;
  25.            defense:percent;
  26.            self,ally,friend:percent; {retaliation levels}
  27.            rel:array[1..20] of char; {diplomatic relations}
  28.            percapita:real; {social expenditures}
  29.            dinero:real; {money for you gringos}
  30.            intel:percent; {intelligence}
  31.            embarg:array[1..20] of real; {embargoes}
  32.            lmnth,attacks:integer; {last month on}
  33.            ncomm,tcomm:array[1..6] of real; {national and trade stockpiles}
  34.            price,exim:array[1..6] of real; {export/import level}
  35.            tax:percent;
  36.            ispy:integer; {spies left}
  37.     end;
  38.     planet=record
  39.           pop:real; {total population}
  40.           radiation,nukewinter:percent;
  41.           lstdate:bigstring;
  42.           currmonth,curryear:integer;
  43.     end;
  44.     message=record
  45.            mess:bigstring;
  46.            from,por:integer;
  47.     end;
  48.     Stuffy=record
  49.            Stuff:Integer;
  50.     end;
  51.  
  52. const
  53.      commods:array[1..6] of string[11]=('Agriculture','Energy','Metals','Nonmetals','Industry','Technology');
  54.      commworth:array[1..6] of real=(25000.0,60000.0,40000.0,50000.0,80000.0,100000.0);
  55.      weaps:array[1..4] of string[6]=('troops','tanks','planes','ships');
  56.      pweaps:array[2..4] of string[8]=('[T]anks','[P]lanes','[S]hips');
  57.      nuke:array[1..5] of string[15]=('Minuteman silos','MX silos','submarines','bombers','space platforms');
  58.      pnuke:array[1..5] of string[17]=('[M]inuteman silos','M[X] silos','[S]ubmarines','[B]ombers','space [P]latforms');
  59.      weapcost:array[2..4,3..6] of integer=((4,2,5,7),(4,3,7,10),(12,10,13,9));
  60.      weapmon:array[2..4] of real=(1,1,2);
  61.      nukecost:array[1..5,3..6] of integer=((5,7,20,18),(10,13,30,70),(13,15,50,60),(7,5,43,50),(50,60,85,170));
  62.      nukemon:array[1..5] of real=(2,14,18,13,40);
  63.      wh:array[1..5] of real=(1,10,10,7,30);
  64.      mnames:array[1..12] of string[3]=('JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT','NOV','DEC');
  65.      rheader='                   Region( #)';
  66.      rqual='                   ==========';
  67.  
  68. var
  69.     nation:array[1..20] of country;
  70.     region:array[1..80] of area;
  71.     world:planet;
  72.     Stuffx:stuffy;
  73.     Stufffile:file of Stuffy;
  74.     nations:file of country;
  75.     regions:file of area;
  76.     newspaper:file of bigstring;
  77.     letters:file of message;
  78.     worldfile:file of planet;
  79.     trashcan:file of bigstring;
  80.     co,victor,cn,c1,c2:integer;
  81.     sel:char;
  82.     dummy,m:message;
  83.     currdate:string[10];
  84.     ab,nx,qut,inv,yah,ok2play:boolean;
  85.     lilmess:bigstring;
  86.     baduser,handl:bigstring;
  87.     art:message;
  88.     zap:real; {average wealth/number of regions}
  89.  
  90. procedure pa(i:bigstring); {print a string allowing for abort}
  91. begin
  92.      if not ab then printacr(i,ab,nx);
  93. end;
  94.  
  95. procedure pra(i:bigstring); {same as pa, but without a carriage return}
  96. begin
  97.      if not ab then printa(i,ab,nx);
  98. end;
  99.  
  100. procedure goodbye; {exit to BBS}
  101. begin
  102.      print('* * * Saving * * *');
  103.      rewrite(nations);
  104.      for c1:=1 to 20 do write(nations,nation[c1]);
  105.      close(nations);
  106.      rewrite(regions);
  107.      for c1:=1 to 80 do write(regions,region[c1]);
  108.      close(regions);
  109.      rewrite(worldfile);
  110.      write(worldfile,world);
  111.      close(worldfile);
  112.      return;
  113. end;
  114.  
  115. procedure inputn(var p:namstring); {input country's name}
  116. var a:bigstring;
  117. begin
  118.      checkhangup;
  119.      if hangup then goodbye;
  120.      inputl(a,25);
  121.      if hangup then goodbye;
  122.      p:=a;
  123. end;
  124.  
  125. procedure silly(var a,b:real;c:integer;d:percent); {get nuclear retaliation levels}
  126. var
  127.    e,f:real;
  128. begin
  129.      e:=d/100;
  130.      with nation[c] do begin
  131.           f:=int(e*nukes[1]);
  132.           a:=a+f;
  133.           nukes[1]:=nukes[1]-f;
  134.           f:=int(e*nukes[2]);
  135.           a:=a+f*10;
  136.           nukes[2]:=nukes[2]-f;
  137.           f:=int(e*nukes[3]);
  138.           b:=b+f*10;
  139.           nukes[3]:=nukes[3]-f;
  140.           f:=int(e*nukes[4]);
  141.           a:=a+f*7;
  142.           nukes[4]:=nukes[4]-f;
  143.           f:=int(e*nukes[5]);
  144.           a:=a+f*30;
  145.           nukes[5]:=nukes[5]-f;
  146.      end;
  147. end;
  148.  
  149. procedure census; {determine world.pop}
  150. var f:integer;
  151. begin
  152.      world.pop:=0;
  153.      for f:=1 to 80 do world.pop:=world.pop+region[f].men+region[f].wandc+region[f].rebels[1];
  154.      for f:=1 to 20 do world.pop:=world.pop+nation[f].military[1];
  155. end;
  156.  
  157. function cont(p:integer):integer; {how many regions controlled by nation[p]}
  158. var f,g:integer;
  159. begin
  160.      g:=0;
  161.      for f:=1 to 80 do if region[f].controller=p then g:=g+1;
  162.      cont:=g;
  163. end;
  164.  
  165. function pad(p:bigstring;q:integer):bigstring; {pad a string out to length q}
  166. var f,g:integer;
  167.     h:bigstring;
  168. begin
  169.      g:=q-length(p);
  170.      h:='';
  171.      for f:=1 to g do h:=h+' ';
  172.      pad:=h+p;
  173. end;
  174.  
  175. function st(a:real;b:integer):bigstring; {convert number to string with commas}
  176. var p:bigstring;
  177.     f:integer;
  178. begin
  179.      str(a:0:0,p);
  180.      f:=length(p);
  181.      if f>4 then while f>3 do begin
  182.            f:=f-3;
  183.            if not ((f=1) and (p[1]='-')) then insert(',',p,f+1);
  184.      end;
  185.      st:=pad(p,b);
  186. end;
  187.  
  188. function rname(f:integer):bigstring; {name of region with number}
  189. begin
  190.      rname:=pad(region[f].nombre+'('+st(f,2)+')',29);
  191. end;
  192.  
  193. function nname(f:integer):bigstring; {name of nation with number}
  194. begin
  195.      nname:=pad(nation[f].nombre+'('+st(f,2)+')',29);
  196. end;
  197.  
  198. function skew(a:real;c:integer):bigstring; {same as st, only the number is distorted depending on intelligence level}
  199. var f,g:real;
  200.     h:integer;
  201. begin
  202.      h:=round(100-nation[cn].intel);
  203.      if random<0.5 then g:=1 else g:=-1;
  204.      f:=int(a+g*a*random(h)/100);
  205.      skew:=st(f,c);
  206. end;
  207.  
  208. function convert(a,b:integer):bigstring; {number -> month name}
  209. begin
  210.      convert:=mnames[a]+' '+st(b,0);
  211. end;
  212.  
  213. function mon2int(a:bigstring):integer; {month name -> number}
  214. var f:integer;
  215. begin
  216.      mon2int:=0;
  217.      for f:=1 to 12 do if mnames[f]=a then mon2int:=f;
  218. end;
  219.  
  220. function embargo:boolean; {check for embargoes}
  221. var f:integer;
  222.     g:boolean;
  223. begin
  224.      g:=false;
  225.      for f:=1 to 20 do with nation[f] do if embarg[cn]>0 then begin
  226.          print(nombre+' is embargoing you with '+st(embarg[cn],0)+' ships.');
  227.          g:=true;
  228.      end;
  229.      embargo:=g;
  230.      if g then print('You may not trade or carry out attacks until all embargoing ships are destroyed.');
  231. end;
  232.  
  233. function strength(p:force):real; {strength of a military force}
  234. begin
  235.      strength:=p[1]+25*p[2]+50*p[3];
  236. end;
  237.  
  238. procedure pstock; {print out current national stockpile}
  239. var f:integer;
  240. begin
  241.      prompt('Your national stockpile contains');
  242.      for f:=1 to 6 do prompt(' ['+st(nation[cn].ncomm[f],0)+' '+copy(commods[f],1,3)+'] ');
  243.      print(#8);
  244. end;
  245.  
  246. procedure pmoney; {show contents of treasury}
  247. begin
  248.      with nation[cn] do if dinero>0 then print('You have $'+st(dinero,0)+'.')
  249.                                     else print('You are $'+st(-dinero,0)+' in debt.');
  250. end;
  251.  
  252. procedure ppop; {population for all controlled regions}
  253. var
  254.    f:integer;
  255.    h:real;
  256. begin
  257.      h:=0;
  258.      for f:=1 to 80 do with region[f] do if controller=cn then h:=h+wandc+men;
  259.      h:=h+nation[cn].military[1];
  260.      print('National population is '+st(h,0));
  261. end;
  262.  
  263. procedure getreal(var z:real;a,b:real); {input a number}
  264. var
  265.    q:bigstring;
  266.    err:integer;
  267.    bk:real;
  268. begin
  269.      a:=int(a);
  270.      b:=int(b);
  271.      bk:=z;
  272.      if a=b then begin
  273.         print(st(a,0));
  274.         z:=a;
  275.         exit;
  276.      end;
  277.      repeat
  278.            checkhangup;
  279.            if hangup then goodbye;
  280.            inputl(q,20);
  281.            if hangup then goodbye;
  282.            if q='' then q:='0';
  283.            if upcase(q[1])='Q' then begin
  284.               z:=bk;
  285.               qut:=true;
  286.               exit;
  287.            end;
  288.            val(q,z,err);
  289.            z:=int(z);
  290.            if (z<a) or (z>b) then err:=1;
  291.            if err>0 then ynq('Numbers from '+st(a,0)+' to '+st(b,0)+' only (Q aborts):  ');
  292.      until err=0;
  293. end;
  294.  
  295. function minn(x,y:real):real; {take the minimum of x and y}
  296. begin
  297.      if x>y then minn:=int(y) else minn:=int(x);
  298. end;
  299.  
  300. function kill(x:real;y:real):real; {determine casualties}
  301. begin
  302.      kill:=int(random*x*y/100);
  303. end;
  304.  
  305. procedure fleetbattle(var a1,a2:real;ac:real); {too obvious for comment}
  306. var f2,f3,f4:real;
  307. begin
  308.      f4:=ac;
  309.      print('Air cover ratio is '+st(f4*100,0)+'%');
  310.      f4:=f4+(1-f4)/2;
  311.      if (a1>0) and (a2>0) then repeat
  312.         print('Your navy of '+st(a1,0)+' ships attacks the enemy fleet of '+st(a2,0)+' ships.');
  313.         f2:=minn(kill(a2,30)+1,a1);
  314.         f3:=minn(kill(a1,20)*f4+1,a2);
  315.         a1:=a1-f2;
  316.         a2:=a2-f3;
  317.         print('Your fleet lost '+st(f2,0)+' ship(s).');
  318.         print('The enemy navy lost '+st(f3,0)+' ship(s).');
  319.         yah:=true;
  320.         if (a1>0) and (a2>0) then begin
  321.            ynq('Continue the attack? ');
  322.            yah:=yn;
  323.         end;
  324.      until (a1=0) or (a2=0) or (a1>a2*2) or not yah;
  325. end;
  326.  
  327. procedure fight(var a1,a2:force;m:real); {land battle}
  328. var
  329.    f1:integer;
  330.    f2,f3,f4,f5,f6,f7,f8,f9,f10:real;
  331. begin
  332.      yah:=true;
  333.      f4:=a1[3]/(a2[3]+1);
  334.      if (a1[4]>0) and (a2[4]>0) then fleetbattle(a1[4],a2[4],f4);
  335.      if yah and (a1[4]>0.5) then print('The enemy fleet is vanquished.');
  336.      if ((a1[4]>=10) and yah) or (m=11) then repeat
  337.            print('Your army attacks the enemy forces.');
  338.            f2:=minn(kill(a2[3],3*m)+kill(a2[2],0.5*m)+kill(a2[1],m*0.1),a1[3]);
  339.            f3:=minn(kill(a1[3],3)+kill(a1[2],0.5)+kill(a1[1],0.1)+1,a2[3]);
  340.            f4:=minn(kill(a2[3],4*m)+kill(a2[2],2*m)+kill(a2[1],0.02*m),a1[2]);
  341.            f5:=minn(kill(a1[3],4)+kill(a1[2],2)+kill(a1[1],0.02)+1,a2[2]);
  342.            f6:=minn(kill(a2[3],100*m)+kill(a2[2],25*m)+kill(a2[1],4*m),a1[1]);
  343.            f7:=minn(kill(a1[3],100)+kill(a1[2],25)+kill(a1[1],4)+1,a2[1]);
  344.            if m<>2 then begin
  345.               f2:=minn(f2+1,a1[3]);
  346.               f4:=minn(f4+1,a1[2]);
  347.               f6:=minn(f6+1,a1[1]);
  348.            end;
  349.            a1[3]:=a1[3]-f2;
  350.            a2[3]:=a2[3]-f3;
  351.            a1[2]:=a1[2]-f4;
  352.            a2[2]:=a2[2]-f5;
  353.            a1[1]:=a1[1]-f6;
  354.            a2[1]:=a2[1]-f7;
  355.            prompt('Your army has '+st(a1[1],0)+' troop(s), ');
  356.            print(st(a1[2],0)+' tank(s), and '+st(a1[3],0)+' plane(s) left.');
  357.            print('(Total strength:  '+st(strength(a1),0)+')');
  358.            prompt('The enemy army has '+st(a2[1],0)+' troop(s), ');
  359.            print(st(a2[2],0)+' tank(s), and '+st(a2[3],0)+' plane(s) left.');
  360.            print('(Total strength:  '+st(strength(a2),0)+')');
  361.            yah:=true;
  362.            if strength(a2)*5*m>strength(a1) then begin
  363.               ynq('Continue the attack? ');
  364.               yah:=yn;
  365.            end;
  366.      until ((a1[1]=0) and (a1[2]=0) and (a1[3]=0)) or (strength(a2)*5*m<strength(a1)) or not yah
  367.      else begin
  368.           print('You must have a fleet of at least 10 ships with a 2-1 fleet ratio for a mainland attack');
  369.           victor:=0;
  370.           exit;
  371.      end;
  372.      if strength(a2)*5>strength(a1) then victor:=2 else
  373.       if strength(a2)*5*m<strength(a1) then victor:=1 else victor:=0;
  374. end;
  375.  
  376. function rworth(p:integer):real; {worth of a single region}
  377. var f:integer;
  378.     z:real;
  379. begin
  380.      z:=0;
  381.      with region[p] do for f:=1 to 6 do z:=z+comm[f].devel*commworth[f];
  382.      rworth:=z;
  383. end;
  384.  
  385. procedure addon(lmess:bigstring); {write a newspaper article}
  386. begin
  387.      assign(newspaper,datapath+'THISYEAR.GEO');
  388.      reset(newspaper);
  389.      seek(newspaper,filesize(newspaper));
  390.      write(newspaper,lmess);
  391.      close(newspaper);
  392. end;
  393.  
  394. function checkk(a,r:char):boolean; {used by getreg and getnat}
  395. var p:boolean;
  396. begin
  397.    case a of
  398.      'S': p:=(r='S');
  399.      'A': p:=(r<>'S');
  400.      'F': p:=(r in ['F','N','H','W']);
  401.      'N': p:=(r in ['N','H','W']);
  402.      'H': p:=(r in ['H','W']);
  403.      'W': p:=(r='W');
  404.      else p:=true;
  405.    end;
  406.    if inv and (a<>'S') then p:=not p;
  407.    checkk:=p;
  408. end;
  409.  
  410. procedure nomesg(r:char;p:boolean); {ditto}
  411. begin
  412.      if p then case r of
  413.         'S':print('You own all the regions!.');
  414.         'A':print('All other nations are allied to you.');
  415.         'F':print('All other nations are either friends or allies.');
  416.         'N':print('You are not at war with or hostile to any other nation.');
  417.         'H':print('You are not at war with any other nation.');
  418.         'W':print('Curiouser and curiouser.');
  419.      end
  420.      else case r of
  421.         'S':print('You own no regions!');
  422.         'A':print('You have no allies.');
  423.         'F':print('You have neither allies nor friends.');
  424.         'N':print('No nation is even neutral towards you.');
  425.         'H':print('Every nation is at war with you.');
  426.         'W':print('Something fishy is going on.');
  427.      end;
  428. end;
  429.  
  430. function adprice(nat1,nat2,commodity:integer):real; {adjusted price for friends/allies}
  431. var z:real;
  432. begin
  433.      z:=nation[nat1].price[commodity];
  434.      if nation[nat1].rel[nat2]='F' then z:=z-z/10;
  435.      if nation[nat1].rel[nat2]='A' then z:=z-z/5;
  436.      adprice:=z;
  437. end;
  438.  
  439. procedure getnat(mmm:bigstring;var which:integer;restrict,info:char); {input a nation's name or number}
  440. const nheader='                   Nation( #)';
  441.       nqual='                    =========';
  442. var
  443.    bk,f,h:integer;
  444.    g:namstring;
  445.    p:array[1..20] of boolean;
  446.    q:boolean;
  447.    hd:string[80];
  448. begin
  449.      bk:=which;
  450.      which:=0;
  451.      for f:=1 to 20 do if inv then p[f]:=checkk(nation[cn].rel[f],restrict)
  452.                               else p[f]:=checkk(nation[f].rel[cn],restrict);
  453.      q:=false;
  454.      for f:=1 to 20 do q:=q or p[f];
  455.      if not q then begin
  456.         nomesg(restrict,inv);
  457.         qut:=true;
  458.         inv:=false;
  459.         exit;
  460.      end;
  461.      repeat
  462.            ynq(mmm+'what nation? [? for list, Q aborts] ');
  463.            checkhangup;
  464.            if hangup then goodbye;
  465.            inputn(g);
  466.            if hangup then goodbye;
  467.            if ((upcase(g[1])='Q') and (length(g)=1)) or (g='') then begin
  468.               qut:=true;
  469.               which:=bk;
  470.               inv:=false;
  471.               exit;
  472.            end;
  473.            if g='?' then case info of
  474.                 'D':begin
  475.                          print(nheader+'   You   Them');
  476.                          print(nqual+'   ===   ===');
  477.                     end;
  478.                 'E':begin
  479.                          print(nheader+'   Your Embargo   Their Embargo');
  480.                          print(nqual+'   ============   =============');
  481.                     end;
  482.                 'W':begin
  483.                          print(nheader+'   Warheads');
  484.                          print(nqual+'   ========');
  485.                     end;
  486.                 'R':begin
  487.                          print(nheader+'   Regions');
  488.                          print(nqual+'   =======');
  489.                     end;
  490.                 'C':begin
  491.                          print(nheader+'   AGR   ENE   MET   NON   IND   TEC');
  492.                          print(nqual+'   ===   ===   ===   ===   ===   ===');
  493.                    end;
  494.                 'P':begin
  495.                          print(nheader+'   Price/unit   Volume');
  496.                          print(nqual+'   ==========   ======');
  497.                     end;
  498.            end;
  499.            ab:=false;
  500.            if g='?' then for f:=1 to 20 do if p[f] then with nation[f] do begin
  501.             hd:=nname(f);
  502.             case info of
  503.              'I':pa(hd);
  504.              'D':pa(hd+pad(nation[cn].rel[f],6)+pad(rel[cn],6));
  505.              'E':pa(hd+st(nation[cn].embarg[f],15)+st(nation[f].embarg[cn],16));
  506.              'W':pa(hd+skew(nukes[1]+nukes[2]*10+nukes[3]*10+nukes[4]*5+nukes[5]*30,11));
  507.              'R':pa(hd+st(cont(f),10));
  508.             'C':pa(hd+skew(ncomm[1],6)+skew(ncomm[2],6)+skew(ncomm[3],6)+skew(ncomm[4],6)+skew(ncomm[5],6)+skew(ncomm[6],6));
  509.              'P':if nation[f].tcomm[co]>0 then pa(hd+st(adprice(f,cn,co),13)+st(nation[f].tcomm[co],9));
  510.             end;
  511.            end;
  512.            if g<>'?' then for f:=1 to 20 do if (nation[f].nombre=g) and p[f] then which:=f;
  513.            if which=0 then begin
  514.               val(g,f,h);
  515.               if (h=0) and (0<f) and (f<=20) and p[f] then which:=f;
  516.            end;
  517.      until which<>0;
  518.      inv:=false;
  519. end;
  520.  
  521. procedure getreg(mmm:bigstring;var which:integer;restrict,info:char); {input a region's name or number}
  522. var
  523.    bk,f,h,f1:integer;
  524.    g:namstring;
  525.    p:array[1..80] of boolean;
  526.    q:boolean;
  527.    t:real;
  528.    hd,hd1:string[80];
  529. begin
  530.      bk:=which;
  531.      which:=0;
  532.      for f:=1 to 80 do if inv then p[f]:=checkk(nation[cn].rel[region[f].controller],restrict)
  533.                               else p[f]:=checkk(nation[region[f].controller].rel[cn],restrict);
  534.      q:=false;
  535.      for f:=1 to 80 do q:=q or p[f];
  536.      if not q then begin
  537.         nomesg(restrict,inv);
  538.         qut:=true;
  539.         inv:=false;
  540.         exit;
  541.      end;
  542.      repeat
  543.            ynq(mmm+'what region? [? for list, Q aborts] ');
  544.            checkhangup;
  545.            if hangup then goodbye;
  546.            inputn(g);
  547.            if hangup then goodbye;
  548.            if ((upcase(g[1])='Q') and (length(g)=1)) or (g='') then begin
  549.               inv:=false;
  550.               qut:=true;
  551.               which:=bk;
  552.               exit;
  553.            end;
  554.            if g='?' then case info of
  555.                 'D':begin
  556.                          print('                                   Development/Credits');
  557.                          print(rheader+'     AGR     ENE     MET     NON     IND     TEC');
  558.                          print(rqual+'     ===     ===     ===     ===     ===     ===');
  559.                     end;
  560.                 'W':begin
  561.                          print(rheader+'            Worth');
  562.                          print(rqual+'            =====');
  563.                     end;
  564.                 'T':begin
  565.                          print(rheader+'   Eligible men');
  566.                          print(rqual+'   ============');
  567.                     end;
  568.                 'R':begin
  569.                          print(rheader+'   Rebel strength');
  570.                          print(rqual+'   ==============');
  571.                     end;
  572.                 'P':begin
  573.                          print(rheader+'     Men     Women&kids');
  574.                          print(rqual+'     ===     ==========');
  575.                     end;
  576.            end;
  577.            ab:=false;
  578.            if g='?' then for f:=1 to 80 do if p[f] then with region[f] do begin
  579.             hd:=rname(f);
  580.             case info of
  581.               'D':begin
  582.                        hd1:=hd;
  583.                        for f1:=1 to 6 do hd1:=hd1+pad(st(comm[f1].devel,0)+'/'+st(comm[f1].credit,0),8);
  584.                        pa(hd1);
  585.                   end;
  586.               'W':pa(hd+pad('$'+st(rworth(f),0),17));
  587.               'T':pa(hd+st(men,15));
  588.               'R':pa(hd+st(strength(rebels),17));
  589.               'P':pa(hd+st(men,8)+st(wandc,15));
  590.             end;
  591.            end;
  592.            if g<>'?' then for f:=1 to 80 do if (region[f].nombre=g) and p[f] then which:=f;
  593.            if which=0 then begin
  594.               val(g,f,h);
  595.               if (h=0) and (0<f) and (f<=80) and p[f] then which:=f;
  596.            end;
  597.      until which<>0;
  598.      inv:=false;
  599. end;
  600.  
  601. function worth(p:integer):real; {national worth}
  602. var f:real;
  603.     g:integer;
  604. begin
  605.      f:=0;
  606.      for g:=1 to 80 do if region[g].controller=p then f:=f+rworth(g);
  607.      f:=f+nation[p].dinero;
  608.      worth:=f;
  609. end;
  610.  
  611. procedure newnat(f:integer); {determine where a region will attach itself to}
  612. var z,f1,n:integer;
  613.     r:real;
  614. begin
  615.      z:=region[f].controller;
  616.      r:=worth(z);
  617.      n:=0;
  618.      if n=0 then repeat
  619.         n:=random(20)+1;
  620.      until (n<>z) and (nation[n].dinero>0);
  621.      addon(region[f].nombre+' revolted from '+nation[z].nombre);
  622.      addon('and joined '+nation[n].nombre);
  623.      region[f].controller:=n;
  624.      with nation[n] do for f1:=1 to 4 do military[f1]:=military[f1]+region[f].rebels[f1];
  625.      with region[f] do for f1:=1 to 4 do rebels[f1]:=0;
  626. end;
  627.  
  628. procedure getzap; {determine average worth/number of regions}
  629. var i:real;
  630.     f:integer;
  631. begin
  632.      i:=0;
  633.      for f:=1 to 20 do i:=i+worth(f)/(cont(f)+1);
  634.      zap:=i/20;
  635. end;
  636.  
  637. procedure sendmess; {send message}
  638. begin
  639.      assign(letters,datapath+'MESSAGES.GEO');
  640.      reset(letters);
  641.      dummy.por:=1;
  642.      while not eof(letters) and not (dummy.por=0) do read(letters,dummy);
  643.      if not eof(letters) then seek(letters,filepos(letters)-1);
  644.      write(letters,art);
  645.      close(letters);
  646. end;
  647.  
  648. function bestnat:integer; {determine the wealthiest nation}
  649. var f:integer;
  650.     g:real;
  651. begin
  652.      bestnat:=1;
  653.      g:=worth(1)/(cont(1)+1);
  654.      for f:=2 to 20 do if worth(f)/(cont(f)+1)>g then begin
  655.          bestnat:=f;
  656.          g:=worth(f)/(cont(f)+1);
  657.      end;
  658. end;
  659.  
  660. function unrest(a:integer):real; {determine unrest in region a}
  661. var rp,e:real;
  662. begin
  663.      with region[a] do begin
  664.         rp:=0;
  665.         e:=int(men/(wandc+1)*100);
  666.         if e<20 then rp:=rp+(20-e);
  667.         with nation[controller] do rp:=rp-int(percapita)+int(tax);
  668.         rp:=rp-int(20*sin(pi*(5/7)*((worth(controller)/(cont(controller)+1))/zap-0.7)));
  669.         if rp>100 then rp:=100;
  670.         if rp<0 then rp:=0;
  671.      end;
  672.      unrest:=rp;
  673. end;
  674.  
  675. function state(a:integer):bigstring; {convert unrest into a string}
  676. var r:real;
  677. begin
  678.      r:=unrest(a);
  679.      case round(r) of
  680.           0: state:='Happy';
  681.           1..7: state:='Restless';
  682.           8..24: state:='Grumbling';
  683.           25..100: state:='In Revolt';
  684.      end;
  685. end;
  686.  
  687. overlay procedure papers;
  688. var p,m1,m2,xyzzy:bigstring;
  689.     sel:char;
  690.     r1,r2,r3,m3,f:integer;
  691. begin
  692.      cls;
  693.      print('It''s '+currdate);
  694.      prt('[T]his year''s paper or [L]ast year''s? ');
  695.      onek(sel,'TL');
  696.      if sel='T' then xyzzy:='THISYEAR.GEO' else xyzzy:='LASTYEAR.GEO';
  697.      assign(newspaper,datapath+xyzzy);
  698.      for f:=1 to 12 do prompt(mnames[f]+' ');
  699.      nl;
  700.      r3:=nation[cn].lmnth;
  701.      if r3>world.currmonth then r3:=1;
  702.      prt('Starting month ['+mnames[r3]+'] ');
  703.      checkhangup;
  704.      if hangup then goodbye;
  705.      input(m1,3);
  706.      if hangup then goodbye;
  707.      r1:=mon2int(m1);
  708.      if r1=0 then r1:=r3;
  709.      print(mnames[r1]);
  710.      reset(newspaper);
  711.      repeat read(newspaper,lilmess) until (lilmess=mnames[r1]) or eof(newspaper);
  712.      ab:=false;
  713.      while not eof(newspaper) and not ab do begin
  714.            read(newspaper,lilmess);
  715.            pa(lilmess);
  716.      end;
  717.      if ab then print('Aborted.');
  718.      close(newspaper);
  719.      nation[cn].lmnth:=world.currmonth;
  720. end;
  721.  
  722. overlay procedure worldstat;
  723. var f,g:integer;
  724.     a,b:real;
  725.     d:char;
  726. begin
  727.      cls;
  728.      ab:=false;
  729.      pa('World status as of '+currdate);
  730.      pa('World population:  '+st(world.pop,0));
  731.      pa('Radiation levels:  '+st(world.radiation,0)+'%');
  732.      pa('Fallout cloud cover:  '+st(world.nukewinter,0)+'%');
  733.      pa('** World Market Report **');
  734.      pa('  Commodity   Volume   Development');
  735.      pa('  =========   ======   ===========');
  736.      for f:=1 to 6 do begin
  737.          a:=0;
  738.          b:=0;
  739.          for g:=1 to 80 do b:=b+region[g].comm[f].devel;
  740.          for g:=1 to 20 do a:=a+nation[g].ncomm[f]+nation[g].tcomm[f];
  741.          pa(pad(commods[f],11)+st(a,9)+st(b,14));
  742.      end;
  743.      ynq('See nation list? ');
  744.      yah:=yn;
  745.      ab:=false;
  746.      if yah then begin
  747.         print('                       Nation   Regions   Economic Worth ($)');
  748.         print('                       ======   =======   ==================');
  749.         for f:=1 to 20 do pa(nname(f)+st(cont(f),10)+st(worth(f),21));
  750.      end;
  751. end;
  752.  
  753. {$I ROUTINE1.PAS}
  754.  
  755. {$I ROUTINE2.PAS}
  756.  
  757. {$I MAINTEN.PAS}
  758.  
  759.  
  760. begin
  761.      main;
  762.      maintenance;
  763.      with world do currdate:=convert(currmonth,curryear);
  764.      print(currdate);
  765.      census;
  766.      repeat
  767.          topscr;
  768.          If (Nation[cn].dinero)<-100000000.0 then begin
  769.            with nation[cn] do if cont(cn)=0 then controller:='NOBODY'
  770.              else controller:='&&&';
  771.            reset(trashcan);
  772.            seek(trashcan,filesize(trashcan)+1);
  773.            write(trashcan,handl);
  774.            close(trashcan);
  775.            Cls;
  776.            Checkhangup;
  777.            if hangup then goodbye;
  778.            Printfile(ASSASS1.GEO);
  779.            Checkhangup;
  780.            if hangup then goodbye;
  781.            Pausescr;
  782.            Cls;
  783.            print('Enter your final words now (75 characters): ');
  784.            checkhangup;
  785.            if hangup then goodbye;
  786.            inputl(lilmess,75);
  787.            if hangup then goodbye;
  788.            {goto ex;}
  789.            addon(' ');
  790.            addon(nation[cn].nombre+' was assassinated!  His final words were:');
  791.            addon('--- '+lilmess);
  792.            addon(' ');
  793.            Cls;
  794.            Printfile(gfilespath+'ASSASS2.GEO');
  795.            Goodbye;
  796.          end;
  797.          prt('Department [A,D,E,H,I,M,N,P,Q,S,W,?] ');
  798.          onek(sel,'ADEHIMNPQSW?');
  799.          case sel of
  800.               'S':domestic;
  801.               'W':worldstat;
  802.               'D':diplomacy;
  803.               'E':economy;
  804.               'M':milit;
  805.               'N':nuclear;
  806.               'P':papers;
  807.               'I':intelligence;
  808.               'H':printfile(gfilespath+'HELPB.GEO');
  809.               'A':printfile(gfilespath+'HISTORY.GEO');
  810.               '?':begin
  811.                        ab:=false;
  812.                        pa('    [A] history lesson');
  813.                        pa('    [D]iplomacy');
  814.                        pa('    [E]conomy');
  815.                        pa('    [H]elp');
  816.                        pa('    [I]ntelligence');
  817.                        pa('    [M]ilitary');
  818.                        pa('    [N]uclear');
  819.                        pa('    news[P]apers');
  820.                        pa('    [Q]uit');
  821.                        pa('    dome[S]tic');
  822.                        pa('    [W]orld status');
  823.                   end;
  824.               'Q':begin
  825.                        ynq('Are you sure? ');
  826.                        yah:=yn;
  827.                        if not yah then sel:='*';
  828.                   end;
  829.          end;
  830.          nl;
  831.      until sel='Q';
  832.      goodbye;
  833. end.
  834.