(*--------------------------------------------------------------------------
    :Program.       Eventwind (Events)
    :Contents.      Fensterverwaltung für Events
    :Author.        D.-I. Hiter Vinzenz
    :Copyright.     Public Domain
    :Language.      Modula-2
    :Translator.    M2Amiga 3.2 d
    :History.       V1.0, 3.12.1989
---------------------------------------------------------------------------*)

(******************************************************************************
 *              Programm               |              Author                  *
 *  ---------------------------------  |  ----------------------------------  *
 *  Modul:      EventWind              |  Name:       D.-I. Hiter Vinzenz     *
 *  Typ:        Projekt: Events        |  Adresse:    Petri Au 20,            *
 *  Version:    V 1.0                  |              A-8042 Graz             *
 *  Datum:      03.12.1989             |  Telefon:    (0)316/44 83 13         *
 *  Inhalt:     Fensterverwaltung      |                                      *
 *  Copyright:  Public Domain          |                                      *
 *                                     |                                      *
 *-------------------------------------+--------------------------------------*
 *        Programmierumgebung          |          Rechnerumgebung             *
 *  ---------------------------------  |  ----------------------------------  *
 *  Sprache:    ETH Modula-2           |  Hardware:   Commodore AMIGA 500     *
 *  System:     M2Amiga c AMSoft       |  Kickstart:  V 1.2                   *
 *  Compiler:   M2C V 3.2d             |  AmigaDos:   V 1.2                   *
 *  Linker:     M2L V 3.2d             |  Workbench:  V 1.3                   *
 *                                     |                                      *
 *----------------------------------------------------------------------------*
 *  Historie:   keine                                                         *
 *  Imports:    keine                                                         *
 *----------------------------------------------------------------------------*
 *  Inhalt:                                                                   *
 *  Fensterverwaltung für die Anzeige von Events. Selektieren von ankommenden *
 *  Eventtypen und deren Parameter.                                           *
 *                                                                            *
 *----------------------------------------------------------------------------*
 *                                                                            *
 *  Prozeduren:                                                               *
 *  ------------------------------------------------------------------------  *
 *  StrLength            Längenermittelung String                             *
 *  OpenEventWindow      Fenster öffnen                                       *
 *  ProcessMsg           Auswerten vom Meldungen                              *
 *  FetchMsg             Abholen von Meldungen                                *
 *  InitEventBox         Initialstrings eintragen                             *
 *  InitQualiBox         Qualifier Box: Strings eingtragen                    *
 *  InitPriorBox         Priority Box: Strings eintragen                      *
 *  DrawGrect            Rechteck zeichnen                                    *
 *  DrawBox              gefüllte Box zeichnen                                *
 *  GetInnerBox          Boxinnenkoordinaten ermitteln                        *
 *  DrawBoxText          Zeichen des Strings in einer Box                     *
 *  SelectBoxElement     Selektieren einer Box (invertieren)                  *
 *  InitEventNames       Initialisieren der Event Namen                       *
 *  InitPriorNames       Initialisieren der Prioritäten Namen                 *
 *  InitQualiNames       Initialisieren der Qualifier Namen                   *
 *  EnterQualifieres     Eintragen der Qualifiernamen                         *
 *  EnterEventNames      Eintragen der Eventnamen                             *
 *                                                                            *
 ******************************************************************************)
(*.pa*)
IMPLEMENTATION MODULE EventWind;

(*---------------------- Import aus Standardbibliothek -----------------------*)
FROM SYSTEM        IMPORT ADR, ADDRESS, CAST, BITSET;
FROM Arts          IMPORT TermProcedure;
FROM Heap          IMPORT Allocate, Deallocate;
FROM Conversions   IMPORT ValToStr;
FROM Str           IMPORT Concat;

(*---------------------- Import aus Amigabibliothek --------------------------*)
FROM Exec          IMPORT execBase,
                          MsgPortPtr, WaitPort, FindPort, GetMsg, PutMsg,
                          ReplyMsg, CopyMem,
                          NodeType, Message, MessagePtr, UByte;
