home *** CD-ROM | disk | FTP | other *** search
/ Sound, Music & MIDI Collection 2 / SMMVOL2.bin / PROG / BWSB120B.ZIP / TTP / TTP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-02  |  6.2 KB  |  239 lines
  1.  {──────────────────────────────────────────────────────────────────────────}
  2.  {              Bells, Whistles, and Sound Boards. Version 1.04             }
  3.  {       Copyright (C) 1993-94, Edward Schlunder. All Rights Reserved.      }
  4.  {══════════════════════════════════════════════════════════════════════════}
  5.  { TTP.BAS - Example game using BWSB sound effects                          }
  6.  {           Written by Alex Chalfin (1994)                                 }
  7.  {                                                                          }
  8.  {──────────────────────────────────────────────────────────────────────────}
  9.  
  10. { NOTE: You cannot compile this. The units used in this game are not      }
  11. {  included, as they do not contain code important to the playing of the  }
  12. {  music/sound effects. All the source code is included in the registered }
  13. {  version of BWSB. If you aren't registering BWSB, but interested in     }
  14. {  the routines used here, feel free to contact me (Alex)                 }
  15.  
  16. {$M 16384,0,0}              { Always make some room for music and sounds! }
  17. {$G+}
  18. Program Bubble_Gunner;
  19.  
  20. Uses
  21.    Crt, Stuff, MSE_TP, MCGA, Vector;
  22.  
  23. Var
  24.   ShotsFired : Longint;
  25.   TargetsHit : Longint;
  26.   StartTime  : Longint;
  27.   EndTime    : Longint;
  28.   Time : Longint Absolute $0000:$046c;
  29.  
  30. Function GetSoundDevice : String;
  31.  
  32. Begin
  33.   Writeln('Choose Sound Device: ');
  34.   Writeln;
  35.   Writeln(' 1. Gravis Ultrasound');
  36.   Writeln(' 2. Sound Blaster 1.xx');
  37.   Writeln(' 3. Sound Blaster 2.xx');
  38.   Writeln(' 4. Sound Blaster Pro');
  39.   Writeln(' 5. Sound Blaster 16');
  40.   Writeln(' 6. Pro AudioSpectrum');
  41.   Case ReadKey of
  42.     '1' : GetSoundDevice := 'GUS.MSE';
  43.     '2' : GetSoundDevice := 'SB1X.MSE';
  44.     '3' : GetSoundDevice := 'SB2X.MSE';
  45.     '4' : GetSoundDevice := 'SBPRO.MSE';
  46.     '5' : GetSoundDevice := 'SB16.MSE';
  47.     '6' : GetSoundDevice := 'PAS.MSE';
  48.     Else EndProg('Invalid Sound Device');
  49.   End;
  50. End;
  51.  
  52. Function GetBaseIO : Word;
  53.  
  54. Begin
  55.   Writeln;
  56.   Writeln('Select Base I/O Address:');
  57.   Writeln;
  58.   Writeln(' 1. 210h');
  59.   Writeln(' 2. 220h');
  60.   Writeln(' 3. 230h');
  61.   Writeln(' 4. 240h');
  62.   Writeln(' 5. 250h');
  63.   Writeln(' 6. 260h');
  64.   Writeln(' Anything else - Autodetect.');
  65.   Case ReadKey of
  66.     '1' : GetBaseIO := $210;
  67.     '2' : GetBaseIO := $220;
  68.     '3' : GetBaseIO := $230;
  69.     '4' : GetBaseIO := $240;
  70.     '5' : GetBaseIO := $250;
  71.     '6' : GetBaseIO := $260;
  72.     Else GetBaseIO := $FFFF;
  73.   End;
  74. End;
  75.  
  76. Function GetIRQ : Byte;
  77.  
  78. Begin
  79.   Writeln;
  80.   Writeln('Select IRQ Level:');
  81.   Writeln;
  82.   Writeln(' 1. IRQ 2');
  83.   Writeln(' 2. IRQ 5');
  84.   Writeln(' 3. IRQ 7');
  85.   Writeln(' 4. IRQ 11');
  86.   Writeln(' 5. IRQ 12');
  87.   Writeln(' Anything else - Autodetect.');
  88.   Case ReadKey of
  89.     '1' : GetIRQ := 2;
  90.     '2' : GetIRQ := 5;
  91.     '3' : GetIRQ := 7;
  92.     '4' : GetIRQ := 11;
  93.     '5' : GetIRQ := 12;
  94.     Else GetIRQ := $FF;
  95.   End;
  96. End;
  97.  
  98. Function GetDMA : Byte;
  99.  
  100. Begin
  101.   Writeln;
  102.   Writeln('Select DMA Channel:');
  103.   Writeln;
  104.   Writeln(' 1. DMA 1');
  105.   Writeln(' 2. DMA 2');
  106.   Writeln(' 3. DMA 3');
  107.   Writeln(' 4. DMA 5');
  108.   Writeln(' Anything else - Autodetect.');
  109.   Case ReadKey of
  110.     '1' : GetDMA := 1;
  111.     '2' : GetDMA := 2;
  112.     '3' : GetDMA := 3;
  113.     '4' : GetDMA := 5;
  114.     Else GetDMA := $FF;
  115.   End;
  116. End;
  117.  
  118. Procedure InitSound;
  119.  
  120. Var
  121.   BaseIO : Word;
  122.   IRQ : Byte;
  123.   DMA : Byte;
  124.   Handle : File;
  125.   Header : GDMHeader;
  126.   ErrorCode : Word;
  127.   Channels : Word;
  128.   DriverName : String;
  129.  
  130. Begin
  131.   DriverName := GetSoundDevice;
  132.   BaseIO := GetBaseIO;
  133.   IRQ := GetIRQ;
  134.   DMA := GetDMA;
  135.   ErrorCode := LoadMSE(DriverName, 0, 45, 4096, BaseIO, IRQ, DMA);
  136.   If ErrorCode <> 0
  137.     Then EndProg('Could not initialize sound device');
  138.   ExitProc := @FreeMSE;
  139.  
  140. {$I-}
  141.   Assign(Handle, 'TTP.GDM');        { Open the module for loading }
  142.   Reset(Handle);
  143. {$I+}
  144.   If IOResult <> 0 Then
  145.      EndProg('Could not open TTP.GDM');
  146.   ErrorCode := 0;                               { Don't use EMS }
  147.   Writeln('Loading GDM');
  148.   ErrorCode := LoadGDM(Handle, 0, ErrorCode, Header);
  149.   If ErrorCode <> 0
  150.     Then EndProg('Could not load TTP.GDM');
  151.   Close(Handle);
  152.  
  153.   Channels := 0;
  154.   For ErrorCode := 1 to 32 do
  155.     If Header.PanMap[ErrorCode] <> $FF
  156.       Then Channels := Channels + 1;
  157.   ErrorCode := StartOutput(Channels + 2, 0);
  158.   StartMusic;
  159. End;
  160.  
  161.  
  162. Procedure DoPlayLoop;
  163.  
  164. Var
  165.   LRAngle, UDAngle : Integer;
  166.   TargetHit : Boolean;
  167.   Fired, Quit : Boolean;
  168.   Side : Integer;
  169.   Time : Longint Absolute $0000:$046c;
  170.  
  171. Begin
  172.   Frames := 0;
  173.   ShotsFired := 0;
  174.   TargetsHit := 0;
  175.   Side := 1;
  176.   LRAngle := 256;
  177.   UDAngle := 256;
  178.   Quit := False;
  179.   Fired := False;
  180.   TargetHit := False;
  181.   InitCircle;
  182.   Randomize;
  183.   StartTime := Time;
  184.   Repeat
  185.     SpawnTarget(Random(511), -((Random(700) - 350) + 1000), Random(1500) + 800);
  186.     Repeat
  187.       Frames := Frames + 1;
  188.       GetKeyStuff(LRAngle, UDAngle, Fired, Quit);
  189.       If Quit
  190.         Then Exit;
  191.       If Fired
  192.         Then Begin
  193.           ShotsFired := ShotsFired + 1;
  194.  
  195. (* Play the laser sample (sample #8) on Channel 5 at 8000 Hz.               *)
  196. (* Use higest volume (63), and switch pan position based on the side of the *)
  197. (* laser blast (-1 And 15) = 15, (1 and 15) = 1                             *)
  198.  
  199.           Side := -Side;
  200.           PlaySample(5, 7, 8000, 63, Side And 15);  { Laser blast sound }
  201.  
  202.           TargetHit := CheckHit;
  203.         End;
  204.       DisplayIt(Fired, Side, LRAngle, UDAngle);
  205.     Until (TargetHit);
  206.     TargetHit := False;
  207.     TargetsHit := TargetsHit + 1;
  208.  
  209. (* Do the explosion sound effect.                      *)
  210. (* Play sample 9 on channel 6 at 8000 Hz.              *)
  211. (* Use maximum volume (63) and middle pan position (8) *)
  212.  
  213.     PlaySample(6, 8, 8000, 63, 8);    { Do explosion sound }
  214.     DrawExplosion;
  215.   Until False;
  216. End;
  217.  
  218. Begin
  219.   InitSound;
  220.   InitGraphics;
  221.   InitStars;
  222.   SetPalette;
  223.   TitleScreen;
  224.   KickKBDaemon;
  225.   StartTime := Time;
  226.   DoPlayLoop;
  227.   EndTime := Time;
  228.   FreeKBDaemon;
  229.   CleanUp;
  230.   StopMusic;
  231.   StopOutput;
  232.   UnloadModule;
  233.   FreeMSE;
  234.   If ShotsFired = 0
  235.     Then Writeln('No shots fired.')
  236.     Else Writeln('Hit percentage: ',(TargetsHit/ShotsFired)*100:2:0, '%' );
  237.   If (EndTime-StartTime) > 0
  238.     Then Writeln(Frames*18.2/(EndTime-StartTime):5:2, ' fps');
  239. End.