home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 25 / CD_ASCQ_25_1095.iso / dos / prg / dwstk200 / playdwm.pas < prev    next >
Pascal/Delphi Source File  |  1995-06-26  |  6KB  |  268 lines
  1. (******************************************************************************
  2. File:                          playdwm.pas
  3. Version:                     2.00
  4. Tab stops:                 every 2 columns
  5. Project:                     DWM Player
  6. Copyright:                 1994-1995 DiamondWare, Ltd.    All rights reserved.
  7. Written:                     Keith Weiner & Erik Lorenzen
  8. Pascal Conversion: David A. Johndrow
  9. Purpose:                     Contains simple example code to show how to load/play a
  10.                                      .DWM file
  11. History:                     94/10/21 KW Started playdwm.c
  12.                                      94/11/12 DJ Translated to Pascal
  13.                                      95/01/12 EL Finalized
  14.                                      95/03/22 EL Finalized for 1.01
  15.                                      95/04/11 EL Finalized for 1.02
  16.                                      95/06/06 EL Finalized for 1.03 (no changes)
  17.                                      95/06/06 EL Finalized for 2.00 (no changes)
  18.  
  19. Notes
  20. -----
  21. This code isn't really robust when it comes to standard error checking
  22. and particularly recovery, software engineering technique, etc.  A buffer
  23. is statically allocated.    A better technique would be to use fstat() or stat()
  24. to determine the file's size then malloc(size).  The STK will handle songs
  25. larger than 64K (but not digitized sounds).  Obviously, you'd need to fread()
  26. such a file in chunks, or write some sort of hfread() (huge fread).  Also,
  27. exitting and cleanup is not handled robustly in this code.    The code below can
  28. only be validated by extremely careful scrutiny to make sure each case is
  29. handled properly.  A better method would the use of C's atexit function.
  30.  
  31. But all such code would make this example file less clear; its purpose was
  32. to illustrate how to call the STK, not how to write QA-proof software.
  33. ******************************************************************************)
  34.  
  35.  
  36.  
  37. Program PlayDWM;
  38.  
  39. uses crt, err, dws;
  40.  
  41.  
  42.  
  43. var
  44.     ExitSave: pointer;
  45.  
  46.     song:              pointer;
  47.     fp:                  file;
  48.     dov:                 dws_DOPTR;
  49.     dres:              dws_DRPTR;
  50.     ideal:             dws_IDPTR;
  51.     mplay:             dws_MPPTR;
  52.     ch:                  char;
  53.     musvol:          word;
  54.     errno:             word;
  55.     songplaying: word;
  56.     songsize:      longint;
  57.  
  58.  
  59.  
  60. Function Exist(FileName: string): boolean;
  61. Var
  62.     Fil: File;
  63.  
  64. begin
  65.     Assign(Fil,FileName);
  66.     {$I- }
  67.     Reset(Fil);
  68.     Close(Fil);
  69.     {$I+ }
  70.  
  71.     Exist := (IOResult = 0);
  72. end;
  73.  
  74.  
  75.  
  76. procedure ExitPlay; far;
  77.  
  78. label TRYTOKILLAGAIN;
  79.  
  80. begin
  81.     ExitProc := ExitSave;
  82.  
  83.     (* If dwt is not inited calling dwt_Kill will have no effect *)
  84.     dwt_Kill;
  85.  
  86. TRYTOKILLAGAIN:
  87.  
  88.     if (dws_Kill <> 1) then
  89.     begin
  90.         (*
  91.          . If an error occurs here, it's either dws_Kill_CANTUNHOOKISR
  92.          . or dws_NOTINITTED.  If it's dws_Kill_CANTUNHOOKISR the user
  93.          . must remove his tsr, and dws_Kill must be called again.    If it's
  94.          . dws_NOTINITTED, there's nothing to worry about at this point.
  95.         *)
  96.         err_Display;
  97.  
  98.         if (dws_ErrNo = dws_Kill_CANTUNHOOKISR) then
  99.         begin
  100.             goto TRYTOKILLAGAIN;
  101.         end;
  102.     end;
  103.  
  104.     if (song <> nil) then
  105.     begin
  106.         freemem(song, songsize);
  107.     end;
  108.  
  109.     dispose(mplay);
  110.     dispose(ideal);
  111.     dispose(dres);
  112.     dispose(dov);
  113.  
  114. end;
  115.  
  116.  
  117.  
  118. begin
  119.     ExitSave := ExitProc;
  120.     ExitProc := @ExitPlay;
  121.  
  122.     writeln;
  123.     writeln('PLAYDWM 2.00 is Copyright 1994-95, DiamondWare, Ltd.');
  124.     writeln('All rights reserved.');
  125.     writeln;
  126.     writeln;
  127.  
  128.     new(dov);
  129.     new(dres);
  130.     new(ideal);
  131.     new(mplay);
  132.  
  133.     song     := nil;
  134.     musvol := 255; (* Default mxr volume at startup is max *)
  135.     ch         := '0';
  136.  
  137.     if (ParamCount = 0) then
  138.     begin
  139.         writeln('Usage PLAYDWM <dwm-file>');
  140.         halt(65535);
  141.     end;
  142.  
  143.     if Exist(ParamStr(1)) then
  144.     begin
  145.         Assign(fp, ParamStr(1));
  146.         Reset(fp,1);
  147.         songsize := filesize(fp);
  148.  
  149.         (* Please note we don't check to see if we get the memory we need. *)
  150.         Getmem(song, songsize);
  151.         BlockRead(fp,song^,songsize);
  152.  
  153.         Close(fp);
  154.     end
  155.     else
  156.     begin
  157.         writeln('Unable to open '+ParamStr(1));
  158.         halt(65535);
  159.     end;
  160.  
  161.     (*
  162.      . We need to set every field to -1 in dws_DETECTOVERRIDES record; this
  163.      . tells the STK to autodetect everything.    Any other value
  164.      . overrides the autodetect routine, and will be accepted on
  165.      . faith, though the STK will verify it if possible.
  166.     *)
  167.     dov^.baseport := 65535;
  168.     dov^.digdma     := 65535;
  169.     dov^.digirq     := 65535;
  170.  
  171.     if (dws_DetectHardWare(dov, dres) = 0) then
  172.     begin
  173.         err_Display;
  174.         halt(65535);
  175.     end;
  176.  
  177.     (*
  178.      . The "ideal" record tells the STK how you'd like it to initialize the
  179.      . sound hardware.    In all cases, if the hardware won't support your
  180.      . request, the STK will go as close as possible.  For example, not all
  181.      . sound boards will support al sampling rates (some only support 5 or
  182.      . 6 discrete rates).
  183.     *)
  184.     ideal^.musictyp     := 1;         (*for now, it's OPL2 music*)
  185.     ideal^.digtyp         := 0;         (*0=No Dig, 8=8bit, 16=16bit*)
  186.     ideal^.digrate        := 0;         (*sampling rate, in Hz*)
  187.     ideal^.dignvoices := 0;         (*number of voices (up to 16)*)
  188.     ideal^.dignchan     := 0;         (*1=mono, 2=stereo*)
  189.  
  190.     if (dws_Init(dres, ideal) = 0) then
  191.     begin
  192.         err_Display;
  193.         halt(65535);
  194.     end;
  195.  
  196.     (*
  197.      .    72.8Hz is a decent compromise.    It will work in a Windows DOS box
  198.      .    without any problems, and yet it allows music to sound pretty good.
  199.      .    In my opinion, there's no reason to go lower than 72.8 (unless you
  200.      .    don't want the hardware timer reprogrammed)--music sounds kinda chunky
  201.      .    at lower rates.  You can go to 145.6 Hz, and get smoother (very
  202.      .    subtly) sounding music, at the cost that it will NOT run at the correct
  203.      .    (or constant) speed in a Windows DOS box.}
  204.     *)
  205.     dwt_Init(dwt_72_8HZ);
  206.  
  207.     (* Set music volume to about 80% max *)
  208.     musvol := 200;
  209.  
  210.     if (dws_XMusic(musvol) = 0) then
  211.     begin
  212.         err_Display;
  213.     end;
  214.  
  215.     mplay^.track := song;
  216.     mplay^.count := 1;
  217.  
  218.     if (dws_MPlay(mplay) = 0) then
  219.     begin
  220.         err_Display;
  221.         halt(65535);
  222.     end;
  223.  
  224.     (*
  225.      . We're playing.  Let's exit when the song is over, and allow the user
  226.      . to fiddle with the volume level (mixer) in the meantime
  227.     *)
  228.     writeln('Press + or - to change playback volume ');
  229.  
  230.     repeat
  231.     begin
  232.         if(dws_MSongStatus(@songplaying) = 0) then
  233.         begin
  234.             err_Display;
  235.             halt(65535);
  236.         end;
  237.  
  238.         if Keypressed then begin
  239.             ch := readkey;
  240.             case ord(ch) of
  241.                 43:
  242.                 begin
  243.                     inc(musvol);
  244.                     writeln('Music Volume is ', musvol);
  245.  
  246.                     if (dws_XMusic(musvol) = 0) then
  247.                     begin
  248.                         err_Display;
  249.                     end;
  250.                 end;
  251.                 45:
  252.                 begin
  253.                     dec(musvol);
  254.                     writeln('Music Volume is ', musvol);
  255.  
  256.                     if (dws_XMusic(musvol) = 0) then
  257.                     begin
  258.                         err_Display;
  259.                     end;
  260.                 end;
  261.             end;
  262.         end;
  263.     end;
  264.     until (songplaying = 0) or (ch = 'q') or (ch = 'Q') or (ch = chr(27));
  265.  
  266.     halt(65535);
  267. end.
  268.