FROM Graphics      IMPORT ViewModes, ViewModeSet, jam1, LoadRGB4,
                          DrawModes, DrawModeSet, jam2,
                                RastPortPtr, Draw, Move, Text, TextLength,
                          SetAPen, SetBPen, SetDrMd, RectFill;

FROM InputEvent    IMPORT InputEvent, Class, upPrefix;
FROM Intuition     IMPORT  ScreenPtr, NewScreen, ScreenFlags, ScreenFlagSet,
                           OpenScreen, CloseScreen,
                           NewWindow, WindowPtr, IDCMPFlags, IDCMPFlagSet,
                           WindowFlags, WindowFlagSet,
                           OpenWindow, CloseWindow, WindowToFront,
                           ModifyIDCMP,
                           GadgetPtr, IntuiMessagePtr, RefreshGadgets;


(*---------------------- Import aus eigener Bibliothek -----------------------*)

(*---------------------- globale Definitionen --------------------------------*)
TYPE
MessagePROC = PROCEDURE (MessagePtr): BOOLEAN;

TYPE String15 = ARRAY[0..15] OF CHAR;

TYPE
Box = RECORD
  x, y, w, h: INTEGER;
  nx, ny    : INTEGER;
  fgPen:       INTEGER;
  bgPen:       INTEGER;
END;

CONST
  CEventBoxX = 10;
  CEventBoxY = 25;
  CEventBoxW = 140;
  CQualiBoxX = CEventBoxX + CEventBoxW + 10;
  CQualiBoxY = CEventBoxY;
  CQualiBoxW = CEventBoxW;
  CEventCntX = CQualiBoxX + CQualiBoxW + 15;
  CEventCntY = CEventBoxY + 9;
  CRawKeyX   = CEventCntX;
  CRawKeyY   = 65;

  CMaxEventTypes = 20;
  CMaxQualifiers = 16;

TYPE
Event = RECORD
  name : String15;
  ref  : INTEGER;
END;

Quali = RECORD
  name: String15;
  sel : BOOLEAN;
END;

VAR windowData : NewWindow;
    windowPtr  : WindowPtr;
    rPort      : RastPortPtr;
    eventCounter: CARDINAL;
    events: ARRAY[1..CMaxEventTypes] OF Event;
    quali : ARRAY[1..CMaxQualifiers] OF Quali;
    prior : ARRAY[1..3] OF String15;


VAR eventBox, qualiBox, priorBox: Box;

(*.cp-------------------------------------------------------------------------*)
PROCEDURE StrLength (textPtr: ADDRESS): INTEGER;
(*----------------------------------------------------------------------------*)
VAR len: INTEGER;

BEGIN
  len := 0;
  WHILE CAST (CHAR, textPtr^) # CHAR (0) DO
    INC(len); INC(textPtr);
  END;
  RETURN len;
END StrLength;

(*.cp-------------------------------------------------------------------------*)
PROCEDURE OpenEventWindow;
(*----------------------------------------------------------------------------*)

BEGIN
  WITH windowData DO
    detailPen  := 1;
    blockPen   := 2;
    idcmpFlags := IDCMPFlagSet {closeWindow, refreshWindow, mouseButtons,
                                vanillaKey};
    idcmpFlags := IDCMPFlagSet{};
    flags      := WindowFlagSet {windowDepth, windowClose, windowDrag, noCareRefresh};
    title      := ADR ("Events from Input Device ");
    type       := ScreenFlagSet{wbenchScreen};
    firstGadget:= NIL;
    checkMark  := NIL;
    screen     := NIL;
    bitMap     := NIL;
    leftEdge   := 0;
    topEdge    := 15;
    width      := 460;
    height     := 210;
    minWidth   := width/10; minHeight := height/10;
    maxWidth   := width;    maxHeight := height;
  END;
  windowPtr := OpenWindow (windowData);
END OpenEventWindow;

(*.cp-------------------------------------------------------------------------*)
PROCEDURE ProcessMsg (messPtr: MessagePtr): BOOLEAN;
(*----------------------------------------------------------------------------*)
VAR msgPtr : IntuiMessagePtr;

