home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / PASCAL / FASTVGA / STARDREK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-13  |  8.2 KB  |  281 lines
  1. {$IFDEF Ver70}
  2. { Compiler directives for Turbo Pascal 7.0 }
  3. {$A+,B-,D+,E-,F-,I-,L+,N-,O-,P+,Q-,R-,S-,T-,V-,X+}
  4. {$IFDEF DPMI} {$G+} {$ELSE} {$G-} {$ENDIF}
  5. {$M 16384,0,655360}
  6. {$ENDIF}
  7.  
  8. {$IFDEF Ver60}
  9. { Compiler directives for Turbo Pascal 6.0 }
  10. {$A+,B-,D+,E-,F-,G-,I-,L+,N-,O-,R-,S-,V-,X+}
  11. {$M 16384,0,655360}
  12. {$ENDIF}
  13.  
  14. program StarDrek;
  15.  
  16. { FastVGA v1.0, (C)1993 by Tal Cohen }
  17.  
  18. uses FastVGA,FastKeys,FastTimer,PCXUnit,DemoSprites,AimSprUnit,Crt;
  19.  
  20. type StarRec = record
  21.                 x,y,a,d:Real;
  22.                 C:Byte;
  23.                end;
  24.  
  25. var Star:array [1..25] of StarRec;
  26.     i,ShipImage,Er:Byte;
  27.     Ship,Aim:Sprite;
  28.     ShipMvX,ShipMvY,AimMvX,AimMvY:ShortInt;
  29.     Temp,PitchDir:Integer;
  30.     Pitch:Word;
  31.     Pal:PaletteType;
  32.     Shots,Hits:LongInt;
  33.     Noisy,SDown:Boolean;
  34.  
  35. begin
  36.  TextAttr:=Cyan;
  37.  Write ('Fast');
  38.  TextAttr:=LightCyan;
  39.  Write ('VGA');
  40.  TextAttr:=LightGray;
  41.  WriteLn (' v1.0: "Star Drek" Game Demo');
  42.  WriteLn;
  43.  if TestVGA=0 then
  44.   begin
  45.    WriteLn ('This program requires a VGA/MCGA card.');
  46.    Halt;
  47.   end;
  48.  WriteLn ('In the following game, move the aim (looks like a plus sign) using the numeric');
  49.  WriteLn ('keypad, and press space to fire. Try to maintain a high hit ratio!');
  50.  WriteLn;
  51.  WriteLn ('Use "P" to pause the game, "S" to toggle the sound on/off, and Esc to quit.');
  52.  Write ('Press any key to begin ... ');
  53.  ReadKey;
  54.  Randomize;
  55.  InstallFastKeys;
  56.  GoVGA256;
  57.  FillChar (Pal,SizeOf(Pal),0); { Zero the Pal variable }
  58.  SetActivePalette (Pal,0,255); { Make all colors black,
  59.                                                     so nothing is visible }
  60.  LoadPCXPage2 ('DREK1.PCX',Pal,Er); { Load PCX into page 2 }
  61.  if Er<>0 then { Check for errors }
  62.   begin
  63.    TextMode (Co80);
  64.    WriteLn ('Error reading image file DREK1.PCX. Program halted.');
  65.   end;
  66.  CopyFromPage2; { Copy image to page 1. All colors are black, so nothing
  67.                                                    is really seen on-screen }
  68.  TextAttr:=64; { In this PCX's palette, color #64 is white }
  69.  DirectVideo:=False; { This MUST be done to write on the graphical screen }
  70.  GotoXY (1,25);
  71.  Write ('  Version 1.0     Press Space ...'); { All black, so it's unseen }
  72.  FadeToPalette (Pal,0,255,12); { Make real colors visible, with a fade }
  73.  repeat until Key[scSpace]; { Wait for a Space press ... }
  74.  FadeOut (12); { Fade to black }
  75.  ClrVGAScr; ClrPage2Scr; { Clear both screens }
  76.  LoadPCXPage2 ('DREK2.PCX',Pal,Er); { Load new image }
  77.  if Er<>0 then { Check for errors }
  78.   begin
  79.    TextMode (Co80);
  80.    WriteLn ('Bad or missing DREK2.PCX. Program terminated.');
  81.   end;
  82.  SetActivePalette (Pal,0,255); { Activate palette. Page 1 is still cleared,
  83.                                                       so nothing is visible }
  84.  Shots:=1; Hits:=0; { Zero variables. Shots is set to one to prevent
  85.                                                     division-by-zero errors }
  86.  for i:=1 to 25 do { Select random stars }
  87.   with Star[i] do
  88.    begin
  89.     x:=Random (20)+150;
  90.     y:=Random (20)+65;
  91.     if x=160 then a:=1e8 else a:=(y-75)/(x-160);
  92.     C:=Random (10)+64;
  93.     Page2^[Round(y)][Round(x)]:=C; { Put Pixel on Page 2 }
  94.    end;
  95.  CopyFromPage2; { Copy Page 2, making the complete picture visible }
  96.  ShipImage:=1; { There are 4 different ship sprites; use #1 now }
  97.  AssignSprite (@Ship,@ShipBMP[1]); { Assign the bitmap to the sprite }
  98.  PutSprite (@Ship,120,70); { Show the sprite }
  99.  { Assign and show the aim sprite: }
  100.  AssignSprite (@Aim,@AimSprite);
  101.  PutSprite (@Aim,137,47);
  102.  
  103.  { Initialize some variables: }
  104.  Pitch:=0;
  105.  Noisy:=True;
  106.  SDown:=True; { When SDown is true, "S" can be used to toggle sound }
  107.  
  108.  { Zero on-screen counters: }
  109.  
  110.  GotoXY (10,20); Write (0:10);
  111.  GotoXY (10,24); Write (0:10);
  112.  GotoXY (26,22); Write (0.0:5:1,'%');
  113.  
  114.  repeat { Main loop }
  115.  
  116.   StartTimer;
  117.  
  118.   { READY Step: }
  119.  
  120.   ReadyMoveSprite (@Aim);
  121.   ReadyMoveSprite (@Ship);
  122.  
  123.   { Make changes to background, ONLY to page 2: }
  124.  
  125.   for i:=1 to 25 do
  126.    with Star[i] do
  127.     begin
  128.      Page2^ [Round(y)][Round(x)]:=0;  { Clear old star position }
  129.      x:=x-160;
  130.      x:=x*1.1;
  131.      y:=a*x+75;
  132.      x:=x+160;
  133.      if (x<70) or (x>250) or (y<20) or (y>130) then
  134.       begin
  135.        x:=Random (20)+150; if Round(x)=160 then x:=161;
  136.        y:=Random (20)+65;
  137.        if x=160 then a:=1e8 else a:=(y-75)/(x-160);
  138.        C:=Random (10)+64;
  139.       end;
  140.      Page2^ [Round(y)][Round(x)]:=C;
  141.     end;
  142.  
  143.   { The 72,152 to 239,191 block contains the counters (Shots, Hits, and
  144.     Ratio). For syncronizing the two pages, we copy from page 1 (where
  145.     the text was written) to page 2: }
  146.  
  147.   CopyBlockToPage2 (72,152,247,191);
  148.  
  149.   { Calculate sprite movements }
  150.  
  151.   AimMvX:=0; AimMvY:=0;
  152.  
  153.   if Key[scLeft]  or Key[scHome] or Key[scEnd]  then  Dec(AimMvX,2);
  154.   if Key[scRight] or Key[scPgUp] or Key[scPgDn] then  Inc(AimMvX,2);
  155.   if Key[scUp]    or Key[scHome] or Key[scPgUp] then  Dec(AimMvY,2);
  156.   if Key[scDown]  or Key[scEnd]  or Key[scPgDn] then  Inc(AimMvY,2);
  157.  
  158.   if (Aim.X<53)  and (AimMvX<0) then AimMvX:=0 else
  159.   if (Aim.X>222) and (AimMvX>0) then AimMvX:=0;
  160.  
  161.   if (Aim.Y<-5)  and (AimMvY<0) then AimMvY:=0 else
  162.   if (Aim.Y>94)  and (AimMvY>0) then AimMvY:=0;
  163.  
  164.   if Random<0.1 then ShipMvX:=Random(7)-3; { 10% likely to change X speed }
  165.  
  166.   { Check we're not out-of-bound in the X axis: }
  167.   Temp:=Ship.X+ShipMvX;
  168.   if (Temp<70) or (Temp>200) then ShipMvX:=0;
  169.  
  170.   if Random<0.1 then ShipMvY:=Random(7)-3; { 10% likely to change Y speed }
  171.  
  172.   { Check we're not out-of-bound in the Y axis: }
  173.   Temp:=Ship.Y+ShipMvY;
  174.   if (Temp<3) or (Temp>90) then ShipMvY:=0;
  175.  
  176.   { SET Step: }
  177.  
  178.   SetMoveSprite (@Ship,ShipMvX,ShipMvY);
  179.   SetMoveSprite (@Aim,AimMvX,AimMvY);
  180.  
  181.   { When calling GoMoveSprites, we'd like the program to update the entire
  182.     70,20 to 251,131 block (this is the "Main Screen".) So, we set LoX and
  183.     co: }
  184.  
  185.   LoX:=70;
  186.   LoY:=20;
  187.   HiX:=251-SprXLen;
  188.   HiY:=131-SprYLen;
  189.  
  190.   { GO Step: }
  191.  
  192.   GoMoveSprites;
  193.  
  194.   if (Key[scSpace]) then { If Space is pressed, the player FIRED }
  195.    begin
  196.     Inc (Shots);
  197.     GotoXY (10,20);
  198.     Write (Shots:10);
  199.  
  200.     { We check for a hit by checking the color. The ship's color values
  201.       are all greater than 50: }
  202.     if VGAScreen[Aim.Y+31][Aim.X+23]>50 then { Hit }
  203.      begin
  204.       { All those settings to Pitch and PitchDir simply set the sound }
  205.       PitchDir:=15;
  206.       if Pitch>150 then Pitch:=100;
  207.       Inc (Hits);
  208.       GotoXY (10,24);
  209.       Write (Hits:10);
  210.      end
  211.     else { Shot, but no hit }
  212.      begin
  213.       if Pitch<475 then Pitch:=500;
  214.       PitchDir:=-10;
  215.      end;
  216.  
  217.     { Display new ratio: }
  218.     GotoXY (26,22);
  219.     Write ((Hits/Shots)*100:5:1);
  220.  
  221.     { We draw the "lasers" on page 1, so they'll soon be erased: }
  222.  
  223.     VGAColor:=Random(256);
  224.     Line (250,130,Aim.X+23,Aim.Y+31);
  225.     Line (071,130,Aim.X+23,Aim.Y+31);
  226.    end;
  227.  
  228.   { Assign new ship image: }
  229.  
  230.   Inc (ShipImage);
  231.   if ShipImage=5 then ShipImage:=1;
  232.   AssignSprite (@Ship,@ShipBMP[ShipImage]);
  233.  
  234.   { Wait for a clocktick to pass since the call to StartTimer: }
  235.  
  236.   WaitFor (1);
  237.  
  238.   { Check for Pause: }
  239.  
  240.   if Key[scP] then
  241.    begin
  242.     NoSound; { Leaving the Buzzer on can be a nightmare ... }
  243.     repeat until not Key[scP];  { Wait for key release }
  244.     repeat until Key[scP];      { Wait for another press ... }
  245.     repeat until not Key[scP];  { and release }
  246.    end;
  247.  
  248.   { Check for sound toggle: }
  249.  
  250.   if not Key[scS] then SDown:=True; { If the S key was released, we can
  251.                                              accept sound-toggle commands }
  252.   if Key[scS] and SDown then
  253.    begin
  254.     Noisy:=not Noisy; { Sound mode is toggled }
  255.     if not Noisy then NoSound; { Silence speaker if needed }
  256.     SDown:=False; { Until the S key is released, further S pressed should
  257.                                                                 be ignored }
  258.    end;
  259.  
  260.   if Noisy then
  261.    if ((Pitch<450) and (PitchDir<0)) or ((Pitch>200) and (PitchDir>0)) then
  262.     begin
  263.      NoSound;
  264.      Pitch:=0;
  265.      PitchDir:=0;
  266.     end
  267.    else
  268.     begin
  269.      Sound(Pitch);
  270.      Inc (Pitch,PitchDir);
  271.     end;
  272.  
  273.  until Key[scEsc]; { Only the Esc key breaks this loop }
  274.  
  275.  { Wind down: }
  276.  
  277.  RestoreKeyboard;
  278.  NoSound;
  279.  TextMode (Co80);
  280. end.
  281.