Liren Large Software Subsidy 10/10.iso/m/m003_1/sdk_dos.ddi/TPASCAL/MUSIC/DEMOCMF.PAS

Pascal/Delphi Source File | 1991-12-13 | 10.0 KB | 279 lines

{ ------------------------------------------------------------------------ }
{  @@ Source Documentation                           *** TP6 Version ***   }
{                                                                          }
{  Copyright (c) Creative Technology Pte Ltd, 1991. All rights reserved.   }
{                                                                          }
{   TITLE       : DEMOCMF.PAS                                              }
{                                                                          }
{   DESCRIPTION :                                                          }
{       This program demonstrates how to use the SBFM high level functions }
{       to play back the music file FFARES.CMF. The user is allowed to     }
{       control the music output from the keyboard.                        }
{                                                                          }
{       Note that the BLASTER environment has to be set and SBFMDRV.COM    }
{       has to be installed before executing this program.                 }
{                                                                          }
{ ------------------------------------------------------------------------ }

program democmf;

{ Include the SBC Unit, and any other units needed }
uses sbc_tp6, dos, crt;

{ Include type-defined for CMF header }
{$I sbcmusic.inc }

var
  transpose : Integer;
  lpMusicBuf : pointer;


{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   function LoadFile (szFilename : string) : Boolean                      }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Load file into memory. The Global variable lpMusicBuf is used to   }
{       point to the loaded buffer.                                        }
{                                                                          }
{   ENTRY:                                                                 }
{       szFileName :- File to be loaded.                                   }
{                                                                          }
{   EXIT:                                                                  }
{       True if successful, else return False.                             }
{                                                                          }
{ ------------------------------------------------------------------------ }

function LoadFile (szFilename : string) : Boolean;
type
    PtrRec = record
        lo, hi : word
    end;

var
    wTemp, wByteRead : word;
    lpTmpPtr : pointer;
    lFSize : longint;
    F : file;

begin
    {$I-}
    Assign(F, szFilename);
    Reset(F,1);
    {$I+}

    LoadFile := False;

    if IOResult = 0 then begin
        lFSize := FileSize(F);

        { allocate memory }
        Mark(lpMusicBuf);

        repeat
            wTemp := $8000;

            if lFSize < $8000 then
                wTemp := word(lFSize);

            GetMem(lpTmpPtr,wTemp);

            lFSize := lFSize - wTemp;
        until not Boolean(Lo(word(lFSize)));


        lpTmpPtr := lpMusicBuf;
        LoadFile := True;
        wByteRead := 0;

        { Read data from file to buffer }
        repeat
            BlockRead(F,lpTmpPtr^,$8000,wTemp);
            wByteRead := wByteRead + wTemp;

            { advance pointer }
            PtrRec(lpTmpPtr).lo := PtrRec(lpTmpPtr).lo + wTemp;

            { adjust when cross segment }
            if not Boolean(Hi(wByteRead)) then
                PtrRec(lpTmpPtr).hi := PtrRec(lpTmpPtr).hi + $1000;

        until wTemp <> $8000;

        close(F);
    end
    else
        writeln('Open ',szFilename,' error ...');
end;


{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   procedure StartMusic                                                   }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Retrieves music information from the CMF music file header and     }
{       starts playing music.                                              }
{                                                                          }
{   ENTRY:                                                                 }
{       None.                                                              }
{                                                                          }
{   EXIT:                                                                  }
{       None.                                                              }
{                                                                          }
{ ------------------------------------------------------------------------ }

procedure StartMusic;
var
    lTmp : longint;
    lpInstPtr, lpMusicPtr : pointer;
    Timer0Freq : word;

begin

    lTmp := longint(lpMusicBuf) + longint((CMFHDR(lpMusicBuf^)).inst_blk);
    lpInstPtr := pointer(lTmp);

    lTmp := longint(lpMusicBuf) + longint((CMFHDR(lpMusicBuf^)).music_blk);
    lpMusicPtr := pointer(lTmp);

    sbfm_reset;

    Timer0Freq := word(longint(1193180) div (CMFHDR(lpMusicBuf^)).clock_ticks);
    sbfm_song_speed(Timer0Freq);

    if Boolean(Ofs(lpInstPtr)) then
        sbfm_instrument(lpInstPtr,(CMFHDR(lpMusicBuf^)).inst_num);

    sbfm_play_music(lpMusicPtr);

end;


{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   procedure WaitMusicEnd                                                 }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Control the music output from keyboard.                            }
{                                                                          }
{   ENTRY:                                                                 }
{       None.                                                              }
{                                                                          }
{   EXIT:                                                                  }
{       None.                                                              }
{                                                                          }
{ ------------------------------------------------------------------------ }

procedure WaitMusicEnd;
const
    ESC            = 27;
    up_P           = 80;
    lo_p           = 112;
    up_C           = 67;
    lo_c           = 99;

    EXT            = 256;
    LEFTARROW      = (EXT+75);
    RIGHTARROW     = (EXT+77);

var
    key : char;
    keyval : integer;

begin

    repeat
        if KeyPressed then begin

            key := ReadKey;
            keyval := ord(key);

            if ((key = #0) and KeyPressed) then begin
                key := ReadKey;
                keyval := ord(key)+EXT;
            end;

            case (keyval) of
                ESC :
                    sbfm_stop_music;

                LEFTARROW :
                    begin
                        transpose := transpose - 1;
                        sbfm_transpose(transpose);
                        writeln('Transpose : ',transpose);
                    end;

                RIGHTARROW :
                    begin
                        transpose := transpose + 1;
                        sbfm_transpose(transpose);
                        writeln('Transpose : ',transpose);
                    end;

                up_P,lo_p :
                    sbfm_pause_music;

                up_C,lo_c :
                    sbfm_resume_music;
            end;
        end;
    until not Boolean(_ct_music_status);

end;



{ ------------------------------------------------------------------------ }
{  @@ Usage                                                                }
{                                                                          }
{   procedure PlayCmfFile (szFilename: string)                             }
{                                                                          }
{   DESCRIPTION:                                                           }
{       Play a CMF file and wait for music end.                            }
{                                                                          }
{   ENTRY:                                                                 }
{       szFileName :- Music file to be played.                             }
{                                                                          }
{   EXIT:                                                                  }
{       None.                                                              }
{                                                                          }
{ ------------------------------------------------------------------------ }

procedure PlayCmfFile (szFilename: string);

begin

    if LoadFile(szFilename)  then begin
        StartMusic;
        WaitMusicEnd;
    end;

end;


{ ------------------------------------------------------------------------ }

{ main function }
var
    wVersion : word;

begin

   if Boolean(sbfm_init) then begin

        wVersion := sbfm_version;
        writeln('     SBFMDRV version ',Hi(wVersion),'.',Lo(wVersion):2);

        PlayCmfFile('FFARES.CMF');

        sbfm_terminate;
    end
    else
        writeln('SBFMDRV not installed or FM Driver initialization error.');
end.