Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/BKPLAY10.ZIP/BACKPLAY.PAS

Pascal/Delphi Source File | 1988-09-24 | 10.1 KB | 260 lines

{$B-,F-,I+,O-,R-}

unit BackPlay;

{ Unit for playing music in the background.

  Copyright 1988 Scott Bussinger
  All rights reserved.
  Permission is hereby granted by the author for you to use this unit in your programs.

  Scott Bussinger
  Professional Practice Systems
  110 South 131st Street
  Tacoma, WA  98444
  [phone]
  Compuserve [72247,2671]

  Version 1.00 --  9/24/1988 -- First version }

interface

type Song = procedure;
     SongAction = (EndRepeatSong,RepeatSong,ResumeSong,StopSong,SuspendSong);

function PlayingInBackground: boolean;
  { Is there a song currently playing? }

procedure PlayingMode(Action: SongAction);
  { Change the play mode }

function PlayMuz(Filename: string): boolean;
  { Play a song in the background loaded from a file -- returns true if file found }

procedure PlaySong(S: Song);
  { Play a song in the background already loaded in memory }

implementation

uses Dos;

const BackgroundBufferSize = 256;                { Maximum number of note changes in song }
      FreqConstant = 1193180.0;                  { Master timer chip clock rate }
      TickConstant = FreqConstant / 65536.0 / 1000.0; { Constant for tick speed }

const CurrentNote: 0..BackgroundBufferSize+1 = 0; { Pointer to current note in BackgroundBuffer }
      LastNote: 0..BackgroundBufferSize = 0;     { Pointer to last note in BackgroundBuffer }
      Playing: boolean = false;                  { Are we currently playing? }
      Repeating: boolean = false;                { Repeat song at end (automatically turned off when song started) }
      Suspended: boolean = false;                { Suspend playing temporarily (automatically turned off when song started) }
      TicksLeftInNote: word = 0;                 { Number of ticks left in current note }

var BackgroundBuffer: array[0..BackgroundBufferSize] of record
      TimerCount: word;                          { Timer constant for the frequency }
      Duration: word                             { Number of ticks left for this note }
      end;
    ExitSave: pointer;                           { Previous exit procedure }
    SaveInt1C: pointer;                          { Previous timer interrupt handler }

procedure DisableInterrupts;
  { Turn off interrupts }
  inline($FA);                                   { CLI }

procedure EnableInterrupts;
  { Turn on interrupts }
  inline($FB);                                   { STI }

