home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / midas / midas.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-06  |  35KB  |  1,121 lines
  1. {*      MIDAS.PAS
  2.  *
  3.  * Simple MIDAS Sound System interface unit
  4.  *
  5.  * Copyright 1994 Petteri Kangaslampi and Jarno Paananen
  6.  *
  7.  * This file is part of the MIDAS Sound System, and may only be
  8.  * used, modified and distributed under the terms of the MIDAS
  9.  * Sound System license, LICENSE.TXT. By continuing to use,
  10.  * modify or distribute this file you indicate that you have
  11.  * read the license and understand and accept it fully.
  12. *}
  13.  
  14.  
  15. unit MIDAS;
  16.  
  17.  
  18. interface
  19.  
  20.  
  21.  
  22.  
  23. {****************************************************************************\
  24. *      MIDAS global variables:
  25. \****************************************************************************}
  26.  
  27. const
  28.     NUMSDEVICES = 5;                    { total number of Sound Devices }
  29.     NUMMPLAYERS = 2;                    { total number of Module Players }
  30.  
  31. var
  32.     SDptr : pointer;                    { pointer to current Sound Device }
  33.     MPptr : pointer;                    { pointer to current Module Player }
  34.  
  35.  
  36.  
  37. {****************************************************************************\
  38. *
  39. * Function:     midasError(msg : string);
  40. *
  41. * Description:  Prints a MIDAS error message to stderr and exits to DOS
  42. *
  43. * Input:        msg : string            Pointer to error message string
  44. *
  45. \****************************************************************************}
  46.  
  47. procedure midasError(msg : string);
  48.  
  49.  
  50.  
  51.  
  52. {****************************************************************************\
  53. *
  54. * Function:     midasUninitError(msg : string);
  55. *
  56. * Description:  Prints an error message to stderr and exits to DOS without
  57. *               uninitializing MIDAS. This function should only be used
  58. *               from midasClose();
  59. *
  60. * Input:        msg : string            Pointer to error message string
  61. *
  62. \****************************************************************************}
  63.  
  64. procedure midasUninitError(msg : string);
  65.  
  66.  
  67.  
  68. {****************************************************************************\
  69. *
  70. * Function:     midasDetectSD;
  71. *
  72. * Description:  Attempts to detect a Sound Device. Sets the global variable
  73. *               SDptr to point to the detected Sound Device or NIL if no
  74. *               Sound Device was detected
  75. *
  76. \****************************************************************************}
  77.  
  78. procedure midasDetectSD;
  79.  
  80.  
  81.  
  82. {****************************************************************************\
  83. *
  84. * Function:     midasInit;
  85. *
  86. * Description:  Initializes MIDAS Sound System
  87. *
  88. \****************************************************************************}
  89.  
  90. procedure midasInit;
  91.  
  92.  
  93.  
  94. {****************************************************************************\
  95. *
  96. * Function:     midasClose;
  97. *
  98. * Description:  Uninitializes MIDAS Sound System
  99. *
  100. \****************************************************************************}
  101.  
  102. procedure midasClose;
  103.  
  104.  
  105.  
  106. {****************************************************************************\
  107. *
  108. * Function:     midasSetDefaults;
  109. *
  110. * Description:  Initializes MIDAS Sound System variables to their default
  111. *               states. MUST be the first MIDAS function to be called.
  112. *
  113. \****************************************************************************}
  114.  
  115. procedure midasSetDefaults;
  116.  
  117.  
  118.  
  119. {****************************************************************************\
  120. *
  121. * Function:     midasParseOption(option : string);
  122. *
  123. * Description:  Parses one MIDAS command line option.
  124. *
  125. * Input:        option : string         Command line option string WITHOUT
  126. *                                       the leading '-' or '/'.
  127. *
  128. * Recognized options:
  129. *       -sx     Force Sound Device x (1 = GUS, 2 = PAS, 3 = WSS, 4 = SB,
  130. *               5 = No Sound)
  131. *       -pxxx   Force I/O port xxx (hex) for Sound Device
  132. *       -ix     Force IRQ x for Sound Device
  133. *       -dx     Force DMA channel x for Sound Device
  134. *       -mxxxx  Set mixing rate to xxxx Hz
  135. *       -oxxx   Force output mode (8 = 8-bit, 1 = 16-bit, s = stereo,
  136. *               m = mono)
  137. *       -e      Disable EMS usage
  138. *       -t      Disable ProTracker BPM tempos
  139. *       -u      Enable Surround sound
  140. *       -v      Disable real VU-meters
  141. *
  142. \****************************************************************************}
  143.  
  144. procedure midasParseOption(option : string);
  145.  
  146.  
  147.  
  148. {****************************************************************************\
  149. *
  150. * Function:     midasParseOptions(firstOpt, numOpts : integer);
  151. *
  152. * Description:  Parses MIDAS command line options and sets MIDAS variables
  153. *               accordingly.
  154. *
  155. * Input:        firstOpt : integer      first ParamStr() to parse.
  156. *               numOpts : integer       number of ParamStr() options to parse
  157. *
  158. * Also '/' is recognized as a option delimiter.
  159. *
  160. \****************************************************************************}
  161.  
  162. procedure midasParseOptions(firstOpt, numOpts : integer);
  163.  
  164.  
  165.  
  166. {****************************************************************************\
  167. *
  168. * Function:     void midasParseEnvironment;
  169. *
  170. * Description:  Parses the MIDAS environment string, which has same format
  171. *               as the command line options.
  172. *
  173. \****************************************************************************}
  174.  
  175. procedure midasParseEnvironment;
  176.  
  177.  
  178.  
  179. {****************************************************************************\
  180. *
  181. * Function:     midasPlayModule(fileName : string; numEffectChns : integer) :
  182. *                   pointer;
  183. *
  184. * Description:  Loads a module into memory, points MP to the correct Module
  185. *               Player and starts playing it.
  186. *
  187. * Input:        fileName : string       Module file name
  188. *               numEffectChns : integer Number of channels to open for sound
  189. *                                       effects.
  190. *
  191. * Returns:      Pointer to module structure. This function can not fail,
  192. *               as it will call midasError() to handle all error cases.
  193. *
  194. * Notes:        The Sound Device channels available for sound effects are the
  195. *               _first_ numEffectChns channels. So, for example, if you use
  196. *               midasPlayModule('TUNE.MOD', 3), you can use channels 0-2 for
  197. *               sound effects.
  198. *
  199. \****************************************************************************}
  200.  
  201. function midasPlayModule(fileName : string; numEffectChns : integer) :
  202.     pointer;
  203.  
  204.  
  205.  
  206. {****************************************************************************\
  207. *
  208. * Function:     midasStopModule(module : pointer);
  209. *
  210. * Description:  Stops playing a module, deallocates it and uninitializes
  211. *               the Module Player. Also closes _all_ Sound Device channels,
  212. *               including those opened for effects.
  213. *
  214. \****************************************************************************}
  215.  
  216. procedure midasStopModule(module : pointer);
  217.  
  218.  
  219.  
  220. {****************************************************************************\
  221. *
  222. * Function:     toASCIIZ(str : string) : pointer;
  223. *
  224. * Description:  Converts a string to ASCIIZ format, that can be used with the
  225. *               file functions and module loaders. Uses the buffer
  226. *               "asczBuffer" that has to be allocated beforehand.
  227. *
  228. * Input:        msg : string            string to be converted
  229. *
  230. * Returns:      Pointer to converted ASCIIZ string
  231. *
  232. \****************************************************************************}
  233.  
  234. function toASCIIZ(str : string) : pointer;
  235.  
  236.  
  237.  
  238.  
  239. implementation
  240.  
  241.  
  242. uses crt, dos, Errors, mGlobals, mMem, mFile, EMS, SDevice, MPlayer, S3M,
  243.     MODP, Timer
  244. {$IFDEF REALVUMETERS}
  245.     ,VU
  246. {$ENDIF}
  247.     ;
  248.  
  249.  
  250. type
  251.     charArray = array[0..255] of char;
  252.     PcharArray = ^charArray;
  253.  
  254.  
  255. {****************************************************************************\
  256. *      Static variables used by midasXXXX() functions:
  257. \****************************************************************************}
  258.  
  259. const
  260.     { pointers to all Sound Devices: }
  261.     midasSoundDevices : array[0..(NUMSDEVICES-1)] of PSoundDevice = (
  262.         @GUS, @PAS, @WSS, @SB, @NSND );
  263.  
  264.     { pointers to all Module Players: }
  265.     midasModulePlayers : array[0..(NUMMPLAYERS-1)] of PModulePlayer = (
  266.         @mpS3M, @mpMOD );
  267.  
  268.     { Amiga Loop Emulation flags for Module Players: }
  269.     midasMPALE : array[0..(NUMMPLAYERS-1)] of integer = (
  270.         0, 1 );
  271.  
  272.  
  273.  
  274. var
  275.     disableEMS : boolean;               { should EMS usage be disabled? }
  276.     sdNum : word;                       { Sound Device number ($FFFF for
  277.                                           autodetect) }
  278.     ioPort : word;                      { I/O port number ($FFFF for
  279.                                           autodetect/default) }
  280.     IRQ : byte;                         { IRQ number ($FF for autodetect/
  281.                                           default) }
  282.     DMA : byte;                         { DMA channel number ($FF for
  283.                                           autodetect/default) }
  284.     mixRate : word;                     { mixing rate }
  285.     mode : word;                        { forced output mode }
  286.  
  287.     emsInitialized : boolean;           { is EMS heap manager initialized? }
  288.     tmrInitialized : boolean;           { is TempoTimer initialized? }
  289.     sdInitialized : boolean;            { is Sound Device initialized? }
  290.     sdChOpen : boolean;                 { are Sound Device channels open? }
  291.     vuInitialized : boolean;            { are real VU-meters initialized? }
  292.     mpInit : boolean;                   { is Module Player initialized? }
  293.     mpPlay : boolean;                   { is Module Player playing? }
  294.     mpInterrupt : boolean;              { is Module Player interrupt set? }
  295.  
  296.     SD : PSoundDevice;                  { current Sound Device }
  297.     MP : PModulePlayer;                 { current Module Player }
  298.  
  299.     asczBuffer : PcharArray;            { ASCIIZ conversion buffer }
  300.  
  301.  
  302.  
  303.  
  304.  
  305. {****************************************************************************\
  306. *
  307. * Function:     midasError(msg : string);
  308. *
  309. * Description:  Prints a MIDAS error message to stderr and exits to DOS
  310. *
  311. * Input:        msg : string            Pointer to error message string
  312. *
  313. \****************************************************************************}
  314.  
  315. procedure midasError(msg : string);
  316. begin
  317.     TextMode(CO80);
  318.     WriteLn('MIDAS Error: ', msg);
  319. {$IFDEF DEBUG}
  320.     errPrintList;                       { print error list }
  321. {$ENDIF}
  322.     midasClose;
  323.     Halt;
  324. end;
  325.  
  326.  
  327.  
  328.  
  329. {****************************************************************************\
  330. *
  331. * Function:     midasUninitError(msg : string);
  332. *
  333. * Description:  Prints an error message to stderr and exits to DOS without
  334. *               uninitializing MIDAS. This function should only be used
  335. *               from midasClose();
  336. *
  337. * Input:        msg : string            Pointer to error message string
  338. *
  339. \****************************************************************************}
  340.  
  341. procedure midasUninitError(msg : string);
  342. begin
  343.     TextMode(CO80);
  344.     WriteLn('FATAL: MIDAS uninitialization error: ', msg);
  345. {$IFDEF DEBUG}
  346.     errPrintList;                       { print error list }
  347. {$ENDIF}
  348.     Halt;
  349. end;
  350.  
  351.  
  352.  
  353.  
  354. {****************************************************************************\
  355. *
  356. * Function:     toASCIIZ(str : string) : pointer;
  357. *
  358. * Description:  Converts a string to ASCIIZ format, that can be used with the
  359. *               file functions and module loaders. Uses the buffer
  360. *               "asczBuffer" that has to be allocated beforehand.
  361. *
  362. * Input:        msg : string            string to be converted
  363. *
  364. * Returns:      Pointer to converted ASCIIZ string
  365. *
  366. \****************************************************************************}
  367.  
  368. function toASCIIZ(str : string) : pointer;
  369. var
  370.     spos, slen : integer;
  371.     i : integer;
  372.  
  373. begin
  374.     spos := 0;                          { string position = 0 }
  375.     slen := ord(str[0]);                { string length }
  376.  
  377.     { copy string to ASCIIZ conversion buffer: }
  378.     while spos < slen do
  379.     begin
  380.         asczBuffer^[spos] := str[spos+1];       { copy a character }
  381.         spos := spos + 1;                       { next character }
  382.     end;
  383.  
  384.     asczBuffer^[spos] := chr(0);        { put terminating 0 to end of string }
  385.  
  386.     toASCIIZ := asczBuffer;             { return pointer to string }
  387. end;
  388.  
  389.  
  390.  
  391.  
  392. {****************************************************************************\
  393. *
  394. * Function:     midasDetectSD;
  395. *
  396. * Description:  Attempts to detect a Sound Device. Sets the global variable
  397. *               SDptr to point to the detected Sound Device or NIL if no
  398. *               Sound Device was detected
  399. *
  400. \****************************************************************************}
  401.  
  402. procedure midasDetectSD;
  403. var
  404.     dsd, dResult, error : integer;
  405.     sdev : PSoundDevice;
  406. begin
  407.     SD := NIL;                          { no Sound Device detected yet }
  408.     SDptr := NIL;
  409.     dsd := 0;                           { start from first Sound Device }
  410.  
  411.     { search through Sound Devices until a Sound Device is detected: }
  412.     while (SD = NIL) and (dsd < NUMSDEVICES) do
  413.     begin
  414.         { attempt to detect current SD: }
  415.         sdev := midasSoundDevices[dsd];
  416.         error := sdev^.Detect(@dResult);
  417.         if error <> OK then
  418.             midasError(errorMsg[error]);
  419.         if dResult = 1 then
  420.         begin
  421.             sdNum := dsd;               { Sound Device detected }
  422.             SD := sdev;                 { point SD to this Sound Device }
  423.             SDptr := sdev;
  424.         end;
  425.         dsd := dsd + 1;                 { try next Sound Device }
  426.     end;
  427. end;
  428.  
  429.  
  430.  
  431.  
  432. {****************************************************************************\
  433. *
  434. * Function:     midasInit;
  435. *
  436. * Description:  Initializes MIDAS Sound System
  437. *
  438. \****************************************************************************}
  439.  
  440. procedure midasInit;
  441. var
  442.     error, result : integer;
  443. begin
  444.     if not disableEMS then              { is EMS usage disabled? }
  445.     begin
  446.         { Initialize EMS Heap Manager: }
  447.         error := emsInit(@result);
  448.         if error <> OK then
  449.             midasError(errorMsg[error]);
  450.  
  451.         { was EMS Heap Manager initialized? }
  452.         if result = 1 then
  453.         begin
  454.             emsInitialized := True;
  455.             useEMS := 1;                { yes, use EMS memory, but do not }
  456.             forceEMS := 0;              { force its usage }
  457.         end
  458.         else
  459.         begin
  460.             emsInitialized := False;
  461.             useEMS := 0;                { no, do not use EMS memory }
  462.             forceEMS := 0;
  463.         end;
  464.     end
  465.     else
  466.     begin
  467.         emsInitialized := False;
  468.         useEMS := 0;                    { EMS disabled - do not use it }
  469.         forceEMS := 0;
  470.     end;
  471.  
  472.     if sdNum = $FFFF then               { has a Sound Device been selected? }
  473.     begin
  474.         midasDetectSD;                  { attempt to detect Sound Device }
  475.         if SD = NIL then
  476.             midasError('Unable to detect Sound Device');
  477.     end
  478.     else
  479.     begin
  480.         SDptr := midasSoundDevices[sdNum];  { use Sound Device sdNum }
  481.         SD := SDptr;
  482.  
  483.         { Sound Device number was forced, but if no I/O port, IRQ or DMA
  484.           number has been set, try to autodetect the values for this Sound
  485.           Device. If detection fails, use default values }
  486.  
  487.         if (ioPort = $FFFF) and (IRQ = $FF) and (DMA = $FF) then
  488.         begin
  489.             error := SD^.Detect(@result);
  490.             if error <> OK then
  491.                 midasError(errorMsg[error]);
  492.             if result <> 1 then
  493.                 midasError('Unable to detect Sound Device values');
  494.         end;
  495.     end;
  496.  
  497.     if ioPort <> $FFFF then             { has an I/O port been set? }
  498.         SD^.ioPort := ioPort;           { if yes, set it to Sound Device }
  499.     if IRQ <> $FF then                  { what about IRQ number? }
  500.         SD^.IRQ := IRQ;
  501.     if DMA <> $FF then                  { or DMA channel number }
  502.         SD^.DMA := DMA;
  503.  
  504. {$IFNDEF NOTIMER}
  505.     { initialize TempoTimer: }
  506.     error := tmrInit;
  507.     if error <> OK then
  508.         midasError(errorMsg[error]);
  509.     tmrInitialized := True;             { TempoTimer initialized }
  510. {$ENDIF}
  511.  
  512.     { initialize Sound Device: }
  513.     error := SD^.Init(mixRate, mode);
  514.     if error <> OK then
  515.         midasError(errorMsg[error]);
  516.     sdInitialized := True;              { Sound Device initialized }
  517.  
  518. {$IFDEF REALVUMETERS}
  519.     if realVU = 1 then
  520.     begin
  521.         { initialize real VU-meters: }
  522.         error := vuInit;
  523.         if error <> OK then
  524.             midasError(errorMsg[error]);
  525.         vuInitialized := True;
  526.     end;
  527. {$ENDIF}
  528. end;
  529.  
  530.  
  531.  
  532. {****************************************************************************\
  533. *
  534. * Function:     midasClose;
  535. *
  536. * Description:  Uninitializes MIDAS Sound System
  537. *
  538. \****************************************************************************}
  539.  
  540. procedure midasClose;
  541. var
  542.     error : integer;
  543. begin
  544.     { Deallocate ASCIIZ convesion buffer if allocated: }
  545.     if asczBuffer <> NIL then
  546.     begin
  547.         error := memFree(asczBuffer);
  548.         if error <> OK then
  549.             midasError(errorMsg[error]);
  550.     end;
  551.     asczBuffer := NIL;
  552.  
  553. {$IFNDEF NOTIMER}
  554.     { if Module Player interrupt is running, remove it: }
  555.     if mpInterrupt then
  556.     begin
  557.         error := MP^.RemoveInterrupt;
  558.         if error <> OK then
  559.             midasUninitError(errorMsg[error]);
  560.         mpInterrupt := False;
  561.     end;
  562. {$ENDIF}
  563.  
  564.     { if Module Player is playing, stop it: }
  565.     if mpPlay then
  566.     begin
  567.         error := MP^.StopModule;
  568.         if error <> OK then
  569.             midasUninitError(errorMsg[error]);
  570.         mpPlay := False;
  571.     end;
  572.  
  573.     { if Module Player has been initialized, uninitialize it: }
  574.     if mpInit then
  575.     begin
  576.         error := MP^.Close;
  577.         if error <> OK then
  578.             midasUninitError(errorMsg[error]);
  579.         mpInit := False;
  580.         MP := NIL;
  581.         MPptr := NIL;
  582.     end;
  583.  
  584. {$IFDEF REALVUMETERS}
  585.     { if real VU-meters have been initialized, uninitialize them: }
  586.     if vuInitialized then
  587.     begin
  588.         error := vuClose;
  589.         if error <> OK then
  590.             midasUninitError(errorMsg[error]);
  591.         vuInitialized := False;
  592.     end;
  593. {$ENDIF}
  594.  
  595.     { if Sound Device channels are open, close them: }
  596.     if sdChOpen then
  597.     begin
  598.         error := SD^.CloseChannels;
  599.         if error <> OK then
  600.             midasUninitError(errorMsg[error]);
  601.         sdChOpen := False;
  602.     end;
  603.  
  604.     { if Sound Device is initialized, uninitialize it: }
  605.     if sdInitialized then
  606.     begin
  607.         error := SD^.Close;
  608.         if error <> OK then
  609.             midasUninitError(errorMsg[error]);
  610.         sdInitialized := False;
  611.         SD := NIL;
  612.         SDptr := NIL;
  613.     end;
  614.  
  615. {$IFNDEF NOTIMER}
  616.     { if TempoTimer is initialized, uninitialize it: }
  617.     if tmrInitialized then
  618.     begin
  619.         error := tmrClose;
  620.         if error <> OK then
  621.             midasUninitError(errorMsg[error]);
  622.         tmrInitialized := False;
  623.     end;
  624. {$ENDIF}
  625.  
  626.     { if EMS Heap Manager is initialized, uninitialize it: }
  627.     if emsInitialized then
  628.     begin
  629.         error := emsClose;
  630.         if error <> OK then
  631.             midasUninitError(errorMsg[error]);
  632.         emsInitialized := False;
  633.     end;
  634. end;
  635.  
  636.  
  637.  
  638.  
  639. {****************************************************************************\
  640. *
  641. * Function:     midasSetDefaults;
  642. *
  643. * Description:  Initializes MIDAS Sound System variables to their default
  644. *               states. MUST be the first MIDAS function to be called.
  645. *
  646. \****************************************************************************}
  647.  
  648. procedure midasSetDefaults;
  649. begin
  650.     asczBuffer := NIL;                  { ASCIIZ conversion buffer not
  651.                                           allocated }
  652.     emsInitialized := False;            { EMS heap manager is not
  653.                                           initialized yet }
  654.     tmrInitialized := False;            { TempoTimer is not initialized }
  655.     sdInitialized := False;             { Sound Device is not initialized }
  656.     sdChOpen := False;                  { Sound Device channels are not
  657.                                           open }
  658.     vuInitialized := False;             { VU meter are not initialized }
  659.     mpInit := False;                    { Module Player is not initialized }
  660.     mpPlay := False;                    { Module Player is not playing }
  661.     mpInterrupt := False;               { No Module Player interrupt }
  662.  
  663.     ptTempo := 1;                       { enable ProTracker BPM tempos }
  664.     usePanning := 1;                    { enable ProTracker panning cmds }
  665.     surround := 0;                      { disable surround to save GUS mem }
  666.     realVU := 1;                        { enable real VU-meters }
  667.  
  668.     disableEMS := False;                { do not disable EMS usage }
  669.     sdNum := $FFFF;                     { no Sound Device forced }
  670.     ioPort := $FFFF;                    { no I/O port forced }
  671.     IRQ := $FF;                         { no IRQ number forced }
  672.     DMA := $FF;                         { no DMA channel number forced }
  673.     mode := 0;                          { no output mode forced }
  674.     mixRate := 44100;                   { attempt to use 44100Hz mixing
  675.                                           rate }
  676.  
  677.     SD := NIL;                          { point SD and MP to NULL for }
  678.     SDptr := NIL;                       { safety }
  679.     MP := NIL;
  680.     MPptr := NIL;
  681. end;
  682.  
  683.  
  684.  
  685. {****************************************************************************\
  686. *
  687. * Function:     midasParseOption(option : string);
  688. *
  689. * Description:  Parses one MIDAS command line option.
  690. *
  691. * Input:        option : string         Command line option string WITHOUT
  692. *                                       the leading '-' or '/'.
  693. *
  694. * Recognized options:
  695. *       -sx     Force Sound Device x (1 = GUS, 2 = PAS, 3 = WSS, 4 = SB,
  696. *               5 = No Sound)
  697. *       -pxxx   Force I/O port xxx (hex) for Sound Device
  698. *       -ix     Force IRQ x for Sound Device
  699. *       -dx     Force DMA channel x for Sound Device
  700. *       -mxxxx  Set mixing rate to xxxx Hz
  701. *       -oxxx   Force output mode (8 = 8-bit, 1 = 16-bit, s = stereo,
  702. *               m = mono)
  703. *       -e      Disable EMS usage
  704. *       -t      Disable ProTracker BPM tempos
  705. *       -u      Enable Surround sound
  706. *       -v      Disable real VU-meters
  707. *
  708. \****************************************************************************}
  709.  
  710. procedure midasParseOption(option : string);
  711. var
  712.     c : integer;
  713.     opt : string;
  714.  
  715.     { hex2word - converts a hexadecimal string to a word }
  716.     function hex2word(hstr : string) : word;
  717.     var
  718.         c : char;
  719.         digit : integer;
  720.         res, w, mult : word;
  721.  
  722.     begin
  723.         mult := 1;
  724.         res := 0;
  725.  
  726.         for digit := ord(hstr[0]) downto 1 do
  727.         begin
  728.             c := UpCase(hstr[digit]);
  729.             if (c >= '0') and (c <= '9') then
  730.                 w := (ord(c) - ord('0')) * mult
  731.             else
  732.                 w := (ord(c) - ord('A')) * mult;
  733.             res := res + w;
  734.             mult := mult shl 4;
  735.         end;
  736.         hex2word := res;
  737.     end;
  738.  
  739.     { atol - converts a string into a longint, returns 0 if conversion
  740.       failure, like the C atol() function }
  741.     function atol(s : string) : longint;
  742.     var
  743.         i : longint;
  744.         code : integer;
  745.     begin
  746.         val(s, i, code);
  747.         if code <> 0 then
  748.             atol := 0
  749.         else
  750.             atol := i;
  751.     end;
  752.  
  753.  
  754. begin
  755.     opt := copy(option, 2, ord(option[0]) - 1);
  756.  
  757.     case option[1] of
  758.         { -sx     Force Sound Device x }
  759.         's':
  760.             begin
  761.                 sdNum := atol(opt) - 1;
  762.                 if (sdNum >= NUMSDEVICES) or (sdNum < 0) then
  763.                     midasError('Illegal Sound Device');
  764.             end;
  765.  
  766.         { -pxxx   Force I/O port xxx (hex) for Sound Device }
  767.         'p':
  768.             ioPort := hex2word(opt);
  769.  
  770.         { -ix     Force IRQ x for Sound Device }
  771.         'i':
  772.             IRQ := atol(opt);
  773.  
  774.         { -dx     Force DMA channel x for Sound Device }
  775.         'd':
  776.             DMA := atol(opt);
  777.  
  778.         { -mxxxx  Set mixing rate to xxxx Hz }
  779.         'm':
  780.             mixRate := atol(opt);
  781.  
  782.         { -e      Disable EMS usage }
  783.         'e':
  784.             disableEMS := True;
  785.  
  786.         { -t      Disable ProTracker BPM tempos }
  787.         't':
  788.             ptTempo := 0;
  789.  
  790.         { -u      Enable Surround sound }
  791.         'u':
  792.             surround := 1;
  793.  
  794.         { -oxxx   Force output mode }
  795.         'o':
  796.             begin
  797.                 for c:= 1 to ord(opt[0]) do
  798.                 begin
  799.                     case opt[c] of
  800.                         { Output mode '8' - 8-bit }
  801.                         '8':
  802.                             mode := (mode or sd8bit) and (not sd16bit);
  803.  
  804.                         { Output mode '1' - 16-bit }
  805.                         '1':
  806.                             mode := (mode or sd16bit) and (not sd8bit);
  807.  
  808.                         { Output mode 'm' - mono }
  809.                         'm':
  810.                             mode := (mode or sdMono) and (not sdStereo);
  811.  
  812.                         { Output mode 's' - stereo }
  813.                         's':
  814.                             mode := (mode or sdStereo) and (not sdMono);
  815.  
  816.                         else
  817.                             midasError('Invalid output mode character');
  818.                     end;
  819.                 end;
  820.             end;
  821.  
  822.         { -v      Disable real VU-meters }
  823.         'v':
  824.             realVU := 0;
  825.  
  826.         else
  827.             midasError('Unknown option character');
  828.     end;
  829. end;
  830.  
  831.  
  832.  
  833.  
  834. {****************************************************************************\
  835. *
  836. * Function:     midasParseOptions(firstOpt, numOpts : integer);
  837. *
  838. * Description:  Parses MIDAS command line options and sets MIDAS variables
  839. *               accordingly.
  840. *
  841. * Input:        firstOpt : integer      first ParamStr() to parse.
  842. *               numOpts : integer       number of ParamStr() options to parse
  843. *
  844. * Also '/' is recognized as a option delimiter.
  845. *
  846. \****************************************************************************}
  847.  
  848. procedure midasParseOptions(firstOpt, numOpts : integer);
  849. var
  850.     i : word;
  851.     s : string;
  852. begin
  853.     if numOpts > 0 then
  854.     begin
  855.         for i := firstOpt to (firstOpt+numOpts-1) do
  856.         begin
  857.             s := ParamStr(i);
  858.             if (s[1] = '-') or (s[1] = '/') then
  859.                 midasParseOption(copy(s, 2, ord(s[0])-1))
  860.             else
  861.                 midasError('Invalid command line option');
  862.         end;
  863.     end;
  864. end;
  865.  
  866.  
  867.  
  868.  
  869. {***************************************************************************\
  870. *
  871. * Function:     midasParseEnvironment;
  872. *
  873. * Description:  Parses the MIDAS environment string, which has same format
  874. *               as the command line options.
  875. \***************************************************************************}
  876.  
  877. procedure midasParseEnvironment;
  878. var
  879.     midasEnv, opt : string;
  880.     spos, slen : integer;
  881.     stopParse : boolean;
  882.     ch : char;
  883.  
  884. begin
  885.     { try to get MIDAS environment string: }
  886.     midasEnv := GetEnv('MIDAS');
  887.  
  888.     if midasEnv <> '' then
  889.     begin
  890.         spos := 1;                      { search position = 0 }
  891.         slen := ord(midasEnv[0]);
  892.         opt := '';                      { current option string is empty }
  893.         stopParse := False;
  894.  
  895.         { parse the whole environment string: }
  896.         while not stopParse do
  897.         begin
  898.             ch := midasEnv[spos];
  899.  
  900.             if spos > slen then
  901.             begin
  902.                 { Current character is past the last character of environment
  903.                   string. Parse option string if it exists and stop
  904.                   parsing. }
  905.                 if opt <> '' then
  906.                     midasParseOption(opt);
  907.                 stopParse := True;
  908.             end
  909.             else
  910.             begin
  911.                 if ch = ' ' then
  912.                 begin
  913.                     { current character is space - parse current option
  914.                       string if it exists }
  915.                     if opt <> '' then
  916.                         midasParseOption(opt);
  917.  
  918.                     opt := '';          { no option string }
  919.                     spos := spos + 1;   { next character }
  920.                 end
  921.                 else
  922.                 begin
  923.                     if (ch = '-') or (ch = '/') then
  924.                     begin
  925.                         { Current character is '-' or '/' - option string
  926.                           starts from next character }
  927.                         spos := spos + 1;
  928.                         opt := midasEnv[spos];
  929.                         spos := spos + 1;
  930.                     end
  931.                     else
  932.                     begin
  933.                         { some normal charater - add to the end of option
  934.                           string if it exists, otherwise just continue
  935.                           parsing }
  936.                         if opt <> '' then
  937.                             opt := opt + ch;
  938.                         spos := spos + 1;
  939.                     end;
  940.                 end;
  941.             end;
  942.         end;
  943.     end;
  944. end;
  945.  
  946.  
  947.  
  948.  
  949. {****************************************************************************\
  950. *
  951. * Function:     midasPlayModule(fileName : string; numEffectChns : integer) :
  952. *                   pointer;
  953. *
  954. * Description:  Loads a module into memory, points MP to the correct Module
  955. *               Player and starts playing it.
  956. *
  957. * Input:        fileName : string       Module file name
  958. *               numEffectChns : integer Number of channels to open for sound
  959. *                                       effects.
  960. *
  961. * Returns:      Pointer to module structure. This function can not fail,
  962. *               as it will call midasError() to handle all error cases.
  963. *
  964. * Notes:        The Sound Device channels available for sound effects are the
  965. *               _first_ numEffectChns channels. So, for example, if you use
  966. *               midasPlayModule('TUNE.MOD', 3), you can use channels 0-2 for
  967. *               sound effects.
  968. *
  969. \****************************************************************************}
  970.  
  971. function midasPlayModule(fileName : string; numEffectChns : integer) :
  972.     pointer;
  973. var
  974.     header : ^byte;
  975.     f : fileHandle;
  976.     module : PmpModule;
  977.     numChans, numRead : word;
  978.     error, mpNum, recognized : integer;
  979.     mpl : PModulePlayer;
  980.  
  981. begin
  982.     error := memAlloc(MPHDRSIZE, @header);
  983.     if error <> OK then
  984.         midasError(errorMsg[error]);
  985.  
  986.     { open module file: }
  987.     error := fileOpen(toASCIIZ(fileName), fileOpenRead, @f);
  988.     if error <> OK then
  989.         midasError(errorMsg[error]);
  990.  
  991.     { read MPHDRSIZE bytes of module header: }
  992.     error := fileRead(f, header, MPHDRSIZE);
  993.     if error <> OK then
  994.         midasError(errorMsg[error]);
  995.  
  996.     { close module file: }
  997.     error := fileClose(f);
  998.     if error <> OK then
  999.         midasError(errorMsg[error]);
  1000.  
  1001.  
  1002.     { Search through all Module Players to find one that recognizes
  1003.       file header: }
  1004.     mpNum := 0;
  1005.     MP := NIL;
  1006.     MPptr := NIL;
  1007.  
  1008.     while (mpNum < NUMMPLAYERS) and (MP = NIL) do
  1009.     begin
  1010.         mpl := midasModulePlayers[mpNum];
  1011.         error := mpl^.Identify(header, @recognized);
  1012.         if error <> OK then
  1013.             midasError(errorMsg[error]);
  1014.         if recognized = 1 then
  1015.         begin
  1016.             MP := mpl;
  1017.             MPptr := mpl;
  1018.             ALE := midasMPAle[mpNum];
  1019.         end;
  1020.         mpNum := mpNum + 1;
  1021.     end;
  1022.  
  1023.     if MP = NIL then
  1024.         midasError('Unknown module format');
  1025.  
  1026.     { deallocate module header: }
  1027.     error := memFree(header);
  1028.     if error <> OK then
  1029.         midasError(errorMsg[error]);
  1030.  
  1031.     { initialize module player: }
  1032.     error := MP^.Init(SD);
  1033.     if error <> OK then
  1034.         midasError(errorMsg[error]);
  1035.     mpInit := True;
  1036.  
  1037.     { load module: }
  1038.     error := MP^.LoadModule(toASCIIZ(fileName), SD, @module);
  1039.     if error <> OK then
  1040.         midasError(errorMsg[error]);
  1041.  
  1042.     numChans := module^.numChans;
  1043.  
  1044.     { open Sound Device channels: }
  1045.     error := SD^.OpenChannels(numChans + numEffectChns);
  1046.     if error <> OK then
  1047.         midasError(errorMsg[error]);
  1048.     sdChOpen := True;
  1049.  
  1050.     { Start playing the module using Sound Device channels (numEffectChns) -
  1051.       (numEffectChns+numChans-1) and looping the whole song: }
  1052.     error := MP^.PlayModule(module, numEffectChns, numChans, 0, 32767);
  1053.     if error <> OK then
  1054.         midasError(errorMsg[error]);
  1055.     mpPlay := True;
  1056.  
  1057. {$IFNDEF NOTIMER}
  1058.     { start playing using the timer: }
  1059.     error := MP^.SetInterrupt;
  1060.     if error <> OK then
  1061.         midasError(errorMsg[error]);
  1062. {$ENDIF}
  1063.  
  1064.     midasPlayModule := module;
  1065. end;
  1066.  
  1067.  
  1068.  
  1069.  
  1070. {****************************************************************************\
  1071. *
  1072. * Function:     midasStopModule(module : pointer);
  1073. *
  1074. * Description:  Stops playing a module, deallocates it and uninitializes
  1075. *               the Module Player. Also closes _all_ Sound Device channels,
  1076. *               including those opened for effects.
  1077. *
  1078. \****************************************************************************}
  1079.  
  1080. procedure midasStopModule(module : pointer);
  1081. var
  1082.     error : integer;
  1083. begin
  1084. {$IFNDEF NOTIMER}
  1085.     { remove Module Player interrupt: }
  1086.     error := MP^.RemoveInterrupt;
  1087.     if error <> OK then
  1088.         midasError(errorMsg[error]);
  1089.     mpInterrupt := False;
  1090. {$ENDIF}
  1091.  
  1092.     { stop playing the module: }
  1093.     error := MP^.StopModule;
  1094.     if error <> OK then
  1095.         midasError(errorMsg[error]);
  1096.     mpPlay := False;
  1097.  
  1098.     { deallocate module: }
  1099.     error := MP^.FreeModule(module, SD);
  1100.     if error <> OK then
  1101.         midasError(errorMsg[error]);
  1102.  
  1103.     { uninitialize Module Player: }
  1104.     error := MP^.Close;
  1105.     if error <> OK then
  1106.         midasError(errorMsg[error]);
  1107.     mpInit := False;
  1108.     MP := NIL;                          { point MP to NIL for safety }
  1109.     MPptr := NIL;
  1110.  
  1111.     { close Sound Device channels: }
  1112.     error := SD^.CloseChannels;
  1113.     if error <> OK then
  1114.         midasError(errorMsg[error]);
  1115.     sdChOpen := False;
  1116. end;
  1117.  
  1118.  
  1119.  
  1120. END.
  1121.