home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / games / turbotrk.zip / TURBOTRK.PAS < prev   
Pascal/Delphi Source File  |  1986-09-14  |  50KB  |  1,860 lines
  1. {$R+} {Range checking}
  2. {$U+} {User interupt}
  3. {$C+} {Abort and input statement with control C}
  4. {$K+} {Check stack before placing local variables}
  5. {$I+} {I/O error checking}
  6. {$V-} {Strick string checking}
  7.  
  8. {Integer Bitmap For Quadrant Matrix}
  9. {Scanned  Base  (      Stars      ) Commander (       Klingons       )}
  10. { 1024    512    128     64     32     16      8      4      2      0}
  11.  
  12. Program Trek;
  13.  
  14. Const
  15.   NumLines = 24;
  16.  
  17. Type
  18.  Triad = array[1..3] of real;
  19.  Display = (short,long,fix,chart,titlepage);
  20.  Line = String[80];
  21.  
  22.  RegPack = Record Case Integer Of
  23.            1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  24.            2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  25.            end;
  26.  
  27.  
  28. Var
  29.  Warp, Torpedoes, QuadX, QuadY, SectorX, SectorY : integer;
  30.  Level, Klingons, Total_Klingons, Shield_Status, Com, EndSecX, EndSecY : integer;
  31.  Energy, EndQuadX, EndQuadY, CommandNumber : integer;
  32.  Quadrant : array[1..10,1..10] of integer;
  33.  Sector : array[1..10,1..10] of integer;
  34.  StarDate, Time_Left, X, Y, PosX, PosY, Delta_X, Delta_Y : Real;
  35.  Fire_Power, Direction, Distance, T, Shield_Strength, Total_hits : Real;
  36.  WaitInterval : real;
  37.  Damage : array[0..7] of Real;
  38.  GameDone, ReadyToStop, Docked, OK, SoundOn : Boolean;
  39.  Command, Command1, Command2 : Char;
  40.  Command12 : String[2];
  41.  CommandLine : String[30];
  42.  Plot : Array[0..5] of Char;
  43.  Device : Array[0..7] of String[20];
  44.  Numbers : triad;
  45.  Screen : display;
  46.  
  47. Procedure Initialize;
  48. var I : integer;
  49. begin
  50.    Randomize;
  51.    Device[0]:='Short range sensors';
  52.    Device[1]:='Long range sensors';
  53.    Device[2]:='Warp engines';
  54.    Device[3]:='Impulse engines';
  55.    Device[4]:='Phasers';
  56.    Device[5]:='Photon torpedoes';
  57.    Device[6]:='Shields';
  58.    Device[7]:='Ship computer';
  59.    Stardate:=2500;
  60.    Time_left:=4.99;
  61.    Plot:='.*KCBE';
  62.    Klingons:=0;
  63.    Energy:=5000;
  64.    Warp:=6;
  65.    Shield_status:=0;
  66.    Shield_strength:=100;
  67.    Torpedoes:=10;
  68.    GameDone:=False;
  69.    ReadyToStop:=False;
  70.    WaitInterval:=1.0;
  71.    For I:=0 to 7 do Damage[I]:=0;
  72.    SoundOn:=True;
  73.  end;
  74.  
  75. Function FnStars(X:integer) : Integer;
  76. begin
  77. Fnstars:=(X and $01E0) DIV $0020;
  78. end;
  79.  
  80. Function FnCommander(X:integer) : Integer;
  81. var I : integer;
  82. begin
  83. I:= X and $0010;
  84. If I=0 Then FnCommander:=0 Else FnCommander:=1;
  85. end;
  86.  
  87. Function Fnklingons(X:integer) : Integer;
  88. begin
  89. Fnklingons:=(X and $000F);
  90. end;
  91.  
  92. Function Fntotalklingons(X:integer) : Integer;
  93. begin
  94. Fntotalklingons:=Fnklingons(X)+FnCommander(X);
  95. end;
  96.  
  97. Function FnEnemy(X:integer) : Boolean;
  98. var I : integer;
  99. begin
  100. I:= X and 31;
  101. If I=0 Then FnEnemy:=False Else FnEnemy:=True;
  102. end;
  103.  
  104. Function FnBase(X:integer) : Integer;
  105. var I : integer;
  106. begin
  107. I:= X and $0200;
  108. If I=0 Then FnBase:=0 Else FnBase:=1;
  109. end;
  110.  
  111. Function FnScanned(X:integer) : Boolean;
  112. var I : integer;
  113. begin
  114. I:= X and $0400;
  115. If I=0 Then FnScanned:=False Else FnScanned:=True;
  116. end;
  117.  
  118. Function FnDistance(X1,Y1,X2,Y2:integer) : Real;
  119. begin
  120. Fndistance:=Sqrt((X1-X2)*(X1-X2)+(Y1-Y2)*(Y1-Y2));
  121. end;
  122.  
  123. Procedure Screen_erase;
  124. begin
  125. ClrScr;
  126. end;
  127.  
  128. Procedure Cursor(X,Y: integer);
  129. begin
  130. GotoXY(X,Y);
  131. end;
  132.  
  133. Procedure Tab(X:integer);
  134. var Y : integer;
  135. begin
  136. Y:=WhereY;
  137. GotoXY(X,Y);
  138. end;
  139.  
  140. Procedure Wait(Time:real);
  141. var i:integer;
  142. begin
  143. Time:=Abs(Time*1000);
  144. If Time>MAXINT then time:=MAXINT;
  145. I:=Round(Time);
  146. Delay(I);
  147. end;
  148.  
  149. Procedure Erase_line (X,Y:integer);
  150. begin
  151. GotoXY(X,Y);
  152. ClrEol;
  153. end;
  154.  
  155. Procedure Erase_bottom (X,Y:integer);
  156. var i : integer;
  157. begin
  158. for i:=Y to 25 do
  159. begin {for}
  160. GotoXY(1,I);
  161. ClrEol;
  162. end;  {for}
  163. GotoXY(X,Y);
  164. end;
  165.  
  166. procedure Explosion;
  167. var frequency,I,J:integer;
  168. begin
  169.  for Frequency:= 30 to 185 do begin Delay(1); Sound(Frequency*2); end;
  170.  for Frequency:= 200 to 30 do begin Delay(1); Sound(Frequency*2); end;
  171. for I:=1 to 225 do
  172.  begin
  173.   J:=random(5)+1;
  174.   If J>3 then Frequency:=random(1000) else frequency:=random(200);
  175.   If I>180 then Frequency:=random(100)+100;
  176.   Sound(Frequency);
  177.   Delay(1);
  178.  end; {for I}
  179. NoSound;
  180. end; {Explosion}
  181.  
  182. Procedure ColorCharacter(I:Integer);
  183. begin
  184. Case I of
  185. 0:textcolor(yellow); {'.' Space}
  186. 1:textcolor(lightblue); {'*' Star}
  187. 2:textcolor(red); {'K' Klingon}
  188. 3:textcolor(lightred); {'C' Klingon Commander}
  189. 4:textcolor(Brown); {'B' Base}
  190. 5:textcolor(lightgreen); {'E' Enterprise}
  191. end; {Case}
  192. Write(Plot[I]);
  193. Textcolor(yellow);
  194. end;
  195.  
  196. Procedure Grid;
  197. var I,J : integer;
  198. begin
  199.        For J:=1 To 10 do
  200.        begin {for J}
  201.        write(J:2);
  202.          For I:=1 To 10 do
  203.          begin {for I}
  204.           write('  ');
  205.           ColorCharacter(Sector[I,J]);
  206.           Write(' ');
  207.          end; {for I}
  208.        writeln('');
  209.        writeln('');
  210.        end; {for J};
  211.      writeln('     1   2   3   4   5   6   7   8   9  10');
  212.      Quadrant[Quadx,Quady]:= Quadrant[Quadx,Quady] or 1024;
  213.  end;
  214.  
  215. Procedure Random_ij(var I,J:Integer);
  216. begin
  217.   repeat
  218.    I:=Random(10)+1;
  219.    J:=Random(10)+1;
  220.   until Sector[I,J]=0;
  221.  end;
  222.  
  223. Procedure ZeroSector;
  224. var I,J : integer;
  225. begin
  226. for i:=1 to 10 do
  227.  begin {for i}
  228.  for j:=1 to 10 do Sector[i,j]:=0;
  229.  end; {i}
  230. end;
  231.  
  232. Procedure Create_sector;
  233. var i,j,l : integer;
  234. begin
  235.    ZeroSector;
  236.    Sector[Sectorx,Sectory]:=5;
  237.    If Fncommander(Quadrant[Quadx,Quady])>0 Then
  238.       begin {if}
  239.       Random_ij(I,J);
  240.       Sector[I,J]:=3;
  241.       end; {if}
  242.    If Fnbase(Quadrant[Quadx,Quady])>0 Then
  243.       begin {if}
  244.       Random_ij(I,J);
  245.       Sector[I,J]:=4;
  246.       end; {if}
  247.    If Fnklingons(Quadrant[Quadx,Quady])>0 Then
  248.      begin {if}
  249.      For L:=1 To Fnklingons(Quadrant[Quadx,Quady]) do
  250.       begin {for l}
  251.       Random_ij(I,J);
  252.       Sector[I,J]:=2;
  253.       end; {for L};
  254.      end; {if}
  255.     If Fnstars(Quadrant[Quadx,Quady])>0 Then
  256.       begin {if}
  257.       For L:=1 To Fnstars(Quadrant[Quadx,Quady]) do
  258.       begin {for L}
  259.       Random_ij(I,J);
  260.       Sector[I,J]:=1;
  261.       end; {for L};
  262.       end; {if}
  263.  end;
  264.  
  265. Procedure Create_universe;
  266. var i,j,k,l,m,bases : integer;
  267. begin
  268.      ZeroSector;
  269.      Random_ij(Quadx,Quady);
  270.      Random_ij(Sectorx,Sectory);
  271.      bases:=0;
  272.      For I:=1 To 10 do
  273.        begin {for I}
  274.        For J:=1 To 10 do
  275.        begin {for J}
  276.        Quadrant[I,J]:=Random(9)*32;  {Number of stars}
  277.        K:=Random(100);
  278.        If (K<(7-Level)) Then {Base}
  279.         begin
  280.         Quadrant[I,J]:=Quadrant[I,J]+512;
  281.         bases:=bases+1;
  282.         end;
  283.        K:=random(100);
  284.        If K<(20+Level*5) Then
  285.          begin {if1}
  286.          If K>25 Then M:=Random(Level*2)+1 else M:=random(2)+1;
  287.          Quadrant[I,J]:=Quadrant[I,J]+M;
  288.          Klingons:=Klingons+M; {Regular Klingons}
  289.          L:=random(100);
  290.          If L<(Level*5+1) Then
  291.             begin {if2}
  292.             Quadrant[I,J]:=Quadrant[I,J]+16;  {Klingon Commander}
  293.             Klingons:=Klingons+1;
  294.             end; {if2}
  295.          end {if1}
  296.        end; {for J}
  297.      end; {for i}
  298.  If bases=0 then {Make sure there is at least one base}
  299.    begin
  300.    Random_ij(I,J);
  301.    Quadrant[I,J]:=Quadrant[I,J]+512;
  302.    end;
  303.    Total_Klingons:=Klingons;
  304. end;
  305.  
  306. Procedure Damaged(I:Integer);
  307. begin
  308.    Erase_bottom (2,23);
  309.    writeln('Damage to ',Device[I]);
  310.    wait(WaitInterval);
  311.  end;
  312.  
  313. Procedure Score_board;
  314. begin
  315.    Cursor(52,1);
  316.    writeln('STARDATE: ',StarDate:5:2);
  317.    Cursor(52,3);
  318.    writeln('POSITION');
  319.    Tab(53);
  320.    writeln(' QUADRANT ',Quadx,',',Quady);
  321.    Tab(53);
  322.    writeln(' SECTOR   ',Sectorx,',',Sectory);
  323.    Cursor(52,7);
  324.    writeln('TIME REMAINING: ',Time_left:3:2);
  325.    Cursor(52,9);
  326.    writeln('KLINGONS: ',Klingons,' ');
  327.    Cursor(52,11);
  328.    writeln('ENERGY: ',Energy:5,' ');
  329.    Cursor(52,13);
  330.    If Shield_status=0 Then writeln('SHIELDS DOWN');
  331.    If Shield_status=1 Then writeln('SHIELDS UP  ');
  332.    Tab(52);
  333.    writeln(' SHIELD STRENGTH: ',Shield_Strength:4:1,'%  ');
  334.    Cursor(52,16);
  335.    writeln('TORPEDOES: ',Torpedoes:2,' ');
  336.    Cursor(52,18);
  337.    writeln('WARP: ',Warp:2);
  338.    Cursor(52,20);
  339.    If Fnenemy(Quadrant[Quadx,Quady]) Then
  340.      begin {if2}
  341.      textcolor(Red);
  342.      writeln('CONDITION: RED  ');
  343.      textcolor(Yellow);
  344.      end {if2}
  345.      else
  346.      begin {else}
  347.      textcolor(Green);
  348.      writeln('CONDITION: GREEN');
  349.      textcolor(Yellow);
  350.      end; {else}
  351. end;
  352.  
  353. Procedure Short_range;
  354. begin
  355.  Screen_erase;
  356.  screen:=short;
  357.  Grid;
  358.  Score_board;
  359. end;
  360.  
  361. Procedure Get_numbers(var numbers : triad);
  362. {Needs to be converted into an independent subroutine.  Now}
  363. {uses global variable CommandLine.}
  364. var
  365.  Command1Line : String[30];
  366.  SubString : String[30];
  367.  J,K,L : integer;
  368. begin
  369.  Command1Line:=CommandLine;
  370.  For L:=1 to 3 do Numbers[L]:=-1;
  371.  L:=1;
  372.  While Pos(',',Command1Line)>0 do
  373.  begin {while}
  374.  K:=Pos(',',Command1Line);
  375.  SubString:=Copy(Command1Line,1,K-1);
  376.  Val(SubString,Numbers[L],J);
  377.  Delete(Command1Line,1,K);
  378.  L:=L+1;
  379.  end; {while}
  380.  If Length(Command1Line)=0 Then Numbers[L]:=-1 Else Val(Command1Line,Numbers[L],J);
  381. end;
  382.  
  383. Procedure Not_enough;
  384. begin
  385.    Erase_bottom (2,23);
  386.    writeln('Not enough energy.');
  387.    wait(WaitInterval);
  388. end;
  389.  
  390. Procedure AnotherGame(Var ReadyToStop : Boolean);
  391. Var Character : char;
  392. begin
  393. repeat
  394.    Erase_bottom(30,18);
  395.    write('ANOTHER GAME (y/n)? ');
  396.    Read(KBD,Character);
  397.    Character:=UpCase(Character);
  398. until (Character='N') or (Character='Y');
  399. If Character='N' then ReadyToStop:=True else ReadyToStop:=False;
  400. end;
  401.  
  402. Procedure Prisoner;
  403. begin
  404.    Cursor(5,10);
  405.    writeln('YOU ARE TAKEN PRISONER BY THE KLINGONS UNTIL THE END OF THE CONFLICT.');
  406.  end;
  407.  
  408. Procedure No_energy;
  409. begin
  410.  Screen_erase;
  411.  Cursor(17,4);
  412.  writeln('THE ENTERPRISE HAS BEEN TOTALLY DISTROYED');
  413.  Prisoner;
  414. end;
  415.  
  416. Procedure No_time;
  417. begin
  418.    Screen_erase;
  419.    Cursor(12,4);
  420.    writeln('YOU HAVE FAILED TO ELIMINATE THE KLINGON THREAT IN TIME.');
  421.    Cursor(25,11);
  422.    writeln('THE FEDERATION HAS SURRENDERED.');
  423.  end;
  424.  
  425. Procedure Collision(I:Integer);
  426. begin
  427.    Screen_erase;
  428.    Cursor(8,4);
  429.    write('THE ENTERPRISE HAS BEEN DESTROYED BY A COLLISION WITH A ');
  430.    If I=1 Then writeln('STAR.');
  431.    If I=2 Then writeln('KLINGON.');
  432.    If I=3 Then writeln('KLINGON COMMANDER.');
  433.    If I=4 Then writeln('STARBASE.');
  434.    If (I<1) or (I>4) then
  435.    begin
  436.     writeln('');
  437.     writeln('Error I= ',I);
  438.    end;
  439.    Prisoner;
  440.  end;
  441.  
  442. Procedure Spiral (SectorX,SectorY:integer;Var FreeX,FreeY:integer);
  443. var I,J,K,Box : integer;
  444. begin
  445.  Box:=Random(3)+1;
  446.  FreeX:=0;
  447.  FreeY:=0;
  448.  repeat
  449.  begin {repeat}
  450.  J:=random(4)+1;
  451.  K:=2*Box+1;
  452.  
  453.  case j of
  454.  
  455.  1:
  456.  begin {case 1}
  457.   I:=Random(K)+(SectorX-Box);
  458.    If (I in [1..10]) and ((SectorY+Box) in [1..10]) and ((FreeX=0) and (FreeY=0)) then
  459.    begin  {Range Check [1..10}
  460.    If Sector[I,SectorY+Box]=0 Then
  461.     begin
  462.     FreeX:=I;
  463.     FreeY:=SectorY+Box;
  464.     end;
  465.    end; {Range Check [1..10}
  466.  end; {case 1}
  467.  
  468.  2:
  469.  begin {case 2}
  470.   I:=Random(K)+(SectorX-Box);
  471.    If (I in [1..10]) and ((SectorY-Box) in [1..10]) and ((FreeX=0) and (FreeY=0)) then
  472.    begin {Range Check [1..10}
  473.    If Sector[I,SectorY-Box]=0 Then
  474.     begin
  475.     FreeX:=I;
  476.     FreeY:=SectorY-Box;
  477.     end;
  478.    end; {Range Check [1..10}
  479.  end; {case 2}
  480.  
  481.  3:
  482.  begin {case 3}
  483.   I:=Random(K)+(SectorY-Box);
  484.    If (I in [1..10]) and ((SectorX+Box) in [1..10]) and ((FreeX=0) and (FreeY=0)) then
  485.    begin {Range Check [1..10}
  486.    If Sector[SectorX+Box,I]=0 Then
  487.     begin
  488.     FreeX:=SectorX+Box;
  489.     FreeY:=I;
  490.     end;
  491.    end; {Range Check [1..10}
  492.   end; {case 3}
  493.  
  494. 4:
  495. begin {case 4}
  496.   I:=Random(K)+(SectorY-Box);
  497.    If (I in [1..10]) and ((SectorX-Box) in [1..10]) and ((FreeX=0) and (FreeY=0)) then
  498.    begin {Range Check [1..10}
  499.    If Sector[SectorX-box,I]=0 Then
  500.     begin
  501.     FreeX:=SectorX-Box;
  502.     FreeY:=I;
  503.     end;
  504.    end; {Range Check [1..10}
  505. end; {case 4}
  506. end; {case}
  507.  
  508.  Box:=Box+1;
  509.  end; {repeat}
  510.  until (box>10) or ((FreeX>0) and (FreeY>0));
  511. end;  {Procedure Spiral}
  512.  
  513.  
  514. Procedure Attackers (Move:integer);
  515. Var
  516.  I,J,K,L,M,N,O : integer;
  517. begin
  518.      For J:=(Quady-1) To(Quady+1) do
  519.      begin {for J}
  520.        For I:=(Quadx-1) To(Quadx+1) do
  521.        begin {for I}
  522.        If ((I in [1..10]) and (j in [1..10])) and ((Quadx<>I) And (Quady<>J)) Then
  523.        begin {if}
  524.        K:=FnKlingons(Quadrant[I,J]);
  525.        If ((K>0) and (K<8)) Then
  526.         begin {if1}
  527.            For L:=1 To K do
  528.            begin {for L}
  529.            M:=random(100);
  530.            If (M<Move) and (Fnklingons(Quadrant[Quadx,Quady])<(4+Level*2)) Then
  531.             begin {if2}
  532.              Quadrant[I,J]:=Quadrant[I,J]-1;
  533.              Quadrant[Quadx,Quady]:=Quadrant[Quadx,Quady]+1;
  534.              Quadrant[I,J]:=Quadrant[I,J] and $FBFF;  {Not scanned}
  535.              repeat
  536.              Spiral(SectorX,SectorY,M,N);
  537.              until (M in [1..10]) and (N in [1..10]);
  538.              Sector[M,N]:=2;
  539.              If (screen=short) and (Damage[0]=0) then
  540.               begin
  541.               Cursor(1+(M*4),(N-1)*2+1);
  542.               ColorCharacter(2);
  543.               end; {If screen=short then plot moves}
  544.             end; {if2}
  545.            end; {for L}
  546.          end; {if 1}
  547.        If FnCommander(Quadrant[I,J])>0 Then
  548.         begin {if1}
  549.            M:=random(100);
  550.            If (M<Move) and (FnCommander(Quadrant[Quadx,Quady])=0) Then
  551.             begin {if2}
  552.              Quadrant[I,J]:=Quadrant[I,J]-16;
  553.              Quadrant[Quadx,Quady]:=Quadrant[Quadx,Quady]+16;
  554.              Quadrant[I,J]:=Quadrant[I,J] and $FBFF;  {Not scanned}
  555.              repeat
  556.              Spiral(SectorX,SectorY,M,N);
  557.              until (M in [1..10]) and (N in [1..10]);
  558.              Sector[M,N]:=3;
  559.              If (screen=short) and (Damage[0]=0) then
  560.               begin
  561.               Cursor(1+(M*4),(N-1)*2+1);
  562.               ColorCharacter(3);
  563.               end; {If screen=short then plot moves}
  564.             end; {if2}
  565.          end; {if 1}
  566.         end; {if}
  567.        end; {for I}
  568.      end; {for J}
  569.  end;
  570.  
  571. Procedure Check_path(Direction,Distance:real;Sectx,Secty:integer;var K,L,Missed:Integer);
  572. Var
  573.    J,M,N:integer;
  574.    Posx, Posy, Delta_x, Delta_y, T : real;
  575. begin
  576.    Delta_x:=Sin(Direction*0.523581);
  577.    Delta_y:=-1*Cos(Direction*0.523581);
  578.    Missed:=0;
  579.    J:=0;
  580.      While Missed=0 do
  581.      begin {while}
  582.      J:=J+1;
  583.      Posx:=Sectx+Delta_x*J;
  584.      Posy:=Secty+Delta_y*J;
  585.      If Distance>0 Then
  586.        begin {if1}
  587.        K:=round(Delta_x*J);
  588.        L:=round(Delta_y*J);
  589.        T:=Fndistance(K,L,0,0);
  590.        If T>=Distance Then Missed:=-1;
  591.        End; {if1}
  592.      If (Posx<1) or (Posx>10) or (Posy<1) or (Posy>10)  Then
  593.        begin {if1}
  594.        If (Posx<0.98) or (Posx>10.02) or (Posy<0.98) or (Posy>10.02) Then Missed:=-1;
  595.        If Posx<1 Then Posx:=1;
  596.        If Posy<1 Then Posy:=1;
  597.        If Posx>10 Then Posx:=10;
  598.        If Posy>10 Then Posy:=10;
  599.        end; {if1}
  600.      K:=round(PosX);
  601.      L:=round(PosY);
  602.      If (Sector[K,L]>0)
  603.         And ((Abs(Sectx-PosX)>0.5) Or (Abs(Secty-PosY)>0.5)) Then
  604.       Begin {if}
  605.       if (SectorX=SectX) and (SectorY=SectY) then
  606.        begin {if}
  607.        Missed:=Sector[K,L];
  608.        end {if}
  609.        else
  610.        begin {else}
  611.        case Sector[K,L] of
  612.        1:Missed:=Sector[K,L];
  613.        4:Missed:=Sector[K,L];
  614.        5:Missed:=Sector[K,L];
  615.        end; {case}
  616.        end; {else}
  617.       End {if}
  618.       Else
  619.       Begin {else}
  620.       If (Screen=short) and (damage[0]=0) and ((SectorX<>K) and (SectorY<>L)) then
  621.        begin {if screen=short}
  622.         M:=K*4+1;
  623.         N:=1+(L-1)*2;
  624.         Cursor(M,N);
  625.         write('Θ');
  626.         wait(0.125);
  627.         Cursor(M,N);
  628.         If ((M Mod 4)=1) and ((N Mod 2)=1) Then write('.') else write(' ');
  629.        end; {if screen=short}
  630.       End; {Else}
  631.      End; {while}
  632. end;
  633.  
  634.  
  635. Procedure Mover(Sectorx,Sectory,EndSecX,EndSecY,I:integer);
  636. begin
  637.   If (Screen=short) and (Damage[0]=0) then
  638.    begin
  639.     Cursor(1+(Sectorx*4),(Sectory-1)*2+1);
  640.     ColorCharacter(0);
  641.     Cursor(1+(EndSecX*4),(EndSecY-1)*2+1);
  642.     ColorCharacter(I);
  643.    end; {If Screen=short then plot moves}
  644.    Sector[Sectorx,Sectory]:=0;
  645.    Sector[EndSecX,EndSecY]:=I;
  646.  end;
  647.  
  648. Procedure Klingon_attack;
  649. var
  650.   I,J,K,L,M,N,O,P,Q,Missed : integer;
  651.  begin
  652.    If Level>4 Then Attackers(2*Level);
  653.    Total_hits:=0;
  654.      For I:=1 To 10 do
  655.      begin {for I}
  656.        For J:=1 To 10 do
  657.        begin {for J}
  658.        If (Sector[J,I]=2) Or (Sector[J,I]=3) Then
  659.          begin {If Klingons then attack}
  660.          L:=random(100);
  661.          If (L>30) Or (Level>4) Then
  662.            begin {if2}
  663.            Direction:=Arctan((Sectorx-J)/(I-Sectory+1E-10))/(0.523581);
  664.            If I<Sectory Then Direction:=Direction+6;
  665.            If Direction<0 then direction:=direction+12;
  666.            Check_path(Direction,0,J,I,P,Q,Missed);
  667.            If Missed=5 then
  668.             begin {Missed=5}
  669.              Fire_power:=501.0/Fndistance(Sectorx,Sectory,J,I);
  670.              If Sector[J,I]=3 Then Fire_power:=Fire_power*3;
  671.              If Shield_status=1 Then Shield_strength:=Shield_strength-Fire_power/50.0;
  672.              If Shield_strength<0 Then Shield_strength:=0;
  673.              If Shield_status=1 Then Fire_power:=Fire_power*(1-(Shield_strength/100.0));
  674.             {If Com=6 Then Fire_power:=Fire_power*1.5;}
  675.              If Docked=False Then Fire_power:=Fire_power*Level*0.15;
  676.              Energy:=Energy-round(Fire_power);
  677.              Total_hits:=Total_hits+Fire_power;
  678.              Erase_bottom (2,23);
  679.              writeln('You lost ',Trunc(Fire_power),' giga ergs from the Klingon attacking at ',J,',',I,'.');
  680.              if screen<=fix then score_board;
  681.              wait(WaitInterval);
  682.              K:=random(150+Trunc(fire_power));
  683.              If Fire_power>K Then
  684.               begin
  685.               K:=Random(7);
  686.               Damage[K]:=abs((Ln(Fire_power)*Random)/20.0)+Damage[K];
  687.               If Damage[K]<1E-02 Then Damage[K]:=0;
  688.               If Damage[K]>0 then
  689.                begin
  690.                 Erase_bottom (2,23);
  691.                 writeln('Klingon attack damaged ',Device[K]);
  692.                 If K=6 Then
  693.                  begin
  694.                   Shield_status:=0;
  695.                  end; {if K=6}
  696.                 Wait(WaitInterval);
  697.                end; {if Damage[K]>0}
  698.               end; {if Fire_power>K}
  699.             end {If Missed=5}
  700.             else {If Missed=5}
  701.              begin
  702.              Erase_bottom (2,23);
  703.              writeln('The Klingon attacking at ',J,',',I,' missed.');
  704.              wait(WaitInterval);
  705.              end; {Else If Missed=5}
  706.            end; {if2}
  707.            L:=random(100);
  708.          If ((L<5) and (Fire_Power<100) and (Level>3)) or ((Missed<>5) and (Level>1)) then
  709.            begin
  710.              Spiral(SectorX,SectorY,M,N);
  711.              If (M in [1..10]) and (N in [1..10]) then Mover(J,I,M,N,Sector[J,I]);
  712.             end; {If Missed or Small Hit Then Move Klingons}
  713.          end; {If Klingons then attack}
  714.        end {for J};
  715.      end {for I};
  716.  Erase_bottom (2,23);
  717.  If Total_hits>0 Then writeln('You lost ',Trunc(Total_hits),' giga ergs from the Klingon attack.');
  718.  If Level>2 Then Attackers(2*Level);
  719.  If screen<=fix then Score_board;
  720.  end;
  721.  
  722. Procedure Sector_travel;
  723. begin
  724.    Mover(Sectorx,Sectory,EndSecX,EndSecY,5);
  725.    Sectorx:=EndSecX;
  726.    Sectory:=EndSecY;
  727.    If Level>3 Then Attackers(2*Level);
  728.    if screen<=fix then Score_board;
  729.    If Fnenemy(Quadrant[Quadx,Quady]) Then Klingon_attack;
  730.  end;
  731.  
  732. Procedure Quadrant_travel;
  733. var
  734.  I : integer;
  735. begin
  736.  If (Fnenemy(Quadrant[Quadx,Quady])) and (Level>1) Then Klingon_attack;
  737.  Quadx:=EndQuadX;
  738.  Quady:=EndQuadY;
  739.  Sectorx:=EndSecX;
  740.  Sectory:=EndSecY;
  741.  Create_sector;
  742.  If Damage[0]=0 then
  743.   begin
  744.   short_range;
  745.   end  {If Damage[0]=0}
  746.   else
  747.   begin {else}
  748.   Screen_erase;
  749.   screen:=short;
  750.   damaged(0);
  751.   Score_board;
  752.   end; {else}
  753.  If (Level>2) And (Fntotalklingons(Quadrant[Quadx,Quady])>0) Then Attackers(2*level);
  754.  If Fnenemy(Quadrant[Quadx,Quady]) and (Level>4) Then Klingon_attack;
  755.    If (Warp>6) Then
  756.    begin {If1}
  757.      I:=random(150);
  758.      If I<(Warp*Distance) Then
  759.       begin {if2}
  760.       Damage[2]:=Random*Warp;
  761.       Erase_bottom (2,23);
  762.       writeln('Warp drive is damaged from high speed.');
  763.       wait(WaitInterval);
  764.       end; {if2}
  765.    end; {if1}
  766.  end;
  767.  
  768. Procedure New_location;
  769. begin
  770.    Docked:=False;
  771.    If (Quadx=EndQuadX) And (Quady=EndQuadY) Then Sector_travel else Quadrant_travel;
  772.  end;
  773.  
  774. Procedure Destination;
  775. var x,y : real;
  776. begin
  777.    Delta_x:=Distance*Sin(Direction*0.523581);
  778.    Delta_y:=-Distance*Cos(Direction*0.523581);
  779.    X:=Delta_x+Sectorx/10.0+Quadx;
  780.    Y:=Delta_y+Sectory/10.0+Quady;
  781.    EndQuadX:=Trunc(X);
  782.    EndQuadY:=Trunc(Y);
  783.    EndSecX:=Round(Frac(X)*10);
  784.    EndSecY:=Round(Frac(Y)*10);
  785.    If EndSecX<1 Then
  786.    begin
  787.    EndQuadX:=EndQuadX-1;
  788.    EndSecX:=10;
  789.    end;
  790.    If EndSecY<1 Then
  791.    begin
  792.    EndQuadY:=EndQuadY-1;
  793.    EndSecY:=10;
  794.    end;
  795.    If EndSecX>10 Then
  796.    begin
  797.    EndQuadX:=EndQuadX+1;
  798.    EndSecX:=1;
  799.    end;
  800.    If EndSecY>10 then
  801.    begin
  802.    EndQuadY:=EndQuadY+1;
  803.    EndSecY:=1;
  804.    end;
  805.  end;
  806.  
  807. Procedure DirectionDistance(Var Direction,Distance : real; var OK : Boolean);
  808. begin
  809.    Repeat
  810.     Erase_bottom (2,22);
  811.     If CommandNumber=3 then write('For warp travel');
  812.     If CommandNumber=4 then write('For impulse travel');
  813.     write(' enter direction, distance: ');
  814.     Read(CommandLine);
  815.     Get_numbers(Numbers);
  816.     Direction:=Numbers[1];
  817.     Distance:=Numbers[2];
  818.    Until ((Direction>=0) and (Direction<=12) and (Distance>=0.1)) or ((Direction<=0) and (Distance<=0));
  819.   If (Direction<=0) and (Distance<=0) Then OK:=False Else OK:=True;
  820. end;
  821.  
  822. Procedure LeaveGalaxy(Var OK : Boolean);
  823. begin
  824.  If (EndQuadX>10) Or (EndQuadY>10) Or (EndQuadX<1) Or (EndQuadY<1) Then
  825.   begin {if}
  826.   Erase_bottom (2,23);
  827.   writeln('You can`t leave the galaxy.');
  828.   wait(WaitInterval);
  829.   OK:=False;
  830.   end {if}
  831. end;
  832.  
  833. Procedure Warp_drive;
  834. begin
  835.   Energy:=Energy-round((Distance*Warp*10.0)+100+Distance*Warp*10*Shield_status);
  836.   cursor(1,24);
  837.   Time_left:=Time_left-Distance*(1.5/(Warp*Warp));
  838.   Stardate:=Stardate+Distance*(1.5/(Warp*Warp));
  839.   New_location;
  840.  end;
  841.  
  842. Procedure Set_warp;
  843. var I,J : integer;
  844. begin
  845.    Erase_bottom (2,22);
  846.    write('Set warp speed to? ');
  847.    read(trm,Command1);
  848.    Val(Command1,I,J);
  849.    Erase_bottom (2,23);
  850.    If (I<1) Or (I>10) Then
  851.     begin {if1}
  852.     writeln('The Enterprise won`t go that fast.');
  853.     end; {if1}
  854.    Warp:=I;
  855.    If Warp<=6 Then writeln('Warp speed set to ',I,'.');
  856.    If Warp>6 Then writeln('A warp speed of ',I,' may damage the drive.');
  857.    If screen<=fix then Score_board;
  858.    wait(waitinterval);
  859.  end;
  860.  
  861. Procedure PlotGalaxy;
  862. var I,J, X, Y : integer;
  863. begin
  864.      For J:=1 To 10 do
  865.      begin {for J}
  866.      write(J:2);
  867.        For I:=1 To 10 do
  868.        begin {for I}
  869.        If  Fnscanned(Quadrant[I,J]) then
  870.        begin {if}
  871.        if Fnenemy(Quadrant[I,J]) then textcolor(red);
  872.        write((Fntotalklingons(Quadrant[I,J])):3);
  873.        write(Fnbase(Quadrant[I,J]),Fnstars(Quadrant[I,J]),' ');
  874.        textcolor(yellow);
  875.        end {if}
  876.        else
  877.        begin {else}
  878.        If Fnbase(Quadrant[I,J])>0 Then write('  .1. ') else write('  ... ');
  879.        end; {else}
  880.        end; {for I}
  881.      writeln('');
  882.      writeln('');
  883.      end; {for J}
  884.    writeln('     1     2     3     4     5     6     7     8     9    10');
  885.  X:=Quadx*6;
  886.  Y:=Quady*2-2;
  887.  Cursor(X,Y+2);
  888.  writeln('=');
  889.    If Y>1 Then
  890.     begin {if1}
  891.     Cursor(X,Y);
  892.     writeln('=');
  893.     end; {if1}
  894.    Cursor(X-3,Y+1);
  895.    writeln('|');
  896.    Cursor(X+2,Y+1);
  897.    writeln('|');
  898.  end;
  899.  
  900. Procedure Galaxy;
  901. begin
  902.    Screen:=chart;
  903.    Screen_erase;
  904.    PlotGalaxy;
  905. end;
  906.  
  907. Procedure LongGrid;
  908. var I,J : integer;
  909. begin
  910.    writeln('LONG RANGE SCAN FROM QUADRANT ',Quadx,',',Quady,'.');
  911.    writeln('');
  912.    writeln('');
  913.      For J:=(Quady-1) To (Quady+1) do
  914.      begin {for J}
  915.      if (J>0) and (J<11) then
  916.       write(' ',J:2)
  917.       else
  918.       write('   ');
  919.        For I:=(Quadx-1) To (Quadx+1) do
  920.        begin {for I}
  921.        If (I<1) Or (J<1) Or (I>10) Or (J>10) Then
  922.        write( '        ')
  923.        else
  924.        begin {else}
  925.        if Fnenemy(Quadrant[I,J]) then textcolor(red);
  926.        write( '    ',(Fntotalklingons(Quadrant[I,J])):2);
  927.        write(Fnbase(Quadrant[I,J]),Fnstars(Quadrant[I,J]));
  928.        Quadrant[I,J]:=Quadrant[I,J] or 1024;
  929.        textcolor(yellow);
  930.        end; {else}
  931.        end; {for I};
  932.      writeln('');
  933.      writeln('');
  934.      writeln('');
  935.      end; {for J}
  936.      write('  ');
  937.      for I:=-1 to 1 do
  938.      begin {for I}
  939.       if ((Quadx+I)>0) and ((Quadx+I)<11) then
  940.       write('      ',(Quadx+I):2)
  941.       else
  942.       write('       ');
  943.       end; {for I}
  944.  end;
  945.  
  946. Procedure Long_Range;
  947. begin
  948.    Screen_erase;
  949.    screen:=long;
  950.    LongGrid;
  951.    Score_board;
  952. end;
  953.  
  954. Procedure Congradulations;
  955. begin
  956.    Screen_erase;
  957.    Cursor(28,4);
  958.    writeln('CONGRATULATIONS CAPTAIN!!');
  959.    Cursor(21,11);
  960.    writeln('THE KLINGON THREAT HAS BEEN ELIMINATED.');
  961.  end;
  962.  
  963. Procedure Struck(X,Y:Integer);
  964. begin
  965.   If Sector[X,Y] in [2,3] then
  966.    begin
  967.    Klingons:=Klingons-1;
  968.    Time_left:=Time_left+(0.03)*(Total_klingons/(Klingons+1));
  969.    If Sector[X,Y]=2 Then Quadrant[Quadx,Quady]:=Quadrant[Quadx,Quady]-1;
  970.    If Sector[X,Y]=3 Then Quadrant[Quadx,Quady]:=Quadrant[Quadx,Quady]-16;
  971.    if (Damage[0]=0) and (screen=short) then
  972.    begin
  973.     Cursor(1+(X*4),(Y-1)*2+1);
  974.     writeln('.');
  975.    end;
  976.    Erase_bottom (2,23);
  977.    If SoundOn and (Sector[X,Y] in [2,3]) then explosion;
  978.    If Sector[X,Y]=2 Then write('You eliminated the Klingon ship with a ');
  979.    If Sector[X,Y]=3 Then write('You eliminated the Klingon commander with a ');
  980.    If CommandNumber=5 then write( trunc(Fire_power),' giga erg hit.');
  981.    If CommandNumber=6 then write('torpedo.');
  982.    Sector[X,Y]:=0;
  983.    end {If Sector[X,Y] in [2,3]}
  984.    else
  985.    begin {else}
  986.    Erase_bottom (2,23);
  987.    If Sector[X,Y]=1 Then write('You hit a star!!');
  988.    If Sector[X,Y]=4 Then
  989.     begin {If a base}
  990.     write('You destroyed a Federation base!');
  991.     Cursor(1+(X*4),(Y-1)*2+1);
  992.     writeln('.');
  993.     Sector[X,Y]:=0;
  994.     Quadrant[Quadx,Quady]:=Quadrant[Quadx,Quady] and 1279;
  995.     end; {If a base}
  996.    end; {else}
  997.    wait(WaitInterval);
  998.  end;
  999.  
  1000. Procedure Miss(EndSecX,EndSecY:integer);
  1001. begin
  1002.    Cursor(1+(EndSecX*4),(EndSecY-1)+1);
  1003.    Erase_bottom (2,23);
  1004.    If Sector[EndSecX,EndSecY]=0 Then writeln('You fired into empty space!');
  1005.    If Sector[EndSecX,EndSecY]=1 Then writeln('You hit a star!');
  1006.    If (Sector[EndSecX,EndSecY]=2) Or (Sector[EndSecX,EndSecY]=3) Then
  1007.    writeln('A ',trunc(Fire_power),' giga erg hit failed to break the Klingon`s screen');
  1008.    If Sector[EndSecX,EndSecY]=4 Then writeln('You hit your own base!');
  1009.    Wait(WaitInterval);
  1010.  end;
  1011.  
  1012. Procedure AskPhasers(var OK : Boolean);
  1013. begin
  1014.    Erase_bottom (2,22);
  1015.    write('Enter direction,energy. ');
  1016.    read(CommandLine);
  1017.    Get_numbers(Numbers);
  1018.    Direction:=Numbers[1];
  1019.    Fire_power:=Numbers[2];
  1020.    If (Direction<0) Or (Direction>12) Then OK:=False;
  1021.    If Fire_power<1 Then OK:=False;
  1022. end;
  1023.  
  1024. Procedure Phasers;
  1025. var
  1026.    x,y,z : real;
  1027.    I,J,Missed : Integer;
  1028. begin
  1029.    Energy:=Energy-round(Fire_power);
  1030.    Check_path(Direction,0,Sectorx,Sectory,I,J,Missed);
  1031.    Fire_power:=(5/(Fndistance(Sectorx,Sectory,I,J)+0.001))*Fire_power;
  1032.    If((Fire_power>=500) And (Sector[I,J]=2)) Or ((Fire_power>=1500) And (Sector[I,J]=3)) Then
  1033.      Struck(I,J)
  1034.      Else
  1035.      Miss(I,J);
  1036.   Klingon_attack;
  1037.  end;
  1038.  
  1039. Procedure AskDirections(var OK:Boolean);
  1040. var I : integer;
  1041. begin
  1042.    Erase_bottom (2,22);
  1043.    Cursor(2,23);
  1044.    write('You may fire ');
  1045.    If Torpedoes>3 then I:=3 else I:=torpedoes;
  1046.    If I>1 Then write('up to ',I,' torpedoes.') Else Write('1 torpedoe.');
  1047.    Cursor(2,22);
  1048.    write('Directions to fire? ');
  1049.    read(CommandLine);
  1050.    Get_numbers(Numbers);
  1051.    If Numbers[1]<0 Then OK:=False;
  1052. end;
  1053.  
  1054. Procedure FireTorpedoes;
  1055. var
  1056.    x,y,z : real;
  1057.    I,P,Q,Missed : integer;
  1058. begin
  1059.      For I:=1 To 3 do
  1060.      begin {for I}
  1061.      If (Numbers[I]>=0) and (Numbers[I]<=12) then
  1062.      begin {if}
  1063.      If Torpedoes<1 Then
  1064.       begin {if}
  1065.       Erase_bottom (2,23);
  1066.       writeln('You have no more torpedoes');
  1067.       wait(WaitInterval);
  1068.       end {if}
  1069.       else
  1070.       begin {else}
  1071.       Torpedoes:=Torpedoes-1;
  1072.       Check_path(Numbers[I],0,Sectorx,Sectory,P,Q,Missed);
  1073.       If Missed=-1 Then Miss(P,Q) else Struck(P,Q);
  1074.       end; {else}
  1075.      end; {if}
  1076.      end; {for I}
  1077.    Klingon_attack;
  1078.  end;
  1079.  
  1080. Procedure Dock;
  1081. var I, J : integer;
  1082. begin
  1083.      For J := Sectory-1 To Sectory+1 do
  1084.      begin {for J}
  1085.        For I:=Sectorx-1 To Sectorx+1 do
  1086.        begin {for I}
  1087.         If (I in [1..10]) and (J in [1..10]) Then
  1088.          begin
  1089.           If Sector[I,J]=4 Then Docked:=True;
  1090.          end; {if}
  1091.        end; {for I}
  1092.      end; {for J}
  1093.    If Docked Then
  1094.      begin {if}
  1095.      Energy:=5000;
  1096.      Torpedoes:=10;
  1097.      Shield_strength:=100;
  1098.      Erase_bottom (2,23);
  1099.      writeln('Enterprise docked at starbase.');
  1100.      If screen<=fix then  Score_board;
  1101.      end {if}
  1102.      Else
  1103.      begin {else}
  1104.      Erase_bottom (2,23);
  1105.      writeln('Enterprise not adjacent to starbase.');
  1106.      end; {else}
  1107.     Wait(WaitInterval);
  1108.  end;
  1109.  
  1110. Procedure Impulse;
  1111. var
  1112.  P,Q,Missed : integer;
  1113. begin
  1114.    Cursor(1+(Sectorx)*4,(Sectory-1)*2+1);
  1115.    writeln('. ');
  1116.    Check_path(Direction,Distance*10,Sectorx,Sectory,P,Q,Missed);
  1117.    If Missed>0 Then
  1118.      begin {if}
  1119.      Erase_bottom (2,23);
  1120.      writeln('Safety system stops collision.');
  1121.      Wait(WaitInterval);
  1122.      EndSecX:=Sectorx;
  1123.      EndSecY:=Sectory;
  1124.      EndQuadX:=Quadx;
  1125.      EndQuadY:=Quady;
  1126.      end; {if}
  1127.    Energy:=Energy-round(Distance*250);
  1128.    Time_left:=Time_left-0.05*Distance;
  1129.    Stardate:=Stardate+Distance*0.05;
  1130.    New_location;
  1131.  end;
  1132.  
  1133. Procedure Damage_numbers;
  1134. var I, Y : integer;
  1135. begin
  1136.      For I:=0 To 7 do
  1137.      begin {for I}
  1138.      Y:=I*2+6;
  1139.      Cursor(30,Y);
  1140.      textcolor(Red);
  1141.      If (Damage[I]>0) And (Docked=False) Then writeln(Damage[I]:3:3);
  1142.      If (Damage[I]>0) And (Docked) Then writeln((Damage[I]/10):3:3);
  1143.      textcolor(Yellow);
  1144.      If Damage[I]=0 Then writeln('  OK    ');
  1145.      end; {for I}
  1146. end;
  1147.  
  1148. Procedure DamageInformation;
  1149. var I : integer;
  1150. begin
  1151.    writeln('');
  1152.    writeln('           DAMAGE REPORT');
  1153.    writeln('');
  1154.    writeln('System                     Repair Time');
  1155.    writeln('');
  1156.      For I:=0 To 7 do
  1157.      begin {for I}
  1158.      If Damage[I]>0 then textcolor(red);
  1159.      writeln(Device[I]);
  1160.      textcolor(yellow);
  1161.      writeln('');
  1162.      end; {for I}
  1163.    Damage_numbers;
  1164.  end;
  1165.  
  1166. Procedure Damage_Report;
  1167. begin
  1168.    Screen_erase;
  1169.    Screen:=fix;
  1170.    DamageInformation;
  1171.    Score_board;
  1172. end;
  1173.  
  1174. Procedure RepairTime(var T:real);
  1175. var i : integer;
  1176. begin
  1177.    Erase_bottom (2,22);
  1178.    write('Work on repairs for how long? ');
  1179.    read(CommandLine);
  1180.    If CommandLine='' Then CommandLine:='0';
  1181.    Val(CommandLine,T,I);
  1182.    Erase_bottom (2,23);
  1183. end;
  1184.  
  1185. Procedure DoRepairs(T:real);
  1186. var
  1187.  I : integer;
  1188. begin
  1189.    If Fnenemy(Quadrant[Quadx,Quady]) Then T:=0.01+Random*0.2;
  1190.    Time_left:=Time_left-T;
  1191.    Stardate:=Stardate+T;
  1192.    If Docked Then T:=T*10;
  1193.      For I:=0 To 7 do
  1194.      begin {for I}
  1195.      Damage[I]:=Damage[I]-T;
  1196.      If Damage[I]<0.01 Then Damage[I]:=0;
  1197.      end; {for I}
  1198.    If Fnenemy(Quadrant[Quadx,Quady]) Then
  1199.      begin {if}
  1200.      writeln('Repairs interrupted by Klingon attack.');
  1201.      Klingon_attack;
  1202.      end
  1203.      Else
  1204.      writeln('Repairs worked on for time ordered.');
  1205.  If screen=fix then Damage_report;
  1206.  If screen<fix then Score_board;
  1207.  end;
  1208.  
  1209. Procedure Repair;
  1210. var
  1211.  i : integer;
  1212.  t : real;
  1213. begin
  1214. RepairTime(t);
  1215. If T>0 Then DoRepairs(T);
  1216. end;
  1217.  
  1218. Procedure HelpText;
  1219. begin
  1220.  writeln('SR=Short range scan  MO=Warp drive     PH=Phasers        RE=Repair      DO=Dock');
  1221.  writeln('LR=Long range scan   WA=Warp speed     PT=Torpedoes      SU=Shields up');
  1222.  writeln('CH=Chart of Galaxy   IM=Impulse drive  DA=Damage report  SD=Shields down');
  1223. end;
  1224.  
  1225. Procedure TitleText;
  1226. begin
  1227.    Screen_erase;
  1228.    Cursor(20,4);
  1229.    writeln('STARTREK');
  1230.    Cursor(20,6);
  1231.    writeln('Public Domain Version to Copy and Enjoy');
  1232.    Cursor(20,8);
  1233.    writeln('by');
  1234.    Cursor(20,10);
  1235.    writeln('David E. Trachtenbarg.');
  1236. end;
  1237.  
  1238. procedure HelpProgram;
  1239. var
  1240.  Command : char;
  1241.  ContinueHelp : Boolean;
  1242.  
  1243.  
  1244. Procedure Intro;
  1245. begin
  1246.    Screen_erase;
  1247.    writeln('Introduction'); writeln('');
  1248.    writeln('After 50 years of peace between the Federation and the Klingon empire');
  1249.    writeln('open war has been declared.  As the commander of the starship Enterprise,');
  1250.    writeln('your mission is to eliminate the Klingon threat and restore peace to the');
  1251.    writeln('Federation.  To ensure peace every Klingon ship must be destroyed.   You');
  1252.    writeln('currently have five stardates to accomplish your mission.  More time may');
  1253.    writeln('be allowed if you are successful.  Good luck commander.  The fate of the');
  1254.    writeln('Federation depends on you.');
  1255.    writeln('');
  1256.    writeln('When starting your command you will be asked to enter your level of');
  1257.    writeln('expertise.  Level 1 is for rookies. Level 5 is only for the most');
  1258.    writeln('experienced commanders.');
  1259. end;
  1260.  
  1261. Procedure Ch;
  1262. begin
  1263.    Screen_erase;
  1264.    If Damage[7]=0 then PlotGalaxy else write('Ship computer has been damaged.');
  1265.    Cursor (1,5);
  1266.    tab(5); writeln('  This display is a chart of the galaxy.  The galaxy is divided up');
  1267.    tab(5); writeln('  into a 10x10 grid of one-hundred different quadrants.  If the');
  1268.    tab(5); writeln('  number of Klingons in a quadrant is not known, the quadrant will');
  1269.    tab(5); writeln('  be 3 dots (...) on the chart.  If the number of Klingons in');
  1270.    tab(5); writeln('  a quadrant is known, a 3 digit number will appear on the chart');
  1271.    tab(5); writeln('  instead.  The first digit is the number of Klingons, the second');
  1272.    tab(5); writeln('  digit is the number of Federation bases, and the third digit is the');
  1273.    tab(5); writeln('  number of stars in the quadrant.  The position of the Enterprise is');
  1274.    tab(5); writeln('  indicated by a box around its position.  Since the information for');
  1275.    tab(5); writeln('  the chart is stored in the ship`s computer, it can not be displayed ');
  1276.    tab(5); writeln('  if the computer is damaged.  The chart command is `CH`.             ');
  1277. end;
  1278.  
  1279. Procedure Lr;
  1280. begin
  1281.    Screen_erase;
  1282.    If Damage[1]=0 then LongGrid else write('Long range sensors have been damaged');
  1283.    Cursor (1,15);
  1284.    writeln('This is a long range scan.  The position of the Enterprise is');
  1285.    writeln('in the middle of the 3x3 grid.  The same 3 digit system is');
  1286.    writeln('used for representing the number of Klingons, bases, and stars');
  1287.    writeln('in a quadrant as in the map of the galaxy.  The quadrant numbers');
  1288.    writeln('are to the left of and below the grid.  The long range sensor');
  1289.    writeln('command is `LR`.');
  1290.  end;
  1291.  
  1292. Procedure Sr;
  1293. begin
  1294.    Screen_erase;
  1295.    If Damage[0]=0 then Grid else write('Short range sensors have been damaged.');
  1296.    cursor(1,2);
  1297.    tab(45); writeln('This is a short range scan of');
  1298.    tab(45); writeln('a quadrant.  Each quadrant is');
  1299.    tab(45); writeln('divided up into a 10x10 grid of');
  1300.    tab(45); writeln('one-hundred sectors.  If a sector');
  1301.    tab(45); writeln('is empty you will see a dot on the');
  1302.    tab(45); writeln('display.  Other symbols are E for');
  1303.    tab(45); writeln('Enterprise, B for Base, * for star,');
  1304.    tab(45); writeln('K for Klingon, and C for a Klingon');
  1305.    tab(45); writeln('commander.  The short range sensor');
  1306.    tab(45); writeln('command is `SR`.');
  1307. end;
  1308.  
  1309. Procedure Score;
  1310. begin
  1311.    Screen_erase;
  1312.    Cursor (1,7);
  1313.    writeln('This is Enterprise`s status display.');
  1314.    writeln('The time remaining is the total number of');
  1315.    writeln('Stardates left that you have to eliminate');
  1316.    writeln('the Klingon threat.  You initially have');
  1317.    writeln('5 stardates, but may be given more time');
  1318.    writeln('as the number of Klingons decreases.');
  1319.    writeln('The number of Klingons listed is the');
  1320.    writeln('total number of Klingons remaining.');
  1321.    writeln('There will be a condition RED if the');
  1322.    writeln('Enterprise is under attack, otherwise');
  1323.    writeln('there will be condition GREEN.');
  1324.    Score_board;
  1325. end;
  1326.  
  1327. Procedure Wa;
  1328. begin
  1329.    Screen_erase;
  1330.    Cursor (1,5);
  1331.    writeln('The command to change the warp speed is `WA`.');
  1332.    writeln('A warp speed above 6 may damage the warp drive.');
  1333.    writeln('The command to move using warp drive is `MO`.');
  1334.    writeln('After typing `MO` you will be asked to specify');
  1335.    writeln('A direction and distance.  The distance is entered');
  1336.    writeln('like the numbers on a clock.');
  1337.    writeln('');
  1338.    writeln( '                          12');
  1339.    writeln( '                        9    1');
  1340.    writeln( '                           6');
  1341.    writeln('');
  1342.    writeln('The distance between two adjacent points in a');
  1343.    writeln('sector is .1, not 1.  The direction and distance');
  1344.    writeln('are entered on one line separated by commas.  For');
  1345.    writeln('example, 1.5,.1 is one possible combination.');
  1346.    Score_board;
  1347. end;
  1348.  
  1349. Procedure Im;
  1350. begin
  1351.    Screen_erase;
  1352.    Cursor (1,7);
  1353.    writeln('The command for impulse drive is `IM`.  Impulse drive is');
  1354.    writeln('slower than warp drive, but uses less energy for short');
  1355.    writeln('distances.  You must enter a direction and distance');
  1356.    writeln('for impulse travel in the same way as they are entered');
  1357.    writeln('for warp travel.');
  1358. end;
  1359.  
  1360. Procedure Ph;
  1361. begin
  1362.    Screen_erase;
  1363.    Cursor (1,7);
  1364.    writeln('The command for phasers is `PH`.  Phasers use');
  1365.    writeln('pure energy.  After entering the phaser');
  1366.    writeln('command you will be asked to enter the direction');
  1367.    writeln('of phaser fire and the amount of energy to use.');
  1368.    writeln('to use.  The direction and energy should be');
  1369.    writeln('entered on one line separated by commas. ');
  1370.    writeln('Your remaining energy level is printed on the');
  1371.    writeln('status display.');
  1372.    Score_board;
  1373. end;
  1374.  
  1375. Procedure Pt;
  1376. begin
  1377.    Screen_erase;
  1378.    Cursor (1,7);
  1379.    writeln('The command to fire photon torpedoes is `PT`.');
  1380.    writeln('Up to 3 photon torpedoes may be fired at once.');
  1381.    writeln('After the `PT` command the direction of');
  1382.    writeln('torpedoe travel must be entered.  Enter');
  1383.    writeln('up to 3 directions separated by commas');
  1384.    writeln('to fire more than one torpedoe.  The ');
  1385.    writeln('number of torpedoes you have left is');
  1386.    writeln('printed in the status display.');
  1387.    Score_board;
  1388. end;
  1389.  
  1390. Procedure Su;
  1391. begin
  1392.    Screen_erase;
  1393.    Cursor (1,7);
  1394.    writeln('The command to bring up the shields is `SU`.');
  1395.    writeln('The command to bring down the shields is `SD`.');
  1396.    writeln('The current state of the shields is printed');
  1397.    writeln('on the status display.');
  1398.    Score_board;
  1399. end;
  1400.  
  1401. Procedure KlingonDescription;
  1402. begin
  1403.    Screen_erase;
  1404.    Cursor (1,9);
  1405.    writeln('There are two types of Klingons.  Regular and Klingon commanders.');
  1406.    writeln('The Klingon commanders are more powerful.  When you start a tour of');
  1407.    writeln('command on the Enterprise you are asked to enter your skill level.');
  1408.    writeln('A higher skill level will entitle you to a more dangerous mission.');
  1409.    writeln('During these more dangerous missions the Klingons are much more');
  1410.    writeln('aggresive and will attempt to move as close as possible to your');
  1411.    writeln('your ship to attack.');
  1412. end;
  1413.  
  1414. Procedure Da;
  1415. begin
  1416.    Screen_erase;
  1417.    DamageInformation;
  1418.    Cursor (1,7);
  1419.    tab(45); writeln('The damage report command is');
  1420.    tab(45); writeln('`DA`.  Repairs are 10 times');
  1421.    tab(45); writeln('faster while docked at a ');
  1422.    tab(45); writeln('starbase. ');
  1423. end;
  1424.  
  1425. Procedure Base;
  1426. begin
  1427.    Screen_erase;
  1428.    Cursor (1,11);
  1429.    writeln('If you are adjacent to a starbase type `DO` to dock.  Your supply');
  1430.    writeln('of energy and photon torpedoes will then be replenished.');
  1431. end;
  1432.  
  1433. Procedure Qg;
  1434. begin
  1435.    Screen_erase;
  1436.    Cursor (1,11);
  1437.    writeln('The command to surrender is `QG` (for quit game).  Of course the');
  1438.    writeln('Federation will be lost if you do this.');
  1439. end;
  1440.  
  1441. Procedure He;
  1442. begin
  1443.    Screen_erase;
  1444.    Cursor (1,7);
  1445.    writeln('The command for help is `HE`.  After typing this the short');
  1446.    writeln('list of commands displayed below will be printed.');
  1447.    Cursor(1,17);
  1448.    HelpText;
  1449. end;
  1450.  
  1451. Procedure Help_index;
  1452.  begin
  1453.    Screen_erase;
  1454.    writeln('');
  1455.    tab(28);
  1456.    writeln('HELP INDEX');
  1457.    writeln('');
  1458.    tab(28); writeln('A. Introduction');
  1459.    tab(28); writeln('B. The galaxy');
  1460.    tab(28); writeln('C. Long range scanner');
  1461.    tab(28); writeln('D. Short range sensors');
  1462.    tab(28); writeln('E. Ship status');
  1463.    tab(28); writeln('F. Warp Drive');
  1464.    tab(28); writeln('G. Impulse Drive');
  1465.    tab(28); writeln('H. Phasers');
  1466.    tab(28); writeln('I. Photon torpedoes');
  1467.    tab(28); writeln('J. Shields');
  1468.    tab(28); writeln('K. Klingons');
  1469.    tab(28); writeln('L. Damage and repairs');
  1470.    tab(28); writeln('M. Starbases');
  1471.    tab(28); writeln('N. Surrendering');
  1472.    tab(28); writeln('O. Help');
  1473.    textcolor(LightBlue);
  1474.    tab(28); writeln('P. Resume command');
  1475.    textcolor(Yellow);
  1476.   repeat
  1477.    Erase_bottom (23,21);
  1478.    write('Enter the letter of your choice. ');
  1479.    Read(KBD,Command);
  1480.    Command:=UpCase(Command);
  1481.    Write(Command);
  1482.   until command in ['A'..'P'];
  1483.  end;
  1484.  
  1485. Procedure Query;
  1486. var com : char;
  1487. begin
  1488.  repeat
  1489.    Erase_bottom (28,24);
  1490.    writeln('Press RETURN to go on.');
  1491.    Cursor (28,25);
  1492.    write('or `I` for main index.  ');
  1493.    read(KBD,Com);
  1494.    com:=UpCase(Com);
  1495.    If Com<>Char(13) then write(Com);
  1496.    If Com='I' Then  Command:='*';
  1497.    If Com=Chr(13) Then
  1498.     begin {if}
  1499.     Command:=Chr(ORD(Command)+1);
  1500.     If command>'O' then command:='*';
  1501.     end; {if}
  1502.  until (com='I') or (Com=Char(13));
  1503. end;
  1504.  
  1505. procedure BranchRoutine;
  1506. begin
  1507.  case command of
  1508.   'A': Intro;
  1509.   'B': Ch;
  1510.   'C': LR;
  1511.   'D': Sr;
  1512.   'E': Score;
  1513.   'F': Wa;
  1514.   'G': Im;
  1515.   'H': Ph;
  1516.   'I': Pt;
  1517.   'J': Su;
  1518.   'K': KlingonDescription;
  1519.   'L': Da;
  1520.   'M': Base;
  1521.   'N': Qg;
  1522.   'O': He;
  1523.   'P': ContinueHelp:=False;
  1524.  end; {case}
  1525.    If (command<>'*') And ContinueHelp then query;
  1526.  end;
  1527.  
  1528. begin
  1529. ContinueHelp:=True;
  1530. Command:='*';
  1531. while ContinueHelp do
  1532. begin
  1533.  If command='*' then Help_index else BranchRoutine;
  1534. end; {while}
  1535. Screen_erase;
  1536. case Screen of
  1537.   short:If Damage[0]=0 then Short_range else Damaged(0);
  1538.   long:If Damage[1]=0 then Long_range else Damaged(1);
  1539.   fix:Damage_report;
  1540.   chart:If Damage[7]=0 then Galaxy else Damaged(7);
  1541.   titlepage:TitleText;
  1542.  else
  1543.   If Damage[0]=0 then Short_range else Damaged(0);
  1544.  end; {case}
  1545. end;
  1546.  
  1547. Procedure Help;
  1548. var
  1549.   command1 : char;
  1550. begin
  1551.   Erase_bottom (1,22);
  1552.   HelpText;
  1553.  repeat
  1554.    Erase_bottom (14,25);
  1555.    write('Press RETURN to go on    OR    `H` for more help. ');
  1556.    read(KBD,Command1);
  1557.    Command1:=UpCase(Command1);
  1558.    If Command1<>Char(13) then write(Command1);
  1559.  until (command1='H') or (Command1=Char(13));
  1560.  If command1='H' then HelpProgram;
  1561. end;
  1562.  
  1563. Procedure Shields_up;
  1564. begin
  1565.  Erase_bottom (2,23);
  1566.  writeln('SHIELDS RAISED.');
  1567.  Shield_status:=1;
  1568.  Energy:=Energy-50;
  1569.  If screen<=fix then Score_board;
  1570.  wait(waitinterval);
  1571. end;
  1572.  
  1573. Procedure Shields_down;
  1574. begin
  1575.   Erase_bottom (2,23);
  1576.   writeln('SHIELDS LOWERED.');
  1577.   Shield_status:=0;
  1578.   if screen<=fix then Score_board;
  1579.   wait(waitinterval);
  1580.  end;
  1581.  
  1582. Procedure Enter_command;
  1583. Var
  1584.  Com : Integer;
  1585.  Command1, Command2 : Char;
  1586.  Command12 : String[2];
  1587.  begin
  1588.    Erase_bottom (1,22);
  1589.    write('Command: ');
  1590.    read(kbd,Command1);
  1591.    Command1:=UpCase(Command1);
  1592.    write(Command1);
  1593.    read(kbd,Command2);
  1594.    Command2:=UpCase(Command2);
  1595.    write(Command2);
  1596.    Command12:=Command1+Command2;
  1597.    Com:=Pos(Command12,'SRLRMOIMPHPTSUCHSDDAREWAQGHEDO');
  1598.    If Com<>0 Then Com:=(Com+2) Div 2;
  1599.    CommandNumber:=Com;
  1600.    case com of
  1601.    1: begin  {Short Range Scanner 0}
  1602.        if Damage[0]=0 then
  1603.        begin {if}
  1604.        Short_range;
  1605.        end   {if}
  1606.        else
  1607.        begin {else}
  1608.        damaged(0);
  1609.        end; {else}
  1610.       end;
  1611.    2: begin  {Long Range Scanner 1}
  1612.        if Damage[1]=0 then
  1613.        begin {if}
  1614.        Long_range;
  1615.        end   {if}
  1616.        else
  1617.        begin {else}
  1618.        damaged(1);
  1619.        end; {else}
  1620.       end;
  1621.    3: begin  {Warp Drive 2}
  1622.        If Damage[2]=0 then
  1623.         begin {if}
  1624.         OK:=True;
  1625.         end {if}
  1626.         else
  1627.         begin {else}
  1628.         damaged(2);
  1629.         OK:=False;
  1630.         end; {else}
  1631.        If OK then DirectionDistance(Direction,Distance,OK);
  1632.        If OK and (Energy<round(Distance*Warp*10+100+Distance*Warp*10*Shield_status)) Then
  1633.         begin {if}
  1634.         Not_enough;
  1635.         OK:=False;
  1636.         end; {if}
  1637.       If OK then
  1638.         begin
  1639.         Destination;
  1640.         LeaveGalaxy(OK);
  1641.         end;
  1642.       If OK and (Sector[EndSecX,EndSecY]>0) and (EndQuadX=QuadX) and (EndQuadY=QuadY) Then
  1643.         begin
  1644.         OK:=False;
  1645.         GameDone:=True;
  1646.         Collision(Sector[EndSecX,EndSecY]);
  1647.         end;
  1648.        If OK then Warp_drive;
  1649.       end;
  1650.    4: begin  {Impulse Drive 3}
  1651.        If Damage[3]=0 then
  1652.         begin {if}
  1653.         OK:=True;
  1654.         end {if}
  1655.         else
  1656.         begin {else}
  1657.         damaged(3);
  1658.         OK:=False;
  1659.         end; {else}
  1660.        If OK then DirectionDistance(Direction,Distance,OK);
  1661.        If Energy<round(Distance*250) Then
  1662.         begin {if}
  1663.         Not_enough;
  1664.         OK:=False;
  1665.         end; {if}
  1666.        If OK then
  1667.         begin
  1668.         Destination;
  1669.         LeaveGalaxy(OK);
  1670.         end;
  1671.        If OK then Impulse;
  1672.       end;
  1673.    5: begin  {Phasers 4}
  1674.        if Damage[4]=0 then
  1675.        begin {if}
  1676.        OK:=true;
  1677.        end   {if}
  1678.        else
  1679.        begin {else}
  1680.        damaged(4);
  1681.        OK:=False;
  1682.        end; {else}
  1683.        If OK then AskPhasers(OK);
  1684.        If OK AND (round(Fire_power)>Energy) Then
  1685.         begin {if}
  1686.         Not_enough;
  1687.         OK:=False;
  1688.         end; {if}
  1689.        If OK then Phasers;
  1690.       end;
  1691.    6: begin  {Photon Torpedoes 5}
  1692.       if Damage[5]=0 then
  1693.        begin {if}
  1694.        OK:=True
  1695.        end   {if}
  1696.        else
  1697.        begin {else}
  1698.        damaged(5);
  1699.        OK:=False;
  1700.        end; {else}
  1701.        If Torpedoes<1 then
  1702.         begin {if1}
  1703.         Erase_bottom (2,23);
  1704.         writeln('You have no torpedoes');
  1705.         wait(WaitInterval);
  1706.         OK:=False;
  1707.         end; {if}
  1708.        If OK then AskDirections(OK);
  1709.        If OK then Firetorpedoes;
  1710.      end;
  1711.    7: begin  {Raise Shields 6}
  1712.        if Damage[6]=0 then
  1713.        begin {if}
  1714.        OK:=True;
  1715.        end   {if}
  1716.        else
  1717.        begin {else}
  1718.        damaged(6);
  1719.        end; {else}
  1720.       If Shield_status=1 Then
  1721.        begin
  1722.        erase_bottom(2,23);
  1723.        writeln('Shields already up.');
  1724.        wait(WaitInterval);
  1725.        OK:=False;
  1726.        end; {If Shield_Status=1}
  1727.       If Energy<=50 Then
  1728.        begin
  1729.        erase_bottom(2,23);
  1730.        writeln('Not enough energy to raise shields.');
  1731.        wait(WaitInterval);
  1732.        OK:=False;
  1733.        end; {If Energy<50}
  1734.       If OK then Shields_Up;
  1735.       end;
  1736.    9: begin  {Lower Shields 6}
  1737.        if Damage[6]=0 then
  1738.         begin {if}
  1739.          OK:=True;
  1740.         end   {if}
  1741.        else
  1742.         begin {else}
  1743.          damaged(6);
  1744.         end; {else}
  1745.        If Shield_status=0 Then
  1746.         begin
  1747.          erase_bottom(2,23);
  1748.          writeln('Shields already down.');
  1749.          wait(WaitInterval);
  1750.          OK:=False;
  1751.         end; {If Shield_Status=0}
  1752.        If OK Then Shields_Down;
  1753.       end;
  1754.    8: begin {Map of Galaxy 7}
  1755.        if Damage[7]=0 then
  1756.        begin {if}
  1757.        Galaxy;
  1758.        end   {if}
  1759.        else
  1760.        begin {else}
  1761.        damaged(7);
  1762.        end; {else}
  1763.       end;
  1764.    10: begin {Damage Report}
  1765.        damage_report;
  1766.        end;
  1767.    11: begin {Repair Ship}
  1768.        repair;
  1769.        end;
  1770.    12: begin {Set Warp Speed 2}
  1771.        if Damage[2]=0 then
  1772.        begin {if}
  1773.        Set_warp;
  1774.        end   {if}
  1775.        else
  1776.        begin {else}
  1777.        damaged(2);
  1778.        end; {else}
  1779.        end;
  1780.    13: begin {Quit Game}
  1781.        GameDone:=True;
  1782.        no_time;
  1783.        end;
  1784.    15: begin {Attempt to dock}
  1785.        dock;
  1786.        end;
  1787.    14: begin {Help Section}
  1788.        help;
  1789.        end
  1790.    else
  1791.    begin {else}
  1792.    If (command2<>Chr(8)) and (command2<>Chr(13)) then
  1793.     begin
  1794.     Erase_bottom (2,23);
  1795.     writeln('Type "HELP" for a list of commands.');
  1796.     wait(WaitInterval);
  1797.     end; {Command2<>chr(8)}
  1798.    end; {else}
  1799.    end; {case}
  1800.    If Klingons=0 Then
  1801.     begin
  1802.     GameDone:=True;
  1803.     Congradulations;
  1804.     end;
  1805.    If (GameDone=False) and (Energy<0) then
  1806.     begin
  1807.     GameDone:=True;
  1808.     No_energy;
  1809.     end; {Energy<0}
  1810.    If (GameDone=False) and (Time_left<0) Then
  1811.     begin
  1812.     GameDone:=True;
  1813.     No_time;
  1814.     end; {If Time_left<0}
  1815. end;
  1816.  
  1817. Procedure Title;
  1818. var
  1819.    I:Integer;
  1820.    Lev:Char;
  1821. begin
  1822.    Screen:=TitlePage;
  1823.    TitleText;
  1824.    repeat
  1825.    Erase_bottom(28,16);
  1826.    writeln('      Press `H` for HELP');
  1827.    Tab(28); writeln('              or');
  1828.    Tab(28); write('Enter your expertise level (1-5): ');
  1829.    Read(KBD,LEV);
  1830.    Val(Lev,Level,I);
  1831.    If Lev in ['H','h'] then
  1832.     begin
  1833.     Screen_erase;
  1834.     cursor(28,12);
  1835.     write('Preparing help section....');
  1836.     level:=1;
  1837.     Initialize;
  1838.     Create_universe;
  1839.     Create_sector;
  1840.     HelpProgram;
  1841.     end;
  1842.    until level in [1..5];
  1843.    Erase_bottom (28,23);
  1844.    writeln('Creating the universe.');
  1845.    Initialize;
  1846.    Create_universe;
  1847.    Create_sector;
  1848.    Short_range;
  1849. end;
  1850.  
  1851. begin {trek}
  1852. repeat
  1853.  title;
  1854.    repeat
  1855.     enter_Command;
  1856.    until GameDone;
  1857.  AnotherGame(ReadyToStop);
  1858. until ReadyToStop;
  1859. end.  {trek}
  1860.