home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 25 / CD_ASCQ_25_1095.iso / dos / prg / dwstk200 / playdwd.pas < prev    next >
Pascal/Delphi Source File  |  1995-06-26  |  6KB  |  249 lines
  1. (******************************************************************************
  2. File:                          playdwd.pas
  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:                     Keith Weiner & Erik Lorenzen
  8. Pascal Conversion: David A. Johndrow
  9. Purpose:                     Contains simple example code to show how to load/play a
  10.                                      .DWD file
  11. History:                     94/10/21 KW Started playdwd.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 PlayDWD;
  38.  
  39. uses crt, err, dws;
  40.  
  41.  
  42.  
  43. var
  44.     ExitSave: pointer;
  45.  
  46.     ch:                 char;
  47.     fp:                 file;
  48.     dov:                dws_DOPTR;
  49.     dres:             dws_DRPTR;
  50.     ideal:            dws_IDPTR;
  51.     dplay:            dws_DPPTR;
  52.     errno:            word;
  53.     input:            integer;
  54.     sound:            pointer;
  55.     result:         word;
  56.     soundsize:    longint;
  57.     DWDInitted: boolean;
  58.     KeepGoing:    boolean;
  59.  
  60.  
  61. Function Exist(FileName: string): boolean;
  62. Var
  63.     Fil: File;
  64.  
  65. begin
  66.     Assign(Fil,FileName);
  67.     {*$I- }
  68.     Reset(Fil);
  69.     Close(Fil);
  70.     {$I+ }
  71.  
  72.     Exist := (IOResult = 0);
  73. end;
  74.  
  75.  
  76.  
  77. procedure ExitPlay; far;
  78.  
  79. label TRYTOKILLAGAIN;
  80.  
  81. begin
  82.     ExitProc := ExitSave;
  83.  
  84. TRYTOKILLAGAIN:
  85.  
  86.     if (dws_Kill <> 1) then
  87.     begin
  88.         (*
  89.          . If an error occurs here, it's either dws_Kill_CANTUNHOOKISR
  90.          . or dws_NOTINITTED.  If it's dws_Kill_CANTUNHOOKISR the user
  91.          . must remove his tsr, and dws_Kill must be called again.    If it's
  92.          . dws_NOTINITTED, there's nothing to worry about at this point.
  93.         *)
  94.         err_Display;
  95.  
  96.         if (dws_ErrNo = dws_Kill_CANTUNHOOKISR) then
  97.         begin
  98.             goto TryToKillAgain;
  99.         end;
  100.     end;
  101.  
  102.     if (sound <> nil) then
  103.     begin
  104.         freemem(sound, soundsize);
  105.     end;
  106.  
  107.     dispose(dplay);
  108.     dispose(ideal);
  109.     dispose(dres);
  110.     dispose(dov);
  111. end;
  112.  
  113.  
  114.  
  115. begin
  116.     ExitSave := ExitProc;
  117.     ExitProc := @ExitPlay;
  118.  
  119.     writeln;
  120.     writeln('PLAYDWD 2.00 is Copyright 1994-95, DiamondWare, Ltd.');
  121.     writeln('All rights reserved.');
  122.     writeln;
  123.     writeln;
  124.  
  125.     new(dov);
  126.     new(dres);
  127.     new(ideal);
  128.     new(dplay);
  129.  
  130.     sound := nil;
  131.  
  132.     if (ParamCount = 0) then
  133.     begin
  134.         writeln('Usage PLAYDWD <dwd-file>');
  135.         halt(65535);
  136.     end;
  137.  
  138.     if Exist(ParamStr(1)) then
  139.     begin
  140.         Assign(fp, ParamStr(1));
  141.         Reset(fp,1);
  142.         soundsize := filesize(fp);
  143.  
  144.         (* Please note we don't check to see if we get the memory we need. *)
  145.         Getmem(sound, soundsize);
  146.         BlockRead(fp,sound^,soundsize);
  147.         Close(fp);
  148.     end
  149.     else
  150.     begin
  151.         writeln('Unable to open '+ParamStr(1));
  152.         halt(65535);
  153.     end;
  154.  
  155.     (*
  156.      . We need to set every field to -1 in dws_DETECTOVERRIDES record; this
  157.      . tells the STK to autodetect everything.    Any other value
  158.      . overrides the autodetect routine, and will be accepted on
  159.      . faith, though the STK will verify it if possible.
  160.     *)
  161.     dov^.baseport := 65535;
  162.     dov^.digdma     := 65535;
  163.     dov^.digirq     := 65535;
  164.  
  165.     if (dws_DetectHardWare(dov, dres) = 0) then
  166.     begin
  167.         err_Display;
  168.         halt(65535);
  169.     end;
  170.  
  171.     if ((dres^.capability and dws_capability_DIG) <> dws_capability_DIG) then
  172.     begin
  173.         if ((dres^.baseport <> 904) and (dres^.baseport <> 65535)) then
  174.         begin
  175.             writeln('The sound hardware supports digitized sound playback,');
  176.             writeln('but we could not find the DMA channel and/or IRQ level.');
  177.         end
  178.         else
  179.         begin
  180.             writeln('Support for digitized playback not found.');
  181.         end;
  182.  
  183.         halt(65535);
  184.     end;
  185.  
  186.  
  187.     (*
  188.      . The "ideal" record tells the STK how you'd like it to initialize the
  189.      . sound hardware.    In all cases, if the hardware won't support your
  190.      . request, the STK will go as close as possible.  For example, not all
  191.      . sound boards will support al sampling rates (some only support 5 or
  192.      . 6 discrete rates).
  193.     *)
  194.     ideal^.musictyp     := 0;         (*0=No music, 1=OPL2*)
  195.     ideal^.digtyp         := 8;         (*0=No Dig, 8=8bit*)
  196.     ideal^.digrate        := 11000; (*sampling rate, in Hz*)
  197.                                                             (*we could have called dws_DGetRateFromDWD*)
  198.                                                             (*before dws_Init to get the correct rate*)
  199.     ideal^.dignvoices := 1;         (*number of voices (up to 16)*)
  200.     ideal^.dignchan     := 1;         (*1=mono*)
  201.  
  202.     if (dws_Init(dres, ideal) = 0) then
  203.     begin
  204.         err_Display;
  205.         halt(65535);
  206.     end;
  207.  
  208.     (* Set master volume to about 80% max *)
  209.     if (dws_XMaster(200) = 0) then
  210.     begin
  211.         err_Display;
  212.     end;
  213.  
  214.     dplay^.snd            := sound;
  215.     dplay^.count        := 1;             (* 0=infinite loop, 1-N num times to play sound *)
  216.     dplay^.priority := 1000;
  217.     dplay^.presnd     := 0;
  218.  
  219.     if (dws_DGetRateFromDWD(sound, @ideal^.digrate) = 0) then
  220.     begin
  221.         err_Display;
  222.         halt(65535);
  223.     end;
  224.  
  225.     if (dws_DSetRate(ideal^.digrate) = 0) then
  226.     begin
  227.         err_Display;
  228.         halt(65535);
  229.     end;
  230.  
  231.     if (dws_DPlay(dplay) = 0) then
  232.     begin
  233.         err_Display;
  234.         halt(65535);
  235.     end;
  236.  
  237.     repeat
  238.     begin
  239.         if(dws_DSoundStatus(dplay^.soundnum, @result) = 0) then
  240.         begin
  241.             err_Display;
  242.             halt(65535);
  243.         end;
  244.     end;
  245.     until (result = 0) or (keypressed);
  246.  
  247.     halt(65535);
  248. end.
  249.