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 / E3.PRO < prev    next >
Text File  |  1989-09-27  |  15KB  |  525 lines
  1.  
  2. procedure faire;
  3. var
  4.    uniforms:boolean;
  5.    adu:byte;
  6.    lu:boolean;
  7. begin
  8. adu:=0;
  9. uniforms:=false;
  10. lu:=false;
  11. repeat
  12.    writeln('The following unusual goods are offered for sale');
  13.    writeln('1. auxilliary drive units, one million credits for the first,');
  14.    writeln('   two million for the second, three for the third.');
  15.    writeln('2. spiffy new uniforms for the crew, sixty thousand credits');
  16.    writeln('3. a laser unit, price one lifeboat and one probe');
  17.    writeln('4. an autodoc of alien manufacture, one million credits');
  18.    writeln('(Credit extended for #2 only)');
  19.    writeln('You may buy any, all, or none. Buy which number (5 to leave)');
  20.    status;
  21.    showcash;
  22.    inputs;
  23.    case inp of
  24.       1: if credits<(adu+1)*1E6 then
  25.             begin
  26.             writeln('You don''t have ',(adu+1)*1e6,' million credits')
  27.             end{ifthen}
  28.          else if adu>2 then writeln('You''ve bought them all.')
  29.             else
  30.                begin
  31.                adu:=adu+1;
  32.                speed:=speed+1;
  33.                tspeed:=tspeed+1;
  34.                cspeed:=cspeed+1;
  35.                credits:=credits-1E6*(adu);
  36.                end;{inner else}
  37.       2: if uniforms=true then writeln('You already bought those.')
  38.          else
  39.             begin
  40.             uniforms:=true;
  41.             writeln('The crew is delighted.');
  42.             morale:=morale+6;
  43.             moralebounce:=moralebounce+3;
  44.             credits:=credits-6E4;
  45.             end;{else}
  46.       3: if (probes=0) or (boats=0) then writeln('you don''t have both a probe and a boat.')
  47.          else if lu=true then writeln('You already bought the only laser unit')
  48.             else
  49.                begin
  50.                lu:=true;
  51.                laser:=laser+1;
  52.                tlaser:=tlaser+1;
  53.                claser:=claser+1;
  54.                boats:=boats-1;
  55.                probes:=probes-1;
  56.                end;{second else}
  57.       4: if credits<1E6 then writeln('Not enough cash')
  58.          else if autodoc=true then writeln('you already have one, and you don''t need two.')
  59.          else
  60.             begin
  61.             autodoc:=true;
  62.             credits:=credits-1E6;
  63.             morale:=morale+6;
  64.             moralebounce:=moralebounce+1;
  65.             end;{second else}
  66.    end;{repeat}
  67.    until inp=5;
  68. end;{procedure faire}
  69.  
  70. procedure gift;
  71. begin
  72. case random(5) of
  73.    0:
  74.    begin
  75.    writeln('a bottle of smnervian lifewater.');
  76.    morale:=morale+10;
  77.    moralebounce:=moralebounce+8;
  78.    end;{case 0}
  79.    1:
  80.    begin
  81.    writeln('an amazing stock of adhesives.');
  82.    hull:=hull+1;
  83.    thull:=thull+1;
  84.    chull:=chull+1;
  85.    writeln('hull strength now ',chull);
  86.    end;{case 1}
  87.    2:
  88.    begin
  89.    writeln('a lifeboat');
  90.    boats:=boats+1;
  91.    end;{case 2}
  92.    3:
  93.    begin
  94.    writeln('alien electronic secrets worth 50000 credits.');
  95.    credits:=credits+5E4;
  96.    end;{case 3}
  97.    4:
  98.    begin
  99.    writeln('measles.');
  100.    if autodoc=true then writeln('Your autodoc cures the measles.')
  101.    else begin
  102.       writeln('You spend the next .01 years recovering.');
  103.       t:=t-0.01;
  104.       end;{else}
  105.    end;{case 4}
  106. end;{case}
  107. end;{gift}
  108.  
  109. procedure aliens;
  110. begin
  111. roll:=false;
  112. writeln;
  113. writeln('You have met a race of alien beings');
  114. if assignment=false then
  115.    begin
  116.    for index:=0 to 4 do alienmatch[index]:=random(5);
  117.    assignment:=true;
  118.    end;
  119. index:=random(5);
  120. case index of
  121. 0:writeln('Some look like mops, while others look more like brooms.');
  122. 1:writeln('They look rather like a combination between a pidgeon and a sprinkler head.');
  123. 2:writeln('They look a little like a cross between a fern and a banana cream pie.');
  124. 3:writeln('They look somewhat like a Spanish tile roof and smell like chocolate.');
  125. 4:writeln('They remind you of a four-foot hot fudge sundae.');
  126. end;{case}
  127. writeln('Will you:');
  128. writeln('1. Ignore the aliens');
  129. writeln('2. Attack');
  130. writeln('3. Flee');
  131. writeln('4. Try to communicate');
  132. inputs;
  133. if (inp>4) or (inp<1) then inp:=1;
  134. case alienmatch[index] of
  135.    0: begin
  136.       if inp=1 then writeln('The aliens ignore you');
  137.       if inp=2 then strikefirst;
  138.       if inp=3 then writeln('The aliens run the other way');
  139.       if inp=4 then faire;
  140.       end;{case 0}
  141.    1: begin
  142.       if inp=1 then
  143.          begin
  144.          writeln('The aliens attack you!');
  145.          handfight(0);
  146.          end;{ifthen}
  147.       if inp=2 then strikefirst;
  148.       if inp=3 then
  149.          begin
  150.          writeln('The aliens catch up and attack you!');
  151.          handfight(0);
  152.          end;{ifthen}
  153.       if inp=4 then writeln('The aliens insult you creatively, and leave.');
  154.       end;{case 1}
  155.    2: begin
  156.       if inp=1 then
  157.          begin
  158.          writeln('Although not talkative, the aliens are friendly, and give you ');
  159.          gift;
  160.          end;{ifthen}
  161.       if inp=2 then strikefirst;
  162.       if inp=3 then writeln('The aliens run the other way');
  163.       if inp=4 then writeln('The aliens explain that they hate talking, and leave');
  164.       end;{case 2}
  165.    3: begin
  166.       if inp=1 then writeln('The aliens ignore you');
  167.       if inp=2 then begin
  168.          strikefirst;
  169.          roll:=false;
  170.          end;{ifthen}
  171.       if inp=3 then writeln('The aliens wave goodbye');
  172.       if inp=4 then if random>0.5 then faire else
  173.          begin
  174.          writeln('The friendly aliens give you');
  175.          gift;
  176.          end; {else}
  177.       end;{case 3}
  178.    4: begin
  179.       if inp=1 then writeln('The aliens ignore you');
  180.       if inp=2 then begin
  181.          strikefirst;
  182.          roll:=false;
  183.          end;{ifthen}
  184.       if inp=3 then writeln('The aliens wave goodbye');
  185.       if inp=4 then if random>0.5 then faire else
  186.          begin
  187.          writeln('The friendly aliens give you');
  188.          gift;
  189.          end;{else}
  190.       end;{case 4}
  191. end;{case}
  192. if (roll=true) and (random>0.7) then begin
  193.    write('the defeated aliens had ');
  194.    gift;
  195.    end;{ifthen}
  196. end;{aliens}
  197.  
  198. procedure findcrew(localint:byte);
  199. begin
  200. case localint of
  201.    1: writeln('A big kiss');
  202.    2: begin
  203.       writeln('a case of chicken pox...you lose .02 years while recovering.');
  204.       t:=t-0.02;
  205.       end;{case 2}
  206.    3: begin
  207.       writeln('their services for the rest of the lease period.');
  208.       mndex:=random(3)+1;
  209.       crew:=crew+mndex;
  210.       writeln('Since there are ',mndex,' of them your crew = ',crew);
  211.       end;{case 3}
  212.    4: if (hull<thull) or (laser<tlaser) or (speed<tspeed) then
  213.          begin
  214.          writeln('a repair job');
  215.          hull:=thull;
  216.          laser:=tlaser;
  217.          speed:=tspeed;
  218.          end
  219.       else writeln('a bright yellow paint job for the ',name);
  220.    end;{case}
  221. morale:=morale+3*localint;
  222. end;{findcrew}
  223.  
  224. procedure getthing;
  225. begin
  226. jndex:=random(10)+1;
  227. case jndex of
  228.    1: begin
  229.       writeln('You find stranded crew; they are so delighted that they give you');
  230.       kndex:=random(4)+1;
  231.       findcrew(kndex);
  232.       if random(5)=0 then begin
  233.          writeln('The grateful crew also gives you');
  234.          kndex:=kndex+1;
  235.          if kndex=5 then kndex:=1;
  236.          findcrew(kndex);
  237.          end;{ifthen}
  238.       end;{case}
  239.    2: writeln('Aliens jump out of a closet and yell BOO, then they laugh and laugh');
  240.    3: begin
  241.       writeln('An abandoned computer holds the secrets of the legendary Jovain');
  242.       write('methods of navigation.');
  243.       kndex:=random(3);
  244.       speed:=speed+kndex;
  245.       tspeed:=tspeed+kndex;
  246.       cspeed:=cspeed+kndex;
  247.       if kndex=0 then writeln('but you don''t understand it')
  248.       else writeln('Your effective speed is now ',cspeed);
  249.       end;{case 3}
  250.    4: begin
  251.       writeln('You find a laser cannon with power cells');
  252.       laser:=laser+1;
  253.       tlaser:=tlaser+1;
  254.       claser:=claser+1;
  255.       writeln('laser power now ',claser);
  256.       end;{case 4}
  257.    5: begin
  258.       dt:=random*0.05;
  259.       writeln('You find a cask of wine from the Rhone, France, Earth');
  260.       writeln('You are delayed ',dt:0:3,' years while your crew sobers up.');
  261.       t:=t-dt;
  262.       morale:=morale+2;
  263.       moralebounce:=moralebounce+1;
  264.       end;{case 5}
  265.    6: begin
  266.       write('An abandoned computer contains new computer games worth ');
  267.       realvar:=random*8E4;
  268.       credits:=credits+realvar;
  269.       writeln(realvar:5:0,' credits.');
  270.       end;{case 6}
  271.    7: begin
  272.       writeln('One area is shielded with gold; your net worth');
  273.       realvar:=random*random*1E6;
  274.       credits:=credits+realvar;
  275.       write(' has increased by ');
  276.       format(realvar);
  277.       writeln;
  278.       end;{case 7}
  279.    8: begin
  280.       writeln('There are two small craft, and you take them aboard');
  281.       boats:=boats+2
  282.       end;{case 8}
  283.    9: begin
  284.       writeln('One of the search party says "What''s this button for?"');
  285.       writeln('There''s an explosion');
  286.       damage;
  287.       end;{case 9}
  288.    10: aliens;
  289.    end;{case}
  290. end;{getthings}
  291.  
  292. procedure findthings;
  293. begin
  294. getthing;
  295. if random>0.6 then getthing;
  296. end;
  297.  
  298. procedure planet;
  299. begin
  300. writeln('An uncharted planet! Will you land?');
  301. readln(yorn);
  302. if upcase(yorn)='N' then exit;
  303. if boats=0 then
  304.    begin
  305.    writeln('You can''t land without small craft. There is nothing to do but leave.');
  306.    exit;
  307.    end;
  308. findthings;
  309. writeln('type <cr> to continue searching');
  310. readln(yorn);
  311. findthings;
  312. if random>0.4 then
  313.    begin
  314.    writeln('type <carriage return> to continue');
  315.    readln;
  316.    aliens;
  317.    while random>0.8 do
  318.       begin
  319.       writeln;
  320.       writeln('Another band of aliens!');
  321.       aliens;
  322.       end;{whiledo}
  323.    end;{ifthen}
  324. writeln('Planetary exploration completed.');
  325. writeln;
  326. end;{planet}
  327.  
  328. procedure asteroid;
  329. begin
  330. writeln('It''s just an asteroid, cluttering up the vacuum');
  331. end;
  332.  
  333. procedure derelict;
  334. begin
  335. writeln('It''s a derelict ship. Will you board?');
  336. readln(yorn);
  337. if upcase(yorn)='N' then exit;
  338. if boats=0 then
  339.    begin
  340.    writeln('but you can''t board without a lifeboat');
  341.    end
  342. else if random<0.15 then
  343.    begin
  344.    writeln('Sorry, but you can''t board. Apparently the aliens were built a little');
  345.    writeln('differently than you are. The cabin is a one-inch cube of molten metal');
  346.    end{ifthen}
  347. else findthings;
  348. end;
  349.  
  350. procedure probe;
  351. begin
  352. writeln('It''s a loose probe.');
  353. if boats>0 then begin
  354.    probes:=probes+1;
  355.    writeln('You catch it with a small boat. You now have ',probes,' probes.');
  356.    end{ifthen}
  357. else writeln('but you can''t catch it without a boat');
  358. end;
  359.  
  360. procedure lifecraft;
  361. begin
  362. write('It''s a lifecraft in freefall;');
  363. if boats>0 then
  364.    begin
  365.    writeln(' you take it aboard');
  366.    boats:=boats+1;
  367.    writeln('you now have ',boats,' boats.');
  368.    if random>0.92 then findthings;
  369.    end{ifthen}
  370. else writeln('But you can''t catch it without a lifecraft');
  371. end;
  372.  
  373. procedure alienship;
  374. begin
  375. writeln('"Alien ship in the viewer, Captain"');
  376. case inp of
  377.    1:
  378.    begin
  379.    writeln('It attacks you with some unknown weapon and leaves.');
  380.    damage;
  381.    end;{case 1}
  382.    7:
  383.    begin
  384.    writeln('It goes on its way before you can take further action.');
  385.    end;{case 2}
  386.    else
  387.    if random>0.3 then aliens
  388.    else writeln('It sends out a message in some unknown language and leaves');
  389.    end;{else case}
  390. end;{alienship}
  391.  
  392. procedure needlecraft;
  393. begin
  394. navy:=true;
  395. writeln('The object is a navy needleship and it escorts you to your destination.');
  396. if inp=1 then begin
  397.    writeln('But it took two shots at you before you were recognized.');
  398.    damage;
  399.    damage;
  400.    end;{ifthen}
  401. end;
  402.  
  403. procedure spacestation;
  404. begin
  405. writeln('It''s an abandoned space station. Will you dock?');
  406. readln(yorn);
  407. if upcase(yorn)<>'N' then
  408.    begin
  409.    findthings;
  410.    writeln('type <cr> to continue search');
  411.    readln;
  412.    findthings;
  413.    end;{ifthen}
  414. end;
  415.  
  416. procedure mine;
  417. begin
  418. writeln('Blam!     The object was a mine.');
  419. if inp=5 then
  420.    begin
  421.    boats:=boats-1;
  422.    index:=random(3)+1;
  423.    crew:=crew-index;
  424.    writeln('boat wrecked, ',index,' crew out of action');
  425.    shortcrew;
  426.    morale:=morale-index*5;
  427.    moralebounce:=moralebounce-2*index;
  428.    end;{ifthen}
  429. if inp=6 then
  430.    begin
  431.    probes:=probes-1;
  432.    writeln('probe destroyed');
  433.    end;{ifthen}
  434. if (inp<>6) and (inp<>5) then damage;
  435. end;
  436.  
  437. procedure trader;
  438. begin
  439. traderflag:=true;
  440. objectcount:=objectcount-1; {takes care of this one, but not previous}
  441. chain(chnfile);
  442. end;
  443.  
  444. procedure object;
  445. begin
  446. jump:=false;
  447. writeln;
  448. writeln('Captain, there is an uncharted object ahead');
  449. inp:=0;
  450. index:=random(40)+1;
  451. while (inp<1) or (inp>7) do
  452.    begin
  453.    writeln('will you:');
  454.    writeln;
  455.    if claser>0 then writeln('1. Fire lasers');
  456.    writeln('2. Communicate');
  457.    if cspeed>0 then writeln('3. Approach');
  458.    if cspeed>0 then writeln('4. Avoid the object');
  459.    if (boats>0) and (crew>2) then writeln('5. Send out a small boat to investegate');
  460.    if probes>0 then writeln('6. Send a probe');
  461.    writeln('7. Ignore the object');
  462.    if crew<complement-3 then writeln('8. Reassign crew');
  463.    inputs;
  464.    if (((boats=0) or (crew<3)) and (inp=5)) or ((probes=0) and (inp=6)) then
  465.       begin
  466.       writeln('not possible, captain');
  467.       inp:=0;     {restarts menu}
  468.       end;{ifthen}
  469.    if (cspeed=0) and ((inp=3) or (inp=4)) then
  470.       begin
  471.       writeln('no drive, captain');
  472.       inp:=0;
  473.       end;{ifthen}
  474.    if (inp=2) and (index<20) then begin
  475.       writeln('No reply to your hail');
  476.       inp:=0;
  477.       end;{ifthen}
  478.    if inp=8 then begin
  479.       shortcrew;
  480.       inp:=0;
  481.       end;{ifthen}
  482.    end;{whiledo}
  483.    if inp=4 then
  484.       if random*cspeed>1 then begin writeln('Object avoided'); exit end{inner ifthen}
  485.       else writeln('unable to avoid object');
  486.    if (inp=1) and ((index<20) or ((27<index) and (index<32))) then
  487.       begin
  488.       writeln('object destroyed');
  489.       exit;
  490.       end;{ifthen}
  491.    if inp=5 then begin
  492.       morale:=morale-2;
  493.       end;{ifthen}
  494.    if inp=1 then jump:=true;
  495.    if ((inp=5) or (inp=6)) and (index>19) and (index<28) then
  496.       begin
  497.       if inp=5 then
  498.          begin
  499.          boats:=boats-1;
  500.          jndex:=random(3)+1;
  501.          writeln('Space bandits have captured your boat with ',jndex,' crewmembers aboard.');
  502.          crewloss(jndex);
  503.          end{if inp=5}
  504.       else begin
  505.          probes:=probes-1;
  506.          writeln('Bandits swipe your probe');
  507.          end;{else}
  508.       exit;
  509.       end;{big ifthen}
  510. case index of
  511.    1:planet;
  512.    2..5:asteroid;
  513.    6..8:mine;
  514.    9..11:lifecraft;
  515.    12:probe;
  516.    13..17:derelict;
  517.    18..19:spacestation;
  518.    20..27:bandit;
  519.    28..31:trader;
  520.    32..35:needlecraft;
  521.    36..40:alienship;
  522.    end;{case}
  523. end;{procedure object}
  524.  
  525.