Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TURBOTRK.ZIP/TURBOTRK.PAS

Pascal/Delphi Source File | 1986-09-14 | 49.0 KB | 1,860 lines

{$R+} {Range checking}
{$U+} {User interupt}
{$C+} {Abort and input statement with control C}
{$K+} {Check stack before placing local variables}
{$I+} {I/O error checking}
{$V-} {Strick string checking}

{Integer Bitmap For Quadrant Matrix}
{Scanned  Base  (      Stars      ) Commander (       Klingons       )}
{ 1024    512    128     64     32     16      8      4      2      0}

Program Trek;

Const
  NumLines = 24;

Type
 Triad = array[1..3] of real;
 Display = (short,long,fix,chart,titlepage);
 Line = String[80];

 RegPack = Record Case Integer Of
           1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
           2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
           end;


Var
 Warp, Torpedoes, QuadX, QuadY, SectorX, SectorY : integer;
 Level, Klingons, Total_Klingons, Shield_Status, Com, EndSecX, EndSecY : integer;
 Energy, EndQuadX, EndQuadY, CommandNumber : integer;
 Quadrant : array[1..10,1..10] of integer;
 Sector : array[1..10,1..10] of integer;
 StarDate, Time_Left, X, Y, PosX, PosY, Delta_X, Delta_Y : Real;
 Fire_Power, Direction, Distance, T, Shield_Strength, Total_hits : Real;
 WaitInterval : real;
 Damage : array[0..7] of Real;
 GameDone, ReadyToStop, Docked, OK, SoundOn : Boolean;
 Command, Command1, Command2 : Char;
 Command12 : String[2];
 CommandLine : String[30];
 Plot : Array[0..5] of Char;
 Device : Array[0..7] of String[20];
 Numbers : triad;
 Screen : display;

Procedure Initialize;
var I : integer;
begin
   Randomize;
   Device[0]:='Short range sensors';
   Device[1]:='Long range sensors';
   Device[2]:='Warp engines';
   Device[3]:='Impulse engines';
   Device[4]:='Phasers';
   Device[5]:='Photon torpedoes';
   Device[6]:='Shields';
   Device[7]:='Ship computer';
   Stardate:=2500;
   Time_left:=4.99;
   Plot:='.*KCBE';
   Klingons:=0;
   Energy:=5000;
   Warp:=6;
   Shield_status:=0;
   Shield_strength:=100;
   Torpedoes:=10;
   GameDone:=False;
   ReadyToStop:=False;
   WaitInterval:=1.0;
   For I:=0 to 7 do Damage[I]:=0;
   SoundOn:=True;
 end;

Function FnStars(X:integer) : Integer;
begin
Fnstars:=(X and $01E0) DIV $0020;
end;

Function FnCommander(X:integer) : Integer;
var I : integer;
begin
I:= X and $0010;
If I=0 Then FnCommander:=0 Else FnCommander:=1;
end;

Function Fnklingons(X:integer) : Integer;
begin
Fnklingons:=(X and $000F);
end;

Function Fntotalklingons(X:integer) : Integer;
begin
Fntotalklingons:=Fnklingons(X)+FnCommander(X);
end;

Function FnEnemy(X:integer) : Boolean;
var I : integer;
begin
I:= X and 31;
If I=0 Then FnEnemy:=False Else FnEnemy:=True;
end;

Function FnBase(X:integer) : Integer;
var I : integer;
begin
I:= X and $0200;
If I=0 Then FnBase:=0 Else FnBase:=1;
end;

Function FnScanned(X:integer) : Boolean;
var I : integer;
begin
I:= X and $0400;
If I=0 Then FnScanned:=False Else FnScanned:=True;
end;

Function FnDistance(X1,Y1,X2,Y2:integer) : Real;
begin
Fndistance:=Sqrt((X1-X2)*(X1-X2)+(Y1-Y2)*(Y1-Y2));
end;

Procedure Screen_erase;
begin
ClrScr;
end;

Procedure Cursor(X,Y: integer);
begin
GotoXY(X,Y);
end;

Procedure Tab(X:integer);
var Y : integer;
begin
Y:=WhereY;
GotoXY(X,Y);
end;

Procedure Wait(Time:real);
var i:integer;
begin
Time:=Abs(Time*1000);
If Time>MAXINT then time:=MAXINT;
I:=Round(Time);
Delay(I);
end;

Procedure Erase_line (X,Y:integer);
begin
GotoXY(X,Y);
ClrEol;
end;

Procedure Erase_bottom (X,Y:integer);
var i : integer;
begin
for i:=Y to 25 do
begin {for}
GotoXY(1,I);
ClrEol;
end;  {for}
GotoXY(X,Y);
end;

procedure Explosion;
var frequency,I,J:integer;
begin
 for Frequency:= 30 to 185 do begin Delay(1); Sound(Frequency*2); end;
 for Frequency:= 200 to 30 do begin Delay(1); Sound(Frequency*2); end;
for I:=1 to 225 do
 begin
  J:=random(5)+1;
  If J>3 then Frequency:=random(1000) else frequency:=random(200);
  If I>180 then Frequency:=random(100)+100;
  Sound(Frequency);
  Delay(1);
 end; {for I}
NoSound;
end; {Explosion}

Procedure ColorCharacter(I:Integer);
begin
Case I of
0:textcolor(yellow); {'.' Space}
1:textcolor(lightblue); {'*' Star}
2:textcolor(red); {'K' Klingon}
3:textcolor(lightred); {'C' Klingon Commander}
4:textcolor(Brown); {'B' Base}
5:textcolor(lightgreen); {'E' Enterprise}
end; {Case}
Write(Plot[I]);
Textcolor(yellow);
end;

Procedure Grid;
var I,J : integer;
begin
       For J:=1 To 10 do
       begin {for J}
       write(J:2);
         For I:=1 To 10 do
         begin {for I}
          write('  ');
          ColorCharacter(Sector[I,J]);
          Write(' ');
         end; {for I}
       writeln('');
       writeln('');
       end; {for J};
     writeln('     1   2   3   4   5   6   7   8   9  10');
     Quadrant[Quadx,Quady]:= Quadrant[Quadx,Quady] or 1024;
 end;

Procedure Random_ij(var I,J:Integer);
begin
  repeat
   I:=Random(10)+1;
   J:=Random(10)+1;
  until Sector[I,J]=0;
 end;

Procedure ZeroSector;
var I,J : integer;
begin
for i:=1 to 10 do
 begin {for i}
 for j:=1 to 10 do Sector[i,j]:=0;
 end; {i}
end;

Procedure Create_sector;
var i,j,l : integer;
begin
   ZeroSector;
   Sector[Sectorx,Sectory]:=5;
   If Fncommander(Quadrant[Quadx,Quady])>0 Then
      begin {if}
      Random_ij(I,J);
      Sector[I,J]:=3;
      end; {if}
   If Fnbase(Quadrant[Quadx,Quady])>0 Then
      begin {if}
      Random_ij(I,J);
      Sector[I,J]:=4;
      end; {if}
   If Fnklingons(Quadrant[Quadx,Quady])>0 Then
     begin {if}
     For L:=1 To Fnklingons(Quadrant[Quadx,Quady]) do
      begin {for l}
      Random_ij(I,J);
      Sector[I,J]:=2;
      end; {for L};
     end; {if}
    If Fnstars(Quadrant[Quadx,Quady])>0 Then
      begin {if}
      For L:=1 To Fnstars(Quadrant[Quadx,Quady]) do
      begin {for L}
      Random_ij(I,J);
      Sector[I,J]:=1;
      end; {for L};
      end; {if}
 end;

