(*---------------------------------------------------------------------------
   :Program.    ControlIntuition
   :Author.     Fridtjof Björn Siebert
   :Address.    Nobileweg 67, D-7-Stgt-40
   :Phone.      (0)711/822509
   :Shortcut.   [fbs]
   :Version.    1.0
   :Date.       31-May-88
   :Copyright.  PD
   :Language.   MODULA-II
   :Translator. M2Amiga
   :Contents.   Prozeduren, die es ermöglichen, Intuition aus und an zu
   :Contents.   schalten. Damit hat man volle Kontrolle Über den Amiga.
   :Remark.     I didn't believe this could be so easy !
---------------------------------------------------------------------------*)

IMPLEMENTATION MODULE ControlIntuition;

FROM SYSTEM      IMPORT ADR, ADDRESS, SETREG, REG, SHIFT, LONGSET, CAST;
FROM Arts        IMPORT Assert,TermProcedure;

FROM Dos         IMPORT Delay;
FROM Exec        IMPORT MsgPortPtr, IOStdReq, Interrupt, MemEntry, Forbid,
                        Permit, IOStdReqPtr, OpenDevice, CloseDevice, DoIO,
                        Disable, Enable;
FROM ExecSupport IMPORT CreatePort, DeletePort, CreateStdIO, DeleteStdIO;
FROM Input       IMPORT inputName, addHandler, remHandler;
FROM InputEvent  IMPORT InputEvent, InputEventPtr, Class, lButton, mButton,
                        rButton;
FROM Timer IMPORT TimeVal;

(*----------------  Variablen aus Definition:  ------------------------------

VAR
  DisableIntuiCount: CARDINAL;
  (* Zähler für verschachtelte Aufrufe von DisableIntuition *)

  MouseX, MouseY: LONGINT;
  (* Mouse Position. Wird währen Intuition ausgeschaltet ist, verändert.   *)
  (* Es wird kein Rand getestet. Es kann also theoretisch zu einem Über-   *)
  (* kommen, dazu muß die Maus jedoch über 500km in eine Richtung bewegt   *)
  (* werden, ist also relativ unwahrscheinlich.                            *)

  RightButton, LeftButton, MiddleButton: TimeVal;
  (* Die Zeit, zu der der letzte Mouse-Event des jeweiligen Buttons kam.   *)
  (* MiddleButton konnte ich mangels Hardware nicht testen.                *)

  RightButtonRel, LeftButtonRel, MiddleButtonRel: TimeVal;
  (* Wie oben, nur Buttons losgelassen                                     *)

  LastRawKey: CARDINAL;
  LastRawKeyTime: TimeVal;
  (* Der letzte RawKey und wann er gedrückt wurde                          *)

  LastTime: TimeVal;
  (* Zeit des letzten Events                                               *)

---------------------------------------------------------------------------*)

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

VAR
  InputDevPort: MsgPortPtr;       (* My MessagePort *)
  InputRequestBlock: IOStdReqPtr;
  HandlerStuff: Interrupt;
  Escaped: BOOLEAN;     (* Disable can be quitted by pressing ESC *)

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*                          Input  Handler:                                *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

(* It's Variables are global (don't know if allocating them scratches      *)
(* A0 or A1. Who knows ? Who's got a M2Amiga-Debugger ??? Or a even        *)
(* a Disassembler, like TDI's ?¿?                                          *)

VAR
  Ev, TraceEv: InputEventPtr;
  Result: InputEventPtr;
  Code: CARDINAL;

PROCEDURE MyHandler();
(* 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 !!                                               *)

CONST
  ESC = 69;

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
      CASE class OF
        rawkey:   LastRawKey := code;
                  LastRawKeyTime := timeStamp;
                  IF code=69 THEN Escaped := NOT(Escaped) END; |
        rawmouse: Code := code;
                  IF Code>127 THEN
                    DEC(Code,128);
                    IF    Code=lButton THEN LeftButtonRel   := timeStamp;
                    ELSIF Code=mButton THEN MiddleButtonRel := timeStamp;
                    ELSIF Code=rButton THEN RightButtonRel  := timeStamp END;
                  ELSE
                    IF    Code=lButton THEN LeftButton   := timeStamp;
                    ELSIF Code=mButton THEN MiddleButton := timeStamp;
                    ELSIF Code=rButton THEN RightButton  := timeStamp END;
                  END;
                  MouseX := MouseX + x;
                  MouseY := MouseY + y;
      ELSE
      END;
      LastTime := timeStamp;
    END;
    TraceEv := TraceEv^.nextEvent;
  END;
  IF Escaped THEN
    SETREG(0,Ev);
  ELSE
    SETREG(0,NIL);
  END;
END MyHandler;
(* that's it. I hope it to work !!! *)

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*                         DisableIntuition:                               *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

PROCEDURE DisableIntuition();
(* Dies kann genausoleicht wie Forbid() aufgerufen werden                  *)

BEGIN
  IF DisableIntuiCount=0 THEN
    Escaped := FALSE;
    WITH InputRequestBlock^ DO
      command := addHandler;
      data := ADR(HandlerStuff);
    END;
    DoIO(InputRequestBlock);
  END;
  INC(DisableIntuiCount);
END DisableIntuition;

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*                         EnableIntuition:                                *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

PROCEDURE EnableIntuition();

BEGIN
  DEC(DisableIntuiCount);
  IF DisableIntuiCount=0 THEN
    WITH InputRequestBlock^ DO
      command := remHandler;
      data := ADR(HandlerStuff);
    END;
    DoIO(InputRequestBlock);
  END;
END EnableIntuition;

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

PROCEDURE CleanUp();

BEGIN
  DeleteStdIO(InputRequestBlock);
  DeletePort(InputDevPort);
END CleanUp;

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

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)  *)
    code := ADR(MyHandler);  (* Thats my Handle-Procedure *)
    node.pri := 52;
  (* 52 to be higher than another Prg, that wants affekt Intuition *)
  END;
  OpenDevice(ADR(inputName),0,InputRequestBlock,LONGSET{});
  TermProcedure(CleanUp);
END ControlIntuition.