home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sound / sbutil / cmsprg.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-06  |  6.0 KB  |  217 lines
  1. {**************************************************************************
  2.  
  3.                 CMSPRD
  4.                  CMS Utilitys
  5.  
  6.                  Date: 6/5/91
  7.                   Version: 1
  8.  
  9. ***************************************************************************
  10.  
  11.                    Copyright (c) 1991, Zackzon Labs.
  12.  
  13.                        Author: Anthony Rumble
  14. ==========
  15. Addresses:
  16. ==========
  17. InterNet: c9106510@cc.newcastle.edu
  18. FIDONet: 3:713/802.3
  19. SIGNet:  28:2200/102.2
  20.  
  21. Snail Mail:
  22.  32 Woolwich Rd.
  23.  Hunters Hill, NSW, 2110
  24.  Australia
  25.  
  26. -------------------------------------------------------------------------
  27.                               HISTORY
  28. -------------------------------------------------------------------------
  29. 1.0 - Works fine so far
  30. *************************************************************************}
  31. unit cmsprg;
  32.  
  33. interface
  34.  
  35. uses dos, misc;
  36.  
  37. const
  38.  teststring = 'CMSDRV';
  39.  GetVersion = 0;
  40.  PlayMusic = 1;
  41.  PauseMusic = 2;
  42.  ResumeMusic = 3;
  43.  StopMusic = 4;
  44.  DisableBreak = 5;
  45.  
  46. type
  47.  
  48.  header_data = array[1..6] of char;
  49.  
  50. Var
  51.       Regs    : Registers;
  52.       intp    : pointer;
  53.       LibInt  : word;
  54.       CMSf    : file;
  55.       CMS_SONG: pointer;
  56.       ERR     : word;
  57.       Size    : word;
  58.       Status  : word;
  59.  
  60. function initialize:boolean;
  61. function CMS_Get_Version:word;
  62. function CMS_Play_Music(p:pointer):boolean;
  63. procedure CMS_Stop_Music;
  64. function CMS_Pause_Music:boolean;
  65. function CMS_Resume_Music:boolean;
  66. function CMS_Load_CMS(fn:string):pointer;
  67.  
  68. implementation
  69.  
  70. {****************************************************************************
  71.                                INITIALIZE
  72. ----------------------------------------------------------------------------
  73.    Checks for the driver. If present will initialise it, and return TRUE
  74.                         else will return FALSE
  75. ****************************************************************************}
  76. function initialize:boolean;
  77. var
  78.  Signature:string[6];
  79.  x,w:word;
  80.  p:^header_data;
  81. begin
  82.  for w:=$80 to $BF do
  83.  begin
  84.   getintvec(w,intp);
  85.  
  86.   p := ptr(seg(intp^), $104);
  87.  
  88.   for x:= 1 to 6 do
  89.   begin
  90.    Signature[x] := p^[x];
  91.   end;
  92.   Signature[0] := #6;
  93.   if Signature = TestString then
  94.   begin
  95.    LibInt:=w;
  96.    initialize:=true;
  97.    exit;
  98.   end
  99.   else initialize := FALSE;
  100.  end;
  101. end;
  102. {****************************************************************************
  103.                  CMS_GET_VERSION
  104. ----------------------------------------------------------------------------
  105. Returns the Version Number HI(v) Major Version. LO(v) Minor Version
  106. ****************************************************************************}
  107. function CMS_Get_Version:word;
  108. begin
  109.  Regs.bx:=GetVersion;
  110.  INTR(LibInt, Regs);
  111.  CMS_Get_Version:=regs.AX;
  112. end;
  113. {****************************************************************************
  114.             CMS_PLAY_MUSIC
  115. ----------------------------------------------------------------------------
  116. Plays the music at the pointer.
  117. Will Return TRUE if OK. Else, FALSE if music is allready playing
  118. ****************************************************************************}
  119. function CMS_Play_Music(p:pointer):boolean;
  120. begin
  121.  
  122.  CMS_Play_Music:=true;
  123.  Regs.ah:=PlayMusic;
  124.  Regs.al:=1; {Play the song only once}
  125.  Regs.ES:=seg(status);
  126.  Regs.BX:=ofs(status);
  127.  
  128.  Regs.CX:=seg(p^);
  129.  
  130.  INTR(LibInt, Regs);
  131.  
  132.  case Regs.AX of
  133.    0:exit;
  134.    1:writeln('non-CMS File Structure');
  135.    2:writeln('wrong COMPOSEr version');
  136.  end;
  137.  CMS_Play_Music:=false;
  138. end;
  139. {****************************************************************************
  140.             CMS_STOP_MUSIC
  141. ----------------------------------------------------------------------------
  142. Stops The currently Playing Music
  143. ****************************************************************************}
  144. procedure CMS_Stop_Music;
  145. begin
  146.  Regs.ah:=StopMusic;
  147.  INTR(LibInt, Regs);
  148. end;
  149. {****************************************************************************
  150.             CMS_PAUSE_MUSIC
  151. ----------------------------------------------------------------------------
  152. Pauses The currently Playing Music
  153. Returns TRUE is No error. Else FALSE if There was no music
  154. ****************************************************************************}
  155. function CMS_Pause_Music:boolean;
  156. begin
  157.  Regs.ax:=PauseMusic;
  158.  INTR(LibInt, Regs);
  159.  if Regs.AX=0 then CMS_Pause_Music:=TRUE else CMS_Pause_Music:=FALSE;
  160. end;
  161. {****************************************************************************
  162.             CMS_RESUME_MUSIC
  163. ----------------------------------------------------------------------------
  164. Resumes The currently Paused Music
  165. Returns TRUE is No error. Else FALSE if There was no paused music
  166. ****************************************************************************}
  167. function CMS_Resume_Music:boolean;
  168. begin
  169.  Regs.ah:=ResumeMusic;
  170.  INTR(LibInt, Regs);
  171.  if Regs.AX=0 then CMS_Resume_Music:=TRUE else CMS_Resume_Music:=FALSE;
  172. end;
  173. {****************************************************************************
  174.             CMS_DISABLE_BREAK
  175. ----------------------------------------------------------------------------
  176. This procedure disables the CMS break function (CTRL-Keypad5)
  177. ****************************************************************************}
  178. procedure CMS_disable_break;
  179. begin
  180.  Regs.ah:=DisableBreak;
  181.  INTR(LibInt, Regs);
  182. end;
  183. {****************************************************************************
  184.             CMS_LOAD_CMS
  185. ----------------------------------------------------------------------------
  186. Loads a CMS file
  187. fn:=the full path and file name. Inc .CMS if neads be
  188. Returns a Pointer to Play.
  189. ****************************************************************************}
  190. function CMS_Load_CMS(fn:string):pointer;
  191. var
  192.  rslt, result:word;
  193. begin
  194.  assign(CMSf, fn);
  195.  {$I-}
  196.  reset(CMSf,1);
  197.  {$I+}
  198.  err:=IORESULT;
  199.  if err<>0 then
  200.  begin
  201.   writeln('Problem Loading ',fn);
  202.   halt(1);
  203.  end;
  204.  size:=filesize(CMSf);
  205.  rslt:=malloc(CMS_SONG, size);
  206.  if rslt<>0 then
  207.  begin
  208.   writeln('Error Allocating Memory, Size=',size);
  209.   halt(1);
  210.  end;
  211.  blockread(CMSf, CMS_SONG^, size, result);
  212.  close(CMSf);
  213.  CMS_Load_CMS:=CMS_SONG;
  214. end;
  215.  
  216. end.
  217.