Procedure Create_universe;
var i,j,k,l,m,bases : integer;
begin
     ZeroSector;
     Random_ij(Quadx,Quady);
     Random_ij(Sectorx,Sectory);
     bases:=0;
     For I:=1 To 10 do
       begin {for I}
       For J:=1 To 10 do
       begin {for J}
       Quadrant[I,J]:=Random(9)*32;  {Number of stars}
       K:=Random(100);
       If (K<(7-Level)) Then {Base}
        begin
        Quadrant[I,J]:=Quadrant[I,J]+512;
        bases:=bases+1;
        end;
       K:=random(100);
       If K<(20+Level*5) Then
         begin {if1}
         If K>25 Then M:=Random(Level*2)+1 else M:=random(2)+1;
         Quadrant[I,J]:=Quadrant[I,J]+M;
         Klingons:=Klingons+M; {Regular Klingons}
         L:=random(100);
         If L<(Level*5+1) Then
            begin {if2}
            Quadrant[I,J]:=Quadrant[I,J]+16;  {Klingon Commander}
            Klingons:=Klingons+1;
            end; {if2}
         end {if1}
       end; {for J}
     end; {for i}
 If bases=0 then {Make sure there is at least one base}
   begin
   Random_ij(I,J);
   Quadrant[I,J]:=Quadrant[I,J]+512;
   end;
   Total_Klingons:=Klingons;
end;

Procedure Damaged(I:Integer);
begin
   Erase_bottom (2,23);
   writeln('Damage to ',Device[I]);
   wait(WaitInterval);
 end;

Procedure Score_board;
begin
   Cursor(52,1);
   writeln('STARDATE: ',StarDate:5:2);
   Cursor(52,3);
   writeln('POSITION');
   Tab(53);
   writeln(' QUADRANT ',Quadx,',',Quady);
   Tab(53);
   writeln(' SECTOR   ',Sectorx,',',Sectory);
   Cursor(52,7);
   writeln('TIME REMAINING: ',Time_left:3:2);
   Cursor(52,9);
   writeln('KLINGONS: ',Klingons,' ');
   Cursor(52,11);
   writeln('ENERGY: ',Energy:5,' ');
   Cursor(52,13);
   If Shield_status=0 Then writeln('SHIELDS DOWN');
   If Shield_status=1 Then writeln('SHIELDS UP  ');
   Tab(52);
   writeln(' SHIELD STRENGTH: ',Shield_Strength:4:1,'%  ');
   Cursor(52,16);
   writeln('TORPEDOES: ',Torpedoes:2,' ');
   Cursor(52,18);
   writeln('WARP: ',Warp:2);
   Cursor(52,20);
   If Fnenemy(Quadrant[Quadx,Quady]) Then
     begin {if2}
     textcolor(Red);
     writeln('CONDITION: RED  ');
     textcolor(Yellow);
     end {if2}
     else
     begin {else}
     textcolor(Green);
     writeln('CONDITION: GREEN');
     textcolor(Yellow);
     end; {else}
end;

Procedure Short_range;
begin
 Screen_erase;
 screen:=short;
 Grid;
 Score_board;
end;

Procedure Get_numbers(var numbers : triad);
{Needs to be converted into an independent subroutine.  Now}
{uses global variable CommandLine.}
var
 Command1Line : String[30];
 SubString : String[30];
 J,K,L : integer;
begin
 Command1Line:=CommandLine;
 For L:=1 to 3 do Numbers[L]:=-1;
 L:=1;
 While Pos(',',Command1Line)>0 do
 begin {while}
 K:=Pos(',',Command1Line);
 SubString:=Copy(Command1Line,1,K-1);
 Val(SubString,Numbers[L],J);
 Delete(Command1Line,1,K);
 L:=L+1;
 end; {while}
 If Length(Command1Line)=0 Then Numbers[L]:=-1 Else Val(Command1Line,Numbers[L],J);
end;

Procedure Not_enough;
begin
   Erase_bottom (2,23);
   writeln('Not enough energy.');
   wait(WaitInterval);
end;

Procedure AnotherGame(Var ReadyToStop : Boolean);
Var Character : char;
begin
repeat
   Erase_bottom(30,18);
   write('ANOTHER GAME (y/n)? ');
   Read(KBD,Character);
   Character:=UpCase(Character);
until (Character='N') or (Character='Y');
If Character='N' then ReadyToStop:=True else ReadyToStop:=False;
end;

Procedure Prisoner;
begin
   Cursor(5,10);
   writeln('YOU ARE TAKEN PRISONER BY THE KLINGONS UNTIL THE END OF THE CONFLICT.');
 end;

Procedure No_energy;
begin
 Screen_erase;
 Cursor(17,4);
 writeln('THE ENTERPRISE HAS BEEN TOTALLY DISTROYED');
 Prisoner;
end;

Procedure No_time;
begin
   Screen_erase;
   Cursor(12,4);
   writeln('YOU HAVE FAILED TO ELIMINATE THE KLINGON THREAT IN TIME.');
   Cursor(25,11);
   writeln('THE FEDERATION HAS SURRENDERED.');
 end;

Procedure Collision(I:Integer);
begin
   Screen_erase;
   Cursor(8,4);
   write('THE ENTERPRISE HAS BEEN DESTROYED BY A COLLISION WITH A ');
   If I=1 Then writeln('STAR.');
   If I=2 Then writeln('KLINGON.');
   If I=3 Then writeln('KLINGON COMMANDER.');
   If I=4 Then writeln('STARBASE.');
   If (I<1) or (I>4) then
   begin
    writeln('');
    writeln('Error I= ',I);
   end;
   Prisoner;
 end;

