home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / SPADV.ZIP / ENDING.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-08-12  |  4.6 KB  |  175 lines
  1. unit Ending;
  2.  
  3. interface
  4.  
  5. uses Crt,Graph3,Title,Globals,Graph;
  6.  
  7. procedure TheEnd;
  8.  
  9. implementation
  10.  
  11. procedure TheEnd;                      (***** THE END , EXPLOSION *****)
  12. const
  13.   NoOfDots   = 170;
  14. var
  15.   Code,Ctr4,Colr,
  16.   Backgr,Expl,Dist,
  17.   x,y        : integer;
  18.   HoldShip   : array [1..1000] of byte;
  19.   Dot        : array [1..NoOfDots] of record
  20.                  x,y : word;
  21.                  xinc,yinc : word;
  22.                  bcol : byte;
  23.                end;
  24.  
  25.   procedure Pod (x,y,col : word);
  26.   begin
  27.     PutPixel (x,y,col); PutPixel (x+1,y,col);
  28.     PutPixel (x,y+1,col); PutPixel (x+1,y+1,col);
  29.   end;
  30.   procedure MovePod (Times,Xinc,Yinc : integer);
  31.   var Ctr4 : integer;
  32.   begin
  33.     for Ctr4 := 1 to Times do begin
  34.       Delay (60);
  35.       Pod (x,y,Backgr);
  36.       Inc (x,Xinc); Inc (y,Yinc);
  37.       Pod (x,y,3);
  38.     end;
  39.   end;
  40.  
  41. begin
  42.   ClearDevice;
  43.   SetColor (2);
  44.   Arc (0,700,0,90,680);
  45.   SetFillStyle (SolidFill,2);
  46.   FloodFill (0,199,2);
  47.   TurtleDelay (0);
  48.   TurtleWindow (159,99,320,200); PenDown;
  49.   SetPosition (-159,-50); SetPenColor (1);
  50.   SetHeading (60); Forwd (4);
  51.   TurnRight (32); Forwd (11);
  52.   TurnRight (100); Forwd (7);
  53.   TurnLeft (167); Forwd (6);
  54.   TurnRight (90); Forwd (10);
  55.   TurnRight (10); Forwd (6);
  56.   TurnLeft (30);  Forwd (7);
  57.   TurnRight (30); Forwd (10);
  58.   TurnRight (20); Forwd (4);
  59.   TurnLeft (45);  Forwd (7);
  60.   TurnRight (100); Forwd (12);
  61.   TurnRight (30); Forwd (6);
  62.   TurnLeft (140); Forwd (7);
  63.   TurnRight (110); Forwd (8);
  64.   TurnLeft (160); Forwd (10);
  65.   TurnRight (45); Forwd (8);
  66.   TurnLeft (20); Forwd (9);
  67.   TurnLeft (20); Forwd (5);
  68.   TurnRight (60); Forwd (6);
  69.   TurnLeft (150); Forwd (10);
  70.   TurnRight (150); Forwd (7);
  71.   TurnRight (45); Forwd (8);
  72.   TurnLeft (80); Forwd (15);
  73.   TurnLeft (20); Forwd (8);
  74.   TurnLeft (60); Forwd (7);
  75.   TurnRight (150); Forwd (20);
  76.   TurnRight (45); Forwd (10);
  77.   TurnLeft (60); Forwd (8);
  78.   TurnRight (80); Forwd (10);
  79.   SetFillStyle (SolidFill,1);
  80.   FloodFill (0,190,1);
  81.   for Ctr4 := 1 to 300 do begin
  82.     x := Random (320); y := Random (200);
  83.     if GetPixel (x,y) = 0 then PutPixel (x,y,Random (4));
  84.   end;
  85.   SetFillStyle (SolidFill,0);
  86.   Bar (182,33,212,53);
  87.   SetPosition (50,50); SetPenColor (1);
  88.   SetHeading (250); Forwd (4);
  89.   TurnRight (45); Forwd (5);
  90.   TurnRight (45); Forwd (3);
  91.   TurnLeft (45);  Forwd (7);
  92.   TurnLeft (45);  Forwd (3);
  93.   TurnRight (45); Forwd (6);
  94.   TurnRight (90); Forwd (6);
  95.   TurnRight (90); Forwd (6);
  96.   TurnRight (45); Forwd (3);
  97.   TurnLeft (45);  Forwd (7);
  98.   TurnLeft (45);  Forwd (3);
  99.   TurnRight (45); Forwd (5);
  100.   TurnRight (45); Forwd (4);
  101.   SetFillStyle (SolidFill,2);
  102.   FloodFill (190,39,1);
  103.   FloodFill (203,47,1);
  104.   x := 195; y := 45;
  105.   Backgr := 0;
  106.   Pod (x,y,3);
  107.   Delay (2000);
  108.   Sound (1000); Delay (100); NoSound;
  109.   MovePod (10,1,3);
  110.   MovePod (10,0,3);
  111.   MovePod (5,-1,2);
  112.   MovePod (5,-2,1);
  113.   MovePod (10,-3,0);
  114.   MovePod (10,-3,-1);
  115.   MovePod (5,-3,0);
  116.   MovePod (5,-2,1);
  117.   MovePod (7,-1,2);
  118.   MovePod (5,0,2);
  119.   Backgr := 2;
  120.   MovePod (5,1,2);
  121.   MovePod (5,1,1);
  122.   MovePod (5,0,1);
  123.   MovePod (3,-1,1);
  124.   Sound (200); Delay (100); Nosound;
  125.   Delay (1000);
  126.   GetImage (183,34,211,52,HoldShip);
  127.   for Ctr4 := 1 to 60 do begin
  128.     Sound (Ctr4*15);
  129.     Delay (20);
  130.     PutImage (182+Random(3),33+Random(3),HoldShip,NormalPut);
  131.   end;
  132.   NoSound;
  133.   for Ctr4 := 1 to NoOfDots do with Dot [Ctr4] do begin
  134.     x    := 183+Random (29);
  135.     y    := 34 +Random (19);
  136.     xinc := Random (13) -6;
  137.     yinc := Random (11) -6;
  138.     bcol := 0;
  139.     while (xinc=0) and (yinc=0) do begin
  140.       xinc := Random (13) -6;
  141.       yinc := Random (11) -6;
  142.     end;
  143.   end;
  144.   SetFillStyle (SolidFill,0);
  145.   Bar (182,33,212,53);
  146.   for Expl := 1 to 70 do begin
  147.     Code := (100-Expl)*20;
  148.     Colr := 4 - (Ord(Expl>10) + Ord(Expl>30) + 1);
  149.     if Colr<3 then Colr := 3-Colr;
  150.     for Ctr4 := 1 to NoOfDots do with Dot [Ctr4] do begin
  151.       PutPixel (x,y,bcol);
  152.       Inc (x,xinc);
  153.       Inc (y,yinc);
  154.       if Random (5) = 0 then Inc (yinc);
  155.             bcol := GetPixel (x,y);
  156.       PutPixel (x,y,Colr);
  157.       Sound (Random (Code));
  158.     end;
  159.   end;
  160.   NoSound;
  161.   SetTextJustify (CenterText,CenterText);
  162.   SetTextStyle (GothicFont,HorizDir,7);
  163.   SetColor (2); OutTextXY (159,83,'The End');
  164.   SetColor (1); OutTextXY (160,84,'The End');
  165.   SetColor (3); OutTextXY (161,85,'The End');
  166.   Play ('t120 o1 l2 ef#4gea#1');
  167.   SetTextStyle (DefaultFont,HorizDir,1);
  168.   OutTextXY (160,140,'Your adventure is completed!');
  169.   OutTextXY (160,170,'Now press any key ...');
  170.   while KeyPressed do K1:=ReadKey;
  171.   K1 := ReadKey;
  172. end;
  173.  
  174. end.
  175.