home *** CD-ROM | disk | FTP | other *** search
/ Sound, Music & MIDI Collection 2 / SMMVOL2.bin / PROG / BWSB120A.ZIP / DEMO / SND-PAD.BAS < prev    next >
Encoding:
BASIC Source File  |  1995-03-16  |  6.5 KB  |  217 lines
  1. '──────────────────────────────────────────────────────────────────────────
  2. '              Bells, Whistles, and Sound Boards. Version 1.02
  3. '       Copyright (C) 1993-94, Edward Schlunder. All Rights Reserved.
  4. '══════════════════════════════════════════════════════════════════════════
  5. ' SND-PAD.BAS - Example GDM sound effect player.
  6. '               Written by Edward Schlunder (1994)
  7. '
  8. '──────────────────────────────────────────────────────────────────────────
  9. DEFINT A-Z
  10.  
  11. 'Declare all the BWSB subs and functions:
  12. '$INCLUDE: 'BWSB.BI'
  13. '$INCLUDE: 'GDMTYPE.BI'
  14.  
  15. '$LINK "MSE_PB.OBJ"
  16. '$INCLUDE "BWSB.PBI"
  17. '$INCLUDE "GDMTYPE.BI"
  18.  
  19. DECLARE SUB SetScreen ()
  20. DECLARE SUB UpScreen ()
  21.  
  22. TYPE MSEConfigFile
  23.   SoundCard     AS INTEGER
  24.   BaseIO        AS INTEGER
  25.   IRQ           AS INTEGER
  26.   DMA           AS INTEGER
  27.   SoundQuality  AS INTEGER
  28. END TYPE
  29.  
  30. TYPE RegTypeX
  31.   ax AS INTEGER
  32.   bx AS INTEGER
  33.   cx AS INTEGER
  34.   dx AS INTEGER
  35.   bp AS INTEGER
  36.   SI AS INTEGER
  37.   DI AS INTEGER
  38.   Flags AS INTEGER
  39.   ds AS INTEGER
  40.   es AS INTEGER
  41. END TYPE
  42.  
  43. TYPE RegType
  44.   ax AS INTEGER
  45.   bx AS INTEGER
  46.   cx AS INTEGER
  47.   dx AS INTEGER
  48.   bp AS INTEGER
  49.   SI AS INTEGER
  50.   DI AS INTEGER
  51.   Flags AS INTEGER
  52. END TYPE
  53.  
  54. DIM ModHead         AS GDMHeader       'Module Header
  55. DIM SndDevMSE(6)    AS STRING          'Array of MSE file names
  56. DIM MSEConfig       AS MSEConfigFile   'Structure of MSE configuration file
  57.  
  58. Freemem& = FRE(-1) - 80000             'Basic Heap - EXE Memory (80000)
  59. A& = SETMEM(-Freemem&)                 'This is the memory freed for module
  60.                                        'and MSE usage.
  61. 'Table of MSE file names
  62. SndDevMSE(1) = "GUS"                   'Gravis Ultrasound
  63. SndDevMSE(2) = "SB1X"                  'Sound Blaster 1.xx
  64. SndDevMSE(3) = "SB2X"                  'Sound Blaster 2.xx
  65. SndDevMSE(4) = "SBPRO"                 'Sound Blaster Pro
  66. SndDevMSE(5) = "SB16"                  'Sound Blaster 16
  67. SndDevMSE(6) = "PAS"                   'Pro AudioSpectrum 16
  68.  
  69. OPEN "MSE.CFG" FOR BINARY AS 1
  70.   GET 1, , MSEConfig
  71. CLOSE 1
  72. IF MSEConfig.SoundCard = 0 THEN
  73.   PRINT "No Sound Selected in SETUP. Please run SETUP."
  74.   END
  75. END IF
  76. '============================================================================
  77.  
  78. MSE$ = SndDevMSE(MSEConfig.SoundCard) + ".MSE"
  79.  
  80. SELECT CASE MSEConfig.SoundQuality
  81. CASE 0: Ov = 16
  82. CASE 1: Ov = 22
  83. CASE 2: Ov = 45
  84. CASE 3: Ov = 8
  85. END SELECT
  86.  
  87. 'Set up our sound system:
  88. ErrorFlag = LoadMSE(MSE$, 0, Ov, 4096, MSEConfig.BaseIO, MSEConfig.IRQ, MSEConfig.DMA)
  89.  
  90. SELECT CASE ErrorFlag
  91. CASE 0
  92. CASE 1: PRINT "Base I/O address autodetection failure": END
  93. CASE 2: PRINT "IRQ level autodetection failure": END
  94. CASE 3: PRINT "DMA channel autodetection failure": END
  95. CASE 4: PRINT "DMA channel not supported": END
  96. CASE 6: PRINT "Sound device does not respond": END
  97. CASE 7: PRINT "Memory control blocks destroyed": END
  98. CASE 8: PRINT "Insufficient memory for mixing buffers": END
  99. CASE 9: PRINT "Insufficient memory for MSE file": END
  100. CASE 10: PRINT "MSE has invalid identification string (corrupt/non-existant)": END
  101. CASE 11: PRINT "MSE disk read failure": END
  102. CASE 12: PRINT "MVSOUND.SYS not loaded (required for PAS use)": END
  103. CASE ELSE: PRINT "Unknown error on MSE startup" + STR$(ErrorFlag): END
  104. END SELECT
  105.  
  106. 'Display the actual settings *used* in the MSE.
  107. PRINT DeviceName$
  108. PRINT "Addr: "; HEX$(MSEConfig.BaseIO); "h  IRQ:"; MSEConfig.IRQ; " DMA:"; MSEConfig.DMA
  109.  
  110. IF LEN(COMMAND$) = 0 THEN INPUT "Module file: ", ModFile$ ELSE ModFile$ = COMMAND$
  111.  
  112. TestMOD:
  113. IF LEN(ModFile$) = 0 THEN END
  114. IF INSTR(ModFile$, ".") = 0 THEN ModFile$ = ModFile$ + ".GDM"
  115.  
  116. PRINT "Loading Module: "; ModFile$
  117.  
  118. IF EmsExist THEN ErrorFlag = 1 ELSE ErrorFlag = 0   'Setup EMS use flag
  119. File = FREEFILE
  120. OPEN ModFile$ FOR BINARY AS File
  121. 'Load our module
  122. LoadGDM FILEATTR(File, 2), 0, ErrorFlag, VARSEG(ModHead), VARPTR(ModHead)
  123. CLOSE File
  124.  
  125. SELECT CASE ErrorFlag
  126. CASE 0
  127. CASE 1: PRINT "Module is corrupt": END
  128. CASE 2: PRINT "Could not autodetect module type": END
  129. CASE 3: PRINT "Bad format ID": END
  130. CASE 4: PRINT "Out of memory": END
  131. CASE 5: PRINT "Cannot unpack samples": END
  132. CASE 6: PRINT "AdLib samples not supported": END
  133. CASE ELSE: PRINT "Unknown Load Error:" + STR$(ErrorFlag): END
  134. END SELECT
  135.  
  136. OverRate& = StartOutput(1, 0)             'Setup for 1 sound effect channel
  137.  
  138. CurSample = 0: CurFreq& = 22000: CurPan = 8
  139. CLS
  140. SetScreen
  141. DO
  142.   DO
  143.     G$ = INKEY$                          'Poll the keyboard for keys
  144.   LOOP UNTIL LEN(G$)
  145.   SELECT CASE ASC(RIGHT$(G$, 1))
  146.   CASE 72                                'Up key
  147.     IF CurSample THEN CurSample = CurSample - 1
  148.     UpScreen
  149.   CASE 80                                'Down key
  150.     CurSample = CurSample + 1
  151.     UpScreen
  152.   CASE 60, 44, 75                        '<
  153.     IF CurFreq& > 4000 THEN CurFreq& = CurFreq& - 1000
  154.     UpScreen
  155.   CASE 62, 46, 77                        '>
  156.     IF CurFreq& < 44000 THEN CurFreq& = CurFreq& + 1000
  157.     UpScreen
  158.   CASE 32                                'Space Bar
  159.     PlaySample 1, CurSample, CurFreq&, 64, CurPan
  160.   CASE 27                                'Esc
  161.     EXIT DO
  162.   END SELECT
  163. LOOP
  164.  
  165. FreeMSE                                'Unload the module and free MSE
  166. COLOR 7, 0
  167. CLS
  168. END
  169.  
  170. SUB SetScreen
  171. DIM Regs AS RegTypeX, SamHead AS SamHeader
  172.  
  173. File = FREEFILE
  174. OPEN "SND-PAD.BIN" FOR BINARY AS File
  175.   'Load the screen
  176.   Regs.ax = &H3F00
  177.   Regs.bx = FILEATTR(File, 2)
  178.   Regs.ds = &HB800: Regs.dx = 0
  179.   Regs.cx = 8000
  180.   CALL InterruptX(&H21, Regs, Regs)
  181. CLOSE File
  182.  
  183. COLOR 15, 4
  184. GetSampleTable 0, VARSEG(SamHead), VARPTR(SamHead)
  185. LOCATE 7, 5: PRINT SamHead.SamName;
  186.  
  187. COLOR 15, 0
  188. FOR J = 1 TO 17                        'Display all sample names
  189.   GetSampleTable J, VARSEG(SamHead), VARPTR(SamHead)
  190.   LOCATE J + 7, 5: PRINT SamHead.SamName;
  191. NEXT
  192. END SUB
  193.  
  194. SUB UpScreen
  195. DIM SamHead AS SamHeader
  196. SHARED CurSample, CurFreq&
  197. COLOR 15, 4
  198. GetSampleTable CurSample, VARSEG(SamHead), VARPTR(SamHead)
  199. LOCATE 7, 5: PRINT SamHead.SamName;
  200. COLOR 7, 1: LOCATE , 2: PRINT RIGHT$(RTRIM$(STR$(CurSample)), 2);
  201.  
  202. FOR J = 1 TO 17                        'Display all sample names
  203.   GetSampleTable J + CurSample, VARSEG(SamHead), VARPTR(SamHead)
  204.   COLOR 15, 0: LOCATE J + 7, 5: PRINT SamHead.SamName;
  205.   COLOR 7, 1: LOCATE , 2: PRINT RIGHT$(RTRIM$(STR$(J + CurSample)), 2);
  206. NEXT
  207.  
  208. F = CurFreq& \ 1000
  209. COLOR 15, 0: LOCATE 15, 68: PRINT RIGHT$(RTRIM$(STR$(F)), 2);
  210.  
  211. COLOR 0, 7
  212. LOCATE 16, 40: PRINT STRING$(F - 4, 196);
  213. LOCATE 16, 36 + F: PRINT "■";
  214. PRINT STRING$(44 - F, 196);
  215. END SUB
  216.  
  217.