home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / BEEHIVE / GAMES / STARSHIP.ARC / ESTAR.PRO < prev    next >
Text File  |  1989-09-27  |  4KB  |  129 lines
  1.  
  2. procedure Error(ErrNo, ErrAddr: Integer);{see READ.ME from Turbo}
  3. begin
  4. stringvar:=thiscargo.acargoname;
  5. writeln('thiscargo:',stringvar);
  6. stringvar:=thiscargotype.cargoname;
  7. writeln('thiscargotype:',stringvar);
  8. writeln('index,jndex,kndex,mndex,cargonum,star,thistar,realstar');
  9. writeln(index,' ',jndex,' ',kndex,' ',mndex,' ',cargonum,' ',star,' ',thistar,' ',realstar);
  10. writeln('triplength,gamelength:',triplength,' ',gamelength);
  11. writeln('speed,tspeed,cspeed,hull,thull,chull',speed,' ',tspeed,' ',cspeed,' ',hull,' ',thull,chull);
  12. writeln('probes,boats,laser,tlaser,claser');
  13. writeln(probes,' ',boats,' ',laser,' ',tlaser,' ',claser);
  14. writeln('<CR> to continue var listing');
  15. readln;
  16. writeln('crew:',crew);
  17. writeln('drivecrew,lasercrew,hullcrew,space,morale,moralebounce:');
  18. writeln(drivecrew,' ',lasercrew,' ',hullcrew,' ',space,' ',morale,' ',moralebounce);
  19. writeln('num,trial,inp:',num,' ',trial,' ',inp);
  20. writeln('t,dt,credits,realvar,salary:',t,dt,credits,realvar,salary);
  21. writeln('probehere,boathere,navy,messageflag,autodoc,assignment,roll');
  22. writeln(probehere,' ',boathere,' ',navy,' ',messageflag,' ',autodoc,' ',assignment,' ',roll);
  23. writeln('prize',prize);
  24. writeln('OrigEpower:',OrigEpower);
  25. writeln('Epower:', Epower);
  26. writeln('action,battle,newship,nomessage,moraleflag:',action,' ',battle,' ',newship,' ',nomessage,' ',moraleflag);
  27. writeln('traderflag,quitter:',traderflag,' ',quitter);
  28. end;{procedure error}
  29.  
  30. procedure inputs;        {read and check integer inputs}
  31. begin
  32. {$I-}
  33. readln(Trial);
  34. if IOresult<>0 then begin
  35.    writeln('Please type a numeral');
  36.    inp:=0;{restarts menu}
  37.    end
  38. {$I+}
  39. else inp:=trial
  40. end;
  41.  
  42. procedure format(pretty:real);
  43. begin
  44. str(pretty:9:0,stringvar);
  45. if (pretty>999) or (pretty<-999) then insert(',',stringvar,length(stringvar)-2)
  46. else insert(' ',stringvar,1);
  47. if (pretty>9.99999E5) or (pretty<-9.99999E5) then insert(',',stringvar,length(stringvar)-6)
  48. else insert(' ',stringvar,1);
  49. write(stringvar);
  50. end;
  51.  
  52. procedure realround(toround:real);
  53. begin
  54. if frac(toround)>=0.5 then toround:=toround+1;
  55. toround:=int(toround);
  56. end;
  57.  
  58.  
  59. procedure shortposts;
  60. begin
  61.    num:=6-lasercrew;
  62.    if num<0 then num:=0;
  63.    if odd(num) then num:= num-1;
  64.    num:=num div 2;
  65.    if num>claser then claser:=0 else claser:=laser-num;
  66.    num:=6-hullcrew;
  67.    if num<0 then num:=0;
  68.    if odd(num) then num:= num-1;
  69.    num:=num div 2;
  70.    if num>chull then chull:=0 else chull:=hull-num;
  71.    num:=8-drivecrew;
  72.    if num<0 then num:=0;
  73.    if odd(num) then num:= num-1;
  74.    num:=num div 2;
  75.    if num>cspeed then cspeed:=0 else cspeed:=speed-num;
  76. end;
  77.  
  78. procedure jumpship;
  79. begin
  80. if ((boats=0) and (star<>thistar)) or (crew=0) then exit;
  81. if (t>gamelength-1) and (battle=false) then exit;{no go if less than one year elapsed}
  82. index:=random(crew);
  83. if odd(index)=true then index:=index-1;
  84. index:=index div 2;
  85. if index>4 then index:=4;
  86. if index=0 then index:=1;
  87. writeln(chr(7),index,' OF YOUR CREW HAVE JUMPED SHIP.');
  88. if thistar<>star then begin
  89.    writeln('A lifeboat is missing.');
  90.    boats:=boats-1;
  91.    end;{ifthen}
  92. crew:=crew-index;
  93. end;{jumpship}
  94.  
  95. procedure showcash;
  96. begin
  97. write('you have ');
  98. format(credits);
  99. writeln(' credits.  Time left ',t:2:3);
  100. writeln('unused lifting capacity, ',space,' tons');
  101. end;
  102.  
  103.  
  104. procedure status;
  105. begin
  106. if newship=true then exit;
  107. writeln('The merchantman ',name,' has: speed: ',cspeed,', hull integrity: ',chull);
  108. writeln('laser power: ',claser,', probes: ',probes,', small craft: ',boats,', crew: ',crew);
  109. writeln('morale factor=',morale);
  110. end;
  111.  
  112. procedure confiscation;
  113. begin
  114. for index:=1 to random(2)+1 do
  115. jndex:=random(holdnum)+1;
  116. with holdnow[jndex] do
  117.    begin
  118.    writeln('The cargo in hold ',jndex,' has been taken.');
  119.    if category=0 then writeln('...but that hold was empty.')
  120.       else
  121.       begin
  122.       stringvar:=acargoname;
  123.       writeln('The cargo was ',stringvar);
  124.       space:=space+aweight;
  125.       category:=0;
  126.       end;{else}
  127.    end;{with}
  128. end;{confiscation}
  129.