Turbo Toolbox/Turbo_Toolbox.iso/1990/12/grdlagen/mousekey.pas

Pascal/Delphi Source File | 1990-09-10 | 18.1 KB | 597 lines

(* ------------------------------------------------------ *)
(*                     MOUSEKEY.PAS                       *)
(*    Stellt Objekte für EventHandling zur Verfügung.     *)
(*       (c) 1990 Raimond Reichert & TOOLBOX              *)
(* ------------------------------------------------------ *)
UNIT MouseKey;

INTERFACE

USES Dos;

CONST
  MaxEvents   =  100;       { max. Anzahl Events           }
  EvNoEv      =    0;       { kein Event liegt vor         }
  EvMouMove   =    1;       { Maus wurde bewegt            }
  EvLeftPress =    2;       { linke MausTaste gedrückt     }
  EvLeftRel   =    4;       { linke MausTaste losgelassen  }
  EvRightPress=    8;       { rechte Taste gedrückt        }
  EvRightRel  =   16;       { rechte Taste losgelasssen    }
  EvKeyPressed=  256;       { "normale" Taste gedrückt     }
  EvKeyUnknown=  512;       { unbekannt Taste gedrückt     }
  EvKeyState  = 1024;       { Statustaste betätigt         }
  EvMouAll    =   31;       { alle Mausereignisse          }
  EvKeyAll    = 1792;       { alle Tastaturereignisse      }
  EvAll       = 1823;       { alle Ereignisse              }

  IndexArray  : ARRAY [1..9] OF WORD =
                  (0, 1, 2, 4, 8, 16, 256, 512, 1024);

  RightShift  =   1;        { Bitwerte für die einzelnen   }
  LeftShift   =   2;        { Statustasten                 }
  Ctrl        =   4;
  Alt         =   8;
  ScrollLock  =  16;
  NumLock     =  32;
  CapsLock    =  64;
  Insert      = 128;

  TakeOut     : BOOLEAN = FALSE;
                          { aus Tastaturpuffer entfernen ? }

TYPE
  EventObj = OBJECT

    Time            : LONGINT;      { Zeitpunkt des Events }
    EventType       : WORD;         { Art des Events       }
    x, y, Buttons   : INTEGER;
    Key             : WORD;
    ScanCode, State : BYTE;
    StateKey        : BYTE;
  END;

  EventObjArray = ARRAY [1..MaxEvents] OF EventObj;
  EventQueuePtr = ^EventQueue;

  EventQueue    = OBJECT

    NextToCall, CameLastIn : INTEGER;
    Queue                  : EventObjArray;   { die Events }
  END;

  HandlerProc = PROCEDURE(VAR Event : EventObj);

  HandlerObj  = OBJECT

    Call    : BOOLEAN;
    Handler : HandlerProc
  END;

  HandlerArray = ARRAY [1..16] OF HandlerObj;
  MouseObjPtr  = ^MouseObj;

  MouseObj    = OBJECT                  { für Mausabfragen }

    Regs      : Registers;
    Avail,                              { Maus vorhanden ? }
    Visible,                            { Maus sichtbar ?  }
    TextModus : BOOLEAN;                { Textmodus ?      }

    CONSTRUCTOR Init;
    PROCEDURE  Hide;                                VIRTUAL;
    PROCEDURE  Show;                                VIRTUAL;
    PROCEDURE  SetArea(x1, y1, x2, y2 : INTEGER);   VIRTUAL;
    PROCEDURE  SetSpeed(xs, ys : INTEGER);          VIRTUAL;
    PROCEDURE  SetMouse(x, y : INTEGER);
    PROCEDURE  TextMouse(Chr : CHAR; Col, BckCol : BYTE);
    FUNCTION   GetX : BYTE;                         VIRTUAL;
    FUNCTION   GetY : BYTE;                         VIRTUAL;
    DESTRUCTOR Done;                                VIRTUAL;
  END;

  EventHandlerObjPtr = ^EventHandlerObj;

  EventHandlerObj    = OBJECT

    MouQueue     : EventQueuePtr;
    KeyQueue     : EventQueuePtr;
    TextModus    : BOOLEAN;
    AktState,
    AktMouX,
    AktMouY      : BYTE;
    HandlerTable : HandlerArray;

    CONSTRUCTOR Init;
    PROCEDURE   KeybHandler(Key : BYTE);            VIRTUAL;
    PROCEDURE   MouseHandler;                       VIRTUAL;
    PROCEDURE   PutEvInQueue(Queue : EventQueuePtr;
                             Event : EventObj);     VIRTUAL;
    PROCEDURE   GetEvFromQueue(VAR Queue : EventQueuePtr;
                               VAR Event : EventObj);
                                                    VIRTUAL;
    PROCEDURE   PeekEvFromQueue(VAR Queue : EventQueuePtr;
                                VAR Event : EventObj);
                                                    VIRTUAL;
    PROCEDURE   PeekEvent(VAR Event : EventObj);    VIRTUAL;
    PROCEDURE   GetEvent(VAR Event : EventObj);     VIRTUAL;
    PROCEDURE   WaitForEvent(WaitForEv : INTEGER;
                             VAR Event : EventObj); VIRTUAL;
    FUNCTION    GetEvIndex(EventType : WORD) : BYTE;
                                                    VIRTUAL;
    PROCEDURE   RegisterHandler(Event      : WORD;
                                NewHandler : HandlerProc);
                                                    VIRTUAL;
    PROCEDURE   DeRegisterHandler(Event : WORD);    VIRTUAL;
    DESTRUCTOR  Done;                               VIRTUAL;
  END;

VAR
  Mouse  : MouseObjPtr;      { ACHTUNG: Kon- bzw Destruktor}
  EvHand : EventHandlerObjPtr;      { NICHT aufrufen !     }


IMPLEMENTATION

{$L MOUSEKEY}

{$F+}

  PROCEDURE NewMouHandler;  EXTERNAL;
                       { wird vom Mausinterrupt aufgerufen }

  PROCEDURE NewKeybHandler; EXTERNAL;
                                  { ersetzt Interupt 09hex }
{$F-}

VAR
  KeybState : BYTE ABSOLUTE $40:$17;      { Tastaturstatus }
  BiosTime  : LONGINT ABSOLUTE $40:$6C;   { Zeit in Ticks  }
  OldInt09,                { zum Sichern der alten Adresse }
  OldExitProc : POINTER;
  NewFlags,       { werden gesetzt, wenn Mausereignis ein- }
  NewButtons,     { trifft. Nicht als Parameter, da sonst  }
  NewX,           { Gefahr eines "Stack Overflow" .        }
  NewY        : INTEGER;


  CONSTRUCTOR MouseObj.Init;
  BEGIN
    Regs.AX   := $00;
    Intr($33, Regs);
    Avail     := (Regs.AX = $FFFF);
    Visible   := FALSE;
    TextModus := TRUE
  END;

  PROCEDURE MouseObj.Hide;
  BEGIN
    IF Avail AND Visible THEN BEGIN
      Regs.AX := $02;
      Intr($33, Regs);
      Visible := FALSE
    END;
  END;

  PROCEDURE MouseObj.Show;
  BEGIN
    IF Avail AND NOT Visible THEN BEGIN
      Regs.AX := $01;
      Intr($33, Regs);
      Visible := TRUE;
    END;
  END;

  PROCEDURE MouseObj.SetArea(x1, y1, x2, y2 : INTEGER);
  BEGIN
    IF Avail THEN BEGIN
      Regs.AX := $07;
      IF TextModus THEN BEGIN
        Regs.CX := Pred(x1) SHL 3;
        Regs.DX := Pred(x2) SHL 3;
      END ELSE BEGIN
        Regs.CX := x1;
        Regs.DX := x2;
      END;
      Intr($33, Regs);
      Regs.AX := $08;
      IF TextModus THEN BEGIN
        Regs.CX := Pred(y1) SHL 3;
        Regs.DX := Pred(y2) SHL 3;
      END ELSE BEGIN
        Regs.CX := y1;
        Regs.DX := y2;
      END;
      Intr($33, Regs);
    END;
  END;

  PROCEDURE MouseObj.SetSpeed(xs, ys : INTEGER);
  BEGIN
    IF Avail THEN BEGIN
      Regs.AX := $0F;
      Regs.CX := xs;
      Regs.DX := ys;
      Intr($33, Regs);
    END;
  END;

  PROCEDURE MouseObj.SetMouse(x, y : INTEGER);
  BEGIN
    Regs.AX := $04;
    IF TextModus THEN BEGIN
      Regs.CX := x SHR 3;
      Regs.DX := y SHR 3;
    END ELSE BEGIN
      Regs.CX := Pred(x);
      Regs.DX := Pred(y);
    END;
    Intr($33, Regs);
  END;

  PROCEDURE MouseObj.TextMouse(Chr         : CHAR;
                               Col, BckCol : BYTE);
  VAR
    attr : INTEGER;
  BEGIN
    IF TextModus THEN BEGIN
      Regs.AX := $0A;
      Regs.BX := $00;
      Attr := Col OR (BckCol SHL 4);
      IF Col > 15 THEN Attr := Attr OR 128;
      Regs.CX := Attr SHL 8;
      Regs.DX := Regs.CX + Ord(Chr);
      Intr($33, Regs)
    END;
  END;

  FUNCTION MouseObj.GetX : BYTE;
  BEGIN
    IF Avail THEN BEGIN
      Regs.AX := $03;
      Intr($33, Regs);
      IF TextModus THEN
        GetX := Succ(Regs.CX SHR 3)
      ELSE
        GetX := Regs.CX;
    END;
  END;

  FUNCTION MouseObj.GetY : BYTE;
  BEGIN
    IF Avail THEN BEGIN
      Regs.AX := $03;
      Intr($33, Regs);
      IF TextModus THEN
        GetY := Succ(Regs.DX SHR 3)
      ELSE
        GetY := Regs.DX;
    END;
  END;

  DESTRUCTOR MouseObj.Done;
  BEGIN
    Hide;
  END;


  CONSTRUCTOR EventHandlerObj.Init;
  (* Initialisiert EventHandlerObj. ACHTUNG: NICHT auf-   *)
  (* rufen, da der Init-Teil der Unit ihn aufruft.        *)
  VAR
    Regs : Registers;
    i    : BYTE;
  BEGIN
    New(MouQueue);        { Anlegen der Ereignisschlangen  }
    New(KeyQueue);
    IF (MouQueue = NIL) OR (KeyQueue = NIL) THEN Fail;
    WITH MouQueue^ DO BEGIN
      NextToCall := 1;   CameLastIn := 1;
    END;
    WITH KeyQueue^ DO BEGIN
      NextToCall := 1;   CameLastIn := 1;
    END;
    TextModus := TRUE;
    AktState  := KeybState;
    FOR i := 1 TO 16 DO         { kein Handler installiert }
      HandlerTable[i].Call := FALSE;
    IF Mouse^.Avail THEN BEGIN
      AktMouX := Mouse^.GetX;         { auch für Vergleich }
      AktMouY := Mouse^.GetY;
      Regs.AX := $C;      { Funktion Handler installieren  }
      Regs.CX := EvMouAll;  { für jegliche Mausereignisse  }
      Regs.DX := Ofs(NewMouHandler);
      Regs.ES := Seg(NewMouHandler);
      Intr($33, Regs);                      { installieren }
    END;
  END;

  PROCEDURE EventHandlerObj.KeybHandler (Key : BYTE);
  (* Wird von der Prozedur "NewKeybHandler" aufgerufen,   *)
  (* die den Interrupt 09hex ersetzt.                     *)
  (* Darf NICHT vom Programm aufgerufen werden!           *)
  VAR
    Event      : EventObj;
    Regs       : Registers;
    NewKbState : BYTE;
  BEGIN
    Event.Time := BiosTime;    { Zeitpunkt des Eintreffens }
    Regs.AH    := $11;         { liegt Tastendruck vor ?   }
    Intr ($16, Regs);
    IF (Regs.Flags AND FZero) = 0 THEN BEGIN       { ja... }
      IF TakeOut THEN BEGIN { aus Tastaturpuffer entfernen }
        Regs.AH := $10;
        Intr($16, Regs)     { ja, abholen                  }
      END ELSE BEGIN
        Regs.AH := $11;     { nein, nur abfragen           }
        Intr($16, Regs)
      END;
      IF (Regs.AL = 0) OR (Regs.AL = 224) THEN
        Event.Key := Regs.AH + 256
      ELSE
        Event.Key := Regs.AL;
      Event.EventType := EvKeyPressed;
      PutEvInQueue(KeyQueue, Event);
    END ELSE BEGIN         { nein,nichts im Tastaturpuffer }
      NewKbState := KeybState;              { Neuer Status }
      IF (AktState <> NewKbState) THEN BEGIN
        IF (AktState < NewKbState) THEN BEGIN
          Event.StateKey := AktState XOR NewKbState;
          IF (Event.StateKey <> Insert) THEN BEGIN
            Event.EventType := EvKeyState;
            PutEvInQueue(KeyQueue, Event);
          END;
        END;
      END ELSE BEGIN          { keine Statustaste gedrückt }
        IF (Key < 128) THEN BEGIN
          Event.EventType := EvKeyUnknown;
          Event.ScanCode  := Key;
          Event.State     := NewKbState;
          PutEvInQueue(KeyQueue, Event)
        END;
      END;
      AktState := NewKbState;      { neuen Status behalten }
    END;
  END;

  PROCEDURE EventHandlerObj.MouseHandler;
  VAR
    Event   : EventObj;
    i, Mask : INTEGER;
  BEGIN
    WITH Event DO BEGIN
      Time := BiosTime;           { die neuesten Mausdaten }
      IF TextModus THEN BEGIN
        x := Succ(NewX SHR 3);  y := Succ(NewY SHR 3);
      END ELSE BEGIN
        x := NewX;              y := NewY
      END;
      Buttons := NewButtons;
    END;
    Mask := 1;
    FOR i := 0 TO 5 DO BEGIN
      IF NOT ((NewFlags AND Mask = 0) OR
             ((Mask = EvMouMove)      AND
             ((Event.X = AktMouX)     AND
              (Event.Y = AktMouY)))) THEN BEGIN
        Event.EventType := Mask;
        PutEvInQueue(MouQueue, Event);
      END;
      Mask := Mask SHL 1;
    END;
    AktMouX := Event.X;        { in die globalen Variablen }
    AktMouY := Event.Y;        { übernehmen                }
  END;

  PROCEDURE EventHandlerObj.PutEvInQueue
                                     (Queue : EventQueuePtr;
                                      Event : EventObj);
  BEGIN
    WITH Queue^ DO BEGIN
      Queue [CameLastIn] := Event;
      Inc(CameLastIn);
      IF CameLastIn > MaxEvents THEN CameLastIn := 1;
           { Falls ein Überlauf stattgefunden hat, so wird }
           { wieder vorne angefangen, in die Queue einzu-  }
           { tragen, daher MaxEvents gross genug wählen,   }
           { damit keine Events überschrieben werden       }
    END;
  END;

  PROCEDURE EventHandlerObj.GetEvFromQueue
                                 (VAR Queue : EventQueuePtr;
                                  VAR Event : EventObj);
  BEGIN
    WITH Queue^ DO
      IF NextToCall=CameLastIn THEN BEGIN
        { noch kein Event, dann }
        Event.Time      := MaxLongInt;    { ungültige Zeit }
        Event.EventType := EvNoEv;        { und kein Event }
      END ELSE BEGIN
        Event := Queue [NextToCall];
        IF (NextToCall = MaxEvents) THEN
          NextToCall := 1
        ELSE
          Inc(NextToCall);
      END;
  END;

  PROCEDURE EventHandlerObj.PeekEvFromQueue
                                 (VAR Queue : EventQueuePtr;
                                  VAR Event : EventObj);
  BEGIN
    WITH Queue^ DO
      IF NextToCall = CameLastIn THEN BEGIN
        Event.Time      := MaxLongInt;
        Event.EventType := EvNoEv
      END ELSE
        Event := Queue [NextToCall]
  END;

  PROCEDURE EventHandlerObj.GetEvent(VAR Event : EventObj);
  VAR
    MouEvent, KeyEvent : EventObj;
  BEGIN
    REPEAT
      PeekEvFromQueue(MouQueue, MouEvent);
      PeekEvFromQueue(KeyQueue, KeyEvent);
    UNTIL (MouEvent.EventType <> EvNoEv) OR
          (KeyEvent.EventType <> EvNoEv);
    IF (KeyEvent.Time >= MouEvent.Time) THEN
      GetEvFromQueue(MouQueue, Event)
    ELSE
      GetEvFromQueue(KeyQueue, Event);
  END;

  PROCEDURE EventHandlerObj.PeekEvent(VAR Event : EventObj);
  VAR
    MouEvent, KeyEvent : EventObj;
  BEGIN
    PeekEvFromQueue(MouQueue, MouEvent);
    PeekEvFromQueue(KeyQueue, KeyEvent);
    IF (KeyEvent.Time >= MouEvent.Time) THEN
      Event := MouEvent
    ELSE
      Event := KeyEvent;
  END;

  PROCEDURE EventHandlerObj.WaitForEvent
                                     (WaitForEv : INTEGER;
                                      VAR Event : EventObj);
  VAR
    EvIndex  : BYTE;
  BEGIN
    REPEAT
      GetEvent(Event);
      EvIndex := GetEvIndex(Event.EventType);
      IF (HandlerTable[EvIndex].Call) THEN
        HandlerTable[EvIndex].Handler(Event)
    UNTIL (Event.EventType AND WaitForEv <> 0);
    Event := Event;
  END;

  FUNCTION EventHandlerObj.GetEvIndex
                                  (EventType : WORD) : BYTE;
  (* Liefert den Index, d.h. die Position eines Handlers  *)
  (* für "EventType" in einem Array "HandlerArray" zurück *)
  VAR
    i, Index : BYTE;
  BEGIN
    Index := 0;
    FOR i := 1 TO 9 DO
      IF EventType=IndexArray[i] THEN Index := i;
    GetEvIndex := Index;
  END;

  PROCEDURE EventHandlerObj.RegisterHandler
                   (Event : WORD; NewHandler : HandlerProc);
  (* Installiert Handler NewHandler für Eventart "Event". *)
  (* Die Abfragen sind notwendig, damit "NewHandler"      *)
  (* auch für alle Mausereignisse eingetragen wird.       *)
  VAR
    i : INTEGER;
  BEGIN
    IF (Event = EvMouAll) OR (Event = EvKeyAll) OR
       (Event = EvAll) THEN BEGIN
      IF (Event = EvMouAll) OR (Event = EvAll) THEN
        FOR i := 2 TO 6 DO
          WITH HandlerTable [i] DO BEGIN
            Handler := NewHandler;
            Call    := TRUE;
          END;
      IF (Event = EvKeyAll) OR (Event = EvAll) THEN
        FOR i := 7 TO 9 DO
          WITH HandlerTable [i] DO BEGIN
            Handler := NewHandler;
            Call    := TRUE
          END;
    END ELSE
      WITH HandlerTable [GetEvIndex (Event)] DO BEGIN
        Handler := NewHandler;
        Call := TRUE;
      END;
  END;

  PROCEDURE EventHandlerObj.DeRegisterHandler(Event : WORD);
  VAR
    i : INTEGER;
  BEGIN
    IF (Event = EvMouAll) OR (Event = EvKeyAll) OR
       (Event = EvAll) THEN BEGIN
      IF (Event = EvMouAll) OR (Event = EvAll) THEN
        FOR i := 2 TO 6 DO
          WITH HandlerTable[i] DO Call := FALSE;
      IF (Event = EvKeyAll) OR (Event = EvAll) THEN
        FOR i := 7 TO 7 DO
          WITH HandlerTable[i] DO Call := FALSE;
    END ELSE
      WITH HandlerTable[GetEvIndex(Event)] DO
        Call := FALSE
  END;

  DESTRUCTOR EventHandlerObj.Done;
  BEGIN
    IF MouQueue <> NIL THEN Dispose(MouQueue);
    IF KeyQueue <> NIL THEN Dispose(KeyQueue);
  END;

{F+}
  PROCEDURE MouKeyExit;
{$F-}
  (* Neue Exitprozedur, die den Speicher des Mausobjekts  *)
  (* wieder freigibt und verbogene Zeiger zurücksetzt.    *)
  VAR
    Regs : Registers;
  BEGIN
    SetIntVec($09, OldInt09);
    IF Mouse <> NIL THEN Mouse^.Done;
    Regs.AX := $00;                { Maushandler entfernen }
    Intr($33, Regs);
    IF EvHand <> NIL THEN EvHand^.Done;
    ExitProc := OldExitProc;
  END;

  PROCEDURE CallKeybHandler(Key : BYTE);
  (* Wird von dem Interruptersatz für Int 09hex aus       *)
  (* dem Assemblermodul heraus aufgerufen und ruft        *)
  (* ihrerseits "EvHand.KeybHandler".                     *)
  BEGIN
    EvHand^.KeybHandler(Key);
  END;

  PROCEDURE CallMouHandler(NF, NB, NX, NY : INTEGER);
  (* Wird von dem installierten Maushandler aus dem       *)
  (* Assemblermodul aufgerufen und startet den            *)
  (* Maushandler von "EvHand". Die Parameter werden       *)
  (* wegen der Gefahr eines Stacküberlaufs in globalen    *)
  (* Variablen gespeichert. Der Maushandler von "EvHand^" *)
  (* muß diese abfragen.                                  *)
  BEGIN
    NewButtons := NB;
    NewFlags   := NF;
    NewX       := NX;
    NewY       := NY;
    EvHand^.MouseHandler;
  END;

{$F+}
  FUNCTION HeapFunc(Size : WORD) : INTEGER;
{$F-}
  BEGIN
    HeapFunc := 1;
  END;

BEGIN
  HeapError := @HeapFunc;
  Mouse     := New(MouseObjPtr, Init);
  EvHand    := New(EventHandlerObjPtr, Init);
  IF (Mouse <> NIL) AND (EvHand <> NIL) THEN BEGIN
    OldExitProc := ExitProc;
    ExitProc    := @MouKeyExit;
    GetIntVec($09, OldInt09);
    SetIntVec($09, @NewKeybHandler);
  END;
END.
(* ------------------------------------------------------ *)
(*                Ende von MOUSEKEY.PAS                   *)