home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sound / sbutil / source.exe / SBFMPAS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-25  |  9.6 KB  |  303 lines

  1. {**************************************************************************
  2.  
  3.                                 SBFMPAS
  4.                              SBFM Utilitys
  5.  
  6.                              Date: 4/4/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. SIGNet:  28:2200/108
  19.  
  20. Snail Mail:
  21.  32 Woolwich Rd.
  22.  Hunters Hill, NSW, 2110
  23.  Australia
  24.  
  25. -------------------------------------------------------------------------
  26.                               HISTORY
  27. -------------------------------------------------------------------------
  28. 1.0 - Works fine so far
  29. *************************************************************************}
  30. unit sbfmpas;
  31.  
  32. interface
  33.  
  34. uses dos, misc;
  35.  
  36. const
  37.  teststring = 'FMDRV';
  38.  GetVersion = 00;
  39.  SetStatus = 01;
  40.  SetInstTable = 02;
  41.  SetSysClockRate = 03;
  42.  SetDriverClockRate = 04;
  43.  Transpose = 05;
  44.  PlayMusic = 06;
  45.  StopMusic = 07;
  46.  ResetDriver = 08;
  47.  PauseMusic = 09;
  48.  ResumeMusic = 10;
  49.  SetTrap = 11;
  50.  
  51. type
  52.  
  53.  header_data = array[1..5] of char;
  54.  
  55.  CMF_File = record
  56.            file_ID:array[0..3] of char;
  57.            version:word;
  58.           off_inst:word;
  59.          off_music:word;
  60.     ticks_per_beat:word;
  61.  clocks_per_second:word;
  62.          off_title:word;
  63.       off_composer:word;
  64.        off_remarks:word;
  65.    channels_in_use:array[1..16] of byte;
  66.         no_of_inst:word;
  67.        basic_tempo:word;
  68.  end;
  69.  
  70. Var
  71.       Regs    : Registers;
  72.       intp    : pointer;
  73.       LibInt  : word;
  74.       CMFf    : file;
  75.       CMF_SONG: pointer;
  76.       ERR     : word;
  77.       Size    : word;
  78.       CMFFile : ^CMF_FILE;
  79.  
  80. function initialize:boolean;
  81. function SBFM_Get_Version:word;
  82. procedure SBFM_Set_Status(p:pointer);
  83. procedure SBFM_Reset;
  84. procedure SBFM_Set_Instrument(p:pointer; i:word);
  85. procedure SBFM_Set_Sys_Clock_Rate(freq:word);
  86. procedure SBFM_Set_Drv_Clock_Rate(freq:word);
  87. procedure SBFM_Trans_Music(off:integer);
  88. function SBFM_Play_Music(p:pointer):boolean;
  89. function SBFM_Stop_Music:boolean;
  90. function SBFM_Pause_Music:boolean;
  91. function SBFM_Resume_Music:boolean;
  92. function SBFM_Load_CMF(fn:string):pointer;
  93.  
  94. implementation
  95.  
  96. {****************************************************************************
  97.                                INITIALIZE
  98. ----------------------------------------------------------------------------
  99.    Checks for the driver. If present will initialise it, and return TRUE
  100.                         else will return FALSE
  101. ****************************************************************************}
  102. function initialize:boolean;
  103. var
  104.  Signature:string[5];
  105.  x,w:word;
  106.  p:^header_data;
  107. begin
  108.  for w:=$80 to $BF do
  109.  begin
  110.   getintvec(w,intp);
  111.  
  112.   p := ptr(seg(intp^), $103);
  113.  
  114.   for x:= 1 to 5 do
  115.   begin
  116.    Signature[x] := p^[x];
  117.   end;
  118.   Signature[0] := #5;
  119.   if Signature = TestString then
  120.   begin
  121.    regs.BX := ResetDriver;
  122.    LibInt:=w;
  123.    Intr(LibInt, Regs);
  124.    if regs.AX<>0 then initialize:=FALSE else initialize:=TRUE;
  125.    exit;
  126.   end
  127.   else initialize := FALSE;
  128.  end;
  129. end;
  130. {****************************************************************************
  131.                              SBFM_GET_VERSION
  132. ----------------------------------------------------------------------------
  133. Returns the Version Number HI(v) Major Version. LO(v) Minor Version
  134. ****************************************************************************}
  135. function SBFM_Get_Version:word;
  136. begin
  137.  Regs.BX:=GetVersion;
  138.  INTR(LibInt, Regs);
  139.  SBFM_Get_Version:=regs.AX;
  140. end;
  141. {****************************************************************************
  142.                              SBFM_SET_STATUS
  143. ----------------------------------------------------------------------------
  144. Sets the Status BYTE.
  145. ****************************************************************************}
  146. procedure SBFM_Set_Status(p:pointer);
  147. begin
  148.  Regs.BX:=SetStatus;
  149.  Regs.DX:=seg(p^);
  150.  Regs.AX:=ofs(p^);
  151.  INTR(LibInt, Regs);
  152. end;
  153. {****************************************************************************
  154.                              SBFM_RESET
  155. ----------------------------------------------------------------------------
  156. Resets the Driver.. Must be called Before you exit
  157. ****************************************************************************}
  158. procedure SBFM_Reset;
  159. begin
  160.  Regs.BX:=ResetDriver;
  161.  INTR(LibInt, Regs);
  162. end;
  163. {****************************************************************************
  164.                           SBFM_SET_INSTRUMENT
  165. ----------------------------------------------------------------------------
  166. Sets the Instrument Table
  167. p: Pointer to the table.
  168. i: Number of Instruments
  169. ****************************************************************************}
  170. procedure SBFM_Set_Instrument(p:pointer; i:word);
  171. begin
  172.  if i>128 then
  173.  begin
  174.   writeln('FATAL ERROR. Too many instruments defined');
  175.   halt(1);
  176.  end;
  177.  Regs.BX:=SetInstTable;
  178.  Regs.CX:=i;
  179.  Regs.DX:=seg(p^);
  180.  Regs.AX:=ofs(p^);
  181.  INTR(LibInt, Regs);
  182. end;
  183. {****************************************************************************
  184.                        SBFM_SET_SYS_CLOCK_RATE
  185. ----------------------------------------------------------------------------
  186. Sets The System TIMER 0 Clock Rate
  187. ****************************************************************************}
  188. procedure SBFM_Set_Sys_Clock_Rate(freq:word);
  189. begin
  190.  Regs.BX:=SetSysClockRate;
  191.  Regs.AX:=(1193180 div freq);
  192.  INTR(LibInt, Regs);
  193. end;
  194. {****************************************************************************
  195.                        SBFM_SET_DRV_CLOCK_RATE
  196. ----------------------------------------------------------------------------
  197. Sets The System TIMER 0 Clock Rate
  198. ****************************************************************************}
  199. procedure SBFM_Set_Drv_Clock_Rate(freq:word);
  200. begin
  201.  Regs.BX:=SetDriverClockRate;
  202.  Regs.AX:=(1193180 div freq);
  203.  INTR(LibInt, Regs);
  204. end;
  205. {****************************************************************************
  206.                         SBFM_TRANS_MUSIC
  207. ----------------------------------------------------------------------------
  208. Transposes the Music by off.
  209. ****************************************************************************}
  210. procedure SBFM_Trans_Music(off:integer);
  211. begin
  212.  Regs.BX:=Transpose;
  213.  Regs.AX:=off;
  214.  INTR(LibInt, Regs);
  215. end;
  216. {****************************************************************************
  217.                         SBFM_PLAY_MUSIC
  218. ----------------------------------------------------------------------------
  219. Plays the music at the pointer.
  220. Will Return TRUE if OK. Else, FALSE if music is allready playing
  221. ****************************************************************************}
  222. function SBFM_Play_Music(p:pointer):boolean;
  223. begin
  224.  Regs.BX:=PlayMusic;
  225.  Regs.DX:=seg(p^);
  226.  Regs.AX:=ofs(p^);
  227.  INTR(LibInt, Regs);
  228.  if Regs.AX=0 then SBFM_Play_Music:=TRUE else SBFM_Play_Music:=FALSE;
  229. end;
  230. {****************************************************************************
  231.                         SBFM_STOP_MUSIC
  232. ----------------------------------------------------------------------------
  233. Stops The currently Playing Music
  234. Returns TRUE is No error. Else FALSE if There was no music
  235. ****************************************************************************}
  236. function SBFM_Stop_Music:boolean;
  237. begin
  238.  Regs.BX:=StopMusic;
  239.  INTR(LibInt, Regs);
  240.  if Regs.AX=0 then SBFM_Stop_Music:=TRUE else SBFM_Stop_Music:=FALSE;
  241. end;
  242. {****************************************************************************
  243.                         SBFM_PAUSE_MUSIC
  244. ----------------------------------------------------------------------------
  245. Pauses The currently Playing Music
  246. Returns TRUE is No error. Else FALSE if There was no music
  247. ****************************************************************************}
  248. function SBFM_Pause_Music:boolean;
  249. begin
  250.  Regs.BX:=PauseMusic;
  251.  INTR(LibInt, Regs);
  252.  if Regs.AX=0 then SBFM_Pause_Music:=TRUE else SBFM_Pause_Music:=FALSE;
  253. end;
  254. {****************************************************************************
  255.                         SBFM_RESUME_MUSIC
  256. ----------------------------------------------------------------------------
  257. Resumes The currently Paused Music
  258. Returns TRUE is No error. Else FALSE if There was no paused music
  259. ****************************************************************************}
  260. function SBFM_Resume_Music:boolean;
  261. begin
  262.  Regs.BX:=ResumeMusic;
  263.  INTR(LibInt, Regs);
  264.  if Regs.AX=0 then SBFM_Resume_Music:=TRUE else SBFM_Resume_Music:=FALSE;
  265. end;
  266. {****************************************************************************
  267.                         SBFM_LOAD_CMF
  268. ----------------------------------------------------------------------------
  269. Loads a CMF file
  270. fn:=the full path and file name. Inc .CMF if neads be
  271. Returns a Pointer to Play.
  272. ****************************************************************************}
  273. function SBFM_Load_CMF(fn:string):pointer;
  274. var
  275.  rslt, result:word;
  276. begin
  277.  assign(CMFf, fn);
  278.  {$I-}
  279.  reset(CMFf,1);
  280.  {$I+}
  281.  err:=IORESULT;
  282.  if err<>0 then
  283.  begin
  284.   writeln('Problem Loading ',fn);
  285.   halt(1);
  286.  end;
  287.  size:=filesize(CMFf);
  288.  rslt:=malloc(CMF_SONG, size);
  289.  if rslt<>0 then
  290.  begin
  291.   writeln('Error Allocating Memory, Size=',size);
  292.   halt(1);
  293.  end;
  294.  blockread(CMFf, CMF_SONG^, size, result);
  295.  close(CMFf);
  296.  CMFFile:=CMF_SONG;
  297.  SBFM_Set_DRV_Clock_Rate(CMFfile^.Clocks_Per_Second);
  298.  SBFM_Set_Instrument(ptr(seg(CMF_SONG^), ofs(CMF_SONG^)+CMFfile^.off_inst), CMFFile^.no_of_inst);
  299.  SBFM_Load_CMF:=ptr(seg(CMF_SONG^), ofs(CMF_SONG^)+CMFfile^.off_music);
  300. end;
  301.  
  302. end.
  303.