Procedure Spiral (SectorX,SectorY:integer;Var FreeX,FreeY:integer);
var I,J,K,Box : integer;
begin
 Box:=Random(3)+1;
 FreeX:=0;
 FreeY:=0;
 repeat
 begin {repeat}
 J:=random(4)+1;
 K:=2*Box+1;

 case j of

 1:
 begin {case 1}
  I:=Random(K)+(SectorX-Box);
   If (I in [1..10]) and ((SectorY+Box) in [1..10]) and ((FreeX=0) and (FreeY=0)) then
   begin  {Range Check [1..10}
   If Sector[I,SectorY+Box]=0 Then
    begin
    FreeX:=I;
    FreeY:=SectorY+Box;
    end;
   end; {Range Check [1..10}
 end; {case 1}

 2:
 begin {case 2}
  I:=Random(K)+(SectorX-Box);
   If (I in [1..10]) and ((SectorY-Box) in [1..10]) and ((FreeX=0) and (FreeY=0)) then
   begin {Range Check [1..10}
   If Sector[I,SectorY-Box]=0 Then
    begin
    FreeX:=I;
    FreeY:=SectorY-Box;
    end;
   end; {Range Check [1..10}
 end; {case 2}

 3:
 begin {case 3}
  I:=Random(K)+(SectorY-Box);
   If (I in [1..10]) and ((SectorX+Box) in [1..10]) and ((FreeX=0) and (FreeY=0)) then
   begin {Range Check [1..10}
   If Sector[SectorX+Box,I]=0 Then
    begin
    FreeX:=SectorX+Box;
    FreeY:=I;
    end;
   end; {Range Check [1..10}
  end; {case 3}

4:
begin {case 4}
  I:=Random(K)+(SectorY-Box);
   If (I in [1..10]) and ((SectorX-Box) in [1..10]) and ((FreeX=0) and (FreeY=0)) then
   begin {Range Check [1..10}
   If Sector[SectorX-box,I]=0 Then
    begin
    FreeX:=SectorX-Box;
    FreeY:=I;
    end;
   end; {Range Check [1..10}
end; {case 4}
end; {case}

 Box:=Box+1;
 end; {repeat}
 until (box>10) or ((FreeX>0) and (FreeY>0));
end;  {Procedure Spiral}


Procedure Attackers (Move:integer);
Var
 I,J,K,L,M,N,O : integer;
begin
     For J:=(Quady-1) To(Quady+1) do
     begin {for J}
       For I:=(Quadx-1) To(Quadx+1) do
       begin {for I}
       If ((I in [1..10]) and (j in [1..10])) and ((Quadx<>I) And (Quady<>J)) Then
       begin {if}
       K:=FnKlingons(Quadrant[I,J]);
       If ((K>0) and (K<8)) Then
        begin {if1}
           For L:=1 To K do
           begin {for L}
           M:=random(100);
           If (M<Move) and (Fnklingons(Quadrant[Quadx,Quady])<(4+Level*2)) Then
            begin {if2}
             Quadrant[I,J]:=Quadrant[I,J]-1;
             Quadrant[Quadx,Quady]:=Quadrant[Quadx,Quady]+1;
             Quadrant[I,J]:=Quadrant[I,J] and $FBFF;  {Not scanned}
             repeat
             Spiral(SectorX,SectorY,M,N);
             until (M in [1..10]) and (N in [1..10]);
             Sector[M,N]:=2;
             If (screen=short) and (Damage[0]=0) then
              begin
              Cursor(1+(M*4),(N-1)*2+1);
              ColorCharacter(2);
              end; {If screen=short then plot moves}
            end; {if2}
           end; {for L}
         end; {if 1}
       If FnCommander(Quadrant[I,J])>0 Then
        begin {if1}
           M:=random(100);
           If (M<Move) and (FnCommander(Quadrant[Quadx,Quady])=0) Then
            begin {if2}
             Quadrant[I,J]:=Quadrant[I,J]-16;
             Quadrant[Quadx,Quady]:=Quadrant[Quadx,Quady]+16;
             Quadrant[I,J]:=Quadrant[I,J] and $FBFF;  {Not scanned}
             repeat
             Spiral(SectorX,SectorY,M,N);
             until (M in [1..10]) and (N in [1..10]);
             Sector[M,N]:=3;
             If (screen=short) and (Damage[0]=0) then
              begin
              Cursor(1+(M*4),(N-1)*2+1);
              ColorCharacter(3);
              end; {If screen=short then plot moves}
            end; {if2}
         end; {if 1}
        end; {if}
       end; {for I}
     end; {for J}
 end;

Procedure Check_path(Direction,Distance:real;Sectx,Secty:integer;var K,L,Missed:Integer);
Var
   J,M,N:integer;
   Posx, Posy, Delta_x, Delta_y, T : real;
begin
   Delta_x:=Sin(Direction*0.523581);
   Delta_y:=-1*Cos(Direction*0.523581);
   Missed:=0;
   J:=0;
     While Missed=0 do
     begin {while}
     J:=J+1;
     Posx:=Sectx+Delta_x*J;
     Posy:=Secty+Delta_y*J;
     If Distance>0 Then
       begin {if1}
       K:=round(Delta_x*J);
       L:=round(Delta_y*J);
       T:=Fndistance(K,L,0,0);
       If T>=Distance Then Missed:=-1;
       End; {if1}
     If (Posx<1) or (Posx>10) or (Posy<1) or (Posy>10)  Then
       begin {if1}
       If (Posx<0.98) or (Posx>10.02) or (Posy<0.98) or (Posy>10.02) Then Missed:=-1;
       If Posx<1 Then Posx:=1;
       If Posy<1 Then Posy:=1;
       If Posx>10 Then Posx:=10;
       If Posy>10 Then Posy:=10;
       end; {if1}
     K:=round(PosX);
     L:=round(PosY);
     If (Sector[K,L]>0)
        And ((Abs(Sectx-PosX)>0.5) Or (Abs(Secty-PosY)>0.5)) Then
      Begin {if}
      if (SectorX=SectX) and (SectorY=SectY) then
       begin {if}
       Missed:=Sector[K,L];
       end {if}
       else
       begin {else}
       case Sector[K,L] of
       1:Missed:=Sector[K,L];
       4:Missed:=Sector[K,L];
       5:Missed:=Sector[K,L];
       end; {case}
       end; {else}
      End {if}
      Else
      Begin {else}
      If (Screen=short) and (damage[0]=0) and ((SectorX<>K) and (SectorY<>L)) then
       begin {if screen=short}
        M:=K*4+1;
        N:=1+(L-1)*2;
        Cursor(M,N);
        write('Θ');
        wait(0.125);
        Cursor(M,N);
        If ((M Mod 4)=1) and ((N Mod 2)=1) Then write('.') else write(' ');
       end; {if screen=short}
      End; {Else}
     End; {while}
end;


Procedure Mover(Sectorx,Sectory,EndSecX,EndSecY,I:integer);
begin
  If (Screen=short) and (Damage[0]=0) then
   begin
    Cursor(1+(Sectorx*4),(Sectory-1)*2+1);
    ColorCharacter(0);
    Cursor(1+(EndSecX*4),(EndSecY-1)*2+1);
    ColorCharacter(I);
   end; {If Screen=short then plot moves}
   Sector[Sectorx,Sectory]:=0;
   Sector[EndSecX,EndSecY]:=I;
 end;

Procedure Klingon_attack;
var
  I,J,K,L,M,N,O,P,Q,Missed : integer;
 begin
   If Level>4 Then Attackers(2*Level);
   Total_hits:=0;
     For I:=1 To 10 do
     begin {for I}
       For J:=1 To 10 do
       begin {for J}
       If (Sector[J,I]=2) Or (Sector[J,I]=3) Then
         begin {If Klingons then attack}
         L:=random(100);
         If (L>30) Or (Level>4) Then
           begin {if2}
           Direction:=Arctan((Sectorx-J)/(I-Sectory+1E-10))/(0.523581);
           If I<Sectory Then Direction:=Direction+6;
           If Direction<0 then direction:=direction+12;
           Check_path(Direction,0,J,I,P,Q,Missed);
           If Missed=5 then
            begin {Missed=5}
             Fire_power:=501.0/Fndistance(Sectorx,Sectory,J,I);
             If Sector[J,I]=3 Then Fire_power:=Fire_power*3;
             If Shield_status=1 Then Shield_strength:=Shield_strength-Fire_power/50.0;
             If Shield_strength<0 Then Shield_strength:=0;
             If Shield_status=1 Then Fire_power:=Fire_power*(1-(Shield_strength/100.0));
            {If Com=6 Then Fire_power:=Fire_power*1.5;}
             If Docked=False Then Fire_power:=Fire_power*Level*0.15;
             Energy:=Energy-round(Fire_power);
             Total_hits:=Total_hits+Fire_power;
             Erase_bottom (2,23);
             writeln('You lost ',Trunc(Fire_power),' giga ergs from the Klingon attacking at ',J,',',I,'.');
             if screen<=fix then score_board;
             wait(WaitInterval);
             K:=random(150+Trunc(fire_power));
             If Fire_power>K Then
              begin
              K:=Random(7);
              Damage[K]:=abs((Ln(Fire_power)*Random)/20.0)+Damage[K];
              If Damage[K]<1E-02 Then Damage[K]:=0;
              If Damage[K]>0 then
               begin
                Erase_bottom (2,23);
                writeln('Klingon attack damaged ',Device[K]);
                If K=6 Then
                 begin
                  Shield_status:=0;
                 end; {if K=6}
                Wait(WaitInterval);
               end; {if Damage[K]>0}
              end; {if Fire_power>K}
            end {If Missed=5}
            else {If Missed=5}
             begin
             Erase_bottom (2,23);
             writeln('The Klingon attacking at ',J,',',I,' missed.');
             wait(WaitInterval);
             end; {Else If Missed=5}
           end; {if2}
           L:=random(100);
         If ((L<5) and (Fire_Power<100) and (Level>3)) or ((Missed<>5) and (Level>1)) then
           begin
             Spiral(SectorX,SectorY,M,N);
             If (M in [1..10]) and (N in [1..10]) then Mover(J,I,M,N,Sector[J,I]);
            end; {If Missed or Small Hit Then Move Klingons}
         end; {If Klingons then attack}
       end {for J};
     end {for I};
 Erase_bottom (2,23);
 If Total_hits>0 Then writeln('You lost ',Trunc(Total_hits),' giga ergs from the Klingon attack.');
 If Level>2 Then Attackers(2*Level);
 If screen<=fix then Score_board;
 end;

Procedure Sector_travel;
begin
   Mover(Sectorx,Sectory,EndSecX,EndSecY,5);
   Sectorx:=EndSecX;
   Sectory:=EndSecY;
   If Level>3 Then Attackers(2*Level);
   if screen<=fix then Score_board;
   If Fnenemy(Quadrant[Quadx,Quady]) Then Klingon_attack;
 end;

Procedure Quadrant_travel;
var
 I : integer;
begin
 If (Fnenemy(Quadrant[Quadx,Quady])) and (Level>1) Then Klingon_attack;
 Quadx:=EndQuadX;
 Quady:=EndQuadY;
 Sectorx:=EndSecX;
 Sectory:=EndSecY;
 Create_sector;
 If Damage[0]=0 then
  begin
  short_range;
  end  {If Damage[0]=0}
  else
  begin {else}
  Screen_erase;
  screen:=short;
  damaged(0);
  Score_board;
  end; {else}
 If (Level>2) And (Fntotalklingons(Quadrant[Quadx,Quady])>0) Then Attackers(2*level);
 If Fnenemy(Quadrant[Quadx,Quady]) and (Level>4) Then Klingon_attack;
   If (Warp>6) Then
   begin {If1}
     I:=random(150);
     If I<(Warp*Distance) Then
      begin {if2}
      Damage[2]:=Random*Warp;
      Erase_bottom (2,23);
      writeln('Warp drive is damaged from high speed.');
      wait(WaitInterval);
      end; {if2}
   end; {if1}
 end;

Procedure New_location;
begin
   Docked:=False;
   If (Quadx=EndQuadX) And (Quady=EndQuadY) Then Sector_travel else Quadrant_travel;
 end;

Procedure Destination;
var x,y : real;
begin
   Delta_x:=Distance*Sin(Direction*0.523581);
   Delta_y:=-Distance*Cos(Direction*0.523581);
   X:=Delta_x+Sectorx/10.0+Quadx;
   Y:=Delta_y+Sectory/10.0+Quady;
   EndQuadX:=Trunc(X);
   EndQuadY:=Trunc(Y);
   EndSecX:=Round(Frac(X)*10);
   EndSecY:=Round(Frac(Y)*10);
   If EndSecX<1 Then
   begin
   EndQuadX:=EndQuadX-1;
   EndSecX:=10;
   end;
   If EndSecY<1 Then
   begin
   EndQuadY:=EndQuadY-1;
   EndSecY:=10;
   end;
   If EndSecX>10 Then
   begin
   EndQuadX:=EndQuadX+1;
   EndSecX:=1;
   end;
   If EndSecY>10 then
   begin
   EndQuadY:=EndQuadY+1;
   EndSecY:=1;
   end;
 end;

Procedure DirectionDistance(Var Direction,Distance : real; var OK : Boolean);
begin
   Repeat
    Erase_bottom (2,22);
    If CommandNumber=3 then write('For warp travel');
    If CommandNumber=4 then write('For impulse travel');
    write(' enter direction, distance: ');
    Read(CommandLine);
    Get_numbers(Numbers);
    Direction:=Numbers[1];
    Distance:=Numbers[2];
   Until ((Direction>=0) and (Direction<=12) and (Distance>=0.1)) or ((Direction<=0) and (Distance<=0));
  If (Direction<=0) and (Distance<=0) Then OK:=False Else OK:=True;
end;

Procedure LeaveGalaxy(Var OK : Boolean);
begin
 If (EndQuadX>10) Or (EndQuadY>10) Or (EndQuadX<1) Or (EndQuadY<1) Then
  begin {if}
  Erase_bottom (2,23);
  writeln('You can`t leave the galaxy.');
  wait(WaitInterval);
  OK:=False;
  end {if}
end;

Procedure Warp_drive;
begin
  Energy:=Energy-round((Distance*Warp*10.0)+100+Distance*Warp*10*Shield_status);
  cursor(1,24);
  Time_left:=Time_left-Distance*(1.5/(Warp*Warp));
  Stardate:=Stardate+Distance*(1.5/(Warp*Warp));
  New_location;
 end;

Procedure Set_warp;
var I,J : integer;
begin
   Erase_bottom (2,22);
   write('Set warp speed to? ');
   read(trm,Command1);
   Val(Command1,I,J);
   Erase_bottom (2,23);
   If (I<1) Or (I>10) Then
    begin {if1}
    writeln('The Enterprise won`t go that fast.');
    end; {if1}
   Warp:=I;
   If Warp<=6 Then writeln('Warp speed set to ',I,'.');
   If Warp>6 Then writeln('A warp speed of ',I,' may damage the drive.');
   If screen<=fix then Score_board;
   wait(waitinterval);
 end;

Procedure PlotGalaxy;
var I,J, X, Y : integer;
begin
     For J:=1 To 10 do
     begin {for J}
     write(J:2);
       For I:=1 To 10 do
       begin {for I}
       If  Fnscanned(Quadrant[I,J]) then
       begin {if}
       if Fnenemy(Quadrant[I,J]) then textcolor(red);
       write((Fntotalklingons(Quadrant[I,J])):3);
       write(Fnbase(Quadrant[I,J]),Fnstars(Quadrant[I,J]),' ');
       textcolor(yellow);
       end {if}
       else
       begin {else}
       If Fnbase(Quadrant[I,J])>0 Then write('  .1. ') else write('  ... ');
       end; {else}
       end; {for I}
     writeln('');
     writeln('');
     end; {for J}
   writeln('     1     2     3     4     5     6     7     8     9    10');
 X:=Quadx*6;
 Y:=Quady*2-2;
 Cursor(X,Y+2);
 writeln('=');
   If Y>1 Then
    begin {if1}
    Cursor(X,Y);
    writeln('=');
    end; {if1}
   Cursor(X-3,Y+1);
   writeln('|');
   Cursor(X+2,Y+1);
   writeln('|');
 end;

Procedure Galaxy;
begin
   Screen:=chart;
   Screen_erase;
   PlotGalaxy;
end;

Procedure LongGrid;
var I,J : integer;
begin
   writeln('LONG RANGE SCAN FROM QUADRANT ',Quadx,',',Quady,'.');
   writeln('');
   writeln('');
     For J:=(Quady-1) To (Quady+1) do
     begin {for J}
     if (J>0) and (J<11) then
      write(' ',J:2)
      else
      write('   ');
       For I:=(Quadx-1) To (Quadx+1) do
       begin {for I}
       If (I<1) Or (J<1) Or (I>10) Or (J>10) Then
       write( '        ')
       else
       begin {else}
       if Fnenemy(Quadrant[I,J]) then textcolor(red);
       write( '    ',(Fntotalklingons(Quadrant[I,J])):2);
       write(Fnbase(Quadrant[I,J]),Fnstars(Quadrant[I,J]));
       Quadrant[I,J]:=Quadrant[I,J] or 1024;
       textcolor(yellow);
       end; {else}
       end; {for I};
     writeln('');
     writeln('');
     writeln('');
     end; {for J}
     write('  ');
     for I:=-1 to 1 do
     begin {for I}
      if ((Quadx+I)>0) and ((Quadx+I)<11) then
      write('      ',(Quadx+I):2)
      else
      write('       ');
      end; {for I}
 end;

Procedure Long_Range;
begin
   Screen_erase;
   screen:=long;
   LongGrid;
   Score_board;
end;

Procedure Congradulations;
begin
   Screen_erase;
   Cursor(28,4);
   writeln('CONGRATULATIONS CAPTAIN!!');
   Cursor(21,11);
   writeln('THE KLINGON THREAT HAS BEEN ELIMINATED.');
 end;

Procedure Struck(X,Y:Integer);
begin
  If Sector[X,Y] in [2,3] then
   begin
   Klingons:=Klingons-1;
   Time_left:=Time_left+(0.03)*(Total_klingons/(Klingons+1));
   If Sector[X,Y]=2 Then Quadrant[Quadx,Quady]:=Quadrant[Quadx,Quady]-1;
   If Sector[X,Y]=3 Then Quadrant[Quadx,Quady]:=Quadrant[Quadx,Quady]-16;
   if (Damage[0]=0) and (screen=short) then
   begin
    Cursor(1+(X*4),(Y-1)*2+1);
    writeln('.');
   end;
   Erase_bottom (2,23);
   If SoundOn and (Sector[X,Y] in [2,3]) then explosion;
   If Sector[X,Y]=2 Then write('You eliminated the Klingon ship with a ');
   If Sector[X,Y]=3 Then write('You eliminated the Klingon commander with a ');
   If CommandNumber=5 then write( trunc(Fire_power),' giga erg hit.');
   If CommandNumber=6 then write('torpedo.');
   Sector[X,Y]:=0;
   end {If Sector[X,Y] in [2,3]}
   else
   begin {else}
   Erase_bottom (2,23);
   If Sector[X,Y]=1 Then write('You hit a star!!');
   If Sector[X,Y]=4 Then
    begin {If a base}
    write('You destroyed a Federation base!');
    Cursor(1+(X*4),(Y-1)*2+1);
    writeln('.');
    Sector[X,Y]:=0;
    Quadrant[Quadx,Quady]:=Quadrant[Quadx,Quady] and 1279;
    end; {If a base}
   end; {else}
   wait(WaitInterval);
 end;

Procedure Miss(EndSecX,EndSecY:integer);
begin
   Cursor(1+(EndSecX*4),(EndSecY-1)+1);
   Erase_bottom (2,23);
   If Sector[EndSecX,EndSecY]=0 Then writeln('You fired into empty space!');
   If Sector[EndSecX,EndSecY]=1 Then writeln('You hit a star!');
   If (Sector[EndSecX,EndSecY]=2) Or (Sector[EndSecX,EndSecY]=3) Then
   writeln('A ',trunc(Fire_power),' giga erg hit failed to break the Klingon`s screen');
   If Sector[EndSecX,EndSecY]=4 Then writeln('You hit your own base!');
   Wait(WaitInterval);
 end;

Procedure AskPhasers(var OK : Boolean);
begin
   Erase_bottom (2,22);
   write('Enter direction,energy. ');
   read(CommandLine);
   Get_numbers(Numbers);
   Direction:=Numbers[1];
   Fire_power:=Numbers[2];
   If (Direction<0) Or (Direction>12) Then OK:=False;
   If Fire_power<1 Then OK:=False;
end;

Procedure Phasers;
var
   x,y,z : real;
   I,J,Missed : Integer;
begin
   Energy:=Energy-round(Fire_power);
   Check_path(Direction,0,Sectorx,Sectory,I,J,Missed);
   Fire_power:=(5/(Fndistance(Sectorx,Sectory,I,J)+0.001))*Fire_power;
   If((Fire_power>=500) And (Sector[I,J]=2)) Or ((Fire_power>=1500) And (Sector[I,J]=3)) Then
     Struck(I,J)
     Else
     Miss(I,J);
  Klingon_attack;
 end;

Procedure AskDirections(var OK:Boolean);
var I : integer;
begin
   Erase_bottom (2,22);
   Cursor(2,23);
   write('You may fire ');
   If Torpedoes>3 then I:=3 else I:=torpedoes;
   If I>1 Then write('up to ',I,' torpedoes.') Else Write('1 torpedoe.');
   Cursor(2,22);
   write('Directions to fire? ');
   read(CommandLine);
   Get_numbers(Numbers);
   If Numbers[1]<0 Then OK:=False;
end;

Procedure FireTorpedoes;
var
   x,y,z : real;
   I,P,Q,Missed : integer;
begin
     For I:=1 To 3 do
     begin {for I}
     If (Numbers[I]>=0) and (Numbers[I]<=12) then
     begin {if}
     If Torpedoes<1 Then
      begin {if}
      Erase_bottom (2,23);
      writeln('You have no more torpedoes');
      wait(WaitInterval);
      end {if}
      else
      begin {else}
      Torpedoes:=Torpedoes-1;
      Check_path(Numbers[I],0,Sectorx,Sectory,P,Q,Missed);
      If Missed=-1 Then Miss(P,Q) else Struck(P,Q);
      end; {else}
     end; {if}
     end; {for I}
   Klingon_attack;
 end;

Procedure Dock;
var I, J : integer;
begin
     For J := Sectory-1 To Sectory+1 do
     begin {for J}
       For I:=Sectorx-1 To Sectorx+1 do
       begin {for I}
        If (I in [1..10]) and (J in [1..10]) Then
         begin
          If Sector[I,J]=4 Then Docked:=True;
         end; {if}
       end; {for I}
     end; {for J}
   If Docked Then
     begin {if}
     Energy:=5000;
     Torpedoes:=10;
     Shield_strength:=100;
     Erase_bottom (2,23);
     writeln('Enterprise docked at starbase.');
     If screen<=fix then  Score_board;
     end {if}
     Else
     begin {else}
     Erase_bottom (2,23);
     writeln('Enterprise not adjacent to starbase.');
     end; {else}
    Wait(WaitInterval);
 end;

Procedure Impulse;
var
 P,Q,Missed : integer;
begin
   Cursor(1+(Sectorx)*4,(Sectory-1)*2+1);
   writeln('. ');
   Check_path(Direction,Distance*10,Sectorx,Sectory,P,Q,Missed);
   If Missed>0 Then
     begin {if}
     Erase_bottom (2,23);
     writeln('Safety system stops collision.');
     Wait(WaitInterval);
     EndSecX:=Sectorx;
     EndSecY:=Sectory;
     EndQuadX:=Quadx;
     EndQuadY:=Quady;
     end; {if}
   Energy:=Energy-round(Distance*250);
   Time_left:=Time_left-0.05*Distance;
   Stardate:=Stardate+Distance*0.05;
   New_location;
 end;

Procedure Damage_numbers;
var I, Y : integer;
begin
     For I:=0 To 7 do
     begin {for I}
     Y:=I*2+6;
     Cursor(30,Y);
     textcolor(Red);
     If (Damage[I]>0) And (Docked=False) Then writeln(Damage[I]:3:3);
     If (Damage[I]>0) And (Docked) Then writeln((Damage[I]/10):3:3);
     textcolor(Yellow);
     If Damage[I]=0 Then writeln('  OK    ');
     end; {for I}
end;

Procedure DamageInformation;
var I : integer;
begin
   writeln('');
   writeln('           DAMAGE REPORT');
   writeln('');
   writeln('System                     Repair Time');
   writeln('');
     For I:=0 To 7 do
     begin {for I}
     If Damage[I]>0 then textcolor(red);
     writeln(Device[I]);
     textcolor(yellow);
     writeln('');
     end; {for I}
   Damage_numbers;
 end;

Procedure Damage_Report;
begin
   Screen_erase;
   Screen:=fix;
   DamageInformation;
   Score_board;
end;

Procedure RepairTime(var T:real);
var i : integer;
begin
   Erase_bottom (2,22);
   write('Work on repairs for how long? ');
   read(CommandLine);
   If CommandLine='' Then CommandLine:='0';
   Val(CommandLine,T,I);
   Erase_bottom (2,23);
end;

Procedure DoRepairs(T:real);
var
 I : integer;
begin
   If Fnenemy(Quadrant[Quadx,Quady]) Then T:=0.01+Random*0.2;
   Time_left:=Time_left-T;
   Stardate:=Stardate+T;
   If Docked Then T:=T*10;
     For I:=0 To 7 do
     begin {for I}
     Damage[I]:=Damage[I]-T;
     If Damage[I]<0.01 Then Damage[I]:=0;
     end; {for I}
   If Fnenemy(Quadrant[Quadx,Quady]) Then
     begin {if}
     writeln('Repairs interrupted by Klingon attack.');
     Klingon_attack;
     end
     Else
     writeln('Repairs worked on for time ordered.');
 If screen=fix then Damage_report;
 If screen<fix then Score_board;
 end;

Procedure Repair;
var
 i : integer;
 t : real;
begin
RepairTime(t);
If T>0 Then DoRepairs(T);
end;

Procedure HelpText;
begin
 writeln('SR=Short range scan  MO=Warp drive     PH=Phasers        RE=Repair      DO=Dock');
 writeln('LR=Long range scan   WA=Warp speed     PT=Torpedoes      SU=Shields up');
 writeln('CH=Chart of Galaxy   IM=Impulse drive  DA=Damage report  SD=Shields down');
end;

Procedure TitleText;
begin
   Screen_erase;
   Cursor(20,4);
   writeln('STARTREK');
   Cursor(20,6);
   writeln('Public Domain Version to Copy and Enjoy');
   Cursor(20,8);
   writeln('by');
   Cursor(20,10);
   writeln('David E. Trachtenbarg.');
end;

procedure HelpProgram;
var
 Command : char;
 ContinueHelp : Boolean;


Procedure Intro;
begin
   Screen_erase;
   writeln('Introduction'); writeln('');
   writeln('After 50 years of peace between the Federation and the Klingon empire');
   writeln('open war has been declared.  As the commander of the starship Enterprise,');
   writeln('your mission is to eliminate the Klingon threat and restore peace to the');
   writeln('Federation.  To ensure peace every Klingon ship must be destroyed.   You');
   writeln('currently have five stardates to accomplish your mission.  More time may');
   writeln('be allowed if you are successful.  Good luck commander.  The fate of the');
   writeln('Federation depends on you.');
   writeln('');
   writeln('When starting your command you will be asked to enter your level of');
   writeln('expertise.  Level 1 is for rookies. Level 5 is only for the most');
   writeln('experienced commanders.');
end;

Procedure Ch;
begin
   Screen_erase;
   If Damage[7]=0 then PlotGalaxy else write('Ship computer has been damaged.');
   Cursor (1,5);
   tab(5); writeln('  This display is a chart of the galaxy.  The galaxy is divided up');
   tab(5); writeln('  into a 10x10 grid of one-hundred different quadrants.  If the');
   tab(5); writeln('  number of Klingons in a quadrant is not known, the quadrant will');
   tab(5); writeln('  be 3 dots (...) on the chart.  If the number of Klingons in');
   tab(5); writeln('  a quadrant is known, a 3 digit number will appear on the chart');
   tab(5); writeln('  instead.  The first digit is the number of Klingons, the second');
   tab(5); writeln('  digit is the number of Federation bases, and the third digit is the');
   tab(5); writeln('  number of stars in the quadrant.  The position of the Enterprise is');
   tab(5); writeln('  indicated by a box around its position.  Since the information for');
   tab(5); writeln('  the chart is stored in the ship`s computer, it can not be displayed ');
   tab(5); writeln('  if the computer is damaged.  The chart command is `CH`.             ');
end;

Procedure Lr;
begin
   Screen_erase;
   If Damage[1]=0 then LongGrid else write('Long range sensors have been damaged');
   Cursor (1,15);
   writeln('This is a long range scan.  The position of the Enterprise is');
   writeln('in the middle of the 3x3 grid.  The same 3 digit system is');
   writeln('used for representing the number of Klingons, bases, and stars');
   writeln('in a quadrant as in the map of the galaxy.  The quadrant numbers');
   writeln('are to the left of and below the grid.  The long range sensor');
   writeln('command is `LR`.');
 end;

Procedure Sr;
begin
   Screen_erase;
   If Damage[0]=0 then Grid else write('Short range sensors have been damaged.');
   cursor(1,2);
   tab(45); writeln('This is a short range scan of');
   tab(45); writeln('a quadrant.  Each quadrant is');
   tab(45); writeln('divided up into a 10x10 grid of');
   tab(45); writeln('one-hundred sectors.  If a sector');
   tab(45); writeln('is empty you will see a dot on the');
   tab(45); writeln('display.  Other symbols are E for');
   tab(45); writeln('Enterprise, B for Base, * for star,');
   tab(45); writeln('K for Klingon, and C for a Klingon');
   tab(45); writeln('commander.  The short range sensor');
   tab(45); writeln('command is `SR`.');
end;

Procedure Score;
begin
   Screen_erase;
   Cursor (1,7);
   writeln('This is Enterprise`s status display.');
   writeln('The time remaining is the total number of');
   writeln('Stardates left that you have to eliminate');
   writeln('the Klingon threat.  You initially have');
   writeln('5 stardates, but may be given more time');
   writeln('as the number of Klingons decreases.');
   writeln('The number of Klingons listed is the');
   writeln('total number of Klingons remaining.');
   writeln('There will be a condition RED if the');
   writeln('Enterprise is under attack, otherwise');
   writeln('there will be condition GREEN.');
   Score_board;
end;

Procedure Wa;
begin
   Screen_erase;
   Cursor (1,5);
   writeln('The command to change the warp speed is `WA`.');
   writeln('A warp speed above 6 may damage the warp drive.');
   writeln('The command to move using warp drive is `MO`.');
   writeln('After typing `MO` you will be asked to specify');
   writeln('A direction and distance.  The distance is entered');
   writeln('like the numbers on a clock.');
   writeln('');
   writeln( '                          12');
   writeln( '                        9    1');
   writeln( '                           6');
   writeln('');
   writeln('The distance between two adjacent points in a');
   writeln('sector is .1, not 1.  The direction and distance');
   writeln('are entered on one line separated by commas.  For');
   writeln('example, 1.5,.1 is one possible combination.');
   Score_board;
end;

Procedure Im;
begin
   Screen_erase;
   Cursor (1,7);
   writeln('The command for impulse drive is `IM`.  Impulse drive is');
   writeln('slower than warp drive, but uses less energy for short');
   writeln('distances.  You must enter a direction and distance');
   writeln('for impulse travel in the same way as they are entered');
   writeln('for warp travel.');
end;

Procedure Ph;
begin
   Screen_erase;
   Cursor (1,7);
   writeln('The command for phasers is `PH`.  Phasers use');
   writeln('pure energy.  After entering the phaser');
   writeln('command you will be asked to enter the direction');
   writeln('of phaser fire and the amount of energy to use.');
   writeln('to use.  The direction and energy should be');
   writeln('entered on one line separated by commas. ');
   writeln('Your remaining energy level is printed on the');
   writeln('status display.');
   Score_board;
end;

Procedure Pt;
begin
   Screen_erase;
   Cursor (1,7);
   writeln('The command to fire photon torpedoes is `PT`.');
   writeln('Up to 3 photon torpedoes may be fired at once.');
   writeln('After the `PT` command the direction of');
   writeln('torpedoe travel must be entered.  Enter');
   writeln('up to 3 directions separated by commas');
   writeln('to fire more than one torpedoe.  The ');
   writeln('number of torpedoes you have left is');
   writeln('printed in the status display.');
   Score_board;
end;

Procedure Su;
begin
   Screen_erase;
   Cursor (1,7);
   writeln('The command to bring up the shields is `SU`.');
   writeln('The command to bring down the shields is `SD`.');
   writeln('The current state of the shields is printed');
   writeln('on the status display.');
   Score_board;
end;

Procedure KlingonDescription;
begin
   Screen_erase;
   Cursor (1,9);
   writeln('There are two types of Klingons.  Regular and Klingon commanders.');
   writeln('The Klingon commanders are more powerful.  When you start a tour of');
   writeln('command on the Enterprise you are asked to enter your skill level.');
   writeln('A higher skill level will entitle you to a more dangerous mission.');
   writeln('During these more dangerous missions the Klingons are much more');
   writeln('aggresive and will attempt to move as close as possible to your');
   writeln('your ship to attack.');
end;

Procedure Da;
begin
   Screen_erase;
   DamageInformation;
   Cursor (1,7);
   tab(45); writeln('The damage report command is');
   tab(45); writeln('`DA`.  Repairs are 10 times');
   tab(45); writeln('faster while docked at a ');
   tab(45); writeln('starbase. ');
end;

Procedure Base;
begin
   Screen_erase;
   Cursor (1,11);
   writeln('If you are adjacent to a starbase type `DO` to dock.  Your supply');
   writeln('of energy and photon torpedoes will then be replenished.');
end;

Procedure Qg;
begin
   Screen_erase;
   Cursor (1,11);
   writeln('The command to surrender is `QG` (for quit game).  Of course the');
   writeln('Federation will be lost if you do this.');
end;

Procedure He;
begin
   Screen_erase;
   Cursor (1,7);
   writeln('The command for help is `HE`.  After typing this the short');
   writeln('list of commands displayed below will be printed.');
   Cursor(1,17);
   HelpText;
end;

Procedure Help_index;
 begin
   Screen_erase;
   writeln('');
   tab(28);
   writeln('HELP INDEX');
   writeln('');
   tab(28); writeln('A. Introduction');
   tab(28); writeln('B. The galaxy');
   tab(28); writeln('C. Long range scanner');
   tab(28); writeln('D. Short range sensors');
   tab(28); writeln('E. Ship status');
   tab(28); writeln('F. Warp Drive');
   tab(28); writeln('G. Impulse Drive');
   tab(28); writeln('H. Phasers');
   tab(28); writeln('I. Photon torpedoes');
   tab(28); writeln('J. Shields');
   tab(28); writeln('K. Klingons');
   tab(28); writeln('L. Damage and repairs');
   tab(28); writeln('M. Starbases');
   tab(28); writeln('N. Surrendering');
   tab(28); writeln('O. Help');
   textcolor(LightBlue);
   tab(28); writeln('P. Resume command');
   textcolor(Yellow);
  repeat
   Erase_bottom (23,21);
   write('Enter the letter of your choice. ');
   Read(KBD,Command);
   Command:=UpCase(Command);
   Write(Command);
  until command in ['A'..'P'];
 end;

Procedure Query;
var com : char;
begin
 repeat
   Erase_bottom (28,24);
   writeln('Press RETURN to go on.');
   Cursor (28,25);
   write('or `I` for main index.  ');
   read(KBD,Com);
   com:=UpCase(Com);
   If Com<>Char(13) then write(Com);
   If Com='I' Then  Command:='*';
   If Com=Chr(13) Then
    begin {if}
    Command:=Chr(ORD(Command)+1);
    If command>'O' then command:='*';
    end; {if}
 until (com='I') or (Com=Char(13));
end;

procedure BranchRoutine;
begin
 case command of
  'A': Intro;
  'B': Ch;
  'C': LR;
  'D': Sr;
  'E': Score;
  'F': Wa;
  'G': Im;
  'H': Ph;
  'I': Pt;
  'J': Su;
  'K': KlingonDescription;
  'L': Da;
  'M': Base;
  'N': Qg;
  'O': He;
  'P': ContinueHelp:=False;
 end; {case}
   If (command<>'*') And ContinueHelp then query;
 end;

begin
ContinueHelp:=True;
Command:='*';
while ContinueHelp do
begin
 If command='*' then Help_index else BranchRoutine;
end; {while}
Screen_erase;
case Screen of
  short:If Damage[0]=0 then Short_range else Damaged(0);
  long:If Damage[1]=0 then Long_range else Damaged(1);
  fix:Damage_report;
  chart:If Damage[7]=0 then Galaxy else Damaged(7);
  titlepage:TitleText;
 else
  If Damage[0]=0 then Short_range else Damaged(0);
 end; {case}
end;

Procedure Help;
var
  command1 : char;
begin
  Erase_bottom (1,22);
  HelpText;
 repeat
   Erase_bottom (14,25);
   write('Press RETURN to go on    OR    `H` for more help. ');
   read(KBD,Command1);
   Command1:=UpCase(Command1);
   If Command1<>Char(13) then write(Command1);
 until (command1='H') or (Command1=Char(13));
 If command1='H' then HelpProgram;
end;

Procedure Shields_up;
begin
 Erase_bottom (2,23);
 writeln('SHIELDS RAISED.');
 Shield_status:=1;
 Energy:=Energy-50;
 If screen<=fix then Score_board;
 wait(waitinterval);
end;

Procedure Shields_down;
begin
  Erase_bottom (2,23);
  writeln('SHIELDS LOWERED.');
  Shield_status:=0;
  if screen<=fix then Score_board;
  wait(waitinterval);
 end;

Procedure Enter_command;
Var
 Com : Integer;
 Command1, Command2 : Char;
 Command12 : String[2];
 begin
   Erase_bottom (1,22);
   write('Command: ');
   read(kbd,Command1);
   Command1:=UpCase(Command1);
   write(Command1);
   read(kbd,Command2);
   Command2:=UpCase(Command2);
   write(Command2);
   Command12:=Command1+Command2;
   Com:=Pos(Command12,'SRLRMOIMPHPTSUCHSDDAREWAQGHEDO');
   If Com<>0 Then Com:=(Com+2) Div 2;
   CommandNumber:=Com;
   case com of
   1: begin  {Short Range Scanner 0}
       if Damage[0]=0 then
       begin {if}
       Short_range;
       end   {if}
       else
       begin {else}
       damaged(0);
       end; {else}
      end;
   2: begin  {Long Range Scanner 1}
       if Damage[1]=0 then
       begin {if}
       Long_range;
       end   {if}
       else
       begin {else}
       damaged(1);
       end; {else}
      end;
   3: begin  {Warp Drive 2}
       If Damage[2]=0 then
        begin {if}
        OK:=True;
        end {if}
        else
        begin {else}
        damaged(2);
        OK:=False;
        end; {else}
       If OK then DirectionDistance(Direction,Distance,OK);
       If OK and (Energy<round(Distance*Warp*10+100+Distance*Warp*10*Shield_status)) Then
        begin {if}
        Not_enough;
        OK:=False;
        end; {if}
      If OK then
        begin
        Destination;
        LeaveGalaxy(OK);
        end;
      If OK and (Sector[EndSecX,EndSecY]>0) and (EndQuadX=QuadX) and (EndQuadY=QuadY) Then
        begin
        OK:=False;
        GameDone:=True;
        Collision(Sector[EndSecX,EndSecY]);
        end;
       If OK then Warp_drive;
      end;
   4: begin  {Impulse Drive 3}
       If Damage[3]=0 then
        begin {if}
        OK:=True;
        end {if}
        else
        begin {else}
        damaged(3);
        OK:=False;
        end; {else}
       If OK then DirectionDistance(Direction,Distance,OK);
       If Energy<round(Distance*250) Then
        begin {if}
        Not_enough;
        OK:=False;
        end; {if}
       If OK then
        begin
        Destination;
        LeaveGalaxy(OK);
        end;
       If OK then Impulse;
      end;
   5: begin  {Phasers 4}
       if Damage[4]=0 then
       begin {if}
       OK:=true;
       end   {if}
       else
       begin {else}
       damaged(4);
       OK:=False;
       end; {else}
       If OK then AskPhasers(OK);
       If OK AND (round(Fire_power)>Energy) Then
        begin {if}
        Not_enough;
        OK:=False;
        end; {if}
       If OK then Phasers;
      end;
   6: begin  {Photon Torpedoes 5}
      if Damage[5]=0 then
       begin {if}
       OK:=True
       end   {if}
       else
       begin {else}
       damaged(5);
       OK:=False;
       end; {else}
       If Torpedoes<1 then
        begin {if1}
        Erase_bottom (2,23);
        writeln('You have no torpedoes');
        wait(WaitInterval);
        OK:=False;
        end; {if}
       If OK then AskDirections(OK);
       If OK then Firetorpedoes;
     end;
   7: begin  {Raise Shields 6}
       if Damage[6]=0 then
       begin {if}
       OK:=True;
       end   {if}
       else
       begin {else}
       damaged(6);
       end; {else}
      If Shield_status=1 Then
       begin
       erase_bottom(2,23);
       writeln('Shields already up.');
       wait(WaitInterval);
       OK:=False;
       end; {If Shield_Status=1}
      If Energy<=50 Then
       begin
       erase_bottom(2,23);
       writeln('Not enough energy to raise shields.');
       wait(WaitInterval);
       OK:=False;
       end; {If Energy<50}
      If OK then Shields_Up;
      end;
   9: begin  {Lower Shields 6}
       if Damage[6]=0 then
        begin {if}
         OK:=True;
        end   {if}
       else
        begin {else}
         damaged(6);
        end; {else}
       If Shield_status=0 Then
        begin
         erase_bottom(2,23);
         writeln('Shields already down.');
         wait(WaitInterval);
         OK:=False;
        end; {If Shield_Status=0}
       If OK Then Shields_Down;
      end;
   8: begin {Map of Galaxy 7}
       if Damage[7]=0 then
       begin {if}
       Galaxy;
       end   {if}
       else
       begin {else}
       damaged(7);
       end; {else}
      end;
   10: begin {Damage Report}
       damage_report;
       end;
   11: begin {Repair Ship}
       repair;
       end;
   12: begin {Set Warp Speed 2}
       if Damage[2]=0 then
       begin {if}
       Set_warp;
       end   {if}
       else
       begin {else}
       damaged(2);
       end; {else}
       end;
   13: begin {Quit Game}
       GameDone:=True;
       no_time;
       end;
   15: begin {Attempt to dock}
       dock;
       end;
   14: begin {Help Section}
       help;
       end
   else
   begin {else}
   If (command2<>Chr(8)) and (command2<>Chr(13)) then
    begin
    Erase_bottom (2,23);
    writeln('Type "HELP" for a list of commands.');
    wait(WaitInterval);
    end; {Command2<>chr(8)}
   end; {else}
   end; {case}
   If Klingons=0 Then
    begin
    GameDone:=True;
    Congradulations;
    end;
   If (GameDone=False) and (Energy<0) then
    begin
    GameDone:=True;
    No_energy;
    end; {Energy<0}
   If (GameDone=False) and (Time_left<0) Then
    begin
    GameDone:=True;
    No_time;
    end; {If Time_left<0}
end;

Procedure Title;
var
   I:Integer;
   Lev:Char;
begin
   Screen:=TitlePage;
   TitleText;
   repeat
   Erase_bottom(28,16);
   writeln('      Press `H` for HELP');
   Tab(28); writeln('              or');
   Tab(28); write('Enter your expertise level (1-5): ');
   Read(KBD,LEV);
   Val(Lev,Level,I);
   If Lev in ['H','h'] then
    begin
    Screen_erase;
    cursor(28,12);
    write('Preparing help section....');
    level:=1;
    Initialize;
    Create_universe;
    Create_sector;
    HelpProgram;
    end;
   until level in [1..5];
   Erase_bottom (28,23);
   writeln('Creating the universe.');
   Initialize;
   Create_universe;
   Create_sector;
   Short_range;
end;

begin {trek}
repeat
 title;
   repeat
    enter_Command;
   until GameDone;
 AnotherGame(ReadyToStop);
until ReadyToStop;
end.  {trek}