Beijing Paradise BBS Backup/PARADISE.ISO/software/BBSDOORW/RADOOR30.ZIP/FOSSIL.PAS

Pascal/Delphi Source File | 1994-04-10 | 40.2 KB | 1,391 lines

{╔═════════════════════════════════════════════════════════════════════════╗
 ║                                                                         ║
 ║                   (c) CopyRight LiveSystems 1990, 1994                  ║
 ║                                                                         ║
 ║ Author    : Gerhard Hoogterp                                            ║
 ║ FidoNet   : 2:282/100.5   2:283/7.33                                    ║
 ║ BitNet    : [e-mail]                                     ║
 ║                                                                         ║
 ║ SnailMail : Kremersmaten 108                                            ║
 ║             7511 LC Enschede                                            ║
 ║             The Netherlands                                             ║
 ║                                                                         ║
 ║        This module is part of the RADoor BBS doorwriters toolbox.       ║
 ║                                                                         ║
 ╚═════════════════════════════════════════════════════════════════════════╝}
{---------------------------------------------------------------------------|

 Description:

 The fossil unit handles ALL the input/output and timing needed for an door.
 This includes local and remote I/O, putting the StatusLine on screen,
 Checking for SysOp keys, User TimeOut management, Total time online
 management, Carrier watchdogging etc. It's the most important unit
 in the RADoor toolbox, and includes userhooks for output filtering,
 SysOp Keys handling, the statusline. You can redefine the strings
 send to the user as warning for timeout, LockOut, HangUp etc.

 See the documentation for a complete description.



 The compiler directives.

  Sorry, you can only use them if you have the sourcecode. See the docu
  for more info on how to get it..

  CheckTimeOut     Enables/disables the usage of the TimeOut,
                   TotalTimeAvailable, and the reaction on the
                   GlobalInfo.OnlineStatus. All these functions
                   are performed while checking the time.

  CheckCarrier     Enables/disables the watchdog functions and the showing
                   of the StatusLine. (The Statusline is updated every
                   minute while checking the CARRIER.

  UseDRIVERunit    Enables/disables the usage of the Driver unit. This
                   means that local output is send to a special
                   ANSI text-file (to remain the ability to use the
                   CRT functions!) The internal local ANSI/AVT0+/ANSIMusic
                   handling is disabled
                   B.t.w. This also means that a clearscreen clears the
                   WHOLE Screen! Including status line!

  MakeDVAwear      Enables/disables the usage of DesqView calls to give
                   back timeslices while waiting for userinput during
                   the AskKey and ReadLnF routines. Timeslices are also
                   returned when the output buffer is full.

|---------------------------------------------------------------------------}
{$Define CheckTimeOut}    { Enables/disables Timeout checking               }
{$Define CheckCarrier}    { Enables/disables Internal carrier checking      }
{$Define UseDRIVERunit}   { Enables/disables the usage of the DRIVER unit   }
{$Define MakeDVAwear}     { Enables/disables the usage of the Desqview unit }

Unit Fossil;
Interface
Uses Dos,
     CRT,

     GlobInfo,  { Global information on the System }

     {$IfDef MakeDVAwear}
        DesqView,  { Desqview support procedures }
     {$EndIf}

     {$IfDef UseDriverUnit}
       Driver,     { Local ANSI, AVT/0+, AnsiMusic}
     {$EndIf}

     Timer,
     LowLevel,     { LowLevel procedures and functions }
     KeyDefs;      { Keyboard definitions }


{----------------------------------------------------------------------------|
 The input filter type and some predefined constates for the ReadLnF
 procedure.
|----------------------------------------------------------------------------}

Type  InpFilterType = Set Of Char;

Const FileCharSet      = [' '..'~'] - [' ',',','=','+','<','>','|','"','[',']'];
      NumCharSet       = ['0'..'9','-','+'];
      RealCharSet      = NumCharSet + ['.','E','e'];
      AllCharSet       = [' '..#254];
      PhoneCharSet     = ['0'..'9','-'];
      USAPhoneCharSet  = ['0'..'9','(',')',' '];

{----------------------------------------------------------------------------|
  The default strings for the PressEnterOrStop procedure and the
  PressEnter procedure.
|----------------------------------------------------------------------------}
      UsedStopKey : Char = 'S';

      PressEnterOrStopString : String =
         'Press [ENTER] to continue, [S] to stop: ';

      PressEnterString : String =
         'Press [ENTER] to continue: ';

{----------------------------------------------------------------------------|
  The default values for the warning, hangup, lockout etc. strings
|----------------------------------------------------------------------------}

{$IfDef CheckTimeOut}

      Warning1String   : String[80] =
         #13#10'--- Warning, you have only 2 minutes left.';

      Warning2String   : String[80] =
         #13#10'--- Warning, you have only 1 minute left.';

      TimeUpString     : String[80] =
         #13#10'--- You reached your daily limit.';

      AttentionString  : String[20] =
         'Hello???';

      LockOutString    : String[80] =
         #13#10'--- You have been locked out of the system. Don''t call back...';

      HangUpString     : String[80] =
         #13#10'--- The SysOp threw you out..';

{$EndIf}

{----------------------------------------------------------------------------|
  KeyString is the type for a list of keys used by the AskKey function
|----------------------------------------------------------------------------}

Type KeysString       = String[40];

{----------------------------------------------------------------------------|
  The userhook types.
|----------------------------------------------------------------------------}

     OutputFilterType = Procedure(Var InStr : String);
     SysopKeyType     = Procedure (Key : Char);
     StatLineType     = Procedure;


{----------------------------------------------------------------------------|
  And the Fossil Object itself.
|----------------------------------------------------------------------------}


     FossilObject = Object
                      Port      : Word;     { Current Comport            }
                      BaudRate  : LongInt;  { Current Baudrate           }
                      Error     : Integer;  { Error number               }
                      Emergency : Boolean;  { Is set if the carrier is   }
                                            { dropped or the user timed  }
                                            { out                        }

                      LocalEcho : Boolean;  { echo to local console      }
                      LocalInp  : Boolean;  { Input from local cons.     }

                      RemoteEcho: Boolean;  { Echo to remote console     }
                      RemoteInp : Boolean;  { Input from remote cons.    }

                      EchoStars : Boolean;  { Echo stars                 }
                      KeyBuffer : Char;     { Buffer for SmartReadKey    }

                      {$IfDef CheckTimeOut}
                        Reminder      : Byte;        { No. Reminders        }
                        MaxWarning    : Byte;        { Max warnings         }
                        TimeOut       : TimerObject; { Timout Time          }
                        TimeOutMin    : Word;        { Timeout in minutes   }
                        WarningStatus : Byte;        { Internal status byte }
                      {$EndIf}

                      { The userhooks }

                      InputFilter        : InpFilterType;
                      OutputFilter       : OutputfilterType;
                      SysopKeys          : SysopKeyType;
                      StatusLine         : StatLineType;

                      { If NoSystemMsg is true, the programmer has to   }
                      { Send warnings himself! See GlobalInfo           }

                      NoSystemMsg        : Boolean;

                      { The basic i/o functirons }

                      Procedure AssignF(P : Word; Baud : LongInt);
                      Procedure CloseF;
                      Function KeyPressedF:Boolean;
                      Function ReadKeyF:Char;
                      Procedure ReadLnF(Var S : String; MaxLength : Byte);
                      Procedure ClrScrF;
                      Procedure WriteF(S : String);
                      Procedure WriteLnF(S : String);


                      { The controle/check routines }

                      Function FossError:Integer;
                      Function Carrier:Boolean;
                      Function OutPutEmpty:Boolean;
                      Procedure HangUp;

                      { the userhook routines }

                      Procedure InitOutputFilter(Filter : OutputFilterType);
                      Procedure OutputFilterOff;
                      Procedure OutputFilterOn;
                      Procedure InitSysopKeys(Keys : SysOpKeyType);
                      Procedure InitInputFilter(CharSet : InpFilterType);
                      Procedure InitStatLine(Stat : StatLineType);

                      { Added I/O Routines }

                      Function SmartReadKey:Char;
                      Function AskKey(Keys : KeysString; Default : Char):Char;
                      Function AskKeyTimeOut( Keys       : KeysString;
                                              Default    : Char;
                                              Timer      : Word;
                                              TimeOutKey : Char):Char;
                      Procedure ReadPicture(Var Line : String;Picture : String);
                      Function PressEnterOrStop:Boolean;
                      Procedure PressEnter;
                      Procedure PressANYKey;
                      Procedure GotoXyF(X,Y : Byte);

                      { Internal Timeout/Total time checking routines }

                      {$IfDef CheckTimeOut}
                        Procedure InitTimer( MaxWarn      : Byte;
                                             TimeOutTime  : Word);
                        Procedure ResetTimeOut;
                        Function CheckTimeOut:Boolean;
                      {$EndIf}

                      { And some lowlevel routines.. }

                        Procedure ClearInput;
                        Procedure ClearOutput;

                      {$IfDef useDRIVERUnit}
                        Function DetectAnsi:Boolean;
                      {$EndIf}

                    End;


{----------------------------------------------------------------------------|
  Default userhooks. To make sure nothing strange happens when the programmer
  Doesn't install hooks!
|----------------------------------------------------------------------------}

Procedure NoFilter(Var InStr : String);
Procedure NoSysopKeys(Key : Char);
Procedure NoStatLine;

Implementation

{----------------------------------------------------------------------------|
 the default userhooks.
|----------------------------------------------------------------------------}

Procedure NoFilter(Var InStr : String);
Begin
End;

Procedure NoSysopKeys(Key : Char);
Begin
End;

Procedure NoStatLine;
Begin
End;


{----------------------------------------------------------------------------|
  The TIME checking procedures and functions
|----------------------------------------------------------------------------}


{$IfDef CheckTimeOut}

Var MinuteTick : TimerObject;

Procedure FossilObject.InitTimer( MaxWarn      : Byte;
                                  TimeOutTime  : Word);
Begin
WarningStatus:=2;

TimeOut.SetTimer(TimeOutTime*10);
TimeOutMin:=TimeOutTime;
Reminder:=0;
MaxWarning:=MaxWarn;
End;



Function FossilObject.CheckTimeOut:Boolean;
Var Count : Byte;
Begin
CheckTimeOut:=False;

{ Check the total time a user has. Send warnings if it drops below 3 min. }

If GlobalInfo.MinRemaining<3
   Then Begin
        Case GlobalInfo.MinRemaining OF
         2  : Begin
              If WarningStatus=2
                 Then Begin
                      GlobalInfo.SystemStatus:=S_Warning1;
                      If Not NoSystemMsg
                         Then WriteLnF(Warning1String);
                      End;
              WarningStatus:=1;
              End;
         1:   Begin
              If WarningStatus>=1
                 Then Begin
                      GlobalInfo.SystemStatus:=S_Warning2;
                      If Not NoSystemMsg
                         Then WriteLnF(Warning2String);
                      End;
              WarningStatus:=0;
              End;
         0  : Begin
              GlobalInfo.SystemStatus:=S_TimeUp;
              If Not NoSystemMsg
                 Then WriteLnF(TimeUpString);
              CheckTimeOut:=True;
              End;
         End; {Case}
         End
   Else WarningStatus:=2;

{ Check inactivity and send a warning }

If TimeOut.TimeUp
   Then Begin
        If Reminder<MaxWarning
           Then Begin
                WriteF(AttentionString+#7#7);
                Delay(3000);
                For Count:=1 To Length(AttentionString) Do
                  WriteF(#8' '#8);
                TimeOut.SetTimer(TimeOutMin*10);
                Inc(Reminder);
                End
           Else CheckTimeOut:=True;
        End;


{ Check the results of sysop keys. }

If GlobalInfo.OnlineStatus<>Normal
   Then Begin
        Case GlobalInfo.OnlineStatus Of
         HangUpLine : Begin
                      WriteLnF(HangUpString);
                      Delay(100);
                      HangUp;
                      CheckTimeOut:=True;
                      End;
         LockOutUser: Begin
                      WriteLnF(LockOutString);
                      Delay(100);
                      HangUp;
                      GlobalInfo.UserSecurity:=0;
                      GlobalInfo.MinRemaining:=0;
                      CheckTimeOut:=True;
                      End;
        End; {Case}
        End;
End;

Procedure FossilObject.ResetTimeOut;
Begin
TimeOut.SetTimer(TimeOutMin*10);
Reminder:=0;
End;
{$EndIf} {CheckTimeout}


{----------------------------------------------------------------------------|
  The fossil methodes
|----------------------------------------------------------------------------}

Const Input_Available   = $01;
      Input_OverRun     = $02;
      OutPut_Available  = $10;
      OutPut_Empty      = $20;

      Carrier_Detected  = $80;

{$IfNDef UseDRIVERUnit}
  Var   ANSI : Text;
{$EndIf}

{----------------------------------------------------------------------------|
  Open and initialize the fossil and the FossilObject.
|----------------------------------------------------------------------------}

Procedure FossilObject.AssignF(P : Word; Baud : LongInt);
Var Regs : Registers;
Begin
LocalEcho  := True;
RemoteEcho := True;
LocalInp   := True;
RemoteInp  := True;

{$IfDef UseDRIVERunit}
  Driver.BeQuiet:=Not GlobalInfo.LocalNoise;
{$EndIf}

EchoStars  := False;
KeyBuffer  := #00;

Emergency  := False;

InitOutputFilter(NoFilter);
InitSysopKeys(NoSysopKeys);
InitStatLine(NoStatLine);
InitInputFilter(AllCharSet);

NoSystemMsg:=False;

{$IfNDef UseDriverUnit}
 Assign(ANSI,'');
 Rewrite(ANSI);
{$Else}
 Driver.NoColor:=GlobalInfo.LocalMono;
{$EndIf}

Port       := P;
BaudRate   := Baud;
Error      := 0;
If BaudRate=0
   Then Exit;

BaudRate:=BaudRate Div 100;

Regs.Ah:=$04;
Regs.Dx:=Port;
Intr($14,Regs);
If (Regs.AX<>$1954)
   Then Begin
        Error:= -1; { Fossil not found }
        Exit;
        End;

Regs.Ah:=$00;
Case BaudRate Of
 3    : Regs.Al:=$43;
 6    : Regs.Al:=$63;
 12   : Regs.Al:=$83;
 24   : Regs.Al:=$A3;
 48   : Regs.Al:=$C3;
 96   : Regs.Al:=$E3;
 192  : Regs.Al:=$03;
 384  : Regs.Al:=$23;
 Else   Regs.AL:=$23;  { 14k4 ?! }
End;
Regs.Dx:=Port;
Intr($14,Regs);

Regs.Ah:=$06;
Regs.Al:=$01;
Regs.Dx:=Port;
Intr($14,Regs);

Regs.Ah:=$09;
Regs.Dx:=Port;
Intr($14,Regs);

Regs.Ah:=$0A;
Regs.Dx:=Port;
Intr($14,Regs);
End;

{----------------------------------------------------------------------------|
  Close the fossil.
|----------------------------------------------------------------------------}

Procedure FossilObject.CloseF;
Var Regs : Registers;
Begin

If GlobalInfo.OnlineStatus = WarnOnLeaving
   Then Begin
        RemoteEcho:=False;
        {$IfDef UseDriverUnit}
          Driver.BeQuiet:=False;
        {$EndIf}
        WriteF(#7);
        End;

{$IfNDef UseDriverUnit}
 Close(ANSI);
{$EndIf}

If BaudRate=0
   Then Exit;

Regs.Ah:=$05;
Regs.Dx:=Port;
Intr($14,Regs);
End;

{----------------------------------------------------------------------------|
  Return the last errorlevel and clear the interal ERROR variable.
|----------------------------------------------------------------------------}


Function FossilObject.FossError:Integer;
Begin
FossError:=Error;
Error:=0;
End;

{----------------------------------------------------------------------------|
  Check for the presence of a carrier, and update the statusline.
  Also reset the minute TICK timer if nessecary
|----------------------------------------------------------------------------}


Function FossilObject.Carrier:Boolean;
Var Regs : Registers;
Begin
{$IfDef UseDriverUnit}
Driver.BeQuiet:=Not GlobalInfo.LocalNoise;
{$EndIf}
StatusLine;

{$IfDef CheckTimeOut}
If MinuteTick.TimeUp
   Then Begin
        Dec(GlobalInfo.MinRemaining);
        MinuteTick.SetTimer(600);
        End;
{$EndIf}

If BaudRate=0
   Then Begin
        Carrier:=True;
        Exit;
        End;
With Regs Do
 Begin
 AH:=$03;
 DX:=Port;
 End;
Intr($14,Regs);
Carrier:=(Regs.AL And Carrier_Detected) = Carrier_Detected;
End;

{----------------------------------------------------------------------------|
 Check if the outputbuffer is empty
|----------------------------------------------------------------------------}


Function FossilObject.OutPutEmpty:Boolean;
Var Regs : Registers;
Begin
If Emergency Or (BaudRate=0)
   Then Begin
        OutPutEmpty:=True;
        Exit;
        End;
With Regs Do
 Begin
 AH:=$03;
 DX:=Port;
 End;
Intr($14,Regs);
OutputEmpty:=(Regs.AH And OutPut_Empty) = OutPut_Empty;
End;

{----------------------------------------------------------------------------|
  Hangup the line by toggling the DTR
|----------------------------------------------------------------------------}


Procedure FossilObject.HangUp;
Var Regs : Registers;
Begin
If Emergency Or (BaudRate=0)
   Then Exit;

With Regs Do
 Begin
 Regs.Ah:=$06;  { DTR Down }
 Regs.Al:=$00;
 Regs.Dx:=Port;
 Intr($14,Regs);

 Delay(200);

 Regs.Ah:=$06;  { DTR Up   }
 Regs.Al:=$01;
 Regs.Dx:=Port;
 Intr($14,Regs);
 End;
End;

{----------------------------------------------------------------------------|
  Check if a local or remote key was pressed.
|----------------------------------------------------------------------------}


Function FossilObject.KeyPressedF:Boolean;
Var Regs   : Registers;
    Local  : Boolean;
    Remote : Boolean;
Begin
{$IfDef CheckCarrier}
  Emergency:=Not Carrier;
{$EndIf}

If Emergency
   Then KeyPressedF:=False;

{$IfDef CheckTimeOut}
  Emergency:=Emergency Or CheckTimeOut;
{$EndIf}

Local:=False;
Remote:=False;

Local:=CRT.KeyPressed;
If BaudRate=0
   Then Begin
        KeyPressedF:=Local And LocalInp;
        Exit;
        End;

With Regs Do
 Begin
 AH:=$03;
 DX:=Port;
 Intr($14,Regs);
 End;
Remote:=(Regs.AH And Input_Available)=Input_Available;

KeyPressedF := (Local And LocalInp) Or
               (Remote And RemoteInp);
End;


{----------------------------------------------------------------------------|
  Read a local or remote key, and check for SysOp keys.
  Note: If a SysOp key was detected, character #FF is returned!
        Check this as a special case if you use this routine.
|----------------------------------------------------------------------------}

Function FossilObject.ReadKeyF:Char;
Var Regs : Registers;
    Dum  : Char;
Begin

{$IfDef CheckCarrier}
  Emergency:=Not Carrier;
{$EndIf}

{$IfDef CheckTimeOut}
  Emergency:=Emergency Or CheckTimeOut;
{$EndIf}

If Emergency
   Then Exit;

If LocalInp And
   Crt.KeyPressed
   Then Begin
        {$IfDef CheckTimeOut}
          ResetTimeOut;
        {$EndIf}
        Dum:=CRT.ReadKey;
        If Dum=#00
           Then Begin
                Dum:=CRT.ReadKey;
                SysopKeys(Dum);
                ReadKeyF:=#$FF;
                End
           Else ReadKeyF:=Dum;
        Exit;
        End;

If RemoteInp And (BaudRate>0)
   Then Begin
        With Regs Do
         Begin
         AH:=$03;
         DX:=Port;
         End;
        Intr($14,Regs);
        If (Regs.AH And Input_Available)=Input_Available
           Then Begin
                {$IfDef CheckTimeOut}
                  ResetTimeOut;
                {$EndIf}
                With Regs Do
                 Begin
                 AH:=$02;
                 DX:=Port;
                 End;
                Intr($14,Regs);
                ReadKeyF:=Chr(Regs.AL);
                End;
        End;

End;

{----------------------------------------------------------------------------|
  Read a local or remote key, and check for SysOp keys.
  Also check for special ANSI sequences and return extended keys for
  ArrowUp/Down/Left/Right

  Note: If a SysOp key was detected, character #FF is returned!
        Check this as a special case if you use this routine.
|----------------------------------------------------------------------------}

Function FossilObject.SmartReadKey:Char;
Var Regs : Registers;
    Dum  : Char;
    Key  : Char;
Begin
{$IfDef CheckCarrier}
  Emergency:= Not Carrier;
{$EndIf}

{$IfDef CheckTimeOut}
  Emergency:=Emergency Or CheckTimeOut;
{$EndIf}

If Emergency
   Then Exit;

If KeyBuffer<>#00
   Then Begin
        SmartReadKey:=KeyBuffer;
        KeyBuffer:=#00;
        Exit;
        End;

If LocalInp And
   Crt.KeyPressed
   Then Begin

        {$IfDef CheckTimeOut}
          ResetTimeOut;
        {$EndIf}

        Dum:=CRT.ReadKey;
        If Dum=#00
           Then KeyBuffer:=CRT.ReadKey
           Else KeyBuffer:=#00;

        If (Dum=#00) And
           (Not (KeyBuffer In [ArrUp,ArrDn,ArrLft,ArrRt,PgUpK,PgDnK,HomeK,EndK]))
           Then begin
                SysopKeys(KeyBuffer);
                KeyBuffer:=#00;
                SmartReadKey:=#$FF;
                End
           Else SmartReadKey:=Dum;
        Exit;
        End;

If RemoteInp And
   (BaudRate>0)
   Then Begin
        LocalInp:=False;
        If KeyPressedF
           Then Begin
                {$IfDef CheckTimeOut}
                  ResetTimeOut;
                {$EndIf}
                Dum:=ReadKeyF;
                If Dum In [^D,^E,^X,^S,^R,^C,^W,^P]
                   Then Begin
                        SmartReadKey:=#00;
                        Case Dum Of
                         ^E  : KeyBuffer:=ArrUp;
                         ^X  : KeyBuffer:=ArrDn;
                         ^S  : KeyBuffer:=ArrLft;
                         ^D  : KeyBuffer:=ArrRt;
                         ^R  : KeyBuffer:=PgUpK;
                         ^C  : KeyBuffer:=PgDnK;
                         ^W  : KeyBuffer:=HomeK;
                         ^P  : KeyBuffer:=EndK;
                         ^A  : KeyBuffer:=CArrLft;
                         ^F  : KeyBuffer:=CArrRt;
                         ^V  : KeyBuffer:=InsK;
                         ^G  : KeyBuffer:=DelK;
                         Else  SmartReadKey:=Dum;
                        End; {Case}
                        End
                   Else SmartReadKey:=Dum;
                End;
        LocalInp:=True;
        End;


End;

{----------------------------------------------------------------------------|
  Wait until a key in the range contained in KEYS is pressed. This procedure
  it's main purpose is to make menus more simple. DON'T use it for arcade
  style purposes! Use SmartReadKey there...

  If the carrier is dropped or the user times out the default char is send
  back. Make it something to bail out of the program. It's NOT the character
  to give back when the user presses enter. (You can handle that yourself
  by adding #13 to the KEYS list..)
|----------------------------------------------------------------------------}

Function FossilObject.AskKey(Keys : KeysString; Default : Char):Char;
Var Dum : Char;
Begin
If Emergency
   Then Begin
        AskKey:=Default;
        Exit;
        End;
WriteF(' '#8);
Repeat
 If KeyPressedF
    Then Begin
         {$IfDef CheckTimeOut}
           ResetTimeOut;
         {$EndIf}
         Dum:=ReadKeyF;
         If (Pos(UpCase(Dum),Keys)>0) And
            (Dum<>#$FF) { Local Sysop key's send an #$FF back! }
            Then Begin
                 AskKey:=Dum;
                 If EchoStars
                    Then Dum:='*';
                 WriteF(Dum);
                 Exit;
                 End;
         End
    Else {$IfDef MakeDVAwear}
           DV_Pause;
         {$EndIf}

{$IfDef CheckCarrier}
  Emergency:=Not Carrier;
{$EndIf}

{$IfDef CheckTimeOut}
  Emergency:=Emergency OR checkTimeOut;
{$EndIf}

Until Emergency;
AskKey:=Default;
End;

Function FossilObject.AskKeyTimeOut( Keys       : KeysString;
                                     Default    : Char;
                                     Timer      : Word;
                                     TimeOutKey : Char):Char;
Var Dum      : Char;
    WaitTime : TimerObject;

Begin
If Emergency
   Then Begin
        AskKeyTimeOut:=Default;
        Exit;
        End;
WaitTime.SetTimer(Timer);
WriteF(' '#8);
Repeat
 If KeyPressedF
    Then Begin
         {$IfDef CheckTimeOut}
           ResetTimeOut;
         {$EndIf}
         Dum:=ReadKeyF;
         If (Pos(UpCase(Dum),Keys)>0) And
            (Dum<>#$FF) { Local Sysop key's send an #$FF back! }
            Then Begin
                 AskKeyTimeOut:=Dum;
                 If EchoStars
                    Then Dum:='*';
                 WriteF(Dum);
                 Exit;
                 End;
         End
    Else {$IfDef MakeDVAwear}
           DV_Pause;
         {$EndIf}

{$IfDef CheckCarrier}
  Emergency:=Not Carrier;
{$EndIf}

{$IfDef CheckTimeOut}
  Emergency:=Emergency OR checkTimeOut;
{$EndIf}

Until Emergency Or WaitTime.TimeUp;
If Not Emergency
   Then AskKeyTimeOut:=TimeOutKey
   Else AskKeyTimeOut:=Default;
End;

{----------------------------------------------------------------------------|
 Read a line with the maximal length MaxLengt. The procedure recognises
 the RA ^X command to clear the line, BackSpace to clear the previouse
 character and CarriageReturn to accept the input. Other characters typed
 by the user are checked against the InputFilter.
|----------------------------------------------------------------------------}

Procedure FossilObject.ReadLnF(Var S : String; MaxLength : Byte);
Var Count : Byte;
    Key   : Char;
    Remove: Byte;
Begin
For Count:=1 To MaxLength Do
 WriteF(' ');
For Count:=1 To MaxLength Do
 WriteF(#8);

Count:=Length(S);
WriteF(S);
Repeat
 If KeyPressedF
    Then Begin
         Key := ReadKeyF;
         {$IfDef CheckTimeOut}
           ResetTimeout;
         {$EndIf}
         Case Key Of
           #13  : Exit;
           #8   : Begin
                  If Count>0
                     Then Begin
                          Dec(S[0]);
                          WriteF(#8' '#8);
                          Dec(Count);
                          End;
                  End;
           ^X   : Begin
                  If Count>0
                     Then Begin
                          For Remove:= Count DownTo 1 Do
                            WriteF(#8' '#8);
                          S:='';
                          Count:=0;
                          End;
                  End;
           #$FF : ; { Local SysopKeys send an #$FF back! }
           Else Begin
                If (Count=MaxLength) Or
                   (
                    (Not (Key In InputFilter)) AND
                    (InputFilter<> [])
                   )
                   Then WriteF(#7)
                   Else Begin
                        S:=S+Key;
                        If EchoStars
                           Then Key:='*';
                        WriteF(Key);
                        Inc(Count);
                        End;
                End;
          End; {Case}
         End
    Else {$IfDef MakeDVAwear}
           DV_Pause;
         {$EndIf};

{$IfDef CheckTimeOut}
  Emergency:=Emergency Or CheckTimeOut;
{$EndIf}

Until Emergency;
End;

{----------------------------------------------------------------------------|
 Read a string defined by a picture string which defines the input on a
 certain character. Defined picture items are:
   X  Any Character A..Z in any case
   U  Force uppercase
   L  Force lowercase
   N  Numerical char 0..9
   Z  Nummerical char, but if 0, replace with space when finished
   S  Sign, +/-/' '

All other chars are shown on the screen. F.e. an american phonenumber:

   (NNN) NNNN-NNNN

b.t.w. please don't FORCE a USA phone number, make it optional.. It wouldn't
be the first time that I (and I guess more ppl outside usa have this
experience) try to log on an american board, and can't get in as there's
no way to force my phonenumber into this format.. (NNN-NNNNNN)

A dutch ZIP code (postal code)

   NNNN UU

An amout of money:

   fZZNN.NN

|----------------------------------------------------------------------------}

Procedure FossilObject.ReadPicture(Var Line : String;Picture : String);

Const PicSet = ['U','L','X','N','S','Z'];

Var StrPtr : Byte;
    Key    : Char;

Begin
For StrPtr := 1 To Length(Picture) Do
 If Upcase(Picture[StrPtr]) In PicSet
    Then WriteF('_')
    Else WriteF(Picture[StrPtr]);
For StrPtr := 1 To Length(Picture) Do
    Write(#8);

Line:=Picture;
StrPtr:=1;
While StrPtr<=Length(Picture) Do
 Begin
 Case Upcase(Picture[StrPtr]) Of
  'N',
  'Z' : Begin
        Repeat
         Key:=ReadKeyF;
        Until (Key In ['0'..'9',#8]) Or Emergency;

        If Key<>#8
           Then Begin
                WriteF(Key);
                Line[StrPtr]:=Key;
                Inc(StrPtr);
                End
           Else Begin
                If StrPtr>1
                   Then Begin
                        Repeat
                         Dec(StrPtr);
                         WriteF(Key);
                        Until (Picture[StrPtr] In PicSet) Or
                              (StrPtr=1);
                        End;
                End;
        End;
  'U',
  'L',
  'X' : Begin
        Repeat
         Key:=ReadKeyF;
        Until (Upcase(Key) In ['A'..'Z',#8]) Or Emergency;
        If Key<>#8
           Then Begin
                Case Upcase(Picture[StrPtr]) Of
                 'U' : Key:=Upcase(Key);
                 'L' : Key:=CHR(Byte(Key) OR $20);
                End;
                Line[StrPtr]:=Key;
                WriteF(Key);
                Inc(StrPtr);
                End
           Else Begin
                If StrPtr>1
                   Then Begin
                        Repeat
                         Dec(StrPtr);
                         WriteF(Key);
                        Until (Picture[StrPtr] In PicSet) Or
                              (StrPtr=1);
                        End;
                End;
        End;
  'S' : Begin
        Repeat
         Key:=ReadKeyF;
        Until (Upcase(Key) In ['+','-',' ',#8]) Or Emergency;
        If Key<>#8
           Then Begin
                If Key=' '
                   Then Key:='+';
                WriteF(Key);
                Line[StrPtr]:=Key;
                Inc(StrPtr);
                End
           Else Begin
                If StrPtr>1
                   Then Begin
                        Repeat
                         Dec(StrPtr);
                         WriteF(Key);
                        Until (Picture[StrPtr] In PicSet) Or
                              (StrPtr=1);
                        End;
                End;
        End;
  Else  Begin
        WriteF(Picture[StrPtr]);
        Inc(StrPtr);
        End;
 End; {Case}
 End;

For StrPtr := 1 To Length(Picture) Do
  If (Upcase(Picture[StrPtr])='Z') And
     (Line[StrPtr]='0')
     Then Line[StrPtr]:=' ';
End;



{----------------------------------------------------------------------------|
 Put's the PressEnterOrStopString on screen and waits for the user to press
 one of both keys.
|----------------------------------------------------------------------------}

Function FossilObject.PressEnterOrStop;
Var Dum : Char;
Begin
WriteF(PressEnterOrStopString);
Dum:=UpCase(AskKey(#13+UsedStopKey,UsedStopKey));
PressEnterOrStop:=Dum=UsedStopKey;
End;

{----------------------------------------------------------------------------|
 Put's the PressEnterString on screen and waits for the user to press
 a CarriageReturn
|----------------------------------------------------------------------------}

Procedure FossilObject.PressEnter;
Var Dum : Char;
Begin
WriteF(PressEnterString);
Dum:=AskKey(#13,#13);
End;

{----------------------------------------------------------------------------|
 Simply wait for ANY key (except #FF, result of a sysops key) to be pressed.
|----------------------------------------------------------------------------}

Procedure FossilObject.PressANYKey;
Var Dum : Char;
Begin
Repeat
 While Not KeyPressedF Do;
 Dum:=ReadKeyF;
Until (Dum<>#$FF) Or Emergency; { SysopKeys return #$FF! }
End;

{----------------------------------------------------------------------------|
 Clear the screen according to the UseGraphics and UseAvatar settings. If
 the user doesn't has the UseClr toggle set, only a NewLine is send.
|----------------------------------------------------------------------------}

Procedure FossilObject.ClrScrF;
Begin
If Not GlobalInfo.UseClrScr
   Then Begin
        WriteF(#13#10);
        Exit;
        End;
If GlobalInfo.UseGraphics And
   (Not GlobalInfo.UseAVATAR)
   Then WriteF(#27'[2J')
   Else WriteF(#12);
End;

{----------------------------------------------------------------------------|
 Put the cursor on a given place on the screen. Only works if ANSI or AVATAR
 is selected!
|----------------------------------------------------------------------------}


Procedure FossilObject.GotoXyF(X,Y : Byte);
Begin
If Not (GlobalInfo.UseGraphics Or GlobalInfo.UseAvatar)
   Then Exit;
If GlobalInfo.UseAVATAR
   Then WriteF(^V^H+Chr(Y)+Chr(X))
   Else WriteF(#27'['+S(Y,0)+';'+S(X,0)+'f');
End;


{----------------------------------------------------------------------------|
  The output filter procodures. MemFilterPtr is used to store the old
  outputfilter when OutputFilterOff is selected. It's restored when calling
  OutputFilterON.
|----------------------------------------------------------------------------}

Var MemFilterPtr : OutputFilterType;

Procedure FossilObject.InitOutputFilter(Filter : OutputFilterType);
Begin
OutputFilter:=Filter;
End;

Procedure FossilObject.OutputFilterOff;
Begin
MemFilterPtr:=OutputFilter;
OutputFilter:=NoFilter;
End;

Procedure FossilObject.OutputFilterOn;
Begin
OutputFilter:=MemFilterPtr;
End;


{----------------------------------------------------------------------------|
  The InitSysopKeys procedure, simple hooks your procedure to the SysOpkey
  handle.
|----------------------------------------------------------------------------}

Procedure FossilObject.InitSysopKeys(Keys : SysopKeyType);
Begin
SysopKeys:=Keys;
End;

{----------------------------------------------------------------------------|
  The InitStatLine procedure, simple hooks your procedure to the StatLine
  handle.
|----------------------------------------------------------------------------}

Procedure FossilObject.InitStatLine(Stat : StatLineType);
Begin
StatusLine:=Stat;
End;

{----------------------------------------------------------------------------|
  The InitInputFilter procedure, Copies your CharSet to the Used CharSet.
|----------------------------------------------------------------------------}

Procedure FossilObject.InitInputFilter(CharSet : InpFilterType);
Begin
InputFilter:=CharSet;
End;

{----------------------------------------------------------------------------|
 Write a single line after applying the Output filter. If the outputbuffer
 doesn't accept characters, TimeSlices are given back to Desqview.
 It also checks the carrier, but NOT the TimeOut logic!
|----------------------------------------------------------------------------}

Procedure FossilObject.WriteF(S : String);
Var Count : Byte;
    Regs  : Registers;
Begin

OutputFilter(S);

Count:=1;
While (Not Emergency) And (Count<=Length(S)) Do
 Begin
 If (BaudRate>0) And RemoteEcho
    Then Begin
         Repeat
          With Regs Do
           Begin
           AH:=$0B;
           AL:=Ord(S[Count]);
           DX:=Port;
           End;
          Intr($14,Regs);

         {$IfDef MakeDVAwear}
         If Regs.AX<>$0001
            Then DV_Pause;
         {$EndIf}

         Until (Regs.AX=$0001)
               {$IfDef CheckCarrier}
                 Or (Not Carrier)
               {$EndIf} ;
         End;

 If LocalEcho
    Then {$IfDef UseDRIVERUnit}
         ScreenDriver(S[Count]);
         {$Else}
         Write(ANSI,S[Count]);
         {$EndIf}

 Inc(Count);

 {$IfDef CheckCarrier}
   Emergency:= Not Carrier;
 {$EndIf}
 End;
End;

{----------------------------------------------------------------------------|
  Simply add a NewLine to the String and pass it to WriteF
|----------------------------------------------------------------------------}


Procedure FossilObject.WriteLnF(S : String);
Begin
WriteF(S);
WriteF(#13#10);
End;

{----------------------------------------------------------------------------|
  Clear the input/output buffers.
|----------------------------------------------------------------------------}

Procedure FossilObject.ClearInput;
Var Regs : Registers;
Begin
If BaudRate=0
   Then Exit;
Regs.DX:=Port;
Regs.AH:=$0A;
Intr($14,Regs);
End;

Procedure FossilObject.ClearOutput;
Var Regs : Registers;
Begin
If BaudRate=0
   Then Exit;
Regs.AH:=$09;
Regs.DX:=Port;
Intr($14,Regs);
End;

{----------------------------------------------------------------------------|
 Detect if the other side is capable of ansi.
|----------------------------------------------------------------------------}

{$IfDef UseDRIVERunit}

Function FossilObject.DetectAnsi:Boolean;
Var AnsiTimeOut  : TimerObject;
Begin
If BaudRate=0
   Then Begin
        DetectAnsi:=True;
        Exit;
        End;

OutputFilterOFF;
WriteF(#27'[6n'); { Ask for cursor possition }
RemoteEcho:=False;
AnsiTimeOut.SetTimer(30); { Take 3 seconds for detection }
Repeat
 If KeyPressedF
    Then WriteF(ReadKeyF);
Until Driver.AnsiDetect or AnsiTimeOut.TimeUp or Emergency;
RemoteEcho:=True;
DetectAnsi:=Driver.AnsiDetect;
OutputFilterOn;
End;

{$EndIf}

{----------------------------------------------------------------------------|
  Some things have to be initialized. So here it's done
|----------------------------------------------------------------------------}

Begin
MemFilterPtr:=NoFilter;
{$IFDef MakeDVAwear}
  GlobalInfo.Desqview:=DVUsed;
{$Else}
  GlobalInfo.DesqView:=False;
{$EndIf}
{$IfDef CheckTimeOut}
 MinuteTick.SetTimer(600);
{$EndIf}
End.
{----------------------------------------------------------------------------|
   Finto.. Baste.. Het Einde.. The End.
|----------------------------------------------------------------------------}