{$A-,B+,D+,E+,F+,G+,I+,L+,N-,O+,P+,Q+,R+,S+,T-,V+,X+}
{$M 16384,0,655360}
program NewMID;
(*
* 2. Versuch fuer einen MID-Player
*
* laeuft wegen Timing-Problemen nicht komplett im Interrupt (wenn sehr
viele
* Events hintereinander kommen, gibts Haenger)
* Aber: ich arbeite daran :-)
*
* Hat jemand eine Idee oder ein System (Unit?), die 2 unterschiedlich
* schnell getaktete Interrupts bietet (z.B. einer 768 mal pro sek., der
* andere z.B. 50 mal pro sek., der erste muss aber einer hoehere
Prioritaet
* wie der zweite haben. Noch besser waere: der 1. muss den 2. ausloesen
koennen)
* [ Ich hoffe, das hat jetzt jeder verstanden :-) ]
* Wer also sowas hat oder kennt, meldet sich mal bitte bei mir ;)
*
* Aber trotz allem: Verbesserungsvorschlaege, Lobesgesaenge,
Dankesschreiben
* Kritik etc. an: Rene Werner@2:249/4060.3 oder hier im Echo (PASCAL.GER)
*
* (C) 1994,1995 by Rene Werner, Freeware
* Dieser Source ist Freeware! Er darf in Sachen verwendet werden, fuer
* die kein Geld verlangt wird (also nicht in Shareware oder gar
* kommerziellen Programmen). Wenn jemand den Player in seinen eigenen
* Programmen verwendet, wuerde ich mich ueber eine Kopie des Programms
sehr
* freuen.
* Fall jemand den Source aendert, dann moechte ich eine Kopie der
veraenderten
* Version haben!
*
* 01.05.95 : 1.0 (RW) : fertig :-)
*)
uses
crt,dos;
type
BPTR = ^byte;
const
{ Fehlermeldungen fuer loadMidiFile() }
lmf_ok : string[2] = 'OK';
lmf_no_file : string[35] = 'kann Datei nicht oeffnen';
lmf_out_of_mem : string[35] = 'nicht genug Speicher frei';
lmf_no_mid_file : string[35] = 'keine MIDI-Datei (''MTrk''fehlt)';
lmf_mid_format_err : string[35] = 'unerwartete Daten in MIDI-Datei';
lmf_not_typ01 : string[35] = 'MID-Datei ist nicht Typ 0 oder 1';
lmf_missing_mtrk : string[35] = 'kein ''MTrk'' am Track-Anfang';
lmf_track_too_large: string[35] = 'Track ist zu gross ( > 65528 bytes)';
lmf_too_many_tracks: string[35] = 'zu viele Tracks (max. 64)';
{ auf 'false' setzen um Ausgabe zu unterdruecken }
debug : boolean = true;
{ standard values for MPU-401: }
Dataport = $330; {Standard MPU-401 port NoteVals}
Statusport = dataport+1;
Commandport = dataport+1;
DRR = $40; {Data Ready to Receive}
DRS = $80; {Data Ready to Send}
ACKmsg = $FE;
ResetCmd = $FF;
UartModeCmd = $3F;
hexChars: array [0..$F] of Char ='0123456789ABCDEF';
{ die Laengen der Midi-Events }
event_lens : array[$80..$FF] of longint = (
3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, { $8x }
3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, { $9x }
3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, { $Ax }
3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, { $Bx }
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, { $Cx }
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, { $Dx }
3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, { $Ex }
1,1,3,2,1,1,1,1,1,1,1,1,1,1,1,1 { $Fx }
);
var
s : string;
tracks : word;
track_ptr : array[1..64] of pointer;
track_size : array[1..64] of longint;
play_ptr : array[1..64] of BPTR;
bp : BPTR;
play_delta : array[1..64] of longint;
old_cmds : array[1..64] of byte;
trk_finished : array[1..64] of boolean;
deltaticks : word;
bpm : word;
ints : word;
i : word;
il,jl : longint;
c : char;
b,meta : byte;
finished : boolean;
finished_t : word;
tick : boolean;
absDelta : longint;
call08 : boolean;
oldint08 : procedure;
{ modint: Frequenz des Interrupts aendern }
procedure modint(frames:longint);
var
Factor : longint;
begin
asm cli end;
port[$43]:=$36; { Steuerbefehl }
Factor:=1193180 DIV frames; { frequenz in Hz }
port[$40]:=Lo(Factor);
port[$40]:=Hi(Factor);
asm sti end;
end;
{ sendet ein Midi-Byte an den MPU-Port }
procedure sendMidiByte(b : byte);
var
junk : byte;
begin
{Warten, bis MPU bereit zum empfangen ist...}
while port[StatusPort] and DRR <> 0 do begin
{ Solange uns die MPU was senden will, holen wir es uns ;-) }
while port[StatusPort] and DRS = 0 do
junk := port[Dataport];
end;
{ Jetzt ist sie soweit ;) }
port[Dataport] := b;
END;
{ Hex4: Umwandlung word in Hex-String }
function Hex4(w: Word):string;
var
s : string;
begin
s:=hexChars[Hi(w) shr 4]+hexChars[Hi(w) and $F]+hexChars[Lo(w) shr 4]+
hexChars[Lo(w) and $F];
Hex4:=s;
end;
{$F+}
{ der Timer-Interrupt }
procedure int08Handler(Flags, rCS, rIP, rAX, rBX, rCX, rDX,
rSI, rDI, rDS, rES, rBP: Word);
interrupt;
var
i : word;
begin
tick:=true;
inc(absDelta);
if call08 then
{ call original system int 08 vector }
begin
asm
pushf
end;
oldint08;
end
else
port[$20]:=$20;
end;
{$F-}
{ verbiegt Timer-Int 08 und stellt Freuqenz ein }
procedure setint(frames:longint);
var
Factor : longint;
begin
port[$43]:=$36; { Steuerbefehl }
Factor:=1193180 DIV frames; { frequenz in Hz }
port[$40]:=Lo(Factor);
port[$40]:=Hi(Factor);
call08 := false;
GetIntVec($08, @oldint08);
SetIntVec($08, Addr(int08Handler));
end;
{ Setzt Int 08 zurueck }
procedure endint;
var
Factor : longint;
begin
asm
cli
end;
Factor := $FFFF;
Port[$40] := Lo(Factor); { Low-Byte fuer die Timer-Frequenz }
Port[$40] := Hi(Factor); { High-Byte fuer den Timer-Frequenz }
SetIntVec($08, @oldint08);
asm
sti
end;
end;
{ versucht, die MPU zurueckzusetzen, gibt TRUE zurueck, wenn eine MPU
vorhanden ist und auf MIDI-Kommandos reagiert }
function MidiReset : boolean;
var
junk : byte;
retries : integer;
timeout : word;
begin
MidiReset := true;
{ Try to clear pending data }
timeout := 0;
while (port[StatusPort] and DRS = 0) and (timeout < 10) do begin
junk := port[Dataport];
inc(timeout);
end;
for retries := 1 to 2 do begin
timeout := 0;
{Give it 3000 chances to say it
is ready to receive}
while (port[StatusPort] and DRR <> 0) and(timeout < 3000) do
inc(timeout);
if (timeout < 3000) then begin
{Send the reset command}
port[StatusPort] := ResetCmd;
timeout := 0;
{Give it 3000 tries to RESPOND to the
reset with an ACKnowledge}
while (TimeOut < 3000) do begin
if (port[StatusPort]and DRS = 0)
and (port[Dataport] = ACKmsg) then
exit;
inc(timeout);
end;
end;
end;
{If you get here, it failed to initialize}
MidiReset := false;
end;
{ LoadMidiFile
E: Dateiname der zu ladenden Datei
A: Errorcode ('OK', wenn alles i.O. ist) }
function LoadMidiFile(midfn:string):string;
var
f : file;
buf : array[1..4] of byte;
ts : longint;
i,j : word;
begin
{ track_ptr und track_size auf 0 }
for i:=1 to 64 do begin
track_ptr[i]:=nil;
track_size[i]:=0;
end;
if debug then writeln('DEBUG: versuche, ',midfn,' zu laden');
FileMode:=0;
assign(f,midfn);
{$I-}
reset(f,1);
{$I+}
if IOResult<>0 then begin
LoadMidiFile:=lmf_no_file;
exit; { exit mit 'lmf_no_file' }
end;
FileMode:=2;
{ Header lesen und auswerten (MThd) }
blockread(f,buf,4);
if not((buf[1]=ord('M')) and (buf[2]=ord('T')) and (buf[3]=ord('h'))
and (buf[4]=ord('d'))) then begin
close(f);
LoadMidiFile:=lmf_no_mid_file;
exit; { exit mit 'lmf_no_mid_file' }
end;
blockread(f,buf,4);
ts:=longint(buf[1]) shl 24+longint(buf[2]) shl 16+longint(buf[3]) shl
8+
longint(buf[4]);
if ts<>6 then begin
close(f);
LoadMidiFile:=lmf_mid_format_err;
exit; { MThd nicht 6 Bytes gross ! }
end;
blockread(f,buf,2);
if buf[1]<>0 then begin
close(f);
LoadMidiFile:=lmf_mid_format_err;
exit; { format error, muss 0 sein ! }
end;
if not((buf[2]=0) or (buf[2]=1)) then begin
close(f);
LoadMidiFile:=lmf_not_typ01;
exit; { nicht typ 0 oder 1, 2 wird nicht unterstuetzt }
end;
if debug then writeln('DEBUG: MIDI-Datei Typ ',buf[2]);
blockread(f,buf,2);
tracks:=word(buf[1]) shl 8+word(buf[2]);
if debug then writeln('DEBUG: Anzahl Tracks: ',tracks);
if tracks>64 then begin
close(f);
LoadMidiFile:=lmf_too_many_tracks;
exit;
end;
blockread(f,buf,2);
deltaticks:=word(buf[1]) shl 8+word(buf[2]);
if debug then writeln('DEBUG: DeltaTicks pro Viertelnote:',deltaticks);
if debug then writeln('DEBUG: lade Tracks... (',tracks,')');
for i:=1 to tracks do begin
if debug then writeln('DEBUG: lade Spur #',i);
blockread(f,buf,4); { MTrk }
if not((buf[1]=ord('M')) and (buf[2]=ord('T')) and
(buf[3]=ord('r'))
and (buf[4]=ord('k'))) then begin
close(f);
LoadMidiFile:=lmf_missing_mtrk;
exit;
end;
blockread(f,buf,4);
ts:=longint(buf[1]) shl 24+longint(buf[2]) shl 16+
longint(buf[3]) shl 8+longint(buf[4]);
if MemAvail65528 then begin
close(f);
LoadMidiFile:=lmf_track_too_large;
exit;
end;
track_size[i]:=ts;
GetMem(track_ptr[i],ts);
blockread(f,track_ptr[i]^,ts);
end;
loadMidiFile:=lmf_ok;
close(f);
end;
begin
clrscr;
if paramcount<1 then begin
writeln('Aufruf: ',paramstr(0),' midfilename');
halt;
end;
TextMode(CO80+Font8x8);
if not MidiReset then begin
s:=hexChars[Hi(dataport) and $F]+hexChars[Lo(dataport) shr 4]+
hexChars[Lo(dataport) and $F];
writeln('Kann MPU an Port '+s+'h nicht initialisieren!');
{ halt;}
{ Dieser Block wird auf meinem Terratec MiniWaveSystem immer ausgel”st.
Danach funktioniert die MIDI-Ausgabe dennoch einwandfrei.
- Arno (F_Fleck@compuserve.com) }
end
else
if debug then writeln('DEBUG: MPU ok.');
repeat { MPU in UART-mode bringen }
until (port[StatusPort] and DRR) = 0;
port[CommandPort] := UartModeCmd;
while port[StatusPort] and DRS <> 0 DO;
s:=loadMidiFile(paramstr(1));
if s='OK' then
writeln('MID-Datei erfolgreich geladen')
else begin
writeln('loadMidiFile() brachte folgenden Fehler:');
writeln(' -> ',s);
for i:=1 to 64 do
if track_ptr[i]<>nil then
FreeMem(track_ptr[i],track_size[i]);
halt;
end;
{ player initialisieren }
for i:=1 to tracks do begin
bp:=track_ptr[i];
il:=ord(bp^) AND $7F;
while ord(bp^)>127 do begin
il:=il SHL 7;
inc(bp);
il:=il+(ord(bp^) AND $7F);
end;
inc(bp);
play_delta[i]:=il+1;
play_ptr[i]:=bp; { korrigierter Ptr, zeigt auf 1. Event }
trk_finished[i]:=false;
end;
bpm:=120; { default }
ints:=word((longint(bpm)*longint(deltaticks)) div 60);
if debug then begin
write('Druecke eine Taste...');
if readkey=#0 then readkey;
clrscr;
asm { Cursor aus }
xor cl,cl
mov ch,36
mov ah,1
int 10h
end;
gotoxy(1,3);
write('Track Current');
for i:=1 to tracks do begin
gotoxy(1,4+i);
write(' ',i:2,' : $',hex4(seg(play_ptr[i]^)),':',
hex4(ofs(play_ptr[i]^)));
end;
gotoxy(10,1);
write('Speed: ',bpm:3,' BPM ; ',deltaticks:4,'Ticks/Quarternote');
end;
finished:=false;
finished_t:=0;
c:=#0;
tick:=false;
setint(longint(ints)); { start player }
while not tick do;
absDelta:=0;
repeat
if not finished then begin
for i:=1 to tracks do begin
while ((not(trk_finished[i])) and
(play_delta[i]<=absDelta)) do begin
bp:=play_ptr[i];
if bp^<$80 then
b:=old_cmds[i]
else begin
b:=bp^;
inc(bp);
end;
old_cmds[i]:=b;
if b=$ff then begin { meta event ? }
meta:=bp^;
inc(bp);
{ laenge des meta-events holen }
il:=ord(bp^) AND $7F;
while ord(bp^)>127 do begin
il:=il SHL 7;
inc(bp);
il:=il+(ord(bp^) AND $7F);
end;
inc(bp);
case meta of
$2f: begin { track ende }
if debug then begin
gotoxy(15,4+i);
write('---- (track ende)');
end;
trk_finished[i]:=true;
inc(finished_t);
if finished_t=tracks then
finished:=true;
end;
$51: begin { set tempo }
il:=ord(bp^);
inc(bp);
il:=(il SHL 8)+ord(bp^);
inc(bp);
il:=(il SHL 8)+ord(bp^);
inc(bp);
bpm:=word(60000000 DIV il);
ints:=word((longint(deltaticks)*
longint(bpm)) div 60);
if debug then begin
gotoxy(10,1);
write('Speed: ',bpm:3,
' BPM ;',deltaticks:4,
' Ticks/Quarternote');
end;
{ Interrupt-Frequenz aendern }
modint(longint(ints));
end;
$03: begin { Trackname }
if debug then begin
gotoxy(20,4+i);
for jl:=1 to 11 do
write(' ');
gotoxy(20,4+i);
for jl:=1 to il do begin
write(char(bp^));
inc(bp);
end;
end else
for jl:=1 to il do
inc(bp);
end;
else for jl:=1 to il do
inc(bp); { meta-event uebergehen
}
end;
end { if b=$ff }
else begin
il:=event_lens[b]; { laenge des events }
if ((b=$f0) or (b=$f7)) then begin { sysex ?
}
il:=ord(bp^) AND $7F; { laenge holen }
while ord(bp^)>127 do begin
il:=il SHL 7;
inc(bp);
il:=il+(ord(bp^) AND $7F);
end;
inc(bp);
{ anzahl bytes in il }
if b=$f0 then begin { beginn eines sysex ?
}
while port[StatusPort] and DRR <> 0 do;
port[Dataport] := $0f0; {sysex senden}
end;
for jl:=1 to il do begin
while port[StatusPort] and DRR <> 0
do;
port[Dataport] := bp^;
inc(bp);
end;
end else begin
{ Byte in b }
(*
while port[StatusPort] and DRR <> 0 do;
port[Dataport] := b;
*)
asm
mov dx,StatusPort
@1:
in al,dx
and al,DRR
jnz @1
mov al,[b]
dec dx { DataPort = StatusPort - 1 }
out dx,al
end;
if il>=2 then begin {Event mit 2 oder 3
Bytes}
b:=bp^; { Byte holen }
(*
while port[StatusPort] and DRR <> 0
do;
port[Dataport] := bp^;
*)
asm
mov dx,StatusPort
@2:
in al,dx
and al,DRR
jnz @2
mov al,[b]
dec dx
out dx,al
end;
inc(bp);
if il=3 then begin { 3. Byte ?? }
b:=bp^; { Byte holen }
(*
while port[StatusPort] and DRR<>0
do;
port[Dataport] := bp^;
*)
asm
mov dx,StatusPort
@2:
in al,dx
and al,DRR
jnz @2
mov al,[b]
dec dx
out dx,al
end;
inc(bp);
end; { if il=3 }
end; { if il>=2 }
end; { if ((b=$f0) or (b=$f7)) -- else end }
end; { if b=$ff -- else end}
if not trk_finished[i] then begin
il:=ord(bp^) AND $7F;
while ord(bp^)>127 do begin
il:=il SHL 7;
inc(bp);
il:=il+(ord(bp^) AND $7F);
end;
inc(bp);
play_delta[i]:=play_delta[i]+il;
play_ptr[i]:=bp;
if debug then begin
gotoxy(15,4+i);
write(hex4(ofs(play_ptr[i]^)));
end;
end;
end; { while play_delta[i]=0 }
end; { for i:=1 to tracks }
end; { if not finished }
if keypressed then begin
c:=readkey;
if c=#0 then readkey;
end;
until ((c=#27) or (finished));
{ Interrupt wiederherstellen }
endint;
{ bringen wir das Midi-Equipment mal zur Ruhe }
for b:=0 to 15 do begin
sendMidiByte($B0+b); { All notes off }
sendMidiByte($7B);
sendMidiByte($00);
sendMidiByte($B0+b); { All sounds off }
sendMidiByte($78);
sendMidiByte($00);
sendMidiByte($B0+b); { Reset all controllers }
sendMidiByte($79);
sendMidiByte($00);
end;
{ Speicher freigeben }
for i:=1 to 64 do
if track_ptr[i]<>nil then
FreeMem(track_ptr[i],track_size[i]);
TextMode(CO80);
{ und last but not least: wir bringen die Systemzeit in Ordnung :-) }
asm
XOR AL,AL
OUT 70h,AL
IN AL,71h
MOV DH,AL
AND DH,15
SHR AL,4
MOV DL,10
MUL DL
ADD DH,AL
MOV AL,2
OUT 70h,AL
IN AL,71h
MOV CL,AL
AND CL,15
SHR AL,4
MOV DL,10
MUL DL
ADD CL,AL
MOV AL,4
OUT 70h,AL
IN AL,71h
MOV CH,AL
AND CH,15
SHR AL,4
MOV DL,10
MUL DL
ADD CH,AL
XOR DL,DL
MOV AH,2Dh
INT 21h
MOV AL,7
OUT 70h,AL
IN AL,71h
MOV DL,AL
AND DL,15
SHR AL,4
MOV CH,10
MUL CH
ADD DL,AL
MOV AL,8
OUT 70h,AL
IN AL,71h
MOV DH,AL
AND DH,15
SHR AL,4
MOV CH,10
MUL CH
ADD DH,AL
MOV AL,4
OUT 70h,AL
IN AL,71h
MOV CL,AL
AND CL,15
SHR AL,4
MOV CH,10
MUL CH
ADD CL,AL
XOR CH,CH
ADD CX,1900
MOV AH,2Bh
INT 21h
end;
end.
(
geocities.com/~franzglaser)