home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / STK100.ZIP / PLAYDWM.BAS < prev    next >
BASIC Source File  |  1995-01-12  |  12KB  |  374 lines
  1. '******************************************************************************
  2. 'FILE:      playdwm.bas
  3. 'Tab stops: every 2 collumns
  4. 'Project:   DWD Player
  5. 'Copyright: 1994 DiamondWare, Ltd.  All rights reserved.*
  6. 'Written:   Erik Lorenzen & Don Lemmons
  7. 'Purpose:   Contains simple example code to show how to load/play a .DWM file
  8. 'History:   KW 10/21/94 Started playdwm.c
  9. '           DL 11/12/94 Translated to BASIC
  10. '           EL 01/12/95 Cleaned up & Finalized
  11. '
  12. 'Notes
  13. '-----
  14. '
  15. 'The bulk of this file is error checking logic.
  16. '
  17. 'However, this code isn't really robust when it comes to standard error checking
  18. 'and particularly recovery, software engineering technique, etc.  A buffer of
  19. 'size 32767 is statically allocated.  A better technique would be to
  20. 'determine the file's size.  The STK will handle songs larger than 64K
  21. '(but not digitized sounds). Also, exitting and cleanup is not handled
  22. 'robustly in this code.  The code below can only be validated by
  23. 'extremely careful scrutiny to make sure each case is handled properly.
  24. '
  25. 'But all such code would make this example file less clear; its purpose was
  26. 'to illustrate how to call the STK, not how to write QA-proof software.
  27. '
  28. '
  29. '*Permission is expressely granted to use DisplayError or any derivitive made
  30. ' from it to registered users of the STK.
  31. '******************************************************************************/
  32.  
  33.  
  34.  
  35. '$INCLUDE: 'dws.bi'
  36. '$INCLUDE: 'dwt.bi'
  37.  
  38.  
  39.  
  40. TYPE BUFFTYP
  41.     buf AS STRING * 32767
  42. END TYPE
  43.  
  44.  
  45.  
  46. 'DECLARE VARIABLES
  47.     COMMON SHARED dov     AS dwsDETECTOVERRIDES
  48.     COMMON SHARED dres    AS dwsDETECTRESULTS
  49.     COMMON SHARED ideal AS dwsIDEAL
  50.     COMMON SHARED mplay AS dwsMPLAY
  51.  
  52.  
  53.  
  54. DIM SHARED buffer(0) AS BUFFTYP 'set aside string area for song to load into
  55.                                                                 'by doing it this way we give QBasic the
  56.                                                                 'opportunity to place the song into far mem
  57.  
  58.  
  59.  
  60. SUB DisplayError(errornum)
  61.     SELECT CASE errornum
  62.  
  63.         CASE dwsEZERO
  64.             'This should not have happened, considering how we got here!
  65.             PRINT"I'm confused!  Where am I?  HOW DID I GET HERE????"
  66.             PRINT "The ERROR number is:";errornum
  67.  
  68.         CASE dwsNOTINITTED
  69.             'If we get here, it means you haven't called dwsInit().
  70.             'The STK needs to initialize itself and the hardware before
  71.             'it can do anything.
  72.             PRINT"The STK was not initialized"
  73.  
  74.         CASE dwsALREADYINITTED
  75.             'If we get here, it means you've called dwsInit() already.    Calling
  76.             'dwsDetectHardWare() at this point would cause zillions of
  77.             'problems if we let the call through.
  78.             PRINT"The STK was already initialized"
  79.  
  80.         CASE dwsNOTSUPPORTED:
  81.             'If we get here, it means that either the user's machine does not
  82.             'support the function you just called, or the STK was told not to
  83.             'support it in dwsInit.
  84.             PRINT"Function not supported"
  85.  
  86.         CASE dwsDetectHardwareUNSTABLESYSTEM
  87.             ' Please report it to DiamondWare if you get here!
  88.             '
  89.             ' Ideally, you would disable control-C here, so that the user can't
  90.             ' hit control-alt-delete, causing SmartDrive to flush its (possibly
  91.             ' currupt) buffers.
  92.             PRINT"The system is unstable!"
  93.             PRINT"Please power down now!"
  94.  
  95.             AGAIN:
  96.             GOTO AGAIN
  97.  
  98.         'The following three errors are USER/PROGRAMMER errors.  You forgot
  99.         'to fill the cardtyp struct full of -1's (except in those fields
  100.         'you intended to override, or the user (upon the unlikly event that
  101.         'the STK was unable to find a card) gave you a bad overide value.
  102.  
  103.         CASE dwsDetectHardwareBADBASEPORT
  104.             'You set dov.baseport to a bad value, or
  105.             'didn't fill it with a -1.
  106.             PRINT"Bad port address"
  107.  
  108.         CASE dwsDetectHardwareBADDMA
  109.             'You set dov.digdma to a bad value, or
  110.             'didn't fill it with a -1.
  111.             PRINT"Bad DMA channel"
  112.  
  113.         CASE dwsDetectHardwareBADIRQ
  114.             'You set dov.digirq to a bad value, or
  115.             'didn't fill it with a -1.
  116.             PRINT"Bad IRQ level"
  117.  
  118.         CASE dwsKillCANTUNHOOKISR
  119.             'The STK points the interrupt vector for the sound card's IRQ
  120.             'to its own code in dws_Init.
  121.             '
  122.             'dws_Kill was unable to restore the vector to its original
  123.             'value because other code has hooked it after the STK
  124.             'initialized(!)  This is really bad.  Make the user get rid
  125.             'of it and call dws_Kill again.
  126.  
  127.             PRINT"Get rid of your TSR, pal!"
  128.             INPUT"(Hit ENTER when ready)";g$
  129.  
  130.         CASE dwsXBADINPUT
  131.             'The mixer funtion's can only accept volumes between 0 & 255,
  132.             'the volume will remain unchanged.
  133.  
  134.             PRINT"Bad mixer level"
  135.  
  136.         CASE dwsDNOTADWD
  137.             'You passed the STK a pointer to something which is not a .DWD file!
  138.             PRINT"The file you are attempting to play is not a .DWD"
  139.  
  140.         CASE dwsDNOTSUPPORTEDVER
  141.             'The STK can't play a .DWD converted using a version of VOC2DWD.EXE
  142.             'newer than itself.  And, although we'll try to maintain backwards
  143.             'compatibility, we may not be able to guarantee that newer versions
  144.             'of the code will be able to play older .DWD files.  In any event,
  145.             'it's a good idea to always convert .VOC files with the utility
  146.             'which comes with the library you're linking into your application.
  147.             PRINT"Please reconvert this file using the VOC2DWD program which came with this library"
  148.  
  149.         CASE dwsDINTERNALERROR
  150.             'This error should never occur and probably will not affect sound
  151.             'play(?). If it happens please contact DiamondWare.
  152.             PRINT"An internal error has occured"
  153.             PRINT"Please contact DiamondWare"
  154.  
  155.         CASE dwsDPlayNOSPACEFORSOUND
  156.             'This error is more like a warning, though it may happen on a
  157.             'regular basis, depending on how many sounds you told the STK
  158.             'to allow in dws_Init, how you chose to prioritize sounds and
  159.             'how many sounds are currently being played.
  160.             PRINT"No more room for new digitized sounds right now"
  161.  
  162.         CASE dwsDSetRateFREQTOLOW
  163.             'The STK will set rate as close as possible to the indicated rate
  164.             'but cannot set a rate that low.
  165.             PRINT"Playback frequency too low"
  166.  
  167.         CASE dwsDSetRateFREQTOHIGH
  168.             'The STK will set rate as close as possible to the indicated rate
  169.             'but cannot set a rate that high.
  170.             PRINT"Playback frequency too high"
  171.  
  172.         CASE dwsMPlayNOTADWM
  173.             'You passed the STK a pointer to something which is not a .DWM file!
  174.             PRINT"The file you are attempting to play is not a .DWM"
  175.  
  176.         CASE dwsMPlayNOTSUPPORTEDVER
  177.             'The STK can't play a .DWM converted using a version of VOC2DWM.EXE
  178.             'newer than itself.  And, although we'll try to maintain backwards
  179.             'compatibility, we may not be able to guarantee that newer versions
  180.             'of the code will be able to play older .DWM files.  In any event,
  181.             'it's a good idea to always convert .MID files with the utility
  182.             'which comes with the library you're linking into your application.
  183.             PRINT"Please reconvert this file using the MID2DWM.EXE which came with this library";
  184.  
  185.         CASE dwsMPlayINTERNALERROR:
  186.             'This error should never occur and probably will not affect sound
  187.             'play(?). If it happens please contact DiamondWare.
  188.             PRINT"An internal error has occured.  Please contact DiamondWare."
  189.  
  190.         CASE ELSE
  191.             'This should never occur and probably will not affect sound
  192.             'play(?). If it happens please contact DiamondWare.
  193.             PRINT"I'm confused!  Where am I?  HOW DID I GET HERE????"
  194.             PRINT "The ERROR number is:";errornum
  195.  
  196.     END SELECT
  197.  
  198. END SUB
  199.  
  200.  
  201.  
  202. 'START OF MAIN
  203.  
  204.     PRINT
  205.     PRINT "PLAYDWM is Copyright 1994, DiamondWare, Ltd."
  206.     PRINT "All rights reserved."
  207.     PRINT : PRINT : PRINT
  208.  
  209.     timerinited = FALSE
  210.     musvol%         = 255
  211.  
  212.     filename$ = LTRIM$(RTRIM$(COMMAND$))
  213.     IF filename$ = "" THEN
  214.         PRINT "Usage PLAYDWD <dwd-file>"
  215.         GOTO ProgramExit
  216.     END IF
  217.  
  218.     'get the file length
  219.     IF INSTR(filename$, ".DWM") = 0 THEN filename$ = ".DWM"
  220.  
  221.     OPEN filename$ FOR BINARY AS #1 LEN = 1
  222.     filelen = LOF(1)
  223.     CLOSE #1
  224.  
  225.     IF filelen = 0 THEN
  226.         PRINT "File Not Found"
  227.         GOTO ProgramExit
  228.     END IF
  229.  
  230.     IF filelen > 32767 THEN
  231.         PRINT "File Too Big"
  232.         GOTO ProgramExit
  233.     END IF
  234.  
  235.     OPEN filename$ FOR BINARY AS #1 LEN = 1
  236.     GET #1, 1, buffer(0).buf
  237.     CLOSE #1
  238.  
  239.     'We need to set every field to -1 in dwsDETECTOVERRIDES struct; this
  240.     'tells the STK to autodetect everything.  Any other value
  241.     'overrides the autodetect routine, and will be accepted on
  242.     'faith, though the STK will verify it if possible.
  243.  
  244.     dov.baseport = -1
  245.     dov.digdma     = -1
  246.     dov.digirq     = -1
  247.  
  248.     IF DWSDetectHardWare(dov, dres) = 0 THEN
  249.         errnum = dwsErrNo
  250.         DisplayError(errnum)
  251.         GOTO ProgramExit
  252.     END IF
  253.  
  254.     IF (dres.capability AND dwscapabilityFM) <> dwscapabilityFM THEN
  255.         PRINT"FM support not found"
  256.         PRINT dres.capability
  257.         GOTO ProgramExit
  258.     END IF
  259.  
  260.     'The "ideal" struct tells the STK how you'd like it to initialize the
  261.     'sound hardware.      In all cases, if the hardware won't support your
  262.     'request, the STK will go as close as possible.  For example, not all
  263.     'sound boards will support al sampling rates (some only support 5 or
  264.     '6 discrete rates).
  265.  
  266.     ideal.musictyp     = 1                    '0=No music, 1=OPL2
  267.     ideal.digtyp         = 0                    '0=No Dig, 8=8bit, 16=16bit
  268.     ideal.digrate      = 0                    'sampling rate, in Hz
  269.     ideal.dignvoices = 0                    'number of voicws.bies (up to 16)
  270.     ideal.dignchan     = 0                    '1=mono, 2=stereo
  271.  
  272.     IF dwsInit(dres, ideal) = 0 THEN
  273.         errnum = dwsErrNo
  274.         DisplayError(errnum)
  275.         GOTO ProgramKill
  276.     END IF
  277.  
  278.     'Set music vol to about 4/5ths of max
  279.     musvol% = 200
  280.     IF dwsXMusic(musvol%) = 0 THEN
  281.         errnum = dwsErrNo
  282.         DisplayError(errnum)
  283.     END IF
  284.  
  285.     '72.8Hz is a decent compromise.  It will work in a Windows DOS box
  286.     'without any problems, and yet it allows music to sound pretty good.
  287.     'In my opinion, there's no reason to go lower than 72.8 (unless you
  288.     'don't want the hardware timer reprogrammed)--music sounds kinda chunky
  289.     'at lower rates.  You can go to 145.6 Hz, and get smoother (very
  290.     'subtly) sounding music, at the cost that it will NOT run at the correct
  291.     '(or constant) speed in a Windows DOS box.
  292.  
  293.     dwtInit(dwt728HZ)
  294.     timerinited = TRUE
  295.  
  296.     soundseg% = VARSEG(buffer(0).buf)
  297.     soundoff% = VARPTR(buffer(0).buf)
  298.     pointer&    = soundseg% * 256 ^ 2 + soundoff%  'make pointer
  299.  
  300.     mplay.track = pointer&
  301.     mplay.count = 1                  '0=infinite loop, 1-N num times to play sound
  302.  
  303.     IF dwsMPlay(mplay) = 0 THEN
  304.         errnum = dwsErrNo
  305.         DisplayError(errnum)
  306.         GOTO ProgramKill
  307.     END IF
  308.  
  309.     'We're playing.  Let's exit when the song is over, and allow the user
  310.     'to fiddle with the volume level (mixer) in the meantime
  311.  
  312.     PRINT"Press + or - to change playback volume"
  313.  
  314.     result% = dwsMSONGSTATUSPLAYING
  315.     DO UNTIL (result%  AND dwsMSONGSTATUSPLAYING) <> dwsMSONGSTATUSPLAYING
  316.         inpt$ = INKEY$
  317.  
  318.         IF inpt$ = "+" THEN
  319.             musvol% = musvol% + 1
  320.  
  321.             PRINT"Music Volume is ";musvol%
  322.  
  323.             IF dwsXMusic(musvol%) = 0 THEN
  324.                 errnum = dwsErrNo
  325.                 DisplayError(errnum)
  326.             END IF
  327.         END IF
  328.  
  329.         IF inpt$ = "-" THEN
  330.             musvol% = musvol% - 1
  331.  
  332.             PRINT"Music Volume is ";musvol%
  333.  
  334.             IF dwsXMusic(musvol%) = 0 THEN
  335.                 errnum = dwsErrNo
  336.                 DisplayError(errnum)
  337.             END IF
  338.         END IF
  339.  
  340.         IF inpt$ = "q" OR inpt$ = "q" OR inpt$ = chr$(27) THEN
  341.             GOTO ProgramKill
  342.         END IF
  343.  
  344.         IF dwsMSongStatus(result%) = 0 THEN
  345.             errnum = dwsErrNo
  346.             DisplayError(errnum)
  347.             GOTO ProgramKill
  348.         END IF
  349.     LOOP
  350.  
  351.     ProgramKill:
  352.  
  353.     IF timerinited = TRUE THEN
  354.         timerinited = FALSE
  355.         dwtKill
  356.     END IF
  357.  
  358.     IF dwsKill = 0 THEN
  359.         errnum = dwsErrNo
  360.         DisplayError(errnum)
  361.  
  362.         'If an error occurs here, it's either dws_Kill_CANTUNHOOKISR
  363.         'or dws_NOTINITTED.  If it's dws_Kill_CANTUNHOOKISR the user
  364.         'must remove his tsr, and dws_Kill must be called again.  If it's
  365.         'dws_NOTINITTED, there's nothing to worry about at this point.
  366.         IF errnum = dwsKillCANTUNHOOKISR THEN
  367.             GOTO ProgramKill
  368.         END IF
  369.     END IF
  370.  
  371.     ProgramExit:
  372.  
  373. END
  374.