Witam. Poszukuje kodu/unitu, który pozwoli mi odtwarzać (w konsoli) dźwięki w tle, tak aby reszta kodu była niezależna i działała podczas odtwarzania.
Przeszukałem internet i forum lecz niestety jedyne co znalazłem to: jakiś stary unit pod nazwą BackPlay, lecz niestety nie działa.
{$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
(206)531-8944
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.