home *** CD-ROM | disk | FTP | other *** search
/ Sound, Music & MIDI Collection 2 / SMMVOL2.bin / MIDI_PAT / MTOOLS.ZIP / PLAYRDEV.EXE / MLIB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-11-07  |  8.8 KB  |  405 lines
  1. unit mlib;
  2.  
  3. { Play/R interface unit.
  4.   Copyright 1992, Kevin Weiner, All rights reserved. }
  5.  
  6. interface
  7.  
  8. {$i midi.inc}
  9.  
  10. const
  11.   chan_map = 0;
  12.   chan_ena = 1;
  13.   chan_xpos = 2;
  14.  
  15. type
  16.  
  17.   channels = array [0..15] of byte;
  18.  
  19.   proc1type = procedure (a: integer);
  20.   proc2type = procedure (a, b: integer);
  21.   proc3type = procedure (a: integer; var b: integer);
  22.   proc4type = procedure (dev: integer; var m: messages; var c, d1, d2: byte);
  23.   proc5type = procedure (dev: integer; m: messages; c, d1, d2: byte);
  24.   func1type = function: longint;
  25.   func2type = function (a: integer): boolean;
  26.  
  27.  
  28. var
  29.   MidiDriverLoaded: boolean;
  30.   MID: integer;
  31.  
  32.   midiPutByte: proc2type;
  33.   midiInputReady: func2type;
  34.   midiGetbyte: proc3type;
  35.   midiClearInput: proc1type;
  36.   msTimer: func1type;
  37.   midiGetMessage: proc4type;
  38.   midiResend: proc1type;
  39.   midiPutMessage: proc5type;
  40.  
  41. procedure mfPause;
  42. procedure mfContinue;
  43. procedure mfPopup;
  44. procedure mfRewind;
  45. function mfPlay(name: string): integer;
  46. procedure mfSongStat(var playing, done: boolean; var position: longint;
  47.                      var songcount, cursong: byte);
  48. procedure mfFileStat(var stat: byte; var name: string);
  49. function mfLoad(name: string): integer;
  50. procedure mfQuiet;
  51. procedure mfPopEnable(stat: boolean);
  52. procedure mfVolume(adjust: integer);
  53. procedure mfTimeMode(mode: integer);
  54. procedure mfGetChan(datatype: integer; var chan: channels);
  55. procedure mfSetChan(datatype: integer; chan: channels);
  56. procedure mfSetPos(time: longint);
  57. procedure mfSkipSong(n: byte);
  58. procedure mfLoopMode(n: byte);
  59.  
  60. function midiDevName(dev: integer; var devname: string;
  61.                      var devdesc: string): integer;
  62. procedure midiPutBuffer(dev: integer; bufptr: pointer; len: word);
  63. procedure midiPutBuffer1(dev: integer; bufptr: pointer; len: word);
  64. procedure midiGetBuffer(dev: integer; bufptr: pointer; max: word;
  65.                         var recv: word);
  66. procedure midiReset(dev: integer);
  67. procedure midiRemove;
  68.  
  69. implementation
  70.  
  71. uses dos;
  72.  
  73. const
  74.   playrid: array [0..7] of char = 'Play/R  ';  {PlayR id string}
  75.  
  76.   tessmpx =  $5453; {hex}              {TesSeRact multiplex id}
  77.  
  78.   fcnPause     = 0;
  79.   fcnPlay      = 1;
  80.   fcnPopup     = 2;
  81.   fcnRewind    = 3;
  82.   fcnLoadPlay  = 4;
  83.   fcnPlayStat  = 5;
  84.   fcnLoadStat  = 6;
  85.   fcnDoneStat  = 7;
  86.   fcnLoad      = 8;
  87.   fcnQuiet     = 9;
  88.   fcnPopEna    = 10;
  89.   fcnVolume    = 11;
  90.   fcnReset     = 12;
  91.   fcnTimeMode  = 13;
  92.   fcnGetChan   = 14;
  93.   fcnSetChan   = 15;
  94.   fcnSetPos    = 16;
  95.   fcnSkipSong  = 17;
  96.   fcnLoopMode  = 18;
  97.  
  98.   fcnGetName   = 20;
  99.   fcnSendShort = 21;
  100.   fcnSendLong  = 22;
  101.   fcnCheckInp  = 23;
  102.   fcnGetInput  = 24;
  103.   fcnGetTime   = 25;
  104.   fcnGetCID    = 26;
  105.   fcnGetEntry  = 27;
  106.  
  107.   fcnRemove    = 99;
  108.  
  109. type
  110.   bytearray = array [0..0] of byte;
  111.   bptr = ^bytearray;
  112.  
  113. var
  114.   param: array [0..63] of byte;        {Play/R parameter data}
  115.   reg: registers;                      {CPU register set}
  116.   idnum: integer;                      {Play/R id number}
  117.  
  118. procedure CallPlayR(fcn: byte);
  119.  
  120. { Call Play/R using the contents of the byte array "param".
  121.   Byte 0 is the function code, and the rest is any required data. }
  122.  
  123.   begin
  124.     param[0] := fcn;
  125.     reg.ax := tessmpx;                 {ax = Tess multiplex id}
  126.     reg.es := seg(param);              {es = parameter segment}
  127.     reg.di := ofs(param);              {di = parameter offset}
  128.     reg.cx := idnum;                   {cx = PlayR id number}
  129.     reg.bx := $20;                     {bx = Tess call user function}
  130.     intr($2f, reg);                    {Call int 2fh}
  131.   end;
  132.  
  133. procedure mfPause;
  134.  
  135.   begin
  136.     CallPlayR(fcnPause);
  137.   end;
  138.  
  139. procedure mfContinue;
  140.  
  141.   begin
  142.     CallPlayR(fcnPlay);
  143.   end;
  144.  
  145. procedure mfPopup;
  146.  
  147.   begin
  148.     CallPlayR(fcnPopup);
  149.   end;
  150.  
  151. procedure mfRewind;
  152.  
  153.   begin
  154.     CallPlayR(fcnRewind);
  155.   end;
  156.  
  157. function mfPlay(name: string): integer;
  158.  
  159.   var
  160.     i, n: integer;
  161.  
  162.   begin
  163.     n := length(name);
  164.     for i := 1 to n do
  165.       param[i] := byte(name[i]);
  166.     param[n+1] := 0;
  167.     CallPlayR(fcnLoadPlay);
  168.     mfPlay := param[0];
  169.   end;
  170.  
  171. procedure mfSongStat(var playing, done: boolean; var position: longint;
  172.                      var songcount, cursong: byte);
  173.  
  174.   begin
  175.     CallPlayR(fcnPlayStat);
  176.     playing := boolean(param[0]);
  177.     done := boolean(param[1]);
  178.     move(param[2], position, 4);
  179.     songcount := param[6];
  180.     cursong := param[7];
  181.   end;
  182.  
  183. procedure mfFileStat(var stat: byte; var name: string);
  184.  
  185.   var
  186.     i: integer;
  187.  
  188.   begin
  189.     CallPlayR(fcnLoadStat);
  190.     stat := param[0];
  191.     i := 1;
  192.     while (param[i] <> 0) and (i < 256) do
  193.       begin
  194.         name[i] := chr(param[i]);
  195.         inc(i);
  196.       end;
  197.     name[0] := chr(i-1);
  198.   end;
  199.  
  200. function mfLoad(name: string): integer;
  201.  
  202.   var
  203.     i, n: integer;
  204.  
  205.   begin
  206.     n := length(name);
  207.     for i := 1 to n do
  208.       param[i] := byte(name[i]);
  209.     param[n+1] := 0;
  210.     CallPlayR(fcnLoad);
  211.     mfLoad := param[0];
  212.   end;
  213.  
  214. procedure mfQuiet;
  215.  
  216.   begin
  217.     CallPlayR(fcnQuiet);
  218.   end;
  219.  
  220. procedure mfPopEnable(stat: boolean);
  221.  
  222.   begin
  223.     param[1] := ord(stat);
  224.     CallPlayR(fcnPopEna);
  225.   end;
  226.  
  227. procedure mfVolume(adjust: integer);
  228.  
  229.   begin
  230.     param[1] := lo(adjust);
  231.     CallPlayR(fcnVolume);
  232.   end;
  233.  
  234. procedure mfTimeMode(mode: integer);
  235.  
  236.   begin
  237.     param[1] := lo(mode);
  238.     CallPlayR(fcnTimeMode);
  239.   end;
  240.  
  241. procedure mfGetChan(datatype: integer; var chan: channels);
  242.  
  243.   var
  244.     i: integer;
  245.  
  246.   begin
  247.     param[1] := datatype;
  248.     CallPlayR(fcnGetChan);
  249.     move(param[2], chan[0], 16);
  250.   end;
  251.  
  252. procedure mfSetChan(datatype: integer; chan: channels);
  253.  
  254.   var
  255.     i: integer;
  256.  
  257.   begin
  258.     param[1] := datatype;
  259.     move(chan[0], param[2], 16);
  260.     CallPlayR(fcnSetChan);
  261.   end;
  262.  
  263. procedure mfSetPos(time: longint);
  264.  
  265.   begin
  266.     move(time, param[1], 4);
  267.     CallPlayR(fcnSetPos);
  268.   end;
  269.  
  270. procedure mfSkipSong(n: byte);
  271.  
  272.   begin
  273.     param[1] := n;
  274.     CallPlayR(fcnSkipSong);
  275.   end;
  276.  
  277. procedure mfLoopMode(n: byte);
  278.  
  279.   begin
  280.     param[1] := n;
  281.     CallPlayR(fcnLoopMode);
  282.   end;
  283.  
  284. function midiDevName(dev: integer; var devname: string;
  285.                      var devdesc: string): integer;
  286.   var
  287.     i: integer;
  288.  
  289.   begin
  290.     param[1] := dev;
  291.     CallPlayR(fcnGetName);
  292.     if param[1] = 0 then
  293.       begin
  294.         devname := '';
  295.         devdesc := '';
  296.       end
  297.     else
  298.       begin
  299.         for i := 1 to 3 do devname[i] := chr(param[i+1]);
  300.         devname[0] := chr(3);
  301.         for i := 1 to 20 do
  302.           devdesc[i] := chr(param[4+i]);
  303.         devdesc[0] := chr(20);
  304.       end;
  305.     midiDevName := param[1];
  306.   end;
  307.  
  308. procedure midiPutBuffer(dev: integer; bufptr: pointer; len: word);
  309.  
  310.   begin
  311.     param[1] := dev;
  312.     move(len, param[2], 2);
  313.     move(bufptr, param[4], 4);
  314.     fillchar(param[8], 4, 0);
  315.     CallPlayR(fcnSendLong);
  316.   end;
  317.  
  318. procedure midiPutBuffer1(dev: integer; bufptr: pointer; len: word);
  319.  
  320. { Uses direct output }
  321.  
  322.   var
  323.     i: word;
  324.     b: bptr;
  325.  
  326.   begin
  327.     b := bufptr;
  328.     for i := 0 to len-1 do
  329.       midiPutByte(dev, b^[i]);
  330.   end;
  331.  
  332. procedure midiGetBuffer(dev: integer; bufptr: pointer; max: word;
  333.                         var recv: word);
  334.   var
  335.     i: word;
  336.     x: integer;
  337.     b: bptr;
  338.  
  339.   begin
  340.     b := bufptr;
  341.     i := 0;
  342.     while midiInputReady(dev) and (i < max) do
  343.       begin
  344.         midiGetByte(dev, x);
  345.         b^[i] := lo(x);
  346.         inc(i);
  347.       end;
  348.     recv := i;
  349.   end;
  350.  
  351. procedure midiReset(dev: integer);
  352.  
  353.   begin
  354.     param[1] := lo(dev);
  355.     CallPlayR(fcnReset);
  356.   end;
  357.  
  358. procedure midiRemove;
  359.  
  360.   begin
  361.     CallPlayR(fcnRemove);
  362.   end;
  363.  
  364. procedure BindDriver;
  365.  
  366.   begin
  367.     CallPlayR(fcnGetEntry);
  368.     move(param[1], midiPutByte, 4);
  369.     move(param[5], midiInputReady, 4);
  370.     move(param[9], midiGetByte, 4);
  371.     move(param[13], midiClearInput, 4);
  372.     move(param[17], msTimer, 4);
  373.     move(param[21], midiGetMessage, 4);
  374.     move(param[25], midiResend, 4);
  375.     move(param[29], midiPutMessage, 4);
  376.   end;
  377.  
  378. function CheckRes: integer;
  379.  
  380. { Check Play/R is loaded - returns id number if found, else -1 }
  381.  
  382.   begin
  383.     reg.ax := tessmpx;                 {ax = Tess int 2fh muliplex id}
  384.     reg.ds := seg(playrid);            {ds = id string segment}
  385.     reg.si := ofs(playrid);            {si = id string offset}
  386.     reg.cx := 0;                       {cx = Tess id counter - must be 0}
  387.     reg.bx := 0;                       {bx = Tess check resident function}
  388.     intr($2f, reg);                    {Call int 2fh}
  389.     if reg.ax = $ffff then
  390.       idnum := reg.cx                  {Found - return tsr id}
  391.     else
  392.       idnum := -1;                     {Not loaded}
  393.     checkres := idnum;
  394.   end;
  395.  
  396. begin
  397.   midiDriverLoaded := CheckRes >= 0;
  398.   if midiDriverLoaded then
  399.     begin
  400.       CallPlayR(fcnGetCID);
  401.       MID := param[1];
  402.       BindDriver;
  403.     end;
  404. end.
  405.