home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / USCX / TPCOMPLT.ZIP / BOMBER.PAS < prev    next >
Pascal/Delphi Source File  |  1986-05-06  |  7KB  |  193 lines
  1. {--------------------------------------------------------------}
  2. {                           Bomber                             }
  3. {                                                              }
  4. {            Extended graphics demonstration program           }
  5. {                                                              }
  6. {                             by Jeff Duntemann                }
  7. {                             Turbo Pascal V3.0                }
  8. {                             Last update 4/13/86              }
  9. {                                                              }
  10. {    From the book, COMPLETE TURBO PASCAL, by Jeff Duntemann   }
  11. {    Scott, Foresman & Co. (c) 1986,1987  ISBN 0-673-18600-8   }
  12. {--------------------------------------------------------------}
  13.  
  14. PROGRAM Bomber;
  15.  
  16. {$I \turbo\GRAPH.P}
  17.  
  18. CONST
  19.   MissileSize = 39;
  20.   Hatch       = True;
  21.   NoHatch     = False;
  22.  
  23. TYPE
  24.   PatternArray = ARRAY[0..7] OF Byte;
  25.  
  26.   MissileRec = RECORD
  27.                  ModeCode,Width,Height : Integer;
  28.                  Pixels : ARRAY[0..MissileSize] OF Byte
  29.                END;
  30.  
  31.   TargetRec  = RECORD
  32.                  ModeCode,Width,Height : Integer;
  33.                  Pixels : ARRAY[0..511] OF Byte
  34.                END;
  35.  
  36.   TargetArray  = ARRAY[0..7] OF INTEGER;
  37.  
  38.  
  39. CONST
  40.   Lines : PatternArray =
  41.           ($44,$88,$11,$22,$44,$88,$11,$22);
  42.  
  43.  { Note well that PutPic images are displayed "upside-down" }
  44.  { from the orientation in which you code them.  The bomb   }
  45.  { below points "up" in the listing but will be nose-down   }
  46.  { when PutPic shows it on the screen! }
  47.  
  48.   Bomb : MissileRec =
  49.          (ModeCode : 2;   { 2 = Color Graphics; 1 = HiRes }
  50.           Width    : 8;   { Remember...2 bits per pixel!  }
  51.           Height   : 20;
  52.           Pixels   : ($0F,$F0,    {    ********    }
  53.                       $3F,$FC,    {  ************  }
  54.                       $FF,$FF,    {****************}
  55.                       $FF,$FF,    {****************}
  56.                       $FF,$FF,    {****************}
  57.                       $FF,$FF,    {****************}
  58.                       $FF,$FF,    {****************}
  59.                       $FF,$FF,    {****************}
  60.                       $FF,$FF,    {****************}
  61.                       $FF,$FF,    {****************}
  62.                       $FF,$FF,    {****************}
  63.                       $3F,$FC,    {  ************  }
  64.                       $0F,$F0,    {    ********    }
  65.                       $03,$C0,    {      ****      }
  66.                       $0F,$F0,    {    ********    }
  67.                       $3F,$FC,    {  ************  }
  68.                       $FC,$3F,    {******    ******}
  69.                       $FC,$3F,    {******    ******}
  70.                       $FC,$3F,    {******    ******}
  71.                       $FC,$3F));  {******    ******}
  72.  
  73. VAR
  74.   I             : Integer;
  75.   NoBomb        : MissileRec;    { "Black" bomb that erases visible bomb }
  76.   X,XNose,YNose : Integer;
  77.   BombX         : Integer;       { Column from which bomb is dropped }
  78.   TargetFigure  : TargetRec;     { The target itself, replicated by PutPic }
  79.   Targets       : TargetArray;   { Array of flags showing which targets hit }
  80.   DetonateX,DetonateY : Integer; { Point at which bomb encountered target }
  81.  
  82.  
  83. {$I PULL.SRC }   { Described in Section 16.10 }
  84.  
  85.  
  86. PROCEDURE GBAR(X,Y,Width,Height,EdgeColor,FillerColor : Integer;
  87.                Hatch : Boolean;
  88.                HatchPattern : PatternArray);
  89.  
  90. BEGIN
  91.   Draw(X,Y,X+Width,Y,EdgeColor);
  92.   Draw(X,Y+Height,X+Width,Y+Height,EdgeColor);
  93.   Draw(X,Y,X,Y+Height,EdgeColor);
  94.   Draw(X+Width,Y,X+Width,Y+Height,EdgeColor);
  95.   IF Hatch THEN
  96.     BEGIN
  97.       Pattern(HatchPattern);
  98.       FillPattern(X+1,Y+1,X+Width-1,Y+Height-1,FillerColor)
  99.     END
  100.   ELSE
  101.     FillShape(X+1,Y+1,FillerColor,EdgeColor);
  102. END;
  103.  
  104.  
  105. FUNCTION AllClear(Targets : TargetArray) : Boolean;
  106.  
  107. VAR
  108.   I : Integer;
  109.  
  110. BEGIN
  111.   AllClear := True;   { Start by assuming all targets have been hit... }
  112.   FOR I := 0 TO 7 DO
  113.                       { ...but if any haven't, return FALSE }
  114.     IF Targets[I] <> 0 THEN AllClear := False
  115. END;
  116.  
  117.  
  118. PROCEDURE ClearTarget(DetonateX,DetonateY : Integer;
  119.                       VAR Targets : TargetArray);
  120.  
  121. VAR
  122.   I : Integer;
  123.  
  124. BEGIN        { Erase the target by drawing a "black" bar over it }
  125.   GBar((DetonateX DIV 40)*40,DetonateY,40,10,0,0,NoHatch,Lines);
  126.   Targets[DetonateX DIV 40] := 0;
  127. END;
  128.  
  129.  
  130. PROCEDURE DropBomb(StartX,StartY : Integer;
  131.                    VAR DetonateX,DetonateY : Integer);
  132.  
  133. VAR
  134.   YNose : Integer;
  135.  
  136. BEGIN
  137.   YNose := StartY;
  138.   REPEAT
  139.     PutPic(Bomb,StartX,YNose);       { Draw the bomb }
  140.     PutPic(NoBomb,StartX,YNose);     { Erase the bomb }
  141.     YNose := Succ(YNose);            { Prepare to draw it one pixel down }
  142.   UNTIL (GetDotColor(StartX+4,YNose+1) <> 0) OR (YNose+1 >= 199);
  143.   { Bombs travel downward until they hit a target or hit the screen bottom }
  144.   DetonateX := StartX;  DetonateY := YNose + 1;
  145. END;
  146.  
  147.  
  148.  
  149. BEGIN
  150.   Randomize;               { Randomization: the spice of life... }
  151.   FillChar(NoBomb,Sizeof(NoBomb),Chr(0));  { Blacken the bomb-blanker... }
  152.   WITH NoBomb DO                           { ...and fill its header }
  153.     BEGIN
  154.       ModeCode := Bomb.ModeCode;
  155.       Height := Bomb.Height;
  156.       Width  := Bomb.Width
  157.     END;
  158.   GraphColorMode;
  159.                            { Pull random vertical positions for the targets }
  160.   FOR X := 0 TO 7 DO Targets[X] := Pull(85,180);
  161.                            { Draw a target for the intro and "lift" it }
  162.   GBar(140,120,40,10,1,2,NoHatch,Lines);
  163.   GetPic(TargetFigure,140,120,180,130);
  164.                            { Do the animated intro }
  165.   DropBomb(156,24,DetonateX,DetonateY);
  166.   GotoXY(16,18); Write('Bombs Away!');
  167.   GotoXY(12,19); Write('Press (CR) to begin:');
  168.   Readln;
  169.                            { Blank the screen again and begin }
  170.   GraphColorMode;
  171.  
  172.   { Now we lay down the targets, each of which is 40 pixels wide.  The }
  173.   { vertical (Y) position of each target is stored in array Targets. }
  174.   { The elements of Targets also function as collission flags, which }
  175.   { are set to zero when a given target is struck by a bomb.  When all }
  176.   { elements in Targets are zeroed, the game is over. }
  177.   FOR I := 1 TO 8 DO PutPic(TargetFigure,(I-1)*40,Targets[I]);
  178.   YNose := 24;
  179.   XNose := Pull(5,300);
  180.   REPEAT                   { Drop bombs until all the targets are gone }
  181.     { The following statement ensures that bombs will not "graze" the next }
  182.     { target to the right by making sure each bomb is dropped from a point }
  183.     { at least eight pixels from the right edge of each target position }
  184.     REPEAT BombX := Pull(5,310) UNTIL (BombX MOD 40) < 32;
  185.     DropBomb(BombX,24,DetonateX,DetonateY);
  186.     ClearTarget(DetonateX,DetonateY,Targets);
  187.     IF KeyPressed THEN Halt    { To stop things early }
  188.   UNTIL AllClear(Targets);
  189.   GotoXY(1,23); Write('Press (CR) to continue: ');
  190.   Readln;
  191.   TextMode;    { Don't ever leave the user in graphics mode! }
  192. END.
  193.