procedure JumpToOldISR(OldIsr: pointer);
  { Chain on to previous ISR (doesn't return) }
  inline($5B/$58/$87/$5E/$0E/$87/$46/$10/$89/
         $EC/$5D/$07/$1F/$5F/$5E/$5A/$59/$CB);

{$F+,S-}
procedure Int1CHandler; interrupt;
  { Process timer interrupt }
  begin
  if Playing and not Suspended then              { Quit fast if we're not playing right now }
    begin
    if TicksLeftInNote = 0                       { Time to change notes }
     then
      begin
      inc(CurrentNote);
      if CurrentNote > LastNote
       then
        begin
        Port[$61] := Port[$61] and $FC;          { Turn sound off }
        CurrentNote := 0;                        { Reset buffer to beginning }
        if not Repeating then
          begin
          Playing := false;                      { We're done playing }
          LastNote := 0                          { Start filling from beginning }
          end
        end
       else
        with BackgroundBuffer[CurrentNote] do    { Change to new frequency }
          begin
          TicksLeftInNote := Duration;           { How long to hold note }
          if TimerCount = 0
           then
            Port[$61] := Port[$61] and $FC       { Turn sound off }
           else
            begin
            Port[$43] := $B6;                    { Change to new frequency }
            Port[$42] := lo(TimerCount);
            Port[$42] := hi(TimerCount);
            Port[$61] := Port[$61] or $03        { Turn sound on }
            end
          end
      end
     else
      dec(TicksLeftInNote)                       { Wait for note to finish }
    end;
  JumpToOldISR(SaveInt1C)                        { Call other interrupt handlers }
  end;
{$F-,S+}

function PlayingInBackground: boolean;
  { Is there a song currently playing? }
  begin
  PlayingInBackground := Playing
  end;

procedure PlayingMode(Action: SongAction);
  { Change the play mode }
  begin
  case Action of
    EndRepeatSong: Repeating := false;
    RepeatSong: if Playing then
                  Repeating := true;
    ResumeSong: if Suspended then
                  Suspended := false;
    StopSong: if Playing then
                begin
                Port[$61] := Port[$61] and $FC;  { Turn sound off }
                Playing := false;
                Repeating := false;
                Suspended := false;
                CurrentNote := 0;                { Reset buffer to beginning }
                LastNote := 0;
                TicksLeftInNote := 0             { So first tick starts the song }
                end;
    SuspendSong: if Playing and not Suspended then
                   begin
                   Port[$61] := Port[$61] and $FC; { Turn sound off }
                   Suspended := true;
                   TicksLeftInNote := 0          { Chop off current note }
                   end
    end
  end;

procedure PlaySong(S: Song);
  { Play a song in the background already loaded in memory }
  { Add this song to currently playing tune if a tune is still in progress }
  { Turns off automatic song repeat mode }
  type NoteArray = array[1..16383] of record     { Arbitrary sized collection of notes }
         O,NS: Byte;
         D: Word
         end;
  var SongPtr: ^NoteArray;                       { Pointer to a song }
      I: integer;

  procedure PlayANote(Octave,NoteStaccato: byte;Duration: integer);
    { Play a single note from MUZ file }
    const Factor: array[0..10] of real = (0.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1.0);
          FreqVal: array[1..12] of real = (1.0000000000, 1.0594630944, 1.1224620484, 1.1892071151,
                                           1.2599210501, 1.3348398544, 1.4142135627, 1.4983070773,
                                           1.5874010524, 1.6817928311, 1.7817974369, 1.8877486261);
          OctVal: array[0..7] of real = (  65.406391320,  130.81278264,  261.62556528,  523.25113056,
                                         1046.5022611,   2093.0045222,  4186.0090445,  8372.0180890);
    var Note: byte;
        Staccato: byte;

    procedure StuffNote(Freq,Dur: word);
             { Put note information into BackgroundBuffer }
      begin
      DisableInterrupts;                         { Don't let a note change happen during this stretch }
      if (LastNote<BackgroundBufferSize) and (Dur>0) then { Don't enter 0 length durations }
        begin
        inc(LastNote);                           { Bump note counter }
        with BackgroundBuffer[LastNote] do       { Fill in the note information }
          begin
          TimerCount := Freq;
          Duration := Dur - 1                    { Pre-decrement the duration }
          end;
        Playing := true                          { There's at least one note in buffer, so start playing }
        end;
      EnableInterrupts                           { Turn interrupts back on again }
      end;

    begin
    Note := NoteStaccato shr 4;
    Staccato := (NoteStaccato and $0F) mod 11;
    CASE Note OF
      1..12: begin                               { Stuff on and off portion of notes }
              StuffNote(round(FreqConstant / (OctVal[(Octave-1) mod 8] * FreqVal[Note])),
                       round(Duration * Factor[10-Staccato] * TickConstant));
             StuffNote(0,round(Duration * Factor[Staccato] * TickConstant))
             end;
      13: StuffNote(0,round(Duration * TickConstant)) { Stuff a rest into buffer }
      else
      end
    end;

  begin
  SongPtr := @S;                                 { Get address of the song in memory }
  for I := 10 to (longint(SongPtr^[6]) and $FFFF) + 9 do { Play each of the notes in the song }
    with SongPtr^[I] do
      PlayANote(O,NS,D);
  Repeating := false                             { Turn off automatic repeat anytime you add to the music buffer }
  end;

function PlayMuz(Filename: string): boolean;
  { Play a song in the background loaded from a file -- returns true if file found }
  { Add this song to currently playing tune if a tune is still in progress }
  { Turns off automatic song repeat mode }
  var SaveFileMode: word;
      Size: longint;
      SongFile: file;
      SongPtr: pointer;
  begin
  PlayMuz := false;                              { Default to file not loaded }
  FileName := FSearch(FileName+'.MUZ',GetEnv('PATH')); { Search PATH for the song file }
  if Filename <> '' then
    begin
    SaveFileMode := FileMode;
    FileMode := $20 * ord(lo(DosVersion)>=3);    { Allow access to read only files }
    assign(SongFile,Filename);                   { Open the song file }
    {$I-}
    reset(SongFile,1);
    {$I+}
    if ioresult = 0 then                         { Since we've already found it, this really should always work }
      begin
      Size := FileSize(SongFile);
      getmem(SongPtr,Size);                      { Load file onto heap temporarily }
      blockread(SongFile,SongPtr^,Size);
      close(SongFile);
      FileMode := SaveFileMode;
      PlaySong(Song(SongPtr));
      freemem(SongPtr,Size);                     { Free up the heap again }
      PlayMuz := true
      end
    end
  end;

{$F+}
procedure ExitHandler;
{$F-}
  { Restore the timer interrupt and make sure sound is off }
  begin
  ExitProc := ExitSave;                          { Chain to other exit procedures }
  SetIntVec($1C,SaveInt1C);                      { Remove interrupt handler }
  Port[$61] := Port[$61] and $FC                 { Make sure sound is off }
  end;

begin
ExitSave := ExitProc;
ExitProc := @ExitHandler;                        { Install our exit procedure }
GetIntVec($1C,SaveInt1C);
SetIntVec($1C,@Int1CHandler)                     { Install our timer interrupt handler }
end.