(**********************************************************************

    :Program.    ReceiveSysEx.mod
    :Contents.   Workbench-based Midi-Data-Dump program
    :Author.     Jürgen Zimmermann [JnZ]
    :Address.    Ringstraße 6, W-6719 Altleiningen, Germany
    :Phone.      06356/1456
    :Copyright.  Public Domain (but donation is always welcome!)
    :Language.   Modula-2
    :Translator. M2Amiga AMSoft V4.096d
    :Imports.    IDCMP      [bne] IDCMP-Handler-routines
    :Imports.    GadgetHelp [JnZ] Module for easy gadget-gandling
    :Imports.    ARP        [fbs] Interface to the "arp.library"
    :Imports.    Midi       [JnZ] Interface to the "midi.library"
    :History.    V1.0  [JnZ] 16.Apr.1991 first internal version which works
    :History.    V1.0B [JnZ] 12.May.1991 ported to V4.0 of M2Amiga (much shorter now)
    :Hisrory.    V1.0C [JnZ] 16.Jun.1991 some cosmetics
    :Future.     perhaps someone will port this code to OBERON (this is the
    :Future.     reason for the unnormal Modula-2-Notation of the source: I
    :Future.     tried to avoid unqualified IMPORTs) (M2Amiga V4.0d helps much!)
**********************************************************************)

MODULE ReceiveSysEx;


IMPORT ad: ArpD,
       al: ArpL,
       ar: Arts,
       ed: ExecD,
       fs: FileSystem,
       gd: GraphicsD,
       gl: GraphicsL,
       tm: TaskMemory,
       ip: IDCMP,
       gh: GadgetHelp,
       id: IntuitionD,
       il: IntuitionL,
       md: MidiD,
       ml: MidiL,
       st: String,
       sy: SYSTEM;


CONST FileKennung  = "SysEx V1.0JnZ";
      SetUpKennung = "SetUp V1.0JnZ";
      SetUpLen     =  13;
      WindowTitel  = "Receive & Transmit Sys-Ex by Jürgen Zimmermann";

      PropNummern  = 1; (* Nummern der PropGadgets: 1 - 3! *)

      MaxCharsRequest = 50;

      TransmitNum   = 4;
      ReceiveNum    = 5;
      ChanOnOffNum  = 6;
      RequestStrNum = 7;
      ReqOnOffNum   = 8;
      LoadSetUpNum  = 9;
      SaveSetUpNum  = 10;
      AbortNum      = 11;


TYPE FirstBlock = RECORD
                     Anzahl: [1..10];
                     Laenge: ARRAY[1..10] OF CARDINAL;
                  END; (* RECORD *)

     STRING = ARRAY[0..MaxCharsRequest] OF CHAR;

     SetUp = RECORD
                MidiChannel: md.MidiChannels;
                allChannels: BOOLEAN;

                Offset     : [0..9];
                Number     : [1..10];
                ReqString  : STRING;
                ReqOn      : BOOLEAN;
             END; (* RECORD *)


VAR DataBlock      : FirstBlock;
    DataPacketsPtr : ARRAY[1..10] OF md.MidiPacketPtr;
    DataRawPtr     : ARRAY[1..10] OF sy.ADDRESS;


VAR ActualSetUp  : SetUp;


VAR TransmitGadget: gh.BoolGadget;
    ReceiveGadget : gh.BoolGadget;
    ChannelPropGad: gh.PropGadget;
    ChannelStr    : ARRAY[0..2] OF CHAR;
    OffsetPropGad : gh.PropGadget;
    OffsetStr     : ARRAY[0..2] OF CHAR;
    NumberPropGad : gh.PropGadget;
    NumberStr     : ARRAY[0..2] OF CHAR;
    ChanOnOffGad  : gh.BoolGadget;
    RequestStrGad : gh.StringGadget;
    ReqOnOffGad   : gh.BoolGadget;
    LoadSetUpGad  : gh.BoolGadget;
    SaveSetUpGad  : gh.BoolGadget;
    AbortGad      : gh.BoolGadget;


VAR Fenster: id.WindowPtr;
    Rast   : gd.RastPortPtr;


VAR abort        : BOOLEAN;
    abortPossible: BOOLEAN;


VAR ProNum     : INTEGER; (* Nummer des gedrückten Prop-Gadgets *)
    screenTitle: sy.ADDRESS; (* Adresse des Workbench-Titels *)


(******************************************************************************)
(****************************** The Misc-Procedures ***************************)
(******************************************************************************)