BEGIN
  msgPtr := CAST (IntuiMessagePtr ,messPtr);
  IF closeWindow IN msgPtr^.class THEN RETURN TRUE;
  ELSE RETURN FALSE;
  END;
END ProcessMsg;



(*.cp------------------------------------------------------------------------*)
PROCEDURE FetchMsg (port: MsgPortPtr; messageProc: MessagePROC);
(*---------------------------------------------------------------------------*)
VAR msg, copyMsg  : MessagePtr;
    done, noMem   : BOOLEAN;
    msgSize : INTEGER;

BEGIN
  REPEAT
    WaitPort (port);                         (* Auf Meldung warten *)
    done := FALSE;
    noMem := FALSE;
    REPEAT
      msg := GetMsg(port);                   (* Abholen der Meldung *)
      IF msg # NIL THEN
        msgSize := SIZE(Message) + msg^.length;
        Allocate (copyMsg, msgSize);
        IF copyMsg = NIL THEN
          IF NOT noMem THEN                  (* nur einmalige Meldung *)
            noMem := TRUE;
          END;
          ReplyMsg (msg);
        ELSE
          CopyMem (msg, copyMsg, msgSize);
          ReplyMsg (msg);
          IF NOT done THEN done := messageProc (MessagePtr(copyMsg)); END;
          Deallocate (copyMsg);
        END;
      END;
    UNTIL msg = NIL;                          (* noch eine Meldung ? *)
  UNTIL done;
END FetchMsg;


(*.cp-------------------------------------------------------------------------*)
PROCEDURE InitEventBox (VAR box: Box);
(*----------------------------------------------------------------------------*)

BEGIN
  WITH box DO
    x := CEventBoxX;
    y := CEventBoxY;
    w := 140;
    h := 16*10;
    nx := 1;
    ny := 16;
    fgPen := 3;
    bgPen := 2;
    w := nx * (w/nx);
    h := ny * (h/ny);
  END;
END InitEventBox;

(*.cp-------------------------------------------------------------------------*)
PROCEDURE InitQualiBox (VAR box: Box);
(*----------------------------------------------------------------------------*)

BEGIN
  WITH box DO
    x := CQualiBoxX;
    y := CQualiBoxY;
    w := 140;
    h := CMaxQualifiers*10;
    nx := 1;
    ny := CMaxQualifiers;
    fgPen := 3;
    bgPen := 2;
    w := nx * (w/nx);
    h := ny * (h/ny);
  END;
END InitQualiBox;

(*.cp-------------------------------------------------------------------------*)
PROCEDURE InitPriorBox (VAR box: Box);
(*----------------------------------------------------------------------------*)

BEGIN
  WITH box DO
    x := CQualiBoxX + 150;
    y := 105;
    w := 140;
    h := 3*10;
    nx := 1;
    ny := 3;
    fgPen := 3;
    bgPen := 2;
    w := nx * (w/nx);
    h := ny * (h/ny);
  END;
END InitPriorBox;


(*.cp-------------------------------------------------------------------------*)
PROCEDURE DrawGrect (rPort: RastPortPtr; color: INTEGER; x, y, w, h: INTEGER);
(*----------------------------------------------------------------------------*)

BEGIN
  SetAPen (rPort, color);
  Move (rPort, x, y);
  Draw (rPort, x, y+h);
  Draw (rPort, x+w, y+h);
  Draw (rPort, x+w, y);
  Draw (rPort, x, y);
END DrawGrect;



(*.cp-------------------------------------------------------------------------*)
PROCEDURE DrawBox (rPort: RastPortPtr; box: Box);
(*----------------------------------------------------------------------------*)
VAR i, k, dx, dy: INTEGER;

BEGIN
  WITH box DO
    SetAPen  (rPort, bgPen);
    SetBPen  (rPort, bgPen);
    SetDrMd  (rPort, jam2);
    RectFill (rPort, x, y, x + w, y + h);
    DrawGrect (rPort, fgPen, x, y, w, h);
    dy := h / ny;
    dx := w / nx;
    FOR i := 0 TO ny - 1 DO
      FOR k := 0 TO nx - 1 DO
        DrawGrect (rPort, fgPen, x + k * dx, y + i * dy, dx, dy);
      END;
    END;
  END;
END DrawBox;


(*.cp-------------------------------------------------------------------------*)
PROCEDURE GetInnerBox (box: Box; sx, sy: INTEGER; VAR ix, iy, iw, ih: INTEGER);
(*----------------------------------------------------------------------------*)

BEGIN
  WITH box DO
    IF sx > 0 THEN ix := x + (sx-1)*w/nx +1; ELSE iy := x + 1; END;
    IF sy > 0 THEN iy := y + (sy-1)*h/ny +1; ELSE iy := y + 1; END;
    iw := w / nx - 2;
    ih := h / ny - 2;
  END;
END GetInnerBox;


(*----------------------------------------------------------------------------*)
PROCEDURE DrawBoxText (rPort: RastPortPtr; box: Box; color, sx, sy: INTEGER;
                       textPtr: ADDRESS);
(*----------------------------------------------------------------------------*)
VAR x, y, w, h, textLen: INTEGER;

BEGIN
  GetInnerBox (box, sx, sy, x, y, w, h);
  SetAPen (rPort, color);
  SetDrMd (rPort, jam1);
  textLen := StrLength (textPtr);
  x := x + (w - TextLength (rPort, textPtr, textLen)) / 2;
  y := y + 7 + (h - 8)/2;
  Move (rPort, x, y);
  Text (rPort, textPtr, textLen);
END DrawBoxText;


(*.cp-------------------------------------------------------------------------*)
PROCEDURE SelectBoxElement (rPort: RastPortPtr; box: Box; sx, sy: INTEGER);
(*----------------------------------------------------------------------------*)
VAR x, y, w, h: INTEGER;

BEGIN

  SetAPen (rPort, 0FFH);

  GetInnerBox (box, sx, sy, x, y, w, h);
  SetDrMd (rPort, DrawModeSet{complement});
  RectFill  (rPort, x, y, x + w, y + h);
END SelectBoxElement;


(*.cp-------------------------------------------------------------------------*)
PROCEDURE InitEventNames;
(*----------------------------------------------------------------------------*)

BEGIN
  events[1].name  := "rawkey";
  events[2].name  := "rawmouse";
  events[3].name  := "event";
  events[4].name  := "pointerpos";
  events[5].name  := "gadgetdown";
  events[6].name  := "gadgetup";
  events[7].name  := "requester";
  events[8].name  := "menulist";
  events[9].name  := "closewindow";
  events[10].name := "sizewindow";
  events[11].name := "refreshwindow";
  events[12].name := "newprefs";
  events[13].name := "diskremoved";
  events[14].name := "diskinserted";
  events[15].name := "activewindow";
  events[16].name := "inactivewindow";

  (* Zuordung zwischen Event class Ordnung und der angezeigten Tabelle *)
  events[1].ref    := 1;
  events[2].ref    := 2;
  events[3].ref    := 3;
  events[4].ref    := 4;
  events[5].ref    := 0;
  events[6].ref    := 0;
  events[7].ref    := 5;
  events[8].ref    := 6;
  events[9].ref    := 7;
  events[10].ref   := 8;
  events[11].ref   := 9;
  events[12].ref   := 10;
  events[13].ref   := 11;
  events[14].ref   := 12;
  events[15].ref   := 13;
  events[16].ref   := 14;
  events[17].ref   := 15;
  events[18].ref   := 16;
END InitEventNames;

(*.cp-------------------------------------------------------------------------*)
PROCEDURE InitPriorNames;
(*----------------------------------------------------------------------------*)

BEGIN
  prior[1] := "1: < Intui (40)";
  prior[2] := "2: = Intui (50)";
  prior[3] := "3: > Intui (60)";
END InitPriorNames;

(*.cp-------------------------------------------------------------------------*)
PROCEDURE InitQualiNames;
(*----------------------------------------------------------------------------*)
VAR i: INTEGER;

BEGIN
  quali[1].name  := "lShift";
  quali[2].name  := "rShift";
  quali[3].name  := "capsLock";
  quali[4].name  := "control";
  quali[5].name  := "lAlt";
  quali[6].name  := "rAlt";
  quali[7].name  := "lCommand";
  quali[8].name  := "rCommand";
  quali[9].name  := "mumericPad";
  quali[10].name := "repeat";
  quali[11].name := "interrupt";
  quali[12].name := "multiBroadC.";
  quali[13].name := "midButton";
  quali[14].name := "rightButton";
  quali[15].name := "leftButton";
  quali[16].name := "relativM.";
  FOR i := 1 TO CMaxQualifiers DO
    quali[i].sel := FALSE;
  END;
END InitQualiNames;

(*.cp-------------------------------------------------------------------------*)
PROCEDURE EnterQualifiers (qualifiers: BITSET);
(*----------------------------------------------------------------------------*)
VAR i: INTEGER;

BEGIN
  FOR i := 1 TO 16 DO
    IF i - 1 IN qualifiers THEN
      IF NOT quali[i].sel THEN
        quali[i].sel := TRUE;
        SelectBoxElement (windowPtr^.rPort, qualiBox, 1, i);
      END;
    ELSIF quali[i].sel THEN
        quali[i].sel := FALSE;
        SelectBoxElement (windowPtr^.rPort, qualiBox, 1, i);
    END;
  END;
END EnterQualifiers;


(*.cp-------------------------------------------------------------------------*)
PROCEDURE EnterEventNames (rPort: RastPortPtr; box: Box);
(*----------------------------------------------------------------------------*)
VAR i: INTEGER;

BEGIN
  FOR i := 1 TO CMaxEventTypes DO
    DrawBoxText (rPort, box, 3, 1, i, ADR(events[i].name));
  END;
END EnterEventNames;


(*.cp-------------------------------------------------------------------------*)
PROCEDURE EnterQualiNames (rPort: RastPortPtr; box: Box);
(*----------------------------------------------------------------------------*)
VAR i: INTEGER;

BEGIN
  FOR i := 1 TO CMaxQualifiers DO
    DrawBoxText (rPort, box, 3, 1, i, ADR(quali[i].name));
  END;
END EnterQualiNames;

(*.cp-------------------------------------------------------------------------*)
PROCEDURE EnterPriorNames (rPort: RastPortPtr; box: Box);
(*----------------------------------------------------------------------------*)

VAR i: INTEGER;

BEGIN
  FOR i := 1 TO 3 DO
    DrawBoxText (rPort, box, 3, 1, i, ADR(prior[i]));
  END;
END EnterPriorNames;


VAR oldEventSelect : INTEGER;

(*.cp-------------------------------------------------------------------------*)
PROCEDURE SelectEventName (nameIndex: INTEGER);
(*----------------------------------------------------------------------------*)

BEGIN
  IF nameIndex <= 0 THEN RETURN; END;
  nameIndex := events[nameIndex].ref;
  IF oldEventSelect # nameIndex THEN
    IF oldEventSelect # 0 THEN
      SelectBoxElement (windowPtr^.rPort, eventBox, 1, oldEventSelect);
    END;
    oldEventSelect := nameIndex;
    IF oldEventSelect # 0 THEN
      SelectBoxElement (windowPtr^.rPort, eventBox, 1, oldEventSelect);
    END;
  END;
END SelectEventName;

VAR oldPriorSelect : INTEGER;

(*.cp-------------------------------------------------------------------------*)
PROCEDURE SelectPriority (index: INTEGER);
(*----------------------------------------------------------------------------*)

BEGIN
  IF oldPriorSelect # index THEN
    IF oldPriorSelect # 0 THEN
      SelectBoxElement (rPort, priorBox, 1, oldPriorSelect);
    END;
    oldPriorSelect := index;
    IF oldPriorSelect # 0 THEN
      SelectBoxElement (rPort, priorBox, 1, oldPriorSelect);
    END;
  END;
END SelectPriority;

(*.cp-------------------------------------------------------------------------*)
PROCEDURE EnterCode (class: Class; code: CARDINAL);
(*----------------------------------------------------------------------------*)
CONST CWidth = 5;
VAR str :ARRAY[0..15] OF CHAR;
    err: BOOLEAN;
    up : INTEGER;

BEGIN
  SetDrMd (rPort, jam2);
  SetAPen (rPort, 3);
  SetBPen (rPort, 0);
  up := 0;
  IF class = rawkey THEN
    IF code > upPrefix THEN
      code := code - upPrefix;
      up := 1;
    ELSE up := 2;
  END; END;

  ValToStr (code, FALSE, str, 10, CWidth, ' ', err);
  IF up = 1 THEN Concat (str," Up  ")
  ELSIF up = 2 THEN Concat (str," Down");
  ELSE Concat (str,"     ");
  END;
  Concat (str," Dez");
  Move (rPort, 310, CRawKeyY);
  Text (rPort, ADR(str), CWidth+9);
  (* Hexadezimale Anzeige *)
  ValToStr (code, FALSE, str, 16, CWidth, ' ', err);
  IF up = 1 THEN Concat (str," Up  ")
  ELSIF up = 2 THEN Concat (str," Down");
  ELSE Concat (str,"     ");
  END;
  Concat (str," Hex");
  Move (rPort, 310, CRawKeyY + 12);
  Text (rPort, ADR(str), CWidth+9);
END EnterCode;


(*.cp-------------------------------------------------------------------------*)
PROCEDURE EnterEventCounter;
(*----------------------------------------------------------------------------*)
CONST CWidth = 6;
VAR str :ARRAY[0..CWidth] OF CHAR;
    err: BOOLEAN;

BEGIN
  INC (eventCounter);
  ValToStr (eventCounter, FALSE, str, 10, CWidth, ' ', err);
  SetAPen (rPort, 3);
  SetBPen (rPort, 0);
  SetDrMd (rPort, jam2);
  Move (rPort, 310, 32);
  Text (rPort, ADR(str), CWidth);
END EnterEventCounter;

(*.cp-------------------------------------------------------------------------*)
PROCEDURE PrintBackGround;
(*----------------------------------------------------------------------------*)

BEGIN
  SetAPen (rPort, 1);
  SetDrMd (rPort, jam1);
  Move (rPort, 45, 20);
  Text (rPort, ADR("Class"), 5);
  Move (rPort, 205, 20);
  Text (rPort, ADR("Qualifier"),9);
  Move (rPort, 320, 20);
  Text (rPort, ADR("Events"), 6);
  Move (rPort, 325, 55);
  Text (rPort, ADR("Code"), 4);
  Move (rPort, 315, 100);
  Text (rPort, ADR("Handler-Priority"), 16);
  Move (rPort, 15, 200);
  Text (rPort, ADR("ESC for Quit                    "), 30);
  Text (rPort, ADR("by V. Hiter / Graz"),18);
END PrintBackGround;

(*.cp-------------------------------------------------------------------------*)
PROCEDURE EnterInputEvent (VAR inputEvent: InputEvent);
(*----------------------------------------------------------------------------*)

BEGIN
  EnterEventCounter;
  SelectEventName (ORD(inputEvent.class));
  EnterQualifiers (CAST(BITSET,inputEvent.qualifier));
  EnterCode (inputEvent.class, inputEvent.code);
END EnterInputEvent;


(*.cp-------------------------------------------------------------------------*)
PROCEDURE CleanUp;
(*----------------------------------------------------------------------------*)

BEGIN
  IF windowPtr # NIL THEN CloseWindow (windowPtr); END;
END CleanUp;

(*.cp*)
BEGIN
  windowPtr := NIL;
  OpenEventWindow;
  IF windowPtr # NIL THEN
    rPort := windowPtr^.rPort;
    InitEventBox (eventBox);
    InitEventNames;
    DrawBox (rPort, eventBox);
    EnterEventNames (rPort, eventBox);
    InitQualiBox (qualiBox);
    InitQualiNames;
    DrawBox (rPort, qualiBox);
    EnterQualiNames (rPort, qualiBox);
    InitPriorBox (priorBox);
    InitPriorNames;
    DrawBox (rPort, priorBox);
    EnterPriorNames (rPort, priorBox);
    SelectPriority (2);  (* Grundzustand Priority = 50 *)
    PrintBackGround;
  END;
  TermProcedure (CleanUp);
END EventWind.