(*---------------------------------------------------------------------------
   :Program.    RecordInput
   :Author.     Fridtjof Björn Siebert
   :Address.    Nobileweg 67, D-7-Stgt-40
   :Phone.      (0)711/822509
   :Shortcut.   [fbs]
   :Version.    1.0
   :Date.       05-Jun-88
   :Copyright.  ShareWare.
   :Language.   MODULA-II
   :Translator. M2Amiga
   :Contents.   A program to record all your Input (Mouse, Keyboard) and to
   :Contents.   recall them. They can be called by any Keystroke.
   :Remark.     How can you call SubTime, AddTime etc. (Timer-Device) ???
---------------------------------------------------------------------------*)
(* This File became a bit long, but I'm too lazy to share it into 2 Files  *)

MODULE RecordInput;

FROM SYSTEM      IMPORT ADR, ADDRESS, SETREG, REG, SHIFT, LONGSET, CAST,
                        INLINE;
FROM Arts        IMPORT Assert,TermProcedure;
FROM Arguments   IMPORT NumArgs, GetArg;

FROM Dos         IMPORT Open, Close, FileHandlePtr, oldFile, newFile, Write,
                        Read;
FROM Exec        IMPORT MsgPortPtr, IOStdReq, Interrupt, MemEntry, Forbid,
                        Permit, IOStdReqPtr, OpenDevice, CloseDevice, DoIO,
                        Disable, Enable, OpenLibrary, CloseLibrary,
                        IORequest, DevicePtr, IOFlagSet, AllocMem, MemReqs,
                        MemReqSet, FreeMem, WaitPort, GetMsg, ReplyMsg,
                        MessagePtr, Wait, FindTask, AllocSignal, FreeSignal,
                        Signal, TaskPtr;
FROM ExecSupport IMPORT CreatePort, DeletePort, CreateStdIO, DeleteStdIO,
                        CreateExtIO, DeleteExtIO;
FROM Graphics    IMPORT RastPortPtr, SetAPen, SetDrMd, Text, Move, jam1,
                        jam2, SetBPen;
FROM Input       IMPORT inputName, addHandler, remHandler, writeEvent;
FROM InputEvent  IMPORT InputEvent, InputEventPtr, Class, lButton, mButton,
                        rButton, Qualifiers, QualifierSet;
FROM Intuition   IMPORT IntuitionBase, WindowPtr, IDCMPFlags, IDCMPFlagSet,
                        CloseWindow, IntuiMessage, IntuiMessagePtr,
                        GadgetPtr, PropInfoPtr, StringInfoPtr;
FROM Timer       IMPORT TimeVal, TimeValPtr, timerName, microHz,
                        TimeRequestPtr, TimeRequest, addRequest, getSysTime;

FROM Conversions IMPORT ValToStr;
FROM Strings     IMPORT Insert ,Delete, Length, Copy, Compare, last, first;

FROM RIDisplay   IMPORT OpenRIWindow, SetGadgets, RIGadgetID, RIRecordInfo,
                        RIRecordInfoPtr, KeyQualis, KeyQualiSet, RawToStr;

(*-------------------------  Variablen:  ----------------------------------*)

CONST
  MaxInputs = 999;
  MOVEMS = 48E7H; (* that's the 68000-Instruction MOVEM to save Registers*)
  MOVEML = 4CDFH; (* that's MOVEM to load Registers                      *)
  LongCardMax = 4294967295;
  CouldntOpen = "               Couldn't open File !!!               ";
  WrongFormat = "          This File contains wrong Data !!!         ";
  OutOfMem    = "        Not enough Memory !!! Data deleted.         ";
  WriteErr    = "      - - >  Error while Writing ! ! !  < - -       ";
  Saving      = "                      saving ...                    ";
  Loading     = "                     loading ...                    ";

VAR
  InputDevPort, TimerPort: MsgPortPtr;       (* My MessagePorts *)
  InputRequestBlock: IOStdReqPtr;
  TimeRequestBlock: TimeRequestPtr;
  TimerDevice: DevicePtr;
  HandlerStuff: Interrupt;
  Done, OverFlow, WaitCR, ok, GetKey,
  MouseDecision, MouseDecLeft, WaitStop: BOOLEAN;
  Intuitionbase: POINTER TO IntuitionBase;
  LastTime, StartTime, EndTime, Time: TimeVal;
  Records: ARRAY RIGadgetID OF RIRecordInfo;
  IDCount, MyID, RecCount, LastReceived: RIGadgetID;
  Window: WindowPtr;
  MyMessagePtr: IntuiMessagePtr;
  MyMessage: IntuiMessage;
  ActRecord, SaveActRecord: RIGadgetID;
  Gadget: GadgetPtr;
  RP: RastPortPtr;
  RecordEvent: InputEventPtr;
  Count: CARDINAL;
  Stop, GotKey: CARDINAL;
  StopQual, GotQual: KeyQualiSet;
  PropInfo: PropInfoPtr;
  StringInfo: StringInfoPtr;
  OutStr,GotStr: ARRAY[0..52] OF CHAR;
  KeyStr: ARRAY[0..19] OF CHAR;
  Long: LONGINT;
  MyHandle: FileHandlePtr;
  IOMemStr: POINTER TO ARRAY[0..19] OF CHAR;
  IOMemInEvent: POINTER TO InputEvent;
  IOMemRecord: POINTER TO RIRecordInfo;
  WindowSignalSet, MySignalSet, GetSig: LONGSET;
  MySignal: LONGINT;
  MyTask: TaskPtr;
  Argument: ARRAY[0..79] OF CHAR;
  ArgCnt: INTEGER;

(*---------------------  Check Qualifier:  --------------------------------*)

PROCEDURE CheckQuali(Quali: QualifierSet; Qual: KeyQualiSet): BOOLEAN;
(* this checks the specified Keys in Qual (SHIFT,ALT,CTRL,AMIGA) whether   *)
(* they are in Quali (left or right is unimportent) or not.                *)

BEGIN
 RETURN ((Shift IN Qual) = ((lShift   IN Quali) OR (rShift   IN Quali)))
    AND ((Alt   IN Qual) = ((lAlt     IN Quali) OR (rAlt     IN Quali)))
    AND ((Amiga IN Qual) = ((lCommand IN Quali) OR (rCommand IN Quali)))
    AND ((Ctrl  IN Qual) =  (control  IN Quali));
END CheckQuali;

(*---------------------  Timer-Prozedure:  --------------------------------*)
(* Diese beiden Prozeduren entsprechen denen des Timer-Device, die ich     *)
(* nicht zum laufen gebracht habe. Ich habe ihnen den Zeiger zum Timer-    *)
(* Device und zum TimeRequesBlock übergeben. Beides führte zum Abturz !!!  *)

PROCEDURE AddTime(a,b: TimeValPtr);
(* a := a + b *)

BEGIN
  WITH a^ DO
    INC(secs,b^.secs);
    INC(micro,b^.micro);
    IF micro>=1000000 THEN
      DEC(micro,1000000);
      INC(secs,1);
    END;
  END;
END AddTime;

PROCEDURE SubTime(a,b: TimeValPtr);
(* a := a - b *)

BEGIN
  WITH a^ DO
    IF secs>=b^.secs THEN
      DEC(secs,b^.secs);
      IF micro<b^.micro THEN
        INC(micro,1000000);
        IF secs>0 THEN
          DEC(secs,1);
        ELSE
          secs := LongCardMax;
        END;
      END;
      DEC(micro,b^.micro);
    ELSE
      secs := LongCardMax;
    END;
  END;
END SubTime;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*                Input  Handler for recording InputEvents:                *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

VAR
  Ev, TraceEv: InputEventPtr;

PROCEDURE RecordHandler();
(* That's my Input-Handler it receives 2 values, though in MODULA-2 it     *)
(* looks like a Procedure receiving and returning nothing. Anyway, there's *)
(* a Pointer returned:                                                     *)
(* A0: Pointer to EventChain the Handler should handle with.               *)
(* A1: This points to my MemEntries, i.e. contains HandlerStuff.date       *)
(* D0: Will contain the new Pointer to Eventlist or NIL if none.           *)

(* $S- This avoids checking Stack size. This Procedure gets another Stack  *)
(* than the main Programm !!                                               *)

BEGIN
  Ev := ADDRESS(REG(8)); (* this gets InputEventList from A0 *)
    (* A1 is ignored here 'cause there no memory needed *)
  TraceEv := Ev;
  WHILE TraceEv#NIL DO
    WITH TraceEv^ DO
      WITH Records[ActRecord] DO
        IF NOT(Done) THEN
          IF (class=rawkey) AND (code=Stop) AND
             CheckQuali(qualifier,StopQual) THEN
            Done := TRUE;
            Signal(MyTask,MySignalSet);
          ELSIF class#timer THEN
            RecordEvent^ := TraceEv^;
            SubTime(ADR(RecordEvent^.timeStamp),ADR(StartTime));
            INC(Size);
            INC(RecordEvent,SIZE(InputEvent));
            IF Size=Max THEN
              Done := TRUE;
              Signal(MyTask,MySignalSet);
              OverFlow := TRUE;
            END;
          END;
        END;   (* IF NOT(Done) *)
      END;   (* WITH Records[ActRecors] DO *)
    END;   (* WITH TraceEv^ DO *)
    TraceEv := TraceEv^.nextEvent;
  END;   (* WHILE TraceEv#NIL *)
  SETREG(0,Ev);
END RecordHandler;
(* that's it. I hope it to work !!! *)

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*                Input  Handler for Receiving Keystrokes:                 *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

PROCEDURE ReceiveHandler();
(* this looks for KeyStrokes and reports them to main per Variables *)

BEGIN
  Ev := ADDRESS(REG(8)); (* this gets InputEventList from A0 *)
    (* A1 is ignored here 'cause there no memory needed *)
  TraceEv := Ev;
  WHILE TraceEv#NIL DO
    WITH TraceEv^ DO
      IF (class=rawkey) THEN
        IF WaitCR THEN
          WaitCR := NOT((class=rawkey) AND (code=0C4H));
          Signal(MyTask,MySignalSet);
        END;
        IF (code<60H) THEN
          IF GetKey THEN
            GotKey := code;
            GotQual := KeyQualiSet{};
            IF (QualifierSet{lShift,rShift}*qualifier) # QualifierSet{} THEN
              INCL(GotQual,Shift);
            END;
            IF (QualifierSet{lAlt,rAlt}*qualifier) # QualifierSet{} THEN
              INCL(GotQual,Alt);
            END;
            IF (QualifierSet{lCommand,rCommand}*qualifier) # QualifierSet{} THEN
              INCL(GotQual,Amiga);
            END;
            IF control IN qualifier THEN
              INCL(GotQual,Ctrl);
            END;
            GetKey := FALSE;
            Signal(MyTask,MySignalSet);
          END;
          IF WaitStop THEN
            WaitStop := NOT((code=(Stop)) AND
                        CheckQuali(qualifier,StopQual));
            IF NOT(WaitStop) THEN Signal(MyTask,MySignalSet) END;
          END;
          FOR RecCount := a TO z DO
            WITH Records[RecCount] DO
              IF (Size#0) AND (code=Key) THEN
                IF CheckQuali(qualifier,KeyQual) THEN
                  LastReceived := RecCount;
                  Signal(MyTask,MySignalSet);
                END;
              END;
            END;
          END;   (* FOR RecCount ... *)
        ELSIF WaitCR AND (code=0C4H) THEN
          WaitCR := FALSE;
          Signal(MyTask,MySignalSet);
        END;
      ELSIF MouseDecision THEN
        IF (class=rawmouse) AND ((code=68H) OR (code=69H)) THEN
          MouseDecision := FALSE;
          MouseDecLeft := code=68H;
          Signal(MyTask,MySignalSet);
        END;
      END;   (* IF class=rawkey ... *)
    END;   (* WITH TraceEv^ DO *)
    TraceEv := TraceEv^.nextEvent;
  END;   (* WHILE TraceEv#NIL *)
  SETREG(0,Ev);
END ReceiveHandler;

(* $S+ *)

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*                         Small Procedures:                               *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

(*--------------------  Write into Output-Line:  --------------------------*)

PROCEDURE PutText(String: ADDRESS);

BEGIN
  SetAPen(RP,1); SetBPen(RP,0); SetDrMd(RP,jam2);
  Move(RP,8,67);
  Text(RP,String,52);
END PutText;

PROCEDURE TypeDone();
(* this writes Done. to the Window *)

BEGIN
  PutText(ADR("                       Done.                        "));
END TypeDone;

PROCEDURE TypeOK();
(* this writes OK. to the Window *)

BEGIN
  PutText(ADR("                        OK.                         "));
END TypeOK;

(*-------------------  Get String from Keyboard:  -------------------------*)

PROCEDURE GetString();

BEGIN
  LOOP
    Copy(OutStr," Enter Name: ",first,13);
    Insert(OutStr,last,GotStr);
    Insert(OutStr,last,"                                       ");
    PutText(ADR(OutStr));
    GetKey := TRUE;
    WHILE GetKey DO
      GetSig := Wait(MySignalSet)
    END;
    IF GotKey=44H THEN EXIT;
    ELSIF GotKey<40H THEN
      RawToStr(GotKey,GotQual,KeyStr);
      Insert(OutStr,last,KeyStr);
      Insert(GotStr,last,KeyStr);
    ELSIF GotKey=41H THEN
      Delete(OutStr,Length(OutStr)-1,1);
      Delete(GotStr,Length(GotStr)-1,1);
    END;
  END;
END GetString;

(*--------------------  Initialize Input.device:  -------------------------*)
(* This opens the Input-Device                                             *)

PROCEDURE OpenInput();

BEGIN
  InputDevPort := CreatePort(NIL,0);
  Assert(InputDevPort#NIL,ADR("CreatePort failed"));
  InputRequestBlock := CreateStdIO(InputDevPort);
  Assert(InputRequestBlock#NIL,ADR("CreateStdIO failed"));
  WITH HandlerStuff DO
    data := NIL;             (* pointer to it's data (I don't have any)  *)
    node.pri := 60;
  (* 60 to be higher than another Prg, that wants to affekt Intuition *)
  END;
  OpenDevice(ADR(inputName),0,InputRequestBlock,LONGSET{});
END OpenInput;

(*---------------------  Close Input-Device:  -----------------------------*)
(* This terminates the Input.Device                                        *)

PROCEDURE CloseInput();

BEGIN
  CloseDevice(InputRequestBlock);
  DeleteStdIO(InputRequestBlock);
  DeletePort(InputDevPort);
END CloseInput;

(*---------------------------  AddHandler:  -------------------------------*)
(* This adds the specified Handler to Input.Device                         *)

PROCEDURE AddHandler(Handler: PROC);

BEGIN
  HandlerStuff.code := Handler;
  WITH InputRequestBlock^ DO
    command := addHandler;
    data := ADR(HandlerStuff);
  END;
  DoIO(InputRequestBlock);
END AddHandler;

(*---------------------------  RemHandler:  -------------------------------*)
(* This removes the Handler                                                *)

PROCEDURE RemHandler();

BEGIN
  WITH InputRequestBlock^ DO
    command := remHandler;
    data := ADR(HandlerStuff);
  END;
  DoIO(InputRequestBlock);
END RemHandler;

(*------------------------  Write InputEvent:  ----------------------------*)

PROCEDURE WriteEvent(Event: InputEventPtr);

BEGIN
  WITH InputRequestBlock^ DO
    command := writeEvent;
    flags := IOFlagSet{};
    length := SIZE(InputEvent);
    data := Event;
  END;
  DoIO(InputRequestBlock);
END WriteEvent;

(*------------------------  Mul & Div Time:  ------------------------------*)

PROCEDURE MulDivTime(a: TimeValPtr; m,d: LONGCARD);
(* a := a * m DIV d *)

VAR
  sec,mic: LONGCARD;

BEGIN
  IF m>1000 THEN
    m := SHIFT(m,-4); (* Well, it isn't very exact *)
    d := SHIFT(d,-4);
  END;
  WITH a^ DO
    sec := secs * m;
    mic := micro * m;
    secs := sec DIV d;
    micro := (mic + (sec MOD d * 1000000)) DIV d;
    INC(secs,micro DIV 1000000);
    micro := micro MOD 1000000;
  END;
END MulDivTime;

(*---------------------------  Open Timer:  -------------------------------*)
(* This opens the Timer.Device                                             *)

PROCEDURE OpenTimer();

BEGIN
  TimerPort := CreatePort(NIL,0);
  Assert(TimerPort#NIL,ADR("Can't create TimerPort"));
  TimeRequestBlock := CreateExtIO(TimerPort,SIZE(TimeRequest));
  Assert(TimeRequestBlock#NIL,ADR("Can't create ExtIO"));
  OpenDevice(ADR(timerName),microHz,TimeRequestBlock,LONGSET{});
  TimerDevice := TimeRequestBlock^.node.device;
END OpenTimer;

(*--------------------------  Close Timer:  -------------------------------*)

PROCEDURE CloseTimer();

BEGIN
  CloseDevice(TimeRequestBlock);
  DeleteExtIO(TimeRequestBlock);
  DeletePort(TimerPort);
END CloseTimer;

(*-------------------------  WaitForTimer:  -------------------------------*)

PROCEDURE WaitForTimer(HowLong: TimeValPtr);

BEGIN
  WITH TimeRequestBlock^ DO
    node.command := addRequest;
    time := HowLong^;
  END;
  DoIO(TimeRequestBlock);
END WaitForTimer;

(*------------------------  Get System-Time:  -----------------------------*)

PROCEDURE GetSysTime(Time: TimeValPtr);

BEGIN
  TimeRequestBlock^.node.command := getSysTime;
  DoIO(TimeRequestBlock);
  Time^ := TimeRequestBlock^.time;
END GetSysTime;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*                          Main Procedures:                               *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

(*-------------------------  Record Input:  -------------------------------*)

PROCEDURE StartRecord();

BEGIN
  IF Records[ActRecord].Max=0 THEN
    OverFlow := TRUE;
  ELSE
    PutText(ADR("          Press RETURN to start Recording !         "));
    WITH Records[ActRecord] DO
      Size := 0;
      RecordEvent := Memo;
      WaitCR := TRUE;
      WHILE WaitCR DO
        GetSig := Wait(MySignalSet)
      END;
      MouseX := Intuitionbase^.mouseX;
      MouseY := Intuitionbase^.mouseY;
      GetSysTime(ADR(StartTime));
    END;
    RemHandler();
    Done := FALSE; OverFlow := FALSE;
    AddHandler(RecordHandler);
    PutText(ADR("  Recording. Press StopKey to terminate Recording   "));
    WHILE NOT(Done) DO
      GetSig := Wait(MySignalSet)
    END;
    RemHandler();
    AddHandler(ReceiveHandler);
  END;
  IF NOT(OverFlow) THEN
    TypeDone();
  ELSE
    PutText(ADR("      Overflow !!! Try a higher Max-Value !!!       "));
    Records[ActRecord].Size := 0;
  END;
END StartRecord;

(*-------------------------  Play Input:  ---------------------------------*)

PROCEDURE StartPlay(cr: BOOLEAN);

BEGIN
  IF cr THEN
    PutText(ADR("          Press RETURN to start Playing !           "));
    WaitCR := TRUE;
    WHILE WaitCR DO
      GetSig := Wait(MySignalSet)
    END;
  END;
  Count := 0; Done := FALSE; WaitCR := TRUE;
  WITH Records[ActRecord] DO
    WITH Intuitionbase^ DO
      Disable();
      mouseX := MouseX;
      mouseY := MouseY;
      Enable();
    END;
    RecordEvent := Memo;
    LastTime.secs := 0; LastTime.micro := 0;
    GetSysTime(ADR(StartTime));
    WHILE Count<Size DO
      WITH RecordEvent^ DO
        Time := timeStamp;
        SubTime(ADR(Time),ADR(LastTime));
        IF Time.secs#LongCardMax THEN
          IF Speed>=8000H THEN
            MulDivTime(ADR(Time),2000H,Speed-6000H);
          ELSE
            MulDivTime(ADR(Time),9000H,Speed+1000H);
          END;
          GetSysTime(ADR(EndTime));
          SubTime(ADR(EndTime),ADR(StartTime));
          SubTime(ADR(Time),ADR(EndTime));
          IF Time.secs#LongCardMax THEN
            WaitForTimer(ADR(Time));
          END;
        END;
        GetSysTime(ADR(StartTime));
        LastTime := timeStamp;
        timeStamp := StartTime;
        nextEvent := NIL;
        WriteEvent(RecordEvent);
        timeStamp := LastTime;
      END;
      INC(Count);
      INC(RecordEvent,SIZE(InputEvent));
    END;
  END;
  IF cr THEN
    TypeDone();
  END;
END StartPlay;

(*---------------------------  Save List:  --------------------------------*)

PROCEDURE SaveList(Num: RIGadgetID): BOOLEAN;
(* this saves Records[Num] to MyHandle and Returns False if error occured  *)

BEGIN
  IOMemRecord^ := Records[Num];
  Long := Write(MyHandle,IOMemRecord,SIZE(RIRecordInfo));
  WITH Records[Num] DO
    RecordEvent := Memo;
    Count := 0;
    WHILE Count<Size DO
      IOMemInEvent^ := RecordEvent^;
      Long := Write(MyHandle,IOMemInEvent,SIZE(InputEvent));
      INC(RecordEvent,SIZE(InputEvent));
      INC(Count);
    END;
  END;
  RETURN Long#0;
END SaveList;

(*---------------------------  Load List:  --------------------------------*)

PROCEDURE LoadList(Num: RIGadgetID): BOOLEAN;

BEGIN
  WITH Records[Num] DO
    IF Max#0 THEN
      FreeMem(Memo,LONGCARD(Max)*SIZE(InputEvent));
    END;
    Long := Read(MyHandle,IOMemRecord,SIZE(RIRecordInfo));
    Records[Num] := IOMemRecord^;
    IF Max#0 THEN
      Memo := AllocMem(LONGCARD(Max)*SIZE(InputEvent),MemReqSet{public,memClear});
      IF Memo=NIL THEN
        Max := 0;
        Size := 0;
        RETURN FALSE;
      ELSE
        RecordEvent := Memo;
        Count := 0;
        WHILE Count<Size DO
          Long := Read(MyHandle,IOMemInEvent,SIZE(InputEvent));
          RecordEvent^ := IOMemInEvent^;
          INC(RecordEvent,SIZE(InputEvent));
          INC(Count);
        END;
      END;
    END;
  END;
  RETURN TRUE;
END LoadList;

(*-------------------------  TermProcedure:  ------------------------------*)

PROCEDURE CleanUp();

BEGIN
  RemHandler();
  FreeSignal(MySignal);
  IF Window#NIL THEN
    CloseWindow(Window);
  END;
  FreeMem(IOMemStr,SIZE(InputEvent));
  FOR IDCount := a TO z DO
    WITH Records[IDCount] DO
      IF Max#0 THEN
        FreeMem(Memo,LONGCARD(Max)*SIZE(InputEvent));
      END;
    END;
  END;
  CloseLibrary(ADDRESS(Intuitionbase));
  CloseInput();
  CloseTimer();
END CleanUp;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*           Main Programm (initialization, Printing and CleanUp)          *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

BEGIN
(*------  Initial values:  ------*)
  Stop := 5FH; StopQual := KeyQualiSet{}; GetKey := FALSE; WaitCR := FALSE;
  MouseDecision := FALSE; LastReceived := none;
  ActRecord := a;
(*------  Open everything we need:  ------*)
  Intuitionbase := ADDRESS(OpenLibrary(ADR("intuition.library"),0));
  Assert(Intuitionbase#NIL,ADR("Can't open Intuition"));
  OpenInput();
  OpenTimer();
(*------  Initialize Recordings:  ------*)
  FOR IDCount := a TO z DO
    WITH Records[IDCount] DO
      Size := 0;
      IF IDCount<e THEN
        Max := 1000;
        Memo := AllocMem(LONGCARD(Max)*SIZE(InputEvent),
                         MemReqSet{public,memClear});
        Assert(Memo#NIL,ADR("Not enough Memory !"));
      ELSE
        Max := 0;
      END;
      Speed := 8000H;
      Key := 50H+ORD(IDCount);
      KeyQual := KeyQualiSet{};
      IF (Key>=5AH) THEN
        DEC(Key,10);
        KeyQual := KeyQualiSet{Shift};
      END;
      IF (Key>=5AH) THEN
        DEC(Key,10);
        KeyQual := KeyQualiSet{Alt};
      END;
    END;   (* WITH *)
  END;   (* FOR *)
(*------  Get some Memo for Load/Save:  ------*)
  IOMemStr := AllocMem(SIZE(InputEvent),MemReqSet{chip,memClear});
  Assert(IOMemStr#NIL,ADR("Not enough Chip-Memory !"));
  IOMemInEvent := ADDRESS(IOMemStr);
  IOMemRecord := ADDRESS(IOMemStr);
(*------  Link the Handler into InputStream:  ------*)
  AddHandler(ReceiveHandler);
(*------  Get some SignalBit:  ------*)
  MyTask := FindTask(NIL);
  MySignal := AllocSignal(-1);
  Assert(MySignal#-1,ADR("No more Signalbits ..."));
  MySignalSet := LONGSET{MySignal};
  TermProcedure(CleanUp);
(*------  Do they want us to load KeyMappings ?  ------*)
  IF NumArgs()#0 THEN
    GetArg(1,Argument,ArgCnt);
    MyHandle := Open(ADR(Argument),oldFile);
    Assert(MyHandle#NIL,ADR("Couldn't openFile !!!"));
    Long := Read(MyHandle,IOMemStr,20);
    Assert(Compare(IOMemStr^,first,20,"RIDatenFile KeyMap: ",TRUE)=0,
      ADR("Wrong File Format !!!"));
    IDCount := a;
    WHILE IDCount<=z DO
      IF LoadList(IDCount) THEN
        INC(IDCount);
      ELSE
        IDCount := none;
      END;
    END;
    Close(MyHandle);
    WaitStop := TRUE;
(*------  Wait for them to press StopKey:  ------*)
    WHILE WaitStop DO
      GetSig := Wait(MySignalSet);
      IF LastReceived#none THEN
        SaveActRecord := ActRecord;
        ActRecord := LastReceived;
        LastReceived := none;
        StartPlay(FALSE);
        ActRecord := SaveActRecord;
      END;
    END;
  END;
(*------  Now Open Window and start main:  ------*)
  Window := OpenRIWindow();
  Assert(Window#NIL,ADR("Couldn't open Window"));
  RP := Window^.rPort;
  PutText(ADR(" © 1988 by F. Siebert [Amok]. This is Shareware !!! "));
  SetGadgets(ActRecord,ADR(Records[ActRecord]),Stop,StopQual);
  WindowSignalSet := LONGSET{Window^.userPort^.sigBit};
(*------  Main Loop:  ------*)
  LOOP
    GetSig := Wait(WindowSignalSet + MySignalSet);
    MyMessagePtr := ADDRESS(GetMsg(Window^.userPort));
    IF LastReceived#none THEN
      SaveActRecord := ActRecord;
      ActRecord := LastReceived;
      LastReceived := none;
      StartPlay(FALSE);
      ActRecord := SaveActRecord;
    END;
    IF MyMessagePtr#NIL THEN
     MyMessage := MyMessagePtr^;
     ReplyMsg(MessagePtr(MyMessagePtr));
     WITH MyMessage DO
      IF    class=IDCMPFlagSet{closeWindow} THEN
        PutText(ADR("<-- Hide < < < - Press MouseButton - > > > Quit  -->"));
        MouseDecision := TRUE;
        WHILE MouseDecision DO
          GetSig := Wait(MySignalSet)
        END;
        IF MouseDecLeft THEN
          CloseWindow(Window);
          Window := NIL;
          WaitStop := TRUE;
          WHILE WaitStop DO
            GetSig := Wait(MySignalSet);
            IF LastReceived#none THEN
              SaveActRecord := ActRecord;
              ActRecord := LastReceived;
              LastReceived := none;
              StartPlay(FALSE);
              ActRecord := SaveActRecord;
            END;
          END;
          Window := OpenRIWindow();
          RP := Window^.rPort;
          PutText(ADR("     Here I am again ! Make your selection !!!      "));
        ELSE EXIT END;
      ELSIF (gadgetDown IN class) OR (gadgetUp IN class) THEN
       Gadget := MyMessage.iAddress;
       MyID := RIGadgetID(Gadget^.gadgetID);
       CASE MyID OF
        a..z:  ActRecord := MyID;
               PutText(ADR("              New Recordlist selected.              ")); |
        Record:StartRecord(); |
        Play:  StartPlay(TRUE); |
        Speed: PropInfo := Gadget^.specialInfo;
               WITH Records[ActRecord] DO
                Speed := PropInfo^.horizPot;
                IF Speed>=8000H THEN
                 Long := LONGINT(Speed-6000H)*100;
                 ValToStr(SHIFT(Long,-13),FALSE,OutStr,10,3," ",ok);
                ELSE
                 ValToStr(LONGINT(Speed+1000H) DIV 369,FALSE,
                          OutStr,10,3," ",ok);
                END;
                Insert(OutStr,first,"   New Speed is now ");
                Insert(OutStr,last ,"% of Speed while recording   ");
                PutText(ADR(OutStr));
               END; |
        Max:   StringInfo := Gadget^.specialInfo;
               IF (StringInfo^.longInt<0) OR (StringInfo^.longInt>65535) THEN
                PutText(ADR("        Max cannot be higher than 65535 !!!         "));
               ELSE
                WITH Records[ActRecord] DO
                 IF Max#0 THEN
                  FreeMem(Memo,LONGCARD(Max)*SIZE(InputEvent));
                 END;
                 Size := 0;
                 Max := StringInfo^.longInt;
                 IF Max#0 THEN
                  Memo := AllocMem(LONGCARD(Max)*SIZE(InputEvent),MemReqSet{public,memClear});
                 ELSE
                  Memo := 2;
                 END;
                 IF Memo=NIL THEN
                  Max := 0;
                  PutText(ADR(OutOfMem));
                 ELSE
                  PutText(ADR("    New Memory allocated. Old Recording deleted.    "));
                 END;
                END;
               END; |
        Size:  StringInfo := Gadget^.specialInfo;
               WITH Records[ActRecord] DO
                IF StringInfo^.longInt>LONGINT(Max) THEN
                 PutText(ADR("      You cannot make Size higher than Max !!!      "));
                ELSE
                 IF StringInfo^.longInt>LONGINT(Size) THEN
                  PutText(ADR("New Size. Attention: List may content illegal data !"));
                 ELSE
                  PutText(ADR("                     New Size.                      "));
                 END;
                 Size := StringInfo^.longInt;
                END;
               END; |
        Key:   PutText(ADR("       Hit the Key you want for this List !!!       "));
               GetKey := TRUE;
               WHILE GetKey DO
                 GetSig := Wait(MySignalSet)
               END;
               WITH Records[ActRecord] DO
                Key := GotKey;
                KeyQual := GotQual;
               END;
               LastReceived := none;
               TypeOK(); |
        StopKey:PutText(ADR("  Hit the Key you want as Termination/Reopen Key !  "));
               GetKey := TRUE;
               WHILE GetKey DO
                 GetSig := Wait(MySignalSet)
               END;
               WITH Records[ActRecord] DO
                Stop := GotKey;
                StopQual := GotQual;
               END;
               LastReceived := none;
               TypeOK(); |
        Save:  GetString();
               PutText(ADR(Saving));
               MyHandle := Open(ADR(GotStr),newFile);
               IF MyHandle=NIL THEN
                 PutText(ADR(CouldntOpen));
               ELSE
                 IOMemStr^ := "RIDatenFile one Key:";
                 Long := Write(MyHandle,IOMemStr,20);
                 IF SaveList(ActRecord) THEN
                   TypeOK();
                 ELSE
                   PutText(ADR(WriteErr));
                 END;
                 Close(MyHandle);
               END; |
         Load: GetString();
               PutText(ADR(Loading));
               MyHandle := Open(ADR(GotStr),oldFile);
               IF MyHandle=NIL THEN
                 PutText(ADR(CouldntOpen));
               ELSE
                 Long := Read(MyHandle,IOMemStr,20);
                 IF Compare(IOMemStr^,first,11,"RIDatenFile",TRUE)#0 THEN
                   PutText(ADR(WrongFormat));
                 ELSE
                   WITH Records[ActRecord] DO
                     GotKey := Key;
                     GotQual:= KeyQual;
                     IF LoadList(ActRecord) THEN
                       TypeOK();
                     ELSE
                       PutText(ADR(OutOfMem));
                     END;
                     Key := GotKey;
                     KeyQual := GotQual;
                   END;
                 END;
                 Close(MyHandle);
               END; |
        SaveAll:GetString();
               PutText(ADR(Saving));
               MyHandle := Open(ADR(GotStr),newFile);
               IF MyHandle=NIL THEN
                 PutText(ADR(CouldntOpen));
               ELSE
                 IOMemStr^ := "RIDatenFile KeyMap: ";
                 Long := Write(MyHandle,IOMemStr,20);
                 IDCount := a;
                 WHILE IDCount<=z DO
                   IF SaveList(IDCount) THEN
                     INC(IDCount);
                   ELSE
                     IDCount := none
                   END;
                 END;
                 IF IDCount#none THEN
                   TypeOK();
                 ELSE
                   PutText(ADR(WriteErr));
                 END;
                 Close(MyHandle);
               END; |
         LoadAll:GetString();
               PutText(ADR(Loading));
               MyHandle := Open(ADR(GotStr),oldFile);
               IF MyHandle=NIL THEN
                 PutText(ADR(CouldntOpen));
               ELSE
                 Long := Read(MyHandle,IOMemStr,20);
                 IF Compare(IOMemStr^,first,20,"RIDatenFile KeyMap: ",TRUE)#0 THEN
                   PutText(ADR(WrongFormat));
                 ELSE
                   IDCount := a;
                   WHILE IDCount<=z DO
                     IF LoadList(IDCount) THEN
                       INC(IDCount);
                     ELSE
                       IDCount := none;
                     END;
                   END;
                   IF IDCount#none THEN
                     TypeOK();
                   ELSE
                     PutText(ADR(OutOfMem));
                   END;
                 END;
                 Close(MyHandle);
               END;
       ELSE
       END;
      END;   (* IF class=... *)
      SetGadgets(ActRecord,ADR(Records[ActRecord]),Stop,StopQual);
     END;   (* WITH MyMessage *)
    END;   (* IF MyMessagePtr#NIL *)
  END;   (* LOOP *)
END RecordInput.