home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 25 / CD_ASCQ_25_1095.iso / dos / prg / dwstk200 / playdwm.bas < prev    next >
BASIC Source File  |  1995-06-26  |  6KB  |  215 lines
  1. '******************************************************************************
  2. 'File:      playdwm.bas
  3. 'Version:   2.00
  4. 'Tab stops: every 2 columns
  5. 'Project:   DWD Player
  6. 'Copyright: 1994-1995 DiamondWare, Ltd.  All rights reserved.
  7. 'Written:   Erik Lorenzen & Don Lemmons
  8. 'Purpose:   Contains simple example code to show how to load/play a .DWM file
  9. 'History:   94/10/21 KW Started playdwm.c
  10. '           94/11/12 DL Translated to BASIC
  11. '           95/01/12 EL Cleaned up & Finalized
  12. '           95/03/22 EL Finalized for 1.01
  13. '           95/04/11 EL Finalized for 1.02
  14. '           95/06/06 EL Finalized for 1.03 (no changes)
  15. '           95/06/06 EL Finalized for 2.00 (no changes)
  16. '
  17. 'Notes
  18. '-----
  19. 'This code isn't really robust when it comes to standard error checking
  20. 'and particularly recovery, software engineering technique, etc.  A buffer
  21. 'is statically allocated.  A better technique would be to use fstat() or stat()
  22. 'to determine the file's size then malloc(size).    The STK will handle songs
  23. 'larger than 64K (but not digitized sounds).  Obviously, you'd need to fread()
  24. 'such a file in chunks, or write some sort of hfread() (huge fread).  Also,
  25. 'exitting and cleanup is not handled robustly in this code.  The code below can
  26. 'only be validated by extremely careful scrutiny to make sure each case is
  27. 'handled properly.  A better method would the use of C's atexit function.
  28. '
  29. 'But all such code would make this example file less clear; its purpose was
  30. 'to illustrate how to call the STK, not how to write QA-proof software.
  31. '******************************************************************************/
  32.  
  33.  
  34.  
  35. '$INCLUDE: 'dws.bi'
  36. '$INCLUDE: 'dwt.bi'
  37. '$INCLUDE: 'err.bi'
  38.  
  39.  
  40.  
  41. TYPE BUFFTYP
  42.     buf AS STRING * 32767
  43. END TYPE
  44.  
  45.  
  46.  
  47. 'DECLARE VARIABLES
  48.     COMMON SHARED dov     AS dwsDETECTOVERRIDES
  49.     COMMON SHARED dres    AS dwsDETECTRESULTS
  50.     COMMON SHARED ideal AS dwsIDEAL
  51.     COMMON SHARED mplay AS dwsMPLAY
  52.  
  53.  
  54.  
  55. DIM SHARED buffer(0) AS BUFFTYP 'set aside string area for song to load into
  56.                                                                 'by doing it this way we give QBasic the
  57.                                                                 'opportunity to place the song into far mem
  58. 'START OF MAIN
  59.  
  60.     PRINT
  61.     PRINT "PLAYDWM 2.00 is Copyright 1994-95, DiamondWare, Ltd."
  62.     PRINT "All rights reserved."
  63.     PRINT : PRINT : PRINT
  64.  
  65.     musvol%         = 255
  66.  
  67.     filename$ = LTRIM$(RTRIM$(COMMAND$))
  68.     IF filename$ = "" THEN
  69.         PRINT "Usage PLAYDWD <dwd-file>"
  70.         GOTO ProgramExit
  71.     END IF
  72.  
  73.     OPEN filename$ FOR BINARY AS #1 LEN = 1
  74.     filelen = LOF(1)
  75.     CLOSE #1
  76.  
  77.     IF filelen = 0 THEN
  78.         PRINT "File Not Found"
  79.         GOTO ProgramExit
  80.     END IF
  81.  
  82.     IF filelen > 32767 THEN
  83.         PRINT "File Too Big"
  84.         GOTO ProgramExit
  85.     END IF
  86.  
  87.     OPEN filename$ FOR BINARY AS #1 LEN = 1
  88.     GET #1, 1, buffer(0).buf
  89.     CLOSE #1
  90.  
  91.     'We need to set every field to -1 in dwsDETECTOVERRIDES struct; this
  92.     'tells the STK to autodetect everything.  Any other value
  93.     'overrides the autodetect routine, and will be accepted on
  94.     'faith, though the STK will verify it if possible.
  95.  
  96.     dov.baseport = -1
  97.     dov.digdma     = -1
  98.     dov.digirq     = -1
  99.  
  100.     IF DWSDetectHardWare(dov, dres) = 0 THEN
  101.         errDisplay
  102.         GOTO ProgramExit
  103.     END IF
  104.  
  105.     IF (dres.capability AND dwscapabilityFM) <> dwscapabilityFM THEN
  106.         PRINT"FM support not found"
  107.         GOTO ProgramExit
  108.     END IF
  109.  
  110.     'The "ideal" struct tells the STK how you'd like it to initialize the
  111.     'sound hardware.      In all cases, if the hardware won't support your
  112.     'request, the STK will go as close as possible.  For example, not all
  113.     'sound boards will support al sampling rates (some only support 5 or
  114.     '6 discrete rates).
  115.  
  116.     ideal.musictyp     = 1                    '0=No music, 1=OPL2
  117.     ideal.digtyp         = 0                    '0=No Dig, 8=8bit, 16=16bit
  118.     ideal.digrate      = 0                    'sampling rate, in Hz
  119.     ideal.dignvoices = 0                    'number of voicws.bies (up to 16)
  120.     ideal.dignchan     = 0                    '1=mono, 2=stereo
  121.  
  122.     IF dwsInit(dres, ideal) = 0 THEN
  123.         errDisplay
  124.         GOTO ProgramKill
  125.     END IF
  126.  
  127.     'Set music vol to about 4/5ths of max
  128.     musvol% = 200
  129.     IF dwsXMusic(musvol%) = 0 THEN
  130.         errDisplay
  131.     END IF
  132.  
  133.     '72.8Hz is a decent compromise.  It will work in a Windows DOS box
  134.     'without any problems, and yet it allows music to sound pretty good.
  135.     'In my opinion, there's no reason to go lower than 72.8 (unless you
  136.     'don't want the hardware timer reprogrammed)--music sounds kinda chunky
  137.     'at lower rates.  You can go to 145.6 Hz, and get smoother (very
  138.     'subtly) sounding music, at the cost that it will NOT run at the correct
  139.     '(or constant) speed in a Windows DOS box.
  140.  
  141.     dwtInit(dwt728HZ)
  142.  
  143.     soundseg% = VARSEG(buffer(0).buf)
  144.     soundoff% = VARPTR(buffer(0).buf)
  145.     pointer&    = soundseg% * 256 ^ 2 + soundoff%  'make pointer
  146.  
  147.     mplay.track = pointer&
  148.     mplay.count = 1                  '0=infinite loop, 1-N num times to play sound
  149.  
  150.     IF dwsMPlay(mplay) = 0 THEN
  151.         errDisplay
  152.         GOTO ProgramKill
  153.     END IF
  154.  
  155.     'We're playing.  Let's exit when the song is over, and allow the user
  156.     'to fiddle with the volume level (mixer) in the meantime
  157.  
  158.     PRINT"Press + or - to change playback volume"
  159.  
  160.     result% = dwsMSONGSTATUSPLAYING
  161.     DO UNTIL (result%  AND dwsMSONGSTATUSPLAYING) <> dwsMSONGSTATUSPLAYING
  162.         inpt$ = INKEY$
  163.  
  164.         IF inpt$ = "+" THEN
  165.             musvol% = musvol% + 1
  166.  
  167.             PRINT"Music Volume is ";musvol%
  168.  
  169.             IF dwsXMusic(musvol%) = 0 THEN
  170.                 errDisplay
  171.             END IF
  172.         END IF
  173.  
  174.         IF inpt$ = "-" THEN
  175.             musvol% = musvol% - 1
  176.  
  177.             PRINT"Music Volume is ";musvol%
  178.  
  179.             IF dwsXMusic(musvol%) = 0 THEN
  180.                 errDisplay
  181.             END IF
  182.         END IF
  183.  
  184.         IF inpt$ = "q" OR inpt$ = "q" OR inpt$ = chr$(27) THEN
  185.             GOTO ProgramKill
  186.         END IF
  187.  
  188.         IF dwsMSongStatus(result%) = 0 THEN
  189.             errDisplay
  190.             GOTO ProgramKill
  191.         END IF
  192.     LOOP
  193.  
  194.     ProgramKill:
  195.  
  196.     'If dwt is not inited calling dwt_Kill will have no effect
  197.     dwtKill
  198.  
  199.     IF dwsKill = 0 THEN
  200.         errnum = dwsErrNo
  201.         errDisplay
  202.  
  203.         'If an error occurs here, it's either dws_Kill_CANTUNHOOKISR
  204.         'or dws_NOTINITTED.  If it's dws_Kill_CANTUNHOOKISR the user
  205.         'must remove his tsr, and dws_Kill must be called again.  If it's
  206.         'dws_NOTINITTED, there's nothing to worry about at this point.
  207.         IF errnum = dwsKillCANTUNHOOKISR THEN
  208.             GOTO ProgramKill
  209.         END IF
  210.     END IF
  211.  
  212.     ProgramExit:
  213.  
  214. END
  215.