PROCEDURE DiscardDataPackets;

   VAR i: INTEGER;

   BEGIN
      FOR i:=1 TO 10 DO
         IF (DataPacketsPtr[i] # NIL)
            THEN
               ml.FreeMidiPacket(DataPacketsPtr[i]);
               DataPacketsPtr[i]:=NIL;
               DataBlock.Laenge[i]:=0;
         END; (* IF *)

         IF (DataRawPtr[i] # NIL)
            THEN
               tm.Deallocate(DataRawPtr[i]);
               DataRawPtr[i]:=NIL;
         END; (* IF *)
      END; (* FOR *)
   END DiscardDataPackets;

(******************************************************************************)

PROCEDURE Box(RP         : gd.RastPortPtr;
              xs,ys,xe,ye: INTEGER;
              color      : INTEGER);

   BEGIN
      gl.SetDrMd(RP,gd.DrawModeSet{gd.complement});
      gl.SetAPen(RP,color);
      gl.RectFill(RP,xs,ys,xe,ye);
   END Box;

(******************************************************************************)

PROCEDURE ConvertNumToStr(VAR str: ARRAY OF CHAR;
                          number : CARDINAL);

   BEGIN
      str[0]:=CHAR(CARDINAL("0")+(number DIV 10));
      str[1]:=CHAR(CARDINAL("0")+(number MOD 10));
      str[2]:=0C;
   END ConvertNumToStr;

(******************************************************************************)

PROCEDURE TextAt(text : ARRAY OF CHAR;
                 x,y  : INTEGER;
                 color: CARDINAL);

   BEGIN
      gl.SetDrMd(Rast,gd.jam2);
      gl.SetAPen(Rast,color);
      gl.Move(Rast,x,y+7);
      gl.Text(Rast,sy.ADR(text),st.Length(text));
   END TextAt;

(******************************************************************************)

PROCEDURE WriteActualValues;

   BEGIN
      ConvertNumToStr(ChannelStr,(CARDINAL(ActualSetUp.MidiChannel)+1));
      ConvertNumToStr(OffsetStr,ActualSetUp.Offset);
      ConvertNumToStr(NumberStr,ActualSetUp.Number);
      TextAt(ChannelStr,130,20,3);
      TextAt(OffsetStr,130,40,3);
      TextAt(NumberStr,130,60,3);
   END WriteActualValues;


(******************************************************************************)
(********************** Calculation of the Dump-Request ***********************)
(******************************************************************************)

VAR ReqMessage   : ARRAY[0..(MaxCharsRequest DIV 2)] OF SHORTCARD;
    MessageLength: CARDINAL; (* Anzahl gültiger Bytes in 'ReqMessage' *)


VAR Zaehler : INTEGER;
    Laenge  : INTEGER;
    ReqText : POINTER TO STRING;

PROCEDURE CheckDumpRequest(): BOOLEAN;

   BEGIN
      gh.GetGadgetText(RequestStrGad,ReqText);
      Laenge:=st.Length(ReqText^);
      FOR Zaehler:=0 TO Laenge DO
         CASE CAP(ReqText^[Zaehler]) OF
            |"0".."9","A".."F",0C," ","[","]","*":;
            ELSE
               RequestStrGad.stringinfo^.bufferPos:=Zaehler;
               RETURN(FALSE);
         END; (* CASE *)
      END; (* FOR *)
      RETURN(TRUE);
   END CheckDumpRequest;


PROCEDURE ConvertReqMessage(): BOOLEAN;

VAR    Pos     : INTEGER;
       CheckPos: INTEGER; (* Position der Checksumme *)
       FromChk : INTEGER;  (* Anfang der Checksumme *)
       ToChk   : INTEGER;  (* Ende der Checksumme *)
       Wert    : SHORTCARD;
       Zeichen : CHAR;
       Loop    : BOOLEAN; (* TRUE : first loop *)
                          (* FALSE: second loop *)

   PROCEDURE CalcCheckSum(Pos,From,To: INTEGER);

      VAR Pruefsumme: INTEGER;
          i         : INTEGER;

      BEGIN
         Pruefsumme:=0;
         FOR i:=From TO To DO
            Pruefsumme:=Pruefsumme + INTEGER(ReqMessage[i]);
         END; (* FOR *)
         ReqMessage[Pos]:=SHORTCARD(128 - (Pruefsumme MOD 128));
      END CalcCheckSum;

   PROCEDURE ConvertHexNum(Zeichen : CHAR;
                           VAR Wert: SHORTCARD;
                           HiByte  : BOOLEAN);

      VAR Faktor: SHORTCARD;

      BEGIN
         IF HiByte
            THEN
               Faktor:=16;
            ELSE
               Faktor:=1;
         END; (* IF *)
         CASE CAP(Zeichen) OF
            |"0".."9": Wert:=Wert + Faktor * (SHORTCARD(Zeichen) - SHORTCARD("0"));
            |"A".."F": Wert:=Wert + Faktor * (10 +  (SHORTCARD(CAP(Zeichen)) - (SHORTCARD("A"))));
         END; (* CASE *)
     END ConvertHexNum;

   BEGIN
      IF CheckDumpRequest()
         THEN
            Pos:=0;
            Loop:=TRUE;
            Zaehler:=0;
            CheckPos:=-1;
            FromChk:=-1;
            ToChk  :=-1;

            Wert:=0;

            REPEAT
               WHILE ((ReqText^[Zaehler] = " ") AND (Zaehler < Laenge)) DO
                  INC(Zaehler);
               END; (* WHILE *)
               CASE CAP(ReqText^[Zaehler]) OF
                  | "*": IF ((CheckPos = -1) AND ((FromChk = -1) OR (ToChk # -1)))
                            THEN
                               CheckPos:=Pos;
                               INC(Pos);
                            ELSE
                               RETURN(FALSE);
                           (* Error: mehrere Checksummen! *)
                         END; (* IF *)
                  | "[": IF (FromChk = -1)
                            THEN
                               FromChk:=Pos;
                            ELSE
                               RETURN(FALSE);
                           (* Error: mehrere Checksummen! *)
                         END; (* IF *)
                  | "]": IF ((ToChk = -1) AND (FromChk # -1))
                            THEN
                               ToChk:=Pos;
                            ELSE
                               RETURN (FALSE);
                           (* Error: mehrere Checksummen! *)
                         END; (* IF *)
                  | "A".."F","0".."9": ConvertHexNum(ReqText^[Zaehler],
                                             Wert,Loop);
                                       Loop:=NOT(Loop); (* nächstes Byte suchen *)
                                       IF Loop
                                          THEN (* Hi- und LoByte berechnet! *)
                                             ReqMessage[Pos]:=Wert;
                                             INC(Pos);
                                             Wert:=0;
                                       END; (* IF *)
               END; (* CASE *)
               INC(Zaehler);
            UNTIL (Zaehler = Laenge);
            MessageLength:=Pos;
            IF (CheckPos # -1)
               THEN
                  IF ((FromChk # -1) AND (ToChk # -1) AND (ToChk >= FromChk))
                     THEN
                        CalcCheckSum(CheckPos,FromChk,ToChk);
                     ELSE
                        RETURN (FALSE);
                  END; (* IF *)
            END; (* IF *)
            RETURN (Loop); (* letzte Berechnung abgeschlossen? *)
      END; (* IF *)
      RETURN(FALSE);
   END ConvertReqMessage;


(******************************************************************************)
(****************************** The Close-Procedures **************************)
(******************************************************************************)

VAR reroute   : md.MRoutePtr; (* Receiveroute *)
    trroute   : md.MRoutePtr; (* Transmitroute *)

    InDest     : md.MDestPtr;      (* Port, an dem die MSGs ankommen *)
    OutSource  : md.MSourcePtr;    (* Port, an die die MSGs geschickt werden *)
    routeinfoAl: md.MRouteInfo; (* lets all channels pass *)
    routeinfoCh: md.MRouteInfo; (* lets only one channel pass *)

PROCEDURE CloseMidi;

   BEGIN
      IF (reroute # NIL)
         THEN
            ml.DeleteMRoute(reroute);
            reroute:=NIL;
      END; (* IF *)

      IF (trroute # NIL)
         THEN
            ml.DeleteMRoute(trroute);
            trroute:=NIL;
      END; (* IF *)

      IF (InDest # NIL)
         THEN
            ml.FlushMDest(InDest);
            ml.DeleteMDest(InDest);
            InDest:=NIL;
      END; (* IF *)

      IF (OutSource # NIL)
         THEN
            ml.DeleteMSource(OutSource);
            OutSource:=NIL;
      END; (* IF *)
   END CloseMidi;


(******************************************************************************)
(********************** All Procedures to open something **********************)
(******************************************************************************)

PROCEDURE OpenMidi;

   VAR routeinfo: sy.ADDRESS;

   BEGIN
      InDest:=ml.CreateMDest(NIL,NIL);
      ar.Assert(InDest # NIL, sy.ADR("Can't create MIDI-dest"));

      OutSource:=ml.CreateMSource(NIL,NIL);
      ar.Assert(OutSource # NIL, sy.ADR("Can't create MIDI-source"));

      IF ActualSetUp.allChannels
         THEN
            routeinfo:=sy.ADR(routeinfoAl);
         ELSE
            routeinfo:=sy.ADR(routeinfoCh);
            routeinfoCh.ChanFlags:=md.MidiChannelSet{ActualSetUp.MidiChannel};
      END; (* IF *)

      reroute:=ml.MRouteDest(sy.ADR("MidiIn"),InDest,sy.ADR(routeinfo));
      trroute:=ml.MRouteSource(OutSource,sy.ADR("MidiOut"),sy.ADR(routeinfoAl));
      ml.FlushMDest(InDest); (* alle übrigen MIDI-Daten-Dumps löschen! *)
  END OpenMidi;

(******************************************************************************)

PROCEDURE OpenAll;

   VAR NW: id.NewWindow;
       i: INTEGER;
       dum: LONGINT;

   BEGIN
      FOR i:=1 TO 10 DO
         DataPacketsPtr[i]:=NIL;
         DataRawPtr[i]:=NIL;
      END; (* FOR *)

      Fenster    :=NIL;
      screenTitle:=NIL;
      InDest     :=NIL;
      OutSource  :=NIL;

      reroute:=NIL;
      trroute:=NIL;

      routeinfoAl.MsgFlags  :=md.MMFFlagSet{md.SysEx};
      routeinfoAl.ChanFlags :=md.AllChannels;
      routeinfoAl.ChanOffset:=0;
      routeinfoAl.NoteOffset:=0;

      routeinfoCh.MsgFlags  :=md.MMFFlagSet{md.SysEx};
      routeinfoCh.ChanFlags :=md.MidiChannelSet{md.Ch01};
      routeinfoCh.ChanOffset:=0;
      routeinfoCh.NoteOffset:=0;

      WITH ActualSetUp DO
         MidiChannel :=md.Ch01;
         allChannels :=TRUE;
         Offset      :=0;
         Number      :=1;
         ReqString[0]:=0C;
         ReqOn       :=FALSE;
      END; (* WITH *)

      WITH NW DO
         leftEdge  :=0;
         topEdge   :=11;
         width     :=452;
         height    :=140;
         detailPen :=0;
         blockPen  :=1;
         idcmpFlags:=id.IDCMPFlagSet{id.closeWindow,id.gadgetUp,
                                     id.gadgetDown,id.mouseMove};
         flags     :=id.WindowFlagSet{id.windowDrag,id.windowDepth,
                                      id.windowClose,id.windowActive,
                                      id.wbenchWindow,id.rmbTrap};
         firstGadget:=NIL;
         checkMark  :=NIL;
         title      :=sy.ADR(WindowTitel);
         screen     :=NIL;
         bitMap     :=NIL;
         minWidth   :=-1;
         minHeight  :=-1;
         maxWidth   :=-1;
         maxHeight  :=-1;
         type       :=id.ScreenFlagSet{id.wbenchScreen};
      END; (* WITH *)

      Fenster:=il.OpenWindow(NW);
      Rast:=Fenster^.rPort;

      ar.Assert(Fenster # NIL,sy.ADR("Warning: can't open window!"));

      screenTitle:=Fenster^.wScreen^.title;

      gh.SetBooleanGadget(Fenster,TransmitGadget,290,100,
                          id.ActivationFlagSet{id.gadgImmediate},
                          sy.ADR("Transmit"),TransmitNum);
      gh.SetBooleanGadget(Fenster,ReceiveGadget,160,100,
                          id.ActivationFlagSet{id.gadgImmediate},
                          sy.ADR("Receive "),ReceiveNum);
      gh.SetBooleanGadget(Fenster,SaveSetUpGad,274,80,
                          id.ActivationFlagSet{id.gadgImmediate},
                          sy.ADR("Save SetUp"),SaveSetUpNum);
      gh.SetBooleanGadget(Fenster,LoadSetUpGad,160,80,
                          id.ActivationFlagSet{id.gadgImmediate},
                          sy.ADR("Load SetUp"),LoadSetUpNum);
      gh.SetPropGadget(Fenster,ChannelPropGad,160,21,200,8,
                       id.PropInfoFlagSet{id.freeHoriz,id.autoKnob},
                       PropNummern);
      gh.RecalcPropGadget(Fenster,ChannelPropGad,1,0,16,0);

      gh.SetBooleanGadget(Fenster,ChanOnOffGad,380,20,
                          id.ActivationFlagSet{id.gadgImmediate},
                          sy.ADR(" On "),ChanOnOffNum);

      gh.SetPropGadget(Fenster,OffsetPropGad,160,41,200,8,
                       id.PropInfoFlagSet{id.freeHoriz,id.autoKnob},
                       (PropNummern + 1));
      gh.RecalcPropGadget(Fenster,OffsetPropGad,1,0,10,0);


      gh.SetPropGadget(Fenster,NumberPropGad,160,61,200,8,
                       id.PropInfoFlagSet{id.freeHoriz,id.autoKnob},
                       (PropNummern + 2));
      gh.RecalcPropGadget(Fenster,NumberPropGad,1,0,10,0);

      gh.SetStringGadget(Fenster,RequestStrGad,160,121,25,MaxCharsRequest,
                         FALSE,RequestStrNum);
      gh.SetBooleanGadget(Fenster,ReqOnOffGad,380,120,
                          id.ActivationFlagSet{id.gadgImmediate},
                          sy.ADR(" On "),ReqOnOffNum);

      gh.SetBooleanGadget(Fenster,AbortGad,20,90,
                          id.ActivationFlagSet{id.relVerify},
                          sy.ADR("Abort"),AbortNum);

      TextAt("Midi-Channel:",20,20,1);
      TextAt("Data-Offset :",20,40,1);
      TextAt("Data-Blocks :",20,60,1);
      TextAt("Dump-Request:",20,120,1);

      WriteActualValues;
      il.RefreshGadgets(Fenster^.firstGadget,Fenster,NIL);
   END OpenAll;


(******************************************************************************)
(***************************** The File-Procedures ****************************)
(******************************************************************************)

TYPE DirName = ARRAY[0..255] OF CHAR;

VAR FileTxt   : ARRAY[0..50] OF CHAR;
    DirTxt    : DirName;
    FileString: DirName;
    TestString: ARRAY[0..20] OF CHAR; (* Für die Filekennungen *)


PROCEDURE SetAllParams(AlCh: BOOLEAN;
                       ReOn: BOOLEAN);

   VAR ReqText: POINTER TO STRING;
       i,l    : INTEGER;

   BEGIN
       gh.GetGadgetText(RequestStrGad,ReqText);
       l:=st.Length(ActualSetUp.ReqString);
       FOR i:=0 TO l DO
          ReqText^[i]:=ActualSetUp.ReqString[i];
       END; (* FOR *)
       FOR i:= (l+1) TO MaxCharsRequest DO
          ReqText^[i]:=0C;
       END; (* FOR *)

      gh.SetPropPos(Fenster,ChannelPropGad,
                    CARDINAL(ActualSetUp.MidiChannel),0);
      gh.SetPropPos(Fenster,OffsetPropGad,ActualSetUp.Offset,0);
      gh.SetPropPos(Fenster,NumberPropGad,(ActualSetUp.Number - 1),0);
      WriteActualValues;

      IF (ActualSetUp.allChannels)
         THEN
            IF NOT(AlCh)
               THEN
                  Box(Fenster^.rPort,380,20,415,29,3);
            END; (* IF *)
         ELSE
            IF AlCh
               THEN
                  Box(Fenster^.rPort,380,20,415,29,3);
            END; (* IF *)
      END; (* IF *)

      IF (ActualSetUp.ReqOn)
         THEN
            IF NOT(ReOn)
               THEN
                  Box(Fenster^.rPort,380,120,415,129,3);
            END; (* IF *)
         ELSE
            IF ReOn
               THEN
                  Box(Fenster^.rPort,380,120,415,129,3);
            END; (* IF *)
      END; (* IF *)
      il.RefreshGadgets(Fenster^.firstGadget,Fenster,NIL);
   END SetAllParams;

(******************************************************************************)

PROCEDURE FileDelRequest(): BOOLEAN;

   BEGIN
      RETURN(ar.Requester(sy.ADR("SysEx T&R: WARNING"),
             sy.ADR("File exists. Overwrite it?"),
             sy.ADR(" Yes "),sy.ADR(" No ")));
   END FileDelRequest;

(******************************************************************************)

PROCEDURE MakeFileName(): BOOLEAN;

   VAR i: CARDINAL;
       j: CARDINAL;

   BEGIN
      IF (FileTxt[0] = 0C)
         THEN
            RETURN(FALSE);
         ELSE
            FileString:=DirTxt;
            al.TackOn(sy.ADR(FileString),sy.ADR(FileTxt));
            RETURN (TRUE); (* gültiger Filename *)
      END; (* IF *)
   END MakeFileName;

(******************************************************************************)

PROCEDURE FileExist(): BOOLEAN;

   VAR DataFile: fs.File;

   BEGIN
      fs.Lookup(DataFile,FileString,20,FALSE);
      IF (DataFile.res = fs.done)
         THEN
            IF FileDelRequest()
               THEN
                  fs.Delete(DataFile);
                  fs.Close(DataFile);
                  RETURN (FALSE);
               ELSE
                  fs.Close(DataFile);
                  RETURN (TRUE); (* File still exists *)
            END; (* IF *)
         ELSE
            RETURN(FALSE); (* File does not exist *)
      END; (* IF *)
   END FileExist;

(******************************************************************************)

PROCEDURE AskForFile(text: ARRAY OF CHAR): BOOLEAN;

   VAR FR: ad.FileRequester;

   BEGIN
      FileTxt:= "noname";
      DirTxt := "";
      WITH FR DO
         hail      := sy.ADR(text);
         file      := sy.ADR(FileTxt);
         dir       := sy.ADR(DirTxt);
         window    := NIL;
         funcFlags := ad.ReqFlagSet{};
         flags2    := ad.ReqFlagSet2{};
         function  := NIL;
         leftEdge  := 0;
         topEdge   := 11;
      END; (* WITH *)
      RETURN (al.FileRequest(sy.ADR(FR)) # NIL);
   END AskForFile;

(******************************************************************************)

PROCEDURE CheckError(a,b: LONGINT): BOOLEAN;

   BEGIN
      RETURN (a#b);
   END CheckError;

(******************************************************************************)

PROCEDURE SaveSetUp;

   VAR DataFile: fs.File;
       error   : BOOLEAN;
       i,l     : INTEGER;
       ReqText : POINTER TO STRING;

   PROCEDURE SaveSet;

      VAR actual : LONGINT;

      BEGIN
         error:=FALSE;
         fs.Lookup(DataFile,FileString,1000,TRUE);
         fs.WriteBytes(DataFile,sy.ADR(SetUpKennung),
                               SetUpLen,actual);
         error:=CheckError(SetUpLen,actual);
         IF error
            THEN
               RETURN;
         END; (* IF *)

         fs.WriteBytes(DataFile,sy.ADR(ActualSetUp),
                               SIZE(SetUp),actual);
         error:=CheckError(SIZE(SetUp),actual);
      END SaveSet;

   BEGIN
      IF (AskForFile("Save current SetUp") AND MakeFileName() AND
            NOT(FileExist()))
         THEN
            gh.GetGadgetText(RequestStrGad,ReqText);
            l:=st.Length(ReqText^);
            FOR i:=0 TO l DO
               ActualSetUp.ReqString[i]:=ReqText^[i];
            END; (* FOR *)
            FOR i:= (l+1) TO MaxCharsRequest DO
               ActualSetUp.ReqString[i]:=0C;
            END; (* FOR *)
            SaveSet;
            fs.Close(DataFile);
            IF error
               THEN
                  error:=NOT(ar.Requester(sy.ADR("SysEx T&R: WARNING"),
                                   sy.ADR("Error while writing!"),
                                   NIL,sy.ADR(" Ok ")));
            END; (* IF *)
      END; (* IF *)
   END SaveSetUp;

(******************************************************************************)

PROCEDURE LoadSetUp;

   VAR DataFile  : fs.File;
       error     : BOOLEAN;
       OldSetUp  : SetUp;

   PROCEDURE LoadSet;

      VAR counter: INTEGER;
          actual : LONGINT;

      BEGIN
         fs.Lookup(DataFile,FileString,1000,FALSE);
         error:=(DataFile.res # fs.done);
         IF error
            THEN
               error:=NOT(ar.Requester(sy.ADR("SysEx T&R:"),
                                sy.ADR("File not found!"),
                                NIL,sy.ADR(" Ok ")));
               RETURN;
         END; (* IF *)

         fs.ReadBytes(DataFile,sy.ADR(TestString),SetUpLen,actual);
         error:=CheckError(SetUpLen,actual) AND
                (st.Compare(TestString,SetUpKennung) # 0);
         IF error
            THEN
               error:=NOT(ar.Requester(sy.ADR("SysEx T&R:"),
                                sy.ADR("Non of my setup-files!"),
                                NIL,sy.ADR(" Ok ")));
               RETURN;
         END; (* IF *)

         fs.ReadBytes(DataFile,sy.ADR(ActualSetUp),SIZE(SetUp),
               actual);
         error:=CheckError(actual,SIZE(SetUp));
      END LoadSet;

   BEGIN
      OldSetUp:=ActualSetUp;
      IF (AskForFile("Load SetUp") AND MakeFileName())
         THEN
            LoadSet;
            fs.Close(DataFile);
            IF error
               THEN
                  error:=NOT(ar.Requester(sy.ADR("SysEx T&R: WARNING"),
                                   sy.ADR("Error while loading!"),
                                   NIL,sy.ADR(" Ok ")));
                  ActualSetUp:=OldSetUp;
               ELSE
                  gh.SetGadgetText(RequestStrGad,sy.ADR(ActualSetUp.ReqString));
            END; (* IF *)
      END; (* IF *)
      SetAllParams(OldSetUp.allChannels,OldSetUp.ReqOn);
   END LoadSetUp;

(******************************************************************************)

PROCEDURE ReceiveDataDump;

   VAR DataFile       : fs.File;
       error          : BOOLEAN;

   PROCEDURE ReceiveDumps;

      VAR offset, counter: INTEGER;
          dummyDump      : sy.ADDRESS;

      BEGIN
         IF ActualSetUp.ReqOn
            THEN
               IF (ConvertReqMessage())
                  THEN
                     ml.PutMidiStream(OutSource,NIL,
                                        sy.ADR(ReqMessage),
                                        MessageLength,
                                        MessageLength);
                  ELSE
                     error:=NOT(ar.Requester(sy.ADR("SysEx T&R: WARNING"),
                            sy.ADR("Trouble with the Dump-Request!"),
                            NIL,sy.ADR(" Ok ")));
                     RETURN;
               END; (* IF *)
         END; (* IF *)
         il.SetWindowTitles(Fenster,
               sy.ADR(" *  - - - Waiting for MIDI-Data-Dump - - -  * "),
               screenTitle);

(* Offset überspringen! *)
         FOR offset:=1 TO ActualSetUp.Offset DO
            dummyDump:=NIL;
            WHILE (dummyDump = NIL) AND NOT(abort) DO
               dummyDump:=ml.GetMidiPacket(InDest);
            END; (* WHILE *)
            IF (dummyDump # NIL)
               THEN
                  ml.FreeMidiPacket(dummyDump);
            END; (* IF *)
            IF abort
               THEN
                  error:=NOT(ar.Requester(sy.ADR("SysEx T&R"),
                                            sy.ADR("Aborted receiving"),
                                            NIL,sy.ADR(" Ok ")));
                  CloseMidi;
                  abortPossible:=FALSE;
                  RETURN;
            END; (* IF *)
         END; (* FOR *)

(* Ab jetzt eigentliche Zählung! *)

         FOR counter:=1 TO ActualSetUp.Number DO
            dummyDump:=NIL;
            WHILE (dummyDump = NIL) AND NOT(abort) DO
               dummyDump:=ml.GetMidiPacket(InDest);
            END; (* WHILE *)
            IF (dummyDump # NIL)
               THEN
                  DataPacketsPtr[counter]  :=dummyDump;
                  DataBlock.Laenge[counter]:=DataPacketsPtr[counter]^.Length;
            END; (* IF *)
            IF abort
               THEN
                  error:=ar.Requester(sy.ADR("SysEx T&R"),
                                        sy.ADR("Aborted receiving"),
                                        NIL,sy.ADR(" Ok "));
                  abortPossible:=FALSE;
                  CloseMidi;
                  RETURN;
            END; (* IF *)
         END; (* FOR *)

         DataBlock.Anzahl:=ActualSetUp.Number;

         il.SetWindowTitles(Fenster,
               sy.ADR("          All Data received - SAVING          "),
               screenTitle);
      END ReceiveDumps;

   PROCEDURE SaveDataDump;

      VAR counter: INTEGER;
          actual : LONGINT;

      BEGIN
         error:=FALSE;
         fs.Lookup(DataFile,FileString,1000,TRUE);
         fs.WriteBytes(DataFile,sy.ADR(FileKennung),
                               SetUpLen,actual);
         error:=CheckError(SetUpLen,actual);
         IF error
            THEN
               RETURN;
         END; (* IF *)
         fs.WriteBytes(DataFile,sy.ADR(DataBlock),
                               SIZE(FirstBlock),actual);

         error:=CheckError(SIZE(FirstBlock),actual);
         IF error
            THEN
               RETURN;
         END; (* IF *)

         FOR counter:=1 TO ActualSetUp.Number DO
            IF (DataPacketsPtr[counter] # NIL) AND NOT(error)
               THEN
                  fs.WriteBytes(DataFile,
                        sy.ADR(DataPacketsPtr[counter]^.MidiMsg),
                        DataPacketsPtr[counter]^.Length,actual);
                        error:=CheckError(actual,
                                     LONGINT(DataPacketsPtr[counter]^.Length));
               ELSE
                  IF error
                     THEN
                        error:=NOT(ar.Requester(sy.ADR("SysEx T&R: WARNING"),
                                   sy.ADR("Trouble while writing file"),
                                   NIL,sy.ADR(" Ok ")));
                        RETURN;
                  END; (* IF *)
            END; (* IF *)
         END; (* FOR *)
      END SaveDataDump;

   BEGIN
      IF (AskForFile("Save received data to which file?") AND
            MakeFileName() AND NOT(FileExist()))
         THEN
            DiscardDataPackets;
            abort:=FALSE;
            error:=FALSE;
            abortPossible:=TRUE;
            OpenMidi;

            ReceiveDumps;

            IF NOT(error)
               THEN
                  SaveDataDump;
                  IF error
                     THEN
                        fs.Delete(DataFile);
                  END; (* IF *)
                  fs.Close(DataFile);
            END; (* IF *)
            DiscardDataPackets;
            fs.Close(DataFile);
            CloseMidi;
            il.SetWindowTitles(Fenster,sy.ADR(WindowTitel),
                  screenTitle);
      END; (* IF *)
   END ReceiveDataDump;

(******************************************************************************)

PROCEDURE TransmitDataDump;

   VAR error   : BOOLEAN;
       DataFile: fs.File;

   PROCEDURE LoadDataDump;

      VAR counter: INTEGER;
          actual : LONGINT;

      BEGIN
         fs.Lookup(DataFile,FileString,1000,FALSE);
         error:=(DataFile.res # fs.done);
         IF error
            THEN
               error:=NOT(ar.Requester(sy.ADR("SysEx T&R:"),
                                sy.ADR("File not found!"),
                                NIL,sy.ADR(" Ok ")));
               RETURN;
         END; (* IF *)

         fs.ReadBytes(DataFile,sy.ADR(TestString),SetUpLen,actual);
         error:=CheckError(SetUpLen,actual) AND
                (st.Compare(TestString,FileKennung) # 0);
         IF error
            THEN
               error:=NOT(ar.Requester(sy.ADR("SysEx T&R:"),
                                sy.ADR("Non of my data-files!"),
                                NIL,sy.ADR(" Ok ")));
               RETURN;
         END; (* IF *)

         fs.ReadBytes(DataFile,sy.ADR(DataBlock),SIZE(FirstBlock),
               actual);
         error:=CheckError(actual,SIZE(FirstBlock));
         IF error
            THEN
               RETURN;
         END; (* IF *)

         FOR counter:=1 TO DataBlock.Anzahl DO
            tm.Allocate(DataRawPtr[counter],DataBlock.Laenge[counter]);
            error:=(DataRawPtr[counter] = NIL);
            IF error
               THEN
                  RETURN;
            END; (* IF *)
            fs.ReadBytes(DataFile,sy.ADR(DataRawPtr[counter]),
                  DataBlock.Laenge[counter],actual);
            error:=CheckError(actual,LONGINT(DataBlock.Laenge[counter]));
            IF error
               THEN
                  RETURN;
            END; (* IF *)
         END; (* FOR *)
      END LoadDataDump;

   PROCEDURE TransmitDumps;

      VAR counter: INTEGER;

      BEGIN
         FOR counter:=1 TO DataBlock.Anzahl DO
            ml.PutMidiStream(OutSource,NIL,DataRawPtr[counter],
                  DataBlock.Laenge[counter],DataBlock.Laenge[counter]);
         END; (* FOR *)
      END TransmitDumps;

   BEGIN
      IF (AskForFile("Transfer which file?") AND
         MakeFileName())
         THEN
            error:=FALSE;
            DiscardDataPackets;
            il.SetWindowTitles(Fenster,
                  sy.ADR("          Loading the Midi-Dump-Data          "),
                  screenTitle);
            LoadDataDump;
            fs.Close(DataFile);
            IF NOT(error)
               THEN
                  OpenMidi;
                  TransmitDumps;
                  il.SetWindowTitles(Fenster,
                        sy.ADR("       Transmitting the Midi-Dump-Data        "),
                        screenTitle);
                  CloseMidi;
               ELSE
                  error:=NOT(ar.Requester(sy.ADR("SysEx T&R: WARNING"),
                                   sy.ADR("Error while loading!"),
                                   NIL,sy.ADR(" Ok ")));
            END; (* IF *)
            DiscardDataPackets;
            il.SetWindowTitles(Fenster,sy.ADR(WindowTitel),
                  screenTitle);
      END; (* IF *)
   END TransmitDataDump;


(******************************************************************************)
(***************************** The IDCMPHandlers ******************************)
(******************************************************************************)

VAR HandlerClose  : ip.IDCMPHandler;
    HandlerGadDown: ip.IDCMPHandler;
    HandlerGadUp  : ip.IDCMPHandler;
    HandlerProp   : ip.IDCMPHandler;
    HandlerAbort  : ip.IDCMPHandler;
    Port    : ed.MsgPortPtr;
    Schedule: ip.IDCMPSchedule;


PROCEDURE HandleProps;

   VAR x,y: LONGCARD;

   BEGIN
      CASE ProNum OF
         | PropNummern: gh.GetPropPos(ChannelPropGad,x,y);
                        ActualSetUp.MidiChannel:=md.Ch01;
                        INC(ActualSetUp.MidiChannel,x);
         | PropNummern + 1: gh.GetPropPos(OffsetPropGad,x,y);
                            ActualSetUp.Offset:=x;
         | PropNummern + 2: gh.GetPropPos(NumberPropGad,x,y);
                            ActualSetUp.Number:=x+1;
         ELSE
            RETURN;
      END; (* CASE *)
      WriteActualValues;
   END HandleProps;

(******************************************************************************)

PROCEDURE PropHandler(Flags  : id.IDCMPFlagSet;
                      DataPtr: ip.IDCMPHandlerDataPtr): BOOLEAN;

   BEGIN
      HandleProps;
      RETURN (TRUE);
   END PropHandler;

(******************************************************************************)

PROCEDURE AbortHandler(Flags  : id.IDCMPFlagSet;
                       DataPtr: ip.IDCMPHandlerDataPtr): BOOLEAN;

   VAR Adresse: id.GadgetPtr;

   BEGIN
      IF (abortPossible)
         THEN
            Adresse:=DataPtr^.msgPtrPtr^^.iAddress;
            IF (Adresse^.gadgetID = AbortNum)
               THEN
                  abort:=TRUE;
                  abortPossible:=FALSE;
            END; (* IF *)
            RETURN (FALSE);
      END; (* IF *)
      RETURN (TRUE);
   END AbortHandler;

(******************************************************************************)

PROCEDURE GadUpHandler(Flags  : id.IDCMPFlagSet;
                       DataPtr: ip.IDCMPHandlerDataPtr): BOOLEAN;

  VAR dummy: BOOLEAN;

  BEGIN
    il.ReportMouse(Fenster,FALSE);
    ProNum:=0;
    IF NOT(CheckDumpRequest())
       THEN
          dummy:=il.ActivateGadget(sy.ADR(RequestStrGad.stringgadget),
                Fenster,NIL);
    END; (* IF *)
    RETURN (TRUE);
  END GadUpHandler;

(******************************************************************************)

PROCEDURE GadDownHandler(Flags  : id.IDCMPFlagSet;
                         DataPtr: ip.IDCMPHandlerDataPtr): BOOLEAN;

   VAR Adresse: id.GadgetPtr;

   BEGIN
      Adresse:=DataPtr^.msgPtrPtr^^.iAddress;
      CASE Adresse^.gadgetID OF
         |PropNummern..(PropNummern + 2): il.ReportMouse(Fenster,TRUE);
                                          ProNum:=Adresse^.gadgetID;
                                          HandleProps;
         |ChanOnOffNum: ActualSetUp.allChannels:=NOT(ActualSetUp.allChannels);
                        Box(Fenster^.rPort,380,20,415,29,3);
         |ReqOnOffNum : ActualSetUp.ReqOn:=NOT(ActualSetUp.ReqOn);
                        Box(Fenster^.rPort,380,120,415,129,3);
         |ReceiveNum  : ReceiveDataDump;
         |TransmitNum : TransmitDataDump;
         |LoadSetUpNum: LoadSetUp;
         |SaveSetUpNum: SaveSetUp;
         ELSE
      END; (* CASE *)
      RETURN (TRUE);
   END GadDownHandler;

(******************************************************************************)

PROCEDURE CloseHandler(Flags  : id.IDCMPFlagSet;
                       DataPtr: ip.IDCMPHandlerDataPtr): BOOLEAN;
  BEGIN
    ar.Terminate;
    RETURN (TRUE);
  END CloseHandler;


(******************************************************************************)
(************************** The Termination-Procedures ************************)
(******************************************************************************)

PROCEDURE CloseAll;

   BEGIN
      CloseMidi;

      IF (Fenster # NIL)
         THEN
            gh.FreeBooleanGadget(Fenster,LoadSetUpGad);
            gh.FreeBooleanGadget(Fenster,SaveSetUpGad);
            gh.FreeBooleanGadget(Fenster,ReqOnOffGad);
            gh.FreeStringGadget(Fenster,RequestStrGad);
            gh.FreePropGadget(Fenster,NumberPropGad);
            gh.FreePropGadget(Fenster,OffsetPropGad);
            gh.FreePropGadget(Fenster,ChannelPropGad);
            gh.FreeBooleanGadget(Fenster,ChanOnOffGad);
            gh.FreeBooleanGadget(Fenster,TransmitGadget);
            gh.FreeBooleanGadget(Fenster,ReceiveGadget);
            gh.FreeBooleanGadget(Fenster,AbortGad);

            ip.RemoveIDCMPHandler(Schedule,HandlerClose);
            ip.RemoveIDCMPHandler(Schedule,HandlerAbort);
            ip.RemoveIDCMPHandler(Schedule,HandlerProp);
            ip.RemoveIDCMPHandler(Schedule,HandlerGadUp);
            ip.RemoveIDCMPHandler(Schedule,HandlerGadDown);
            ip.DiscardScheduler(Schedule,Port);

            il.CloseWindow(Fenster);
      END; (* IF *)
   END CloseAll;

(******************************************************************************)

BEGIN
  OpenAll;
  IF (ip.InitScheduler(Fenster,Port,Schedule) AND
     ip.InstallIDCMPHandler(Schedule,CloseHandler,
           id.IDCMPFlagSet{id.closeWindow},0,
           ip.HandlerFlagSet{ip.immediate},NIL,HandlerClose) AND
     ip.InstallIDCMPHandler(Schedule,AbortHandler,
           id.IDCMPFlagSet{id.gadgetUp},0,
           ip.HandlerFlagSet{ip.immediate},NIL,HandlerAbort) AND
     ip.InstallIDCMPHandler(Schedule,PropHandler,
           id.IDCMPFlagSet{id.mouseMove},0,
           ip.HandlerFlagSet{},NIL,HandlerProp) AND
     ip.InstallIDCMPHandler(Schedule,GadUpHandler,
           id.IDCMPFlagSet{id.gadgetUp},0,
           ip.HandlerFlagSet{},NIL,HandlerGadUp) AND
     ip.InstallIDCMPHandler(Schedule,GadDownHandler,
           id.IDCMPFlagSet{id.gadgetDown},0,
           ip.HandlerFlagSet{},NIL,HandlerGadDown))
     THEN
        ip.ScheduleIDCMPHandlers;
  END; (* IF *)
CLOSE
   CloseAll;
END ReceiveSysEx.