Turbo Toolbox/Turbo_Toolbox.iso/spezial/22/events/moukey.pas

Pascal/Delphi Source File | 1991-01-04 | 19.4 KB | 571 lines

(* ----------------------------------------------------- *)
(*                      MOUKEY.PAS                       *)
(* Datenobjekte:                                         *)
(*  ■ EventObj: Beschreibt ein beliebiges Event.         *)
(*  ■ EventQueue: Verwaltet einen Array von "EventObj"'s *)
(*    nach dem Überlaufprinzip: Wenn der Array voll ist, *)
(*    wird wieder vorne angefangen zu überschreiben.     *)
(*  ■ HandlerObj: Enthält Zeiger auf Handler-Prozedur.   *)
(*                                                       *)
(* ■ EventHandlerObj: Verwaltet alle hereinkommenden Er- *)
(*   eignisse. Die Unit stellt die einzige Instanze      *)
(*   dieses Objekts zur Verfügung; Init und Done sollten *)
(*   nicht aufgerufen werden, es sei den beim Aufruf von *)
(*   ReInstall (siehe Demo). "TakeOut" sollte FALSE sein,*)
(*   wenn Turbo's Eingabeprozeduren benutzt werden, und  *)
(*   TRUE, wenn Ereignisse mit "EvHand" bearbeitet werden*)
(*                                                       *)
(*           (c) 1991 by R.Reichert & toolbox            *)
(* ----------------------------------------------------- *)
UNIT MouKey;

INTERFACE

USES Dos, UBase, UMouse;

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 von den einzelnen   }
  LeftShift   = 2;         { Statustasten zur Abfrage auf }
  Ctrl        = 4;         { deren Zustand                }
  Alt         = 8;
  ScrollLock  = 16;
  NumLock     = 32;
  CapsLock    = 64;
  Insert      = 128;

TYPE
  EventObj = OBJECT
    Time : LONGINT;                { Zeitpunkt des Events }
    EventType : WORD;              { Art des Events       }
                           { mit den dazugehörigen Daten: }
    x, y,
    Buttons : INTEGER;             { für EvMouAll         }
    Key     : WORD;                { für EvKeyPressed     }
    ScanCode,
    State   : BYTE;                { für EvKeyUnknown     }
    StateKey: BYTE                 { für EvKeyState       }
  END;
  EventObjArray = ARRAY [1..MaxEvents] OF EventObj;

  EventQueuePtr = ^EventQueue;
  EventQueue    = OBJECT
    NextToCall,              { nächst aufzurufendes Event }
    CameLastIn : INTEGER;    { letzt eingetroffenes Event }
    Queue : EventObjArray;   { die Events                 }
  END;
                   { der Typ einer EventHandler-Prozedur: }
  HandlerProc = PROCEDURE (VAR Event : EventObj);
  HandlerObj = OBJECT
    Installed : BOOLEAN;            { Prozedur aufrufen ? }
    Handler   : HandlerProc;    { Adresse der HandlerProz }
  END;
  HandlerArray= ARRAY [1..16] OF HandlerObj;

  EventHandlerObjPtr = ^EventHandlerObj;
  EventHandlerObj    = OBJECT (Base)

    MouQueue : EventQueuePtr;   { Warteschlange der Maus- }
    KeyQueue : EventQueuePtr;   { und Tastaturevents      }
    TakeOut,             { aus Tastaturpuffer entfernen ? }
    TextModus: BOOLEAN;                  { im Textmodus ? }
    AktState,                            { Tastaturstatus }
    AktMouX,                          { akt. Mausposition }
    AktMouY  : BYTE;
    HandlerTable : HandlerArray;      { Tab. mit Handlern }

    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;
    PROCEDURE RegisterHandler
      (Event : WORD; NewHandler : HandlerProc);    VIRTUAL;
    PROCEDURE DeRegisterHandler (Event : WORD);    VIRTUAL;
    PROCEDURE SetTakeOut (T : BOOLEAN);            VIRTUAL;

    FUNCTION GetEvIndex (EventType : WORD) : BYTE; VIRTUAL;
    FUNCTION GetTakeOut : BOOLEAN;                 VIRTUAL;
    FUNCTION KeyState : BYTE;                      VIRTUAL;
    FUNCTION MouPressed (Ev : EventObj) : BOOLEAN; VIRTUAL;
    FUNCTION MouReleased (Ev: EventObj) : BOOLEAN; VIRTUAL;
    DESTRUCTOR Done;                               VIRTUAL;
  END;

PROCEDURE DeInstall;
  (* Löst Eventhandler "EvHand" und "Mouse" auf. Danach  *)
  (* EvHand und Mouse nicht mehr benutzen !              *)

PROCEDURE DeInstallMouse;
PROCEDURE ReInstallMouse (NewMouse : MouseObjPtr);

PROCEDURE ReInstall (NewHandler : EventHandlerObjPtr);
  (* Installiert neuen Eventhandler.                     *)
  (* Zweck dieser vier Prozeduren ist, dass sie, kom-    *)
  (* biniert angewendet, es ermöglichen, einen Nachkommen*)
  (* von EventHandlerObj und/oder MouseObj zu benutzen.  *)
  (* Sie sollten in der hier aufgeführten Reihenfolge    *)
  (* aufgerufen werden ! (siehe auch Demo)               *)


VAR       { öffentlich: Ein Maus- und ein EventHandlerObj }
  Mouse : MouseObjPtr;     { ACHTUNG: Kon- bzw Destruktor }
  EvHand: EventHandlerObjPtr;      { NICHT aufrufen !     }

IMPLEMENTATION

{$L MouKeyAs}

{$F+} PROCEDURE NewMouHandler;  EXTERNAL; {$F-}
  { wird vom Mausinterrupt aufgerufen }

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


VAR
  KeybState : BYTE ABSOLUTE $40:$17;     { Tastaturstatus }
  BiosTime  : LONGINT ABSOLUTE $40:$6C;  { Zeit in Ticks  }
  OldInt09,               { zum Sichern der alten Adresse }
  OldExitProc : POINTER;                           { dito }
  NewFlags,       { Die New... werden gesetzt, sobald ein }
  NewButtons,     { Mausereignis eintrifft. Nicht als Pa- }
  NewX,           { rameter, da dabei die Gefahr eines    }
  NewY : INTEGER; { "Stack Overflow" besteht.             }
  Installed : BOOLEAN;           { "EvHand" installiert ? }

(* ----------------------------------------------------- *)
(* Initialisiert EventHandlerObj. ACHTUNG: Nur in Ver-   *)
(* bindung mit ReInstall aufrufen !                      *)
(* ----------------------------------------------------- *)
CONSTRUCTOR EventHandlerObj.Init;
  VAR Regs : Registers;
      i    : BYTE;
BEGIN
  New (MouQueue);       { anlegen der "Ereignisschlangen" }
  New (KeyQueue);
  IF (MouQueue=NIL) OR
     (KeyQueue=NIL) THEN Fail;       { auch kein Fehler ? }
  WITH MouQueue^ DO BEGIN
    NextToCall := 1;  CameLastIn := 1;
  END;
  WITH KeyQueue^ DO BEGIN
    NextToCall := 1;  CameLastIn := 1;
  END;
  TextModus := TRUE;
  TakeOut   := FALSE;
  AktState := KeybState;      { Tastaturstatus festhalten }
  FOR i := 1 TO 16 DO          { kein Handler installiert }
    HandlerTable [i].Installed := FALSE;
  IF Mouse^.Avail THEN BEGIN
    AktMouX := Mouse^.GetX;
    AktMouY := Mouse^.GetY;
    Regs.AX := $C;        { Funktion Handler installieren }
    Regs.CX := EvMouAll;       { für jegl. Mausereignisse }
    Regs.DX := Ofs (NewMouHandler);
    Regs.ES := Seg (NewMouHandler);
    Intr ($33, Regs);
  END;
END;

PROCEDURE EventHandlerObj.KeybHandler (Key : BYTE);
  VAR
    Event : EventObj;
    Regs  : Registers;
    Quit  : BOOLEAN;
    NewKbState : BYTE;
BEGIN
  Quit := TRUE;
  REPEAT
    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
        Regs.AH := $10;
        Intr ($16, Regs);
      END ELSE BEGIN
        Regs.AH := $11;
        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             { Make-Code ? }
          Event.EventType := EvKeyUnknown;
          Event.ScanCode  := Key;
          Event.State     := NewKbState;
          PutEvInQueue (KeyQueue, Event);
        END;
      END;
      AktState := NewKbState      { neuen Status behalten }
    END;

    IF (TakeOut) AND
       (Event.EventType<>EvKeyState) THEN
      Quit := (Mem [$40:$1A] = Mem [$40:$1C]);

    { Diese Abfrage dient dazu, sicherzustellen, dass
      alle Tastendrücke (bei zu langer Betätigung mit er-
      höhter Wiederholfrequenz) abgearbeitet werden.      }

  UNTIL Quit;
END;

PROCEDURE EventHandlerObj.MouseHandler;
  VAR
    Event : EventObj;
    i,Mask: INTEGER;
BEGIN
  WITH Event DO BEGIN
    Time := BiosTime;
    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);          { in Queue }
    END;
    Mask := Mask SHL 1;
  END;
  AktMouX := Event.X;  AktMouY := Event.Y;
END;

PROCEDURE EventHandlerObj.PutEvInQueue
                            (Queue : EventQueuePtr;
                             Event : EventObj);
BEGIN
  WITH Queue^ DO BEGIN
    Queue [CameLastIn] := Event;
    Inc (CameLastIn);
    IF CameLastIn>MaxEvents THEN
      CameLastIn := 1;
  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 zurück }
    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;

(* ----------------------------------------------------- *)
(* Gibt nächstes aufzurufendes Event zurück und entfernt *)
(* es aus der entsprechenden Queue.                      *)
(* ----------------------------------------------------- *)
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;

(* ----------------------------------------------------- *)
(* Gibt nächstes aufzurufendes Event zurück, belässt es  *)
(* aber in der entsprechenden Queue.                     *)
(* ----------------------------------------------------- *)
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;

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

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

(* ----------------------------------------------------- *)
(* Installiert Handler NewHandler für Eventart Event.    *)
(* Die furchtbar aussehenden Abfragen sind notwendig     *)
(* damit NewHandler, falls Handler z.B. EvMouAll ist     *)
(* auch für alle Mausereignisse eingetragen wird.        *)
(* ----------------------------------------------------- *)
PROCEDURE EventHandlerObj.RegisterHandler
            (Event : WORD; NewHandler : HandlerProc);
  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;  Installed := TRUE;
        END;
    IF (Event=EvKeyAll) OR (Event=EvAll) THEN
      FOR i := 7 TO 9 DO
        WITH HandlerTable [i] DO BEGIN
          Handler := NewHandler;  Installed := TRUE;
        END;
  END ELSE
    WITH HandlerTable [GetEvIndex (Event)] DO BEGIN
      Handler := NewHandler;  Installed := 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
          Installed := FALSE;
    IF (Event=EvKeyAll) OR (Event=EvAll) THEN
      FOR i := 7 TO 7 DO
        WITH HandlerTable [i] DO
          Installed := FALSE;
  END ELSE
    WITH HandlerTable [GetEvIndex (Event)] DO
      Installed := FALSE;
END;

PROCEDURE EventHandlerObj.SetTakeOut (T : BOOLEAN);
BEGIN
  TakeOut := t;
END;

FUNCTION EventHandlerObj.GetTakeOut : BOOLEAN;
BEGIN
  GetTakeOut := TakeOut;
END;

FUNCTION EventHandlerObj.KeyState : BYTE;
BEGIN
  KeyState := AktState;
END;

FUNCTION EventHandlerObj.MouPressed (Ev:EventObj): BOOLEAN;
BEGIN
  MouPressed := (Ev.EventType=EvLeftPress) OR
                (Ev.EventType=EvRightPress);
END;

FUNCTION EventHandlerObj.MouReleased (Ev:EventObj):BOOLEAN;
BEGIN
  MouReleased := ((Ev.EventType=EvLeftRel) OR
                  (Ev.EventType=EvRightRel)) AND
                 (Ev.Buttons=0);
END;

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

(* ----------------------------------------------------- *)
(* Neue Exitprozedur, die den Speicher der Objekte frei- *)
(* gibt und die ein verbogenen Zeiger wieder aufstellt.  *)
(* ----------------------------------------------------- *)
{$F+}              PROCEDURE MouKeyExit;              {$F-}
  VAR Regs : Registers;
BEGIN
  SetIntVec ($09, OldInt09);
  Regs.AX := $00;      { kein Maushandler mehr installiert }
  Intr ($33, Regs);
  IF Mouse<>NIL THEN  Dispose (Mouse, Done);
  IF EvHand<>NIL THEN Dispose (EvHand, Done);
  ExitProc := OldExitProc;
END;

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

(* ----------------------------------------------------- *)
(* Wird von dem installierten Maushandler aus dem        *)
(* Assemblermodul aufgerufen und ruft den Maushandler von*)
(* EvHand  auf.                                          *)
(* ----------------------------------------------------- *)
PROCEDURE CallMouHandler (NF, NB, NX, NY : INTEGER);
BEGIN
  IF Installed THEN BEGIN
    NewButtons := NB;    NewFlags := NF;
    NewX := NX;          NewY := NY;
    EvHand^.MouseHandler;
  END;
END;

(* ----------------------------------------------------- *)
(*       Die vier öffentlich-nicht-objektorientierten    *)
(*                       Prozeduren.                     *)
(* ----------------------------------------------------- *)
PROCEDURE DeInstall;
BEGIN
  Dispose (EvHand, Done);
  EvHand := NIL;  Installed := FALSE;
END;

PROCEDURE DeInstallMouse;
BEGIN
  IF NOT Installed THEN BEGIN
    Dispose (Mouse, Done);
    Mouse := NIL;
  END;
END;

PROCEDURE ReInstallMouse (NewMouse : MouseObjPtr);
BEGIN
  IF (Mouse=NIL) AND (NewMouse<>NIL) THEN
    Mouse := NewMouse;
END;

PROCEDURE ReInstall (NewHandler : EventHandlerObjPtr);
BEGIN
  IF (EvHand=NIL) AND
     (NewHandler<>NIL) AND
     (Mouse<>NIL) THEN BEGIN
    EvHand := NewHandler;  Installed := TRUE;
  END;
END;

(* ----------------------------------------------------- *)
(* Initteil der Unit: Mouse und EvHand anlegen, ExitProc *)
(* umbiegen, Interruptadressen speichern und eigene      *)
(* Handler installieren.                                 *)
(* ----------------------------------------------------- *)
BEGIN
  Installed := FALSE;
  Mouse     := New (MouseObjPtr, Init);
  EvHand    := New (EventHandlerObjPtr, Init);
  Installed := (Mouse<>NIL) AND (EvHand<>NIL);
  IF Installed THEN BEGIN
    OldExitProc := ExitProc;
    ExitProc    := @MouKeyExit;
    GetIntVec ($09, OldInt09);
    SetIntVec ($09, @NewKeybHandler);
  END;
END.
(* ----------------------------------------------------- *)
(*                 Ende von MouKey.Pas                   *)
(* ----------------------------------------------------- *)