Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TP_ADV.ZIP/LIST0707.PAS

Pascal/Delphi Source File | 1989-11-20 | 8.8 KB | 314 lines

Program Game;

Uses
  CRT,
  DOS
{$IFDEF DEBUG}
  ;
{$ELSE}
  ,
  GameInt9;
{$ENDIF}

Const
  ShotChar      = #24; { Define the shot character as an arrow }
  ShotWaitTime  = 500; { Number of times to call UpdateShot before doing so }
  MaxShots      = 2;   { 5 shots on the screen at a time }

  ShipChar      = '^';
  Ship          = ShipChar + ShipChar + ShipChar;

  AlienChar     = '▒';
  Alien         = AlienChar + AlienChar + AlienChar;

  AlienWaitTime = 500;
  MaxAliens     = 5;
  AlienY        = 5;
  AlienPts      = 50;

{$IFDEF DEBUG}
  left   : boolean = false;
  right  : boolean = true;
  space  : boolean = false;
  escape : boolean = false;
{$ENDIF}

Type
  ShotRec  = Record
               Shooting : Boolean;
               ShotX,
               ShotY    : Byte;
             End;
  ShotArr  = Array [1..MaxShots] of ShotRec;
  AlienRec = Record
               Alive : Boolean;
               X     : Byte;
               Delta : ShortInt;
             End;
  AlienArr = Array [1..MaxAliens] of AlienRec;

Var
  Score      : Word;
  Shot       : ShotArr;
  Aliens     : AlienArr;
  ShotDelay  : Word;
  AlienDelay : Word;
  ScrSeg     : Word;
  ScrWidth   : Byte;
  ShipX,
  ShipY      : Byte;
  i          : Byte;

Function ScrChar ( x, y : Byte ) : Char;
{ This procedure will calculate the offset into video memory based   }
{ on the [X,Y] coordinates passed in. The character at this location }
{ in memory will be returned as the function result.                 }
Begin
  If ( y > 0 ) Then
    ScrChar := Chr ( Mem [ ScrSeg : (( x - 1 ) * 2 ) +
                                    (( y - 1 ) * ScrWidth * 2)]);
End;

Procedure MoveLeft;
{ This procedure is called if a key event occurs indicating that }
{ the ship is to be moved left one space.                        }
Begin
  If ( ShipX > 1 ) Then
  Begin
    Dec ( ShipX );
    GotoXY ( ShipX, ShipY );
    Write ( Ship + ' ' );
  End;
  Left := FALSE;
End;

Procedure MoveRight;
{ This procedure is called if a key event occurs indicating that }
{ the ship is to be moved right one space.                       }
Begin
  If ( ShipX < ( ScrWidth - Length ( Ship ) ) ) Then
  Begin
    GotoXY ( ShipX, ShipY );
    Write ( ' ' + Ship );
    Inc ( ShipX );
  End;
  Right := FALSE;
End;

Procedure Fire;
{ This procedure is called if a key event occurs indicating that }
{ the ship has fired a shot at the aliens.                       }
Var
  i : Byte;
Begin
  Space := FALSE;
  i := 1;
  While ( Shot [i].Shooting ) AND ( i < MaxShots ) Do { Find an open }
    Inc ( i );                                        { shot record. }
  If ( Not Shot [i].Shooting ) AND ( i <= MaxShots ) Then
  Begin
    Shot [i].Shooting := TRUE;                        { Set the shot }
    Shot [i].ShotX := ShipX + ( Length ( Ship ) div 2 ); { record.   }
    Shot [i].ShotY := ShipY - 1;
  End;
End;

Function RemoveAlien ( x, y : Byte ) : Byte;
{ This function is called to remove an Alien from the screen.  }
{ The first Alien discovered at the [X,Y] coordinates passed   }
{ in will be removed from the screen. The function will return }
{ array offset of the Alien removed ( for scoring purposes ).  }
Var
  i    : Byte;
  done : Boolean;
Begin
  i := 0;
  done := FALSE;
  While ( i < MaxAliens ) AND ( Not done ) Do
  Begin
    Inc ( i );
    If ( AlienY = y ) AND ( Aliens [i].Alive ) AND
       ( x in [(Aliens [i].X)..(Aliens [i].X+Length (Alien))] ) Then
    Begin
      done := TRUE;
      Aliens [i].Alive := FALSE;
      GotoXY ( Aliens [i].X, AlienY );
      Write ( '   ' );
    End;
  End;
  RemoveAlien := i;
End;

Procedure IncScore ( i : Byte );
{ This procedure will increment the score using the base }
{ score value multiplied by the speed of the Alien.      }
Begin
  Score := Score + ( AlienPts * Abs ( Aliens [i].Delta ) );
  GotoXY ( ( ScrWidth - 10 ), 1 );
  Write ( Score : 5 );
  Sound ( 500 );
  Delay ( 100 );
  NoSound;
End;

Procedure UpdateAliens;
{ This routine will update the Aliens on the video screen. }
Begin
  Inc ( AlienDelay );                   { Add one to the global counter }
  If ( ( AlienDelay Mod AlienWaitTime ) = 0 ) Then { Check delay factor }
    For i := 1 to MaxAliens Do
      If ( Aliens [i].Alive ) Then       { If the Alien is active }
        If ( Aliens [i].X >= ScrWidth - ( Length ( Alien ) + 1 ) ) OR
           ( Aliens [i].X <= 1 ) Then
        Begin
          GotoXY ( Aliens [i].X, AlienY );
          Write ( '   ');
          Aliens [i].Delta := -Aliens [i].Delta;
          Inc ( Aliens [i].X, Aliens [i].Delta );
          GotoXY ( Aliens [i].X, AlienY );
          Write ( Alien );
        End
        Else
        Begin
          GotoXY ( Aliens [i].X, AlienY );
          Write ( '   ' );
          Inc ( Aliens [i].X, Aliens [i].Delta );
          GotoXY ( Aliens [i].X, AlienY );
          Write ( Alien );
        End;
End;

Procedure UpdateShot;
{ This procedure will update any shots that are active on the screen. }
Var
  i : Integer;
Begin
  Inc ( ShotDelay );                      { Add one to the global counter }
  If ( ( ShotDelay mod ShotWaitTime ) = 0 ) Then     { Check delay factor }
    For i := 1 to MaxShots Do
    Begin
      If ( Shot [i].Shooting ) Then               { If the shot is active }
      Begin
        If ( ScrChar ( Shot [i].ShotX, Shot [i].ShotY ) = AlienChar ) Then
        Begin
                  { An Alien moved on top of the bullet }
          IncScore ( RemoveAlien ( Shot [i].ShotX, Shot [i].ShotY ) );
          Shot [i].Shooting := FALSE;
        End
        Else
        If ( ScrChar ( Shot [i].ShotX, Shot [i].ShotY - 1 ) = AlienChar ) Then
        Begin
                  { The bullet will move into an Alien }
          GotoXY ( Shot [i].ShotX, Shot [i].ShotY );
          Write ( ' ' );
          IncScore (RemoveAlien ( Shot [i].ShotX, Shot [i].ShotY - 1 ) );
          Shot [i].Shooting := FALSE;
        End
        Else
        Begin
                  { The shot will not hit anything yet }
          GotoXY ( Shot [i].ShotX, Shot [i].ShotY );
          Write ( ' ' );
          Dec ( Shot [i].ShotY );
          If ( Shot [i].ShotY <= AlienY - 1 ) Then
            Shot [i].Shooting := FALSE
          Else
          Begin
            GotoXY ( Shot [i].ShotX, Shot [i].ShotY );
            Write ( ShotChar );
          End
        End
      End
    End
End;

Procedure EventLoop;
{ Main event loop of the program. }
var
  ch : char;
Begin
  Repeat
    If ( Left ) Then        { Key Event }
      MoveLeft;
    If ( Right ) Then       { Key Event }
      MoveRight;
    If ( Space ) Then       { Key Event }
      Fire;
    UpdateAliens;           { Update Event }
    UpdateShot;             { Update Event }
    While ( KeyPressed ) Do
      ch := ReadKey;
  Until ( Escape );         { Key Event signalling Exit }
End;

Procedure SetUpScrInfo;
{ Get the screen width and base video address for the ScrChar routine. }
Var
  r : Registers;
Begin
  r.ah := $0F;
  Intr ( $10, r );   { Call BIOS Interrupt 10h Service 0Fh }
  ScrWidth := r.ah;
  Case ( r.al ) Of
    1,2,3 : ScrSeg := $B800;
    7 : ScrSeg := $B000;
  End;
End;

Procedure OffCursor;
{ Deactivate the cursor on the screen }
Var
  r : Registers;
Begin
  r.ah := $01;
  r.cx := $2020;     { Start and end scan lines for the cursor      }
  Intr ( $10, r );   { Interrupt 10h, service 01h - Set cursor size }
End;

Procedure OnCursor;
{ Reactivate the cursor on the screen }
Var
  r : Registers;
Begin
  r.ah := $01;
  If ( ScrSeg = $B000 ) Then
    r.cx := $0C0D    { Start and end scan lines for Monochrome cursor }
  Else
    r.cx := $0607;   { Start and end scan lines for Color cursor }
  Intr ( $10, r );   { Interrupt 10h, service 01h - Set cursor size }
End;

Procedure InitVars;
{ Initialize the global variables }
Var
  i : Integer;
Begin
  Score := 0;
  ShotDelay := 0;
  GotoXY ( ( ScrWidth - 17 ), 1 );
  Write ( 'Score: ', Score : 5 );
  For i := 1 to MaxShots do
    Shot [i].Shooting := FALSE;
  Randomize;
  For i := 1 to MaxAliens do
  Begin
    Aliens [i].X := Random ( ScrWidth - 5 ) + 2;
    Aliens [i].Alive := TRUE;
    Aliens [i].Delta := Random (3) + 1;
  End;
  ShipX := 1;
  ShipY := 25;
End;

Begin
  OffCursor;               { Turn off the cursor              }
  ClrScr;                  { Clear the video screen           }
  SetUpScrInfo;            { Get current video information    }
  InitVars;                { Initialize the global variables  }
  GotoXY ( ShipX, ShipY ); { Draw the intial ship location on }
  Write ( Ship );          {   the screen.                    }
  EventLoop;               { Main event loop                  }
  OnCursor;                { Turn on the cursor               }
  ClrScr;
End.