{$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 MemAvail<ts then begin

            close(f);

            LoadMidiFile:=lmf_out_of_mem;

            exit;

         end;

         if ts>65528 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.