home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / m / m003_1 / sdk_dos.ddi / BASIC / EFFECT / DEMOFPV.BAS
Encoding:
BASIC Source File  |  1991-11-13  |  7.3 KB  |  311 lines
  1. '
  2. ' This program demonstrates the panning and fading effect using auxiliary
  3. ' driver.
  4. '
  5.  
  6. ' $INCLUDE: 'SBC.BI'
  7. ' $INCLUDE: 'SBCSYS.BI'
  8. ' $INCLUDE: 'SBCVOICE.BI'
  9. ' $INCLUDE: 'AUXDRV.BI'
  10.  
  11. DECLARE   FUNCTION  GETFHANDLE% (filename$)
  12. DECLARE   FUNCTION  OUTVOC% (fh%)
  13. DECLARE   SUB  SHOWERROR ()
  14. DECLARE   SUB  WAITEFFECT ()
  15. DECLARE   SUB  SNDEFFECT ()
  16.  
  17. CONST     VOCVOL=1
  18.  
  19.  
  20. REM $DYNAMIC
  21. CLEAR
  22.  
  23. DIM   handle AS INTEGER
  24.  
  25.  
  26. ' Following statements free memory for the loadable drivers.
  27. ' You must free sufficient memory for the loadable drivers.
  28. ' The free memory must be larger than the driver file size.
  29.  
  30. ' Free 8K memory for the CTVDSK.DRV at the moment
  31. DUMMY = SETMEM(-8192)
  32.  
  33. ' Free 8K memory for the AUXDRV.DRV at the moment
  34. DUMMY = SETMEM(-8192)
  35.  
  36. ' Following statements free memory for the Disk Double Buffer
  37. ' Two 32K buffers are released by BASIC
  38. DUMMY = SETMEM(-16400)
  39. DUMMY = SETMEM(-16400)
  40. DUMMY = SETMEM(-16400)
  41. DUMMY = SETMEM(-16400)
  42.  
  43. CLS
  44.  
  45. PRINT "SBK Basic Panning and Fading Effect Example"
  46.  
  47. IF (SBGETENV% = 0) THEN
  48.     IF SBCHKCRD% THEN
  49.         IF SBTSTINT% THEN
  50.             IF SBTSTDMA% >= 0 THEN
  51.  
  52.                 ' Load CTVDSK.DRV
  53.                 DSKSEG% = LOADDRV% ("CTVDSK.DRV")
  54.  
  55.                 ' If driver loaded successfully
  56.                 IF (DSKSEG% <> 0) THEN
  57.                     ' Set driver address
  58.                     DSKADDX (DSKSEG%)
  59.  
  60.                     ' Load AUXDRV.DRV
  61.                     AUXSEG% = LOADDRV% ("AUXDRV.DRV")
  62.  
  63.                     ' If driver loaded successfully
  64.                     IF (AUXSEG% <> 0) THEN
  65.                         ' Set driver address
  66.                         AUXADDX (AUXSEG%)
  67.  
  68.                         ' Initial the driver,
  69.                         ' with 64K buffer as double buffer
  70.                         IF ( SVDINIT%((16)) = 0 ) THEN
  71.  
  72.                             handle = GETFHANDLE% ("DEMO1.VOC")
  73.  
  74.                             IF ( handle <> 0 ) THEN
  75.  
  76.                                 ' Output the voice file
  77.                                 IF ( OUTVOC% (handle) ) THEN
  78.  
  79.                                     ' perform effect
  80.                                     CALL SNDEFFECT
  81.                                 ENDIF
  82.  
  83.                                 CALL DOSCLOSE (handle)
  84.                             ENDIF
  85.  
  86.                             ' Terminate the driver
  87.                             CALL SVDEXIT
  88.                         ELSE
  89.                             CALL SHOWERROR
  90.                         ENDIF
  91.  
  92.                         ' Release memory allocated for AUXDRV
  93.                         CALL FREEMEM(AUXSEG%)
  94.                     ENDIF
  95.  
  96.                     ' Release memory allocated for CTVDSK
  97.                     CALL FREEMEM(DSKSEG%)
  98.                 ENDIF
  99.             ELSE
  100.                 PRINT "Error on DMA channel."
  101.             ENDIF
  102.         ELSE
  103.             PRINT "Error on interrupt."
  104.         ENDIF
  105.     ELSE
  106.         PRINT "Sound Blaster Card not found or wrong I/O setting"
  107.     ENDIF
  108. ELSE
  109.     PRINT "BLASTER environment variable not set or incomplete or invalid."
  110. ENDIF
  111.  
  112. ' Return the memory to BASIC
  113. DUMMY = SETMEM(16400)
  114. DUMMY = SETMEM(16400)
  115. DUMMY = SETMEM(16400)
  116. DUMMY = SETMEM(16400)
  117.  
  118. DUMMY = SETMEM(8192)
  119. DUMMY = SETMEM(8192)
  120.  
  121. END
  122.  
  123.  
  124. ' ------------------------------------------------------------------------ '
  125.  
  126. FUNCTION LOADDRV% (szDrvName$)
  127.  
  128.     DIM szDrvFile$, Handle%, dwFileLen&, wDrvSeg%
  129.  
  130.  
  131.     LOADDRV% = 0
  132.  
  133.     ' search SOUND environment for driver
  134.     szDrvFile$ = ENVIRON$("SOUND")
  135.  
  136.     IF (szDrvFile$ <> "") THEN
  137.         szDrvFile$ = szDrvFile$ + "\DRV\" + szDrvName$
  138.  
  139.         IF (FINDFILE%(szDrvFile$) = 0) THEN
  140.             szDrvFile$ = ""
  141.         ENDIF
  142.     ENDIF
  143.  
  144.     ' search the current directory for driver
  145.     IF (szDrvFile$ = "") THEN
  146.         szDrvFile$ = szDrvName$
  147.     ENDIF
  148.  
  149.     IF (FINDFILE%(szDrvFile$) <> 0) THEN
  150.         Handle% = DOSOPEN%(szDrvFile$)
  151.  
  152.         IF (Handle% <> 0) THEN
  153.             dwFileLen& = FILESIZE(Handle%)
  154.  
  155.             wDrvSeg% = ALLOCMEM(INT((dwFileLen& + 15) / 16))
  156.  
  157.             IF (wDrvSeg% <> 0) THEN
  158.                 IF DOSREAD%(Handle%, INT(0), wDrvSeg%, dwFileLen&) THEN
  159.                     LOADDRV% = wDrvSeg%
  160.                 ENDIF
  161.             ENDIF
  162.  
  163.             DOSCLOSE(Handle%)
  164.         ELSE
  165.             PRINT "Error in opening " + szDrvFile$
  166.         ENDIF
  167.     ELSE
  168.         PRINT "Driver file " + szDrvName$ + " does not exist ..."
  169.     ENDIF
  170.  
  171. END FUNCTION
  172.  
  173.  
  174. ' ------------------------------------------------------------------------ '
  175.  
  176.  
  177. REM %STATIC
  178. FUNCTION  GETFHANDLE% (filename$)
  179.  
  180.     DIM  retval AS INTEGER
  181.  
  182.  
  183.     ' Open the file using DOS function
  184.     retval = DOSOPEN%(filename$)
  185.  
  186.     IF (retval = 0) THEN
  187.         PRINT "Open " +filename$ + "error."
  188.     ENDIF
  189.  
  190.     GETFHANDLE% = retval
  191.  
  192. END FUNCTION
  193.  
  194.  
  195. ' ------------------------------------------------------------------------ '
  196.  
  197. REM %STATIC
  198. FUNCTION  OUTVOC% (fh%)
  199.  
  200.     OUTVOC% = 1
  201.  
  202.     ' Turn on speaker
  203.     SVDSPKER(INT(1))
  204.  
  205.     ' Start the output
  206.     IF (SVDOUTPUT%(fh%) <> 0) THEN
  207.         OUTVOC% = 0
  208.         CALL SHOWERROR
  209.     ENDIF
  210.  
  211. END FUNCTION
  212.  
  213.  
  214. ' ------------------------------------------------------------------------ '
  215.  
  216. SUB WAITEFFECT
  217.  
  218.     DIM  userkey AS INTEGER, dummy AS INTEGER
  219.  
  220.  
  221.     WHILE ( CTFADE% OR CTPAN% )
  222.         ' Stop effect if no voice process
  223.         IF CTVOICE% = 0 THEN
  224.             dummy = AXSTOP
  225.         ENDIF
  226.  
  227.         c$ = INKEY$
  228.  
  229.         IF c$ <> "" THEN
  230.             userkey = INT(ASC(LEFT$(c$, 1)))
  231.  
  232.             SELECT CASE userkey
  233.                 CASE ASC("S"), ASC("s"), 27
  234.                     dummy = AXSTOP
  235.                     CALL SVDSTOP
  236.                 CASE ASC("P"), ASC("p")
  237.                     dummy = AXPAUSE
  238.                     CALL SVDPAUSE
  239.                 CASE ASC("C"), ASC("c")
  240.                     dummy = AXSTART
  241.                     CALL SVDCONT
  242.             END SELECT
  243.         END IF
  244.     WEND
  245.  
  246. END SUB
  247.  
  248.  
  249. ' ------------------------------------------------------------------------ '
  250.  
  251. SUB SNDEFFECT
  252.  
  253.     DIM  wPrevVol AS INTEGER, dummy AS INTEGER
  254.  
  255.  
  256.     CALL AXINIT
  257.  
  258.     ' preserve previous volume status
  259.     wPrevVol = AXGETVOL% (VOCVOL)
  260.  
  261.     ' set voice left/right volume to 0
  262.     dummy = AXSETVOL% (VOCVOL,0)
  263.  
  264.     ' setup voice volume fading in mode 0
  265.     dummy = AXFADE% (VOCVOL, &HF0F0, 5000, 0, 0)
  266.     dummy = AXSTART%
  267.     CALL WAITEFFECT
  268.  
  269.     ' setup digitized sound for panning in mode 1
  270.     ' and repeat for 5 times
  271.     dummy = AXPAN% (VOCVOL, 0, 255, 600, 1, 5)
  272.     dummy = AXSTART%
  273.     CALL WAITEFFECT
  274.  
  275.     ' set voice left/right volume to &HF0F0
  276.     dummy = AXSETVOL% (VOCVOL,&HF0F0)
  277.  
  278.     ' setup voice volume fading in mode 0
  279.     dummy = AXFADE% (VOCVOL, 0, 5000, 0, 0)
  280.     dummy = AXSTART%
  281.     CALL WAITEFFECT
  282.  
  283.     ' set voice left/right volume back to previous status
  284.     dummy = AXSETVOL% (VOCVOL,wPrevVol)
  285.  
  286.     CALL AXEXIT
  287.  
  288. END SUB
  289.  
  290.  
  291. ' ------------------------------------------------------------------------ '
  292.  
  293. SUB  SHOWERROR
  294.  
  295. ' This function show the error code from the driver
  296.  
  297.     DIM  errcode AS INTEGER
  298.  
  299.     errcode = SVDDRVERR%
  300.  
  301.     PRINT "Driver error ="; errcode
  302.  
  303.     errcode = SVDEXTERR%
  304.  
  305.     IF (errcode <> 0) THEN
  306.        PRINT "Dos error ="; errcode
  307.     ENDIF
  308.  
  309. END SUB
  310.  
  311.