home *** CD-ROM | disk | FTP | other *** search
- (***************************************************************************
- :Program. rsx.mod
- :Author. Jürgen Zimmermann
- :Address. Ringstraße 6, W-6719 Altleiningen, Germany
- :Phone. 06356/1456
- :ShortCut. [JnZ]
- :Support. -
- :Version. 1.0
- :Date. 24. Febuary 1990
- :Copyright. PD
- :Language. MODULA-II
- :Translator. M2Amiga 4.0d
- :Contents. Demoprogram for the use of "midi.library" in Modula-2
- :Usage. Just start it!
- ****************************************************************************)
-
- MODULE rsx;
-
-
- FROM SYSTEM IMPORT ADR;
-
- FROM Arts IMPORT Assert;
-
- FROM Break IMPORT InstallException, RemoveException;
-
- FROM InOut IMPORT WriteLn, WriteString, WriteCard, WriteInt;
-
- FROM MidiD IMPORT MidiPacket, MidiPacketPtr, MDest, MDestPtr, MRoute, MRoutePtr,
- MRouteInfo, MRouteInfoPtr, MMFFlags, MMFFlagSet, midiInName;
-
- FROM MidiL IMPORT CreateMDest, MRouteDest, GetMidiPacket, FreeMidiPacket,
- DeleteMRoute, DeleteMDest;
-
-
- VAR dest : MDestPtr;
- routeinfo: MRouteInfo;
- route : MRoutePtr;
- packet : MidiPacketPtr;
- pp : POINTER TO ARRAY[0..6] OF SHORTCARD;
-
-
- PROCEDURE CleanUp;
-
- BEGIN
- IF (packet # NIL)
- THEN
- FreeMidiPacket(packet);
- packet:=NIL;
- END; (* IF *)
- IF (route # NIL)
- THEN
- DeleteMRoute(route);
- route:=NIL;
- END; (* IF *)
- IF (dest # NIL)
- THEN
- DeleteMDest(dest);
- dest:=NIL;
- END; (* IF *)
- END CleanUp;
-
- BEGIN
- InstallException;
- routeinfo.MsgFlags:=MMFFlagSet{SysEx};
-
- WriteString("Receive Sys/Ex");
- WriteLn;
- dest:=NIL;
- dest:=CreateMDest(NIL,NIL);
- Assert(dest # NIL, ADR("Can't create Dest"));
-
- route:=NIL;
- route:=MRouteDest(ADR(midiInName),dest,ADR(routeinfo));
-
- LOOP
- packet:=GetMidiPacket(dest);
- IF (packet # NIL)
- THEN
- IF (packet^.Length = 7)
- THEN
- pp:=ADR(packet^.MidiMsg);
- WriteCard(pp^[3], 10);
- WriteCard(pp^[4], 10);
- WriteCard(pp^[5], 20);
- END; (* IF *)
- WriteLn;
- FreeMidiPacket(packet);
- END; (* IF *)
- END; (* LOOP *)
- CLOSE
- CleanUp;
- RemoveException;
- END rsx.
-