Old pascal Unit for CMF File playback. - Relies on SBFMDRV.COM to be present

sbfmpas.pas

{**************************************************************************

                                SBFMPAS
                             SBFM Utilitys

                             Date: 4/4/91
                              Version: 1

***************************************************************************

                   Copyright (c) 1991, Zackzon Labs.

                       Author: Anthony Rumble
==========
Addresses:
==========
InterNet: [email protected]
SIGNet:  28:2200/108

Snail Mail:
 32 Woolwich Rd.
 Hunters Hill, NSW, 2110
 Australia

-------------------------------------------------------------------------
                              HISTORY
-------------------------------------------------------------------------
1.0 - Works fine so far
*************************************************************************}
unit sbfmpas;

interface

uses dos, misc;

const
 teststring = 'FMDRV';
 GetVersion = 00;
 SetStatus = 01;
 SetInstTable = 02;
 SetSysClockRate = 03;
 SetDriverClockRate = 04;
 Transpose = 05;
 PlayMusic = 06;
 StopMusic = 07;
 ResetDriver = 08;
 PauseMusic = 09;
 ResumeMusic = 10;
 SetTrap = 11;

type

 header_data = array[1..5] of char;

 CMF_File = record
           file_ID:array[0..3] of char;
           version:word;
          off_inst:word;
         off_music:word;
    ticks_per_beat:word;
 clocks_per_second:word;
         off_title:word;
      off_composer:word;
       off_remarks:word;
   channels_in_use:array[1..16] of byte;
        no_of_inst:word;
       basic_tempo:word;
 end;

Var
      Regs    : Registers;
      intp    : pointer;
      LibInt  : word;
      CMFf    : file;
      CMF_SONG: pointer;
      ERR     : word;
      Size    : word;
      CMFFile : ^CMF_FILE;

function initialize:boolean;
function SBFM_Get_Version:word;
procedure SBFM_Set_Status(p:pointer);
procedure SBFM_Reset;
procedure SBFM_Set_Instrument(p:pointer; i:word);
procedure SBFM_Set_Sys_Clock_Rate(freq:word);
procedure SBFM_Set_Drv_Clock_Rate(freq:word);
procedure SBFM_Trans_Music(off:integer);
function SBFM_Play_Music(p:pointer):boolean;
function SBFM_Stop_Music:boolean;
function SBFM_Pause_Music:boolean;
function SBFM_Resume_Music:boolean;
function SBFM_Load_CMF(fn:string):pointer;

implementation

{****************************************************************************
                               INITIALIZE
----------------------------------------------------------------------------
   Checks for the driver. If present will initialise it, and return TRUE
                        else will return FALSE
****************************************************************************}
function initialize:boolean;
var
 Signature:string[5];
 x,w:word;
 p:^header_data;
begin
 for w:=$80 to $BF do
 begin
  getintvec(w,intp);

  p := ptr(seg(intp^), $103);

  for x:= 1 to 5 do
  begin
   Signature[x] := p^[x];
  end;
  Signature[0] := #5;
  if Signature = TestString then
  begin
   regs.BX := ResetDriver;
   LibInt:=w;
   Intr(LibInt, Regs);
   if regs.AX<>0 then initialize:=FALSE else initialize:=TRUE;
   exit;
  end
  else initialize := FALSE;
 end;
end;
{****************************************************************************
                             SBFM_GET_VERSION
----------------------------------------------------------------------------
Returns the Version Number HI(v) Major Version. LO(v) Minor Version
****************************************************************************}
function SBFM_Get_Version:word;
begin
 Regs.BX:=GetVersion;
 INTR(LibInt, Regs);
 SBFM_Get_Version:=regs.AX;
end;
{****************************************************************************
                             SBFM_SET_STATUS
----------------------------------------------------------------------------
Sets the Status BYTE.
****************************************************************************}
procedure SBFM_Set_Status(p:pointer);
begin
 Regs.BX:=SetStatus;
 Regs.DX:=seg(p^);
 Regs.AX:=ofs(p^);
 INTR(LibInt, Regs);
end;
{****************************************************************************
                             SBFM_RESET
----------------------------------------------------------------------------
Resets the Driver.. Must be called Before you exit
****************************************************************************}
procedure SBFM_Reset;
begin
 Regs.BX:=ResetDriver;
 INTR(LibInt, Regs);
end;
{****************************************************************************
                          SBFM_SET_INSTRUMENT
----------------------------------------------------------------------------
Sets the Instrument Table
p: Pointer to the table.
i: Number of Instruments
****************************************************************************}
procedure SBFM_Set_Instrument(p:pointer; i:word);
begin
 if i>128 then
 begin
  writeln('FATAL ERROR. Too many instruments defined');
  halt(1);
 end;
 Regs.BX:=SetInstTable;
 Regs.CX:=i;
 Regs.DX:=seg(p^);
 Regs.AX:=ofs(p^);
 INTR(LibInt, Regs);
end;
{****************************************************************************
                       SBFM_SET_SYS_CLOCK_RATE
----------------------------------------------------------------------------
Sets The System TIMER 0 Clock Rate
****************************************************************************}
procedure SBFM_Set_Sys_Clock_Rate(freq:word);
begin
 Regs.BX:=SetSysClockRate;
 Regs.AX:=(1193180 div freq);
 INTR(LibInt, Regs);
end;
{****************************************************************************
                       SBFM_SET_DRV_CLOCK_RATE
----------------------------------------------------------------------------
Sets The System TIMER 0 Clock Rate
****************************************************************************}
procedure SBFM_Set_Drv_Clock_Rate(freq:word);
begin
 Regs.BX:=SetDriverClockRate;
 Regs.AX:=(1193180 div freq);
 INTR(LibInt, Regs);
end;
{****************************************************************************
                        SBFM_TRANS_MUSIC
----------------------------------------------------------------------------
Transposes the Music by off.
****************************************************************************}
procedure SBFM_Trans_Music(off:integer);
begin
 Regs.BX:=Transpose;
 Regs.AX:=off;
 INTR(LibInt, Regs);
end;
{****************************************************************************
                        SBFM_PLAY_MUSIC
----------------------------------------------------------------------------
Plays the music at the pointer.
Will Return TRUE if OK. Else, FALSE if music is allready playing
****************************************************************************}
function SBFM_Play_Music(p:pointer):boolean;
begin
 Regs.BX:=PlayMusic;
 Regs.DX:=seg(p^);
 Regs.AX:=ofs(p^);
 INTR(LibInt, Regs);
 if Regs.AX=0 then SBFM_Play_Music:=TRUE else SBFM_Play_Music:=FALSE;
end;
{****************************************************************************
                        SBFM_STOP_MUSIC
----------------------------------------------------------------------------
Stops The currently Playing Music
Returns TRUE is No error. Else FALSE if There was no music
****************************************************************************}
function SBFM_Stop_Music:boolean;
begin
 Regs.BX:=StopMusic;
 INTR(LibInt, Regs);
 if Regs.AX=0 then SBFM_Stop_Music:=TRUE else SBFM_Stop_Music:=FALSE;
end;
{****************************************************************************
                        SBFM_PAUSE_MUSIC
----------------------------------------------------------------------------
Pauses The currently Playing Music
Returns TRUE is No error. Else FALSE if There was no music
****************************************************************************}
function SBFM_Pause_Music:boolean;
begin
 Regs.BX:=PauseMusic;
 INTR(LibInt, Regs);
 if Regs.AX=0 then SBFM_Pause_Music:=TRUE else SBFM_Pause_Music:=FALSE;
end;
{****************************************************************************
                        SBFM_RESUME_MUSIC
----------------------------------------------------------------------------
Resumes The currently Paused Music
Returns TRUE is No error. Else FALSE if There was no paused music
****************************************************************************}
function SBFM_Resume_Music:boolean;
begin
 Regs.BX:=ResumeMusic;
 INTR(LibInt, Regs);
 if Regs.AX=0 then SBFM_Resume_Music:=TRUE else SBFM_Resume_Music:=FALSE;
end;
{****************************************************************************
                        SBFM_LOAD_CMF
----------------------------------------------------------------------------
Loads a CMF file
fn:=the full path and file name. Inc .CMF if neads be
Returns a Pointer to Play.
****************************************************************************}
function SBFM_Load_CMF(fn:string):pointer;
var
 rslt, result:word;
begin
 assign(CMFf, fn);
 {$I-}
 reset(CMFf,1);
 {$I+}
 err:=IORESULT;
 if err<>0 then
 begin
  writeln('Problem Loading ',fn);
  halt(1);
 end;
 size:=filesize(CMFf);
 getmem(CMF_SONG, size);
 blockread(CMFf, CMF_SONG^, size, result);
 close(CMFf);
 CMFFile:=CMF_SONG;
 SBFM_Set_DRV_Clock_Rate(CMFfile^.Clocks_Per_Second);
 SBFM_Set_Instrument(ptr(seg(CMF_SONG^), ofs(CMF_SONG^)+CMFfile^.off_inst), CMFFile^.no_of_inst);
 SBFM_Load_CMF:=ptr(seg(CMF_SONG^), ofs(CMF_SONG^)+CMFfile^.off_music);
end;

end.