POINT Software Programming/PPROG1.ISO/pascal/visionix/vinu.pas

Pascal/Delphi Source File | 1993-12-28 | 21.7 KB | 1,350 lines

{
 ════════════════════════════════════════════════════════════════════════════

 Visionix Input Unit (VIN)
   Version 0.6
 Copyright 1991,92,93 Visionix
 ALL RIGHTS RESERVED

 ────────────────────────────────────────────────────────────────────────────

 Revision history in reverse chronological order:

 Initials  Date      Comment
 ────────  ────────  ────────────────────────────────────────────────────────

 lpg       03/15/93  Added Source Documentation

 mep       02/11/93  Cleaned up code for beta release

 jrt       02/08/93  Sync with beta 0.12 release

 jrt       12/07/92  Sync with beta 0.11 release

 jrt       11/21/92  Sync with beta 0.08

 jrt       09/01/92  First logged revision.

 ════════════════════════════════════════════════════════════════════════════

}


(*-

[TEXT]

<Overview>

The VINu unit implements the input functions for the VisionTools
text-stream input/output architecture.

The present implementation of VIN is an extremely simplified, one
channel, no sub-channel version of VOUT.  This unit has been rewritten
and will be replaced with the full multi-channel unit in the next
BETA release.

<Interface>

-*)


{$V-}

Unit VInu;

Interface

Uses

  VTypesu,
  VMultiu;

{────────────────────────────────────────────────────────────────────────────}

Const

  Key_Tab       = 9;
  Key_ESC       = 27;
  Key_CR        = 13;

  Key_ShiftTab  = 15;
  Key_PgDn      = 81;
  Key_PgUp      = 73;
  Key_Home      = 71;
  Key_End       = 79;
  Key_Down      = 80;
  Key_Up        = 72;
  Key_Right     = 77;
  Key_Left      = 75;

  Key_Ins       = 82;
  Key_Del       = 83;

  Key_F1        = 59;
  Key_F2        = 60;
  Key_F3        = 61;
  Key_F4        = 62;
  Key_F5        = 63;
  Key_F6        = 64;
  Key_F7        = 65;
  Key_F8        = 66;
  Key_F9        = 67;
  Key_F10       = 68;

  IDF_DriverNew      = 1;
  IDF_DriverOff      = 2;
  IDF_DriverOn       = 3;
  IDF_DriverDispose  = 4;
  IDF_Look           = 5;
  IDF_Read           = 6;
  IDF_Write          = 7;
  IDF_State          = 8;
  IDF_Flush          = 9;
  IDF_Pressed        = 10;

  IDS_Changed        = 1;
  IDS_Install        = 2;
  IDS_Sequence       = 4;

  KDP_New            = 1;
  KDP_Do             = 2;
  KDP_Dispose        = 3;

Type

  PInDriverPacket=^TInDriverPacket;

  TInDriverProc = Procedure( IDPacket : PInDriverPacket );

  TProcName = String[20];

  PProcName = ^TProcName;

  {----}

  TInDriverPacket = Record

    Func          : WORD;
    ID            : Pointer;
    InDriverProc  : TInDriverProc;
    SysKeyBuff    : Pointer;
    Name          : PProcName;
    DriverInfo    : Pointer;
    Key           : CHAR;
    State         : BYTE;
    KeysToWrite   : PString;
    Pressed       : BOOLEAN;

    Status        : WORD;

  End;

  PInDriverProc = ^TInDriverProc;

  {----}

  PInDriverList = ^TInDriverList;

  TInDriverList = Record

    Proc      : TInDriverProc;
    ID        : Pointer;
    Next      : PInDriverList;

  End;

  {----}


  TKeyProc = Procedure( Status     : BYTE;
                        Key1, Key2 : CHAR   );

  PKeyProcList = ^TKeyProcList;

  TKeyProcList = RECORD

    Key1       : CHAR;
    Key2       : CHAR;
    Proc       : TKeyProc;
    Name       : TProcName;
    ProcInfo   : Pointer;
    Off        : WORD;
    Next       : PKeyProcList;

  END;

  {----}

  TInDriverIData = Record

    KeyBuff : PString;
    Off     : WORD;
    Name    : TProcName;

  END;

  PInDriverIData = ^TInDriverIData;

  {----}

{────────────────────────────────────────────────────────────────────────────}

Procedure VInDriverNew(              Proc        : TInDriverProc;
                                     Name        : TProcName;
                                     DriverInfo  : Pointer;
                                 Var Err         : WORD       );

Procedure VInDriverOff(              Name        : TProcName  );

Procedure VInDriverOn(               Name        : TProcName  );

Procedure VInDriverDispose(          Name        : TProcName  );

Function  VInLook    : CHAR;

Function  VInRead    : CHAR;

Function  VInState   : BYTE;

Procedure VInWrite( Keys : String );

Function  VInPressed : BOOLEAN;

Procedure VInFlush;

Procedure VKeyProcNew(                Key1        : CHAR;
                                      Key2        : CHAR;
                                      Proc        : TKeyProc;
                                      Name        : TProcName;
                                      ProcInfo    : Pointer;
                                  Var Err         : WORD       );

Procedure VKeyProcOff(                Name        : TProcName  );

Procedure VKeyProcOn(                 Name        : TProcName  );

Procedure VKeyProcDispose(            Name        : TProcName  );

{Procedure DefaultInDriverProc( IDP : PInDriverPacket );}

{────────────────────────────────────────────────────────────────────────────}

Implementation

Type

  TDefKdInstanceData = Record

    KeyBuff : PString;
    Off     : WORD;
    Name    : TProcName;

  END;

  PDefKDInstanceData = ^TDefKDInstanceData;

  TChanInfo = Record

    IDP              : TInDriverPacket;

    KeyBuff          : String;

    InDriverListHead : PInDriverList;
    InDriverListTail : PInDriverList;
    InDriverListCurr : Array[1..20] of PInDriverList;

    KeyProcList      : PKeyProcList;

  END;

Var

  C : TChanInfo;

{────────────────────────────────────────────────────────────────────────────}

(*
Procedure DefaultInDriverProc( IDP : PInDriverPacket );

Var

   KeyBufHead : INTEGER absolute $0000:$041A;
   KeyBufTail : INTEGER absolute $0000:$041C;

   IData      : PDefKDInstanceData;

BEGIN

  IData := IDP^.ID;

  If IDP^.Status = 0 Then
  BEGIN

    Case IDP^.Func Of

      IDF_DriverNew:
      BEGIN

        IF @IDP^.InDriverProc = @DefaultInDriverProc Then
        BEGIN

          New( Idata );

          IData^.Name    := IDP^.Name^;
          IData^.KeyBuff := IDP^.SysKeyBuff;
          IData^.Off     := 0;

          IDP^.Status := IDS_Install+IDS_Changed;

          IDP^.ID := IData;

        END;

      END;

      {----}

      IDF_DriverOff:
      BEGIN

        If IDP^.Name^ = IData^.Name Then
        BEGIN

          Inc( Idata^.Off );

        END;

      END;

      {----}

      IDF_DriverOn:
      BEGIN

        If IDP^.Name^ = IData^.Name Then
        BEGIN

          If Idata^.Off <> 0 Then
            Dec( Idata^.Off );

        END;

      END;

      {----}

      IDF_DriverDispose:
      BEGIN

        If IDP^.Name^ = IData^.Name Then
        BEGIN

          {RemoveFromInDriverStack }

          Dispose( IData );

        END;

      END;

      {----}

      IDF_Look:
      If IData^.Off=0 Then
      BEGIN

        If Idata^.KeyBuff^<>'' Then
        BEGIN

          IDP^.Key := IData^.KeyBuff^[1];

          IDP^.Status := IDS_Changed;

        END
        Else
        BEGIN

          If KeyPressed Then
          BEGIN

            IDP^.Key := ReadKey;

            IData^.KeyBuff^ := IData^.KeyBuff^ + IDP^.Key;

            IDP^.Status := IDS_Changed;

          END;

        END;

      END;

      {----}

      IDF_Read:
      If IData^.Off=0 Then
      BEGIN

        If IData^.KeyBuff^<>'' Then
        BEGIN

          IDP^.Key := IData^.KeyBuff^[1];

          Delete( IData^.KeyBuff^, 1, 1 );

          IDP^.Status := IDS_Changed;

          If IDP^.Key=#0 Then
            IDP^.Status := IDP^.Status + IDS_Sequence;

        END
        Else
        BEGIN

          If KeyPressed Then
          BEGIN

            IDP^.Key := ReadKey;

            IDP^.Status := IDS_Changed;

            If IDP^.Key = #0 Then
              IDP^.Status := IDP^.Status + IDS_Sequence;

          END;

        END;

      END;

      {----}

      IDF_Write:
      BEGIN

        IData^.KeyBuff^ := IData^.KeyBuff^ + IDP^.KeysToWrite^;

        IDP^.Status := IDS_Changed;

      END;

      {----}

      IDF_State:
      BEGIN

        { Read Shift/Ctrl/Alt State }

      END;

      {----}

      IDF_Flush:
      IF Idata^.Off=0 Then
      BEGIN

        IData^.KeyBuff^ := '';

        KeyBufTail := KeyBufHead;

        IDP^.Status := IDS_Changed;

      END;

      {----}

      IDF_Pressed:
      IF IData^.Off=0 Then
      BEGIN

        IDP^.Pressed := ( KeyPressed ) Or ( IData^.KeyBuff^[0]<>#0 );

        If IDP^.Pressed=TRUE Then
          IDP^.Status := IDS_Changed;

      END;

    Else { Case Func Of }

    END;

  END; { If IDP^.Status = 0 }

END;

*)

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure CallInDrivers(          IDP       : PInDriverPacket );

[PARAMETERS]

IDP         Pointer to In-Data Driver Packet

[RETURNS]

(None)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure CallInDrivers(          IDP       : PInDriverPacket );

Var

  KDN           : PInDriverList;

  NextCurrProc  : PInDriverList;


BEGIN

  KDN := C.InDriverListCurr[ IDP^.Func ];

  NextCurrProc := C.InDriverListCurr[ IDP^.Func ]^.Next;

  IDP^.Status := 0;

  If KDN<>NIL Then
  BEGIN

    Repeat

      IDP^.ID := KDN^.ID;

      KDN^.Proc( IDP );

      If IDP^.Status and IDS_Sequence>0 Then
      BEGIN

        NextCurrProc := KDN;
        IDP^.Status  := IDP^.Status - IDS_Sequence;

      END;

      KDN := KDN^.Next;

    Until KDN=C.InDriverListCurr[ IDP^.Func ];

    C.InDriverListCurr[ IDP^.Func ] := NextCurrProc;

  END;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure VInDriverNew(              Proc        : TInDriverProc;
                                     Name        : TProcName;
                                     DriverInfo  : Pointer;
                                 Var Err         : WORD       );

[PARAMETERS]

Proc        ?
Name        ?
DriverInfo  ?
Err         VAR Returned ?

[RETURNS]

Function : None
(VAR     : [Err] ?)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure VInDriverNew(              Proc        : TInDriverProc;
                                     Name        : TProcName;
                                     DriverInfo  : Pointer;
                                 Var Err         : WORD       );

Var

  DLN : PInDriverList;
  Z   : INTEGER;

BEGIN

  With C Do
  BEGIN

    {-----------------------------------}
    { Build the InDriverPacket for the }
    { "New" function                    }
    {-----------------------------------}

    IDP.Func          := IDF_DriverNew;

    IDP.ID            := NIL;
    IDP.InDriverProc  := Proc;
    IDP.Name          := @Name;
    IDP.DriverInfo    := DriverInfo;
    IDP.SysKeyBuff    := @C.KeyBuff;
    IDP.Status        := 0;

    { call da oder drivers }

    {---------------------------}
    { Call the "New" In Driver }
    {---------------------------}

    Proc( @IDP );

    {---------------------------------------}
    { Was the InDriverPacket returned with }
    { the install bit set?                  }
    {---------------------------------------}

    If IDP.Status and IDS_Install <>0 Then
    BEGIN

      {---------------------------------}
      { Create a new InDriverList node }
      {---------------------------------}

      New( DLN );

      {-------------------------------}
      { Is this the first In driver? }
      {-------------------------------}

      If C.InDriverListHead = NIL Then
      BEGIN

        C.InDriverListHead := DLN;
        C.InDriverListTail := DLN;

        For Z := 1 to 20 Do
          C.InDriverListCurr[ Z ] := DLN;

      END;

      {-----------------------}
      { Fill out the new node }
      {-----------------------}

      DLN^.Proc := Proc;
      DLN^.ID   := IDP.ID;
      DLN^.Next := C.InDriverListHead;

      {---------------------------------}
      { and put it in the InDriverList }
      {---------------------------------}

      C.InDriverListTail^.Next := DLN;

      C.InDriverListTail := DLN;

    END; { If IDP^.Status = Install }

  END; { With C }

END; { Procedure }

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure VInDriverOff(              Name        : TProcName  );

[PARAMETERS]

Name        ?

[RETURNS]

(None)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure VInDriverOff(              Name        : TProcName  );

BEGIN

  With C Do
  BEGIN

    IDP.Func := IDF_DriverOff;
    IDP.Name := @Name;

    CallInDrivers( @IDP );

  END;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure VInDriverOn(               Name        : TProcName  );

[PARAMETERS]

Name        ?

[RETURNS]

(None)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure VInDriverOn(               Name        : TProcName  );

BEGIN

  With C Do
  BEGIN

    IDP.Func := IDF_DriverOn;
    IDP.Name := @Name;

    CallInDrivers( @IDP );

  END;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure VInDriverDispose(          Name        : TProcName  );

[PARAMETERS]

Name        ?

[RETURNS]

(None)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure VInDriverDispose(          Name        : TProcName  );

BEGIN

  With C Do
  BEGIN

    IDP.Func := IDF_DriverDispose;
    IDP.Name := @Name;

    CallInDrivers( @IDP );

  END;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  VInLook                                            : CHAR;

[PARAMETERS]

(None)

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function  VInLook                                            : CHAR;

BEGIN

  With C Do
  BEGIN

    IDP.Func := IDF_Look;

    CallInDrivers( @IDP );

    VInLook := IDP.Key;

    VMultiDo( 0 );

  END;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function CallKeyProcList(         Key1      : CHAR;
                                  Key2      : CHAR           ) : BOOLEAN;

[PARAMETERS]

Key1        ?
Key2        ?

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function CallKeyProcList(         Key1      : CHAR;
                                  Key2      : CHAR           ) : BOOLEAN;

Var

  KDPN      : PKeyProcList;

  CalledOne : BOOLEAN;

BEGIN

  CalledOne := FALSE;

  KDPN := C.KeyProcList;

  While KDPN<>NIL Do
  BEGIN

    If (KDPN^.Off = 0  )   and
       (KDPN^.Key1=Key1) and
       ( (Key1<>#0) or (KDPN^.Key2=Key2) ) Then
    BEGIN

      KDPN^.Proc( KDP_Do, Key1, Key2 );

      CalledOne := TRUE;

    END; { If kdpn^.off = 0, etc... etc...  }

    KDPN := KDPN^.Next;

  END;

  CallKeyProcList := CalledOne;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  VInRead                                            : CHAR;

[PARAMETERS]

(None)

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function  VInRead                                            : CHAR;

Var

  S : String[5];

  ZDP : TInDriverPacket;

BEGIN

  With C Do
  BEGIN

    Repeat

      ZDP.Func := IDF_Read;

      Repeat

        CallInDrivers( @ZDP );

        VMultiDo( 0 );

      Until (ZDP.Status and IDS_Changed >0 );

      If ZDP.Key=#0 Then
      BEGIN

        Repeat

          CallInDrivers( @ZDP );
          VMultiDo( 0 );

        Until (ZDP.Status and IDS_Changed>0 );


        If CallKeyProcList( #0, ZDP.Key )=FALSE Then
        BEGIN

          ZDP.Func        := IDF_Write;
          S               := ZDP.Key;

          ZDP.KeysToWrite := @S;

          CallInDrivers( @ZDP );

          ZDP.Key        := #0;

        END;  { If CallKeyProcList }

      END  { If ZDP.Key }

      Else
      BEGIN

        If CallKeyProcList( ZDP.Key, #0 )=TRUE Then
        BEGIN

          ZDP.Key := #255;

        END  { If CallKeyProcList }

        ELSE
        BEGIN


        END;  { If CallKeyProcList / Else }

      END; { If IDP.Key=#0 }

    Until ZDP.Key<>#255;

    VInRead := ZDP.Key;

    { Call Key procs here }

  END;  { With C }

END;  { VInRead }

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  VInState                                           : BYTE;

[PARAMETERS]

(None)

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function  VInState                                           : BYTE;

BEGIN

  With C Do
  BEGIN

    IDP.Func := IDF_State;

    CallInDrivers( @IDP );

    VInState := IDP.State;

  END;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure VInWrite( Keys : String );

[PARAMETERS]

Keys        ?

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure VInWrite( Keys : String );

BEGIN

  With C Do
  BEGIN

    IDP.Func        := IDF_Write;
    IDP.KeysToWrite := @Keys;

    CallInDrivers( @IDP );

  END;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  VInPressed                                         : BOOLEAN;

[PARAMETERS]

(None)

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function  VInPressed                                         : BOOLEAN;

BEGIN

  With C Do
  BEGIN

    IDP.Func    := IDF_Pressed;
    IDP.Pressed := FALSE;

    CallInDrivers( @IDP );

    VInPressed := IDP.Pressed;

    VMultiDo( 0 );

  END;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure VInFlush;

[PARAMETERS]

(None)

[RETURNS]

(None)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure VInFlush;

BEGIN

  With C Do
  BEGIN

    IDP.Func := IDF_Flush;

    CallInDrivers( @IDP );

  END;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure VKeyProcNew(                Key1        : CHAR;
                                      Key2        : CHAR;
                                      Proc        : TKeyProc;
                                      Name        : TProcName;
                                      ProcInfo    : Pointer;
                                  Var Err         : WORD       );

[PARAMETERS]

Key1        ?
Key2        ?
Proc        ?
Name        ?
ProcInfo    ?
Err         VAR Returned ?

[RETURNS]

Function : None
(VAR     : [Err] ?)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure VKeyProcNew(                Key1        : CHAR;
                                      Key2        : CHAR;
                                      Proc        : TKeyProc;
                                      Name        : TProcName;
                                      ProcInfo    : Pointer;
                                  Var Err         : WORD       );

Var

  KPN : PKeyProcList;

BEGIN

  New( KPN );

  KPN^.Key1     := Key1;
  KPN^.Key2     := Key2;
  KPN^.Proc     := Proc;
  KPN^.Name     := Name;
  KPN^.ProcInfo := ProcInfo;
  KPN^.Off      := 0;

  KPN^.Next := C.KeyProcList;

  C.KeyProcList := KPN;

  Proc( KDP_New, Key1, Key2 );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure VKeyProcOff(                Name        : TProcName  );

[PARAMETERS]

Name        ?

[RETURNS]

(None)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure VKeyProcOff(                Name        : TProcName  );

Var

  KPN : PKeyProcList;

BEGIN

  KPN := C.KeyProcList;

  While (KPN<>NIL) and (KPN^.Name<>Name ) Do
    KPN := KPN^.Next;

  If KPN<>NIL Then
  BEGIN

    Inc( KPN^.Off );

  END;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure VKeyProcOn(                 Name        : TProcName  );

[PARAMETERS]

Name        ?

[RETURNS]

(None)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure VKeyProcOn(                 Name        : TProcName  );

Var

  KPN : PKeyProcList;

BEGIN

  KPN := C.KeyProcList;

  While (KPN<>NIL) and (KPN^.Name<>Name ) Do
    KPN := KPN^.Next;

  If KPN<>NIL Then
  BEGIN

    If KPN^.Off >0 Then
      Dec( KPN^.Off );

  END;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure VKeyProcDispose(            Name        : TProcName  );

[PARAMETERS]

Name        ?

[RETURNS]

(None)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure VKeyProcDispose(            Name        : TProcName  );

BEGIN

END;

{────────────────────────────────────────────────────────────────────────────}
{────────────────────────────────────────────────────────────────────────────}
{────────────────────────────────────────────────────────────────────────────}

BEGIN

  C.KeyBuff             := '';

  C.InDriverListHead    := NIL;
  C.InDriverListTail    := NIL;
  C.InDriverListCurr[1] := NIL;

  C.KeyProcList         := NIL;

END.