Unit BBS_IO;

{$I M_OPS.PAS}

Interface

Uses
  {$IFDEF WINDOWS}
    Windows,
    WinSock2,
  {$ENDIF}
  m_Types,
  m_DateTime,
  m_FileIO,
  m_Strings,
  m_Term_Ansi,
  bbs_Common;

Const
  TBBSIOBufferSize = 4 * 1024 - 1;
  MaxPromptInfo    = 15;

Type
  TBBSIO = Class
    Core         : Pointer;
    Term         : TTermAnsi;
    ScreenInfo   : Array[0..9] of Record X, Y, A : Byte; End;
    PromptInfo   : Array[1..MaxPromptInfo] of String[89];
    FmtString    : Boolean;
    FmtLen       : Byte;
    FmtType      : Byte;
    InMacro      : Boolean;
    InMacroPos   : Byte;
    InMacroStr   : String;
    BaudEmulator : Byte;
    AllowPause   : Boolean;
    AllowMCI     : Boolean;
    LocalInput   : Boolean;
    AllowArrow   : Boolean;
    IsArrow      : Boolean;
    UseInField   : Boolean;
    UseInLimit   : Boolean;
    UseInSize    : Boolean;
    InLimit      : Byte;
    InSize       : Byte;
    AllowAbort   : Boolean;
    Aborted      : Boolean;
    NoFile       : Boolean;
    Graphics     : Byte;
    PausePtr     : Byte;
    InputData    : Array[1..mysMaxInputHistory] of String[255];
    LastMCIValue : String;
    InputPos     : Byte;

    {$IFDEF WINDOWS}
    OutBuffer    : Array[0..TBBSIOBufferSize] of Char;
    OutBufPos    : SmallInt;
    SocketEvent  : THandle;
    {$ENDIF}

    Constructor Create (Var Owner: Pointer);
    Destructor  Destroy; Override;

    Procedure   BufAddChar       (Ch: Char);
    Procedure   BufAddStr        (Str: String);
    Procedure   BufFlush;
    Function    ParseMCI         (Display : Boolean; Code: String) : Boolean;
    Function    StrMci           (Str: String) : String;
    Function    Attr2Ansi        (Attr: Byte) : String;
    Function    Pipe2Ansi        (Color : Byte) : String;
    Procedure   AnsiGotoXY       (X : Byte; Y:Byte);
    Procedure   AnsiMoveX        (X : Byte);
    Procedure   AnsiMoveY        (Y : Byte);
    Procedure   AnsiColor        (A : Byte);
    Procedure   AnsiClear;
    Procedure   AnsiClrEOL;
    Procedure   OutPipe          (Str: String);
    Procedure   OutPipeLn        (Str: String);
    Procedure   OutRaw           (Str : String);
    Procedure   OutRawLn         (Str: String);
    Procedure   OutBS            (Num : Byte; Del: Boolean);
    Procedure   OutFull          (Str : String);
    Procedure   OutFullLn        (Str : String);
    Procedure   OutFile          (FName : String; DoPause: Boolean; Speed: Byte);
    Function    OutYN            (Y : Boolean) : String;
    Function    OutON            (O : Boolean) : String;
    Procedure   PauseScreen;
    Function    MorePrompt       : Char;
    Function    DrawPercent      (Bar : RecPercent; Part, Whole : SmallInt; Var Percent : SmallInt) : String;
    Function    GetInput         (Field, Max, Mode: Byte; Default : String) : String;
    Function    InXY             (X, Y, Field, Max, Mode: Byte; Default: String) : String;
    Function    InKey            (Wait: LongInt) : Char;
    Function    GetYNL           (Str: String; Yes: Boolean) : Boolean;
    Function    GetKey           : Char;
    Function    GetYN            (Str: String; Yes: Boolean) : Boolean;
    Function    GetPW            (Str : String; BadStr : String; PW : String) : Boolean;
    Function    OneKey           (Str: String; Echo: Boolean) : Char;
    Procedure   RemoteRestore    (Var Image: TConsoleImageRec);
    Procedure   PurgeInputBuffer;

    {$IFDEF WINDOWS}
    Procedure   LocalScreenDisable;
    Procedure   LocalScreenEnable;
    {$ENDIF}
  End;

Implementation

Uses
  DOS,
  bbs_Core,
  bbs_General,
  bbs_NodeInfo;

Constructor TBBSIO.Create (Var Owner: Pointer);
Begin
  Core          := Owner;
  FmtString     := False;
  FmtLen        := 0;
  FmtType       := 0;
  InMacro       := False;
  InMacroPos    := 0;
  InMacroStr    := '';
  AllowPause    := False;
  AllowMCI      := True;
  LocalInput    := False;
  AllowArrow    := False;
  IsArrow       := False;
  UseInField    := True;
  UseInLimit    := False;
  UseInSize     := False;
  InLimit       := 0;
  InSize        := 0;
  AllowAbort    := False;
  Aborted       := False;
  NoFile        := False;
  Graphics      := 1;
  PausePtr      := 1;
  LastMCIValue  := '';
  InputPos      := 0;

  {$IFDEF WINDOWS}
    FillChar(OutBuffer, SizeOf(OutBuffer), 0);
    OutBufPos := 0;

    If Not TBBSCore(Core).LocalMode Then
      SocketEvent := WSACreateEvent;
  {$ENDIF}

  Term := TTermAnsi.Create(Screen);
End;

Destructor TBBSIO.Destroy;
Begin
  {$IFDEF WINDOWS}
    If Not TBBSCore(Core).LocalMode Then WSACloseEvent(SocketEvent);
  {$ENDIF}

  Term.Free;

  Inherited Destroy;
End;

Procedure TBBSIO.BufAddChar (Ch: Char);
Begin
  {$IFDEF WINDOWS}
  OutBuffer[OutBufPos] := Ch;

  Inc (OutBufPos);

  If OutBufPos = TBBSIOBufferSize Then BufFlush;
  {$ENDIF}

  Term.Process(Ch);
End;

Procedure TBBSIO.BufAddStr (Str: String);
Var
  Count : Word;
Begin
  For Count := 1 to Length(Str) Do
    BufAddChar(Str[Count]);
End;

Procedure TBBSIO.BufFlush;
Var
  Res : LongInt;
Begin
  {$IFDEF WINDOWS}
  If OutBufPos > 0 Then Begin
    If Not TBBSCore(Core).LocalMode Then Begin
      Res := TBBSCore(Core).Client.WriteBuf(OutBuffer, OutBufPos);

      While (Res = -1) and (WSAGetLastError = EWOULDBLOCK) Do Begin
        WaitMS(10);
        Res := TBBSCore(Core).Client.WriteBuf(OutBuffer, OutBufPos);
      End;
    End;

    OutBufPos := 0;
  End;
  {$ENDIF}

  {$IFDEF UNIX}
    Screen.BufFlush;
  {$ENDIF}
End;

Procedure TBBSIO.AnsiMoveY (Y : Byte);
Var
  T : Byte;
Begin
  If Graphics = 0 Then Exit;

  T := Screen.CursorY;

  If Y > T Then BufAddStr (#27 + '[' + strI2S(Y-T) + 'B') Else
  If Y < T Then BufAddStr (#27 + '[' + strI2S(T-Y) + 'A');
End;

Procedure TBBSIO.AnsiMoveX (X : Byte);
Var
  T : Byte;
Begin
  If Graphics = 0 Then Exit;

  T := Screen.CursorX;

  If X > T Then BufAddStr (#27 + '[' + strI2S(X-T) + 'C') Else
  If X < T Then BufAddStr (#27 + '[' + strI2S(T-X) + 'D');
End;

Procedure TBBSIO.PauseScreen;
Var
  Attr : Byte;
  Ch   : Char;
Begin
  Attr := Screen.TextAttr;

  OutFull (TBBSCore(Core).GetPrompt(22));

  PurgeInputBuffer;

  Repeat
    Ch := GetKey;
  Until Ch <> '';

  AnsiColor(Attr);

  BufAddStr(#13#10);
End;

Function TBBSIO.MorePrompt : Char;
Var
  SavedAttr : Byte;
  SavedMCI  : Boolean;
  Ch        : Char;
Begin
  SavedMCI  := AllowMCI;
  AllowMCI  := True;
  SavedAttr := Screen.TextAttr;

  OutFull (TBBSCore(Core).GetPrompt(132));

  Ch := OneKey('YNC' + #13, False);

  OutBS     (Screen.CursorX, True);
  AnsiColor (SavedAttr);

  PausePtr := 1;
  AllowMCI := SavedMCI;
  Result   := Ch;
End;

Procedure TBBSIO.OutBS (Num: Byte; Del: Boolean);
Var
  A   : Byte;
  Str : String[7];
Begin
  If Del Then Str := #8#32#8 Else Str := #8;

  For A := 1 to Num Do
    OutRaw (Str);
End;

Procedure TBBSIO.OutPipe (Str: String);
Var
  Count : Byte;
  Code  : String[2];
Begin
  If FmtString Then Begin

    FmtString := False;

    Case FmtType of
      1  : Str := strPadR(Str, FmtLen + Length(Str) - Length(strStripPipe(Str)), ' ');
      2  : Str := strPadL(Str, FmtLen + Length(Str) - Length(strStripPipe(Str)), ' ');
      3  : Str := strPadC(Str, FmtLen + Length(Str) - Length(strStripPipe(Str)), ' ');
    End;
  End;

  Count := 1;

  While Count <= Length(Str) Do Begin
    If (Str[Count] = '|') and (Count < Length(Str) - 1) Then Begin
      Code := Copy(Str, Count + 1, 2);
      If Code = '00' Then BufAddStr(Pipe2Ansi(0)) Else
      If Code = '01' Then BufAddStr(Pipe2Ansi(1)) Else
      If Code = '02' Then BufAddStr(Pipe2Ansi(2)) Else
      If Code = '03' Then BufAddStr(Pipe2Ansi(3)) Else
      If Code = '04' Then BufAddStr(Pipe2Ansi(4)) Else
      If Code = '05' Then BufAddStr(Pipe2Ansi(5)) Else
      If Code = '06' Then BufAddStr(Pipe2Ansi(6)) Else
      If Code = '07' Then BufAddStr(Pipe2Ansi(7)) Else
      If Code = '08' Then BufAddStr(Pipe2Ansi(8)) Else
      If Code = '09' Then BufAddStr(Pipe2Ansi(9)) Else
      If Code = '10' Then BufAddStr(Pipe2Ansi(10)) Else
      If Code = '11' Then BufAddStr(Pipe2Ansi(11)) Else
      If Code = '12' Then BufAddStr(Pipe2Ansi(12)) Else
      If Code = '13' Then BufAddStr(Pipe2Ansi(13)) Else
      If Code = '14' Then BufAddStr(Pipe2Ansi(14)) Else
      If Code = '15' Then BufAddStr(Pipe2Ansi(15)) Else
      If Code = '16' Then BufAddStr(Pipe2Ansi(16)) Else
      If Code = '17' Then BufAddStr(Pipe2Ansi(17)) Else
      If Code = '18' Then BufAddStr(Pipe2Ansi(18)) Else
      If Code = '19' Then BufAddStr(Pipe2Ansi(19)) Else
      If Code = '20' Then BufAddStr(Pipe2Ansi(20)) Else
      If Code = '21' Then BufAddStr(Pipe2Ansi(21)) Else
      If Code = '22' Then BufAddStr(Pipe2Ansi(22)) Else
      If Code = '23' Then BufAddStr(Pipe2Ansi(23)) Else
      BufAddStr(Str[Count] + Code);
      Inc (Count, 2);
    End Else
      BufAddChar(Str[Count]);

    Inc (Count);
  End;
End;

Procedure TBBSIO.OutPipeLn (Str : String);
Begin
  OutPipe (Str + #13#10);
  Inc (PausePtr);
End;

Procedure TBBSIO.OutRaw (Str: String);
Begin
  If FmtString Then Begin

    FmtString := False;

    Case FmtType of
      1 : Str := strPadR(Str, FmtLen, ' ');
      2 : Str := strPadL(Str, FmtLen, ' ');
      3 : Str := strPadC(Str, FmtLen, ' ');
    End;
  End;

  BufAddStr(Str);
End;

Procedure TBBSIO.OutRawLn (Str: String);
Begin
  BufAddStr (Str + #13#10);
  Inc (PausePtr);
End;

Function TBBSIO.ParseMCI (Display: Boolean; Code: String) : Boolean;
Var
  A : LongInt;
Begin
  LastMCIValue := #255;
  Result       := True;

  If Not AllowMCI Then Begin
    Result := False;
    Exit;
  End;

  Case Code[1] of
    '!' : If Code[2] in ['0'..'9'] Then Begin
            A := strS2I(Code[2]);

            ScreenInfo[A].X := Screen.CursorX;
            ScreenInfo[A].Y := Screen.CursorY;
            ScreenInfo[A].A := Screen.TextAttr;
          End Else Begin
            Result := False;

            Exit;
          End;
    '$' : Case Code[2] of
            'C' : Begin
                    FmtString := True;
                    FmtType   := 3;
                  End;
            'D' : Begin
                    FmtString := True;
                    FmtType   := 4;
                  End;
            'L' : Begin
                    FmtString := True;
                    FmtType   := 2;
                  End;
            'R' : Begin
                    FmtString := True;
                    FmtType   := 1;
                  End;
            'X' : Begin
                    FmtString := True;
                    FmtType   := 17;
                  End;
          End;
    '&' : Case Code[2] of
            '1' : LastMCIValue := PromptInfo[1];
            '2' : LastMCIValue := PromptInfo[2];
            '3' : LastMCIValue := PromptInfo[3];
            '4' : LastMCIValue := PromptInfo[4];
            '5' : LastMCIValue := PromptInfo[5];
            '6' : LastMCIValue := PromptInfo[6];
            '7' : LastMCIValue := PromptInfo[7];
            '8' : LastMCIValue := PromptInfo[8];
            '9' : LastMCIValue := PromptInfo[9];
            '0' : LastMCIValue := PromptInfo[10];
            'A' : LastMCIValue := PromptInfo[11];
            'B' : LastMCIValue := PromptInfo[12];
            'C' : LastMCIValue := PromptInfo[13];
            'D' : LastMCIValue := PromptInfo[14];
            'E' : LastMCIValue := PromptInfo[15];
          End;
    '0' : Case Code[2] of
            '0' : LastMCIValue := Pipe2Ansi(0);
            '1' : LastMCIValue := Pipe2Ansi(1);
            '2' : LastMCIValue := Pipe2Ansi(2);
            '3' : LastMCIValue := Pipe2Ansi(3);
            '4' : LastMCIValue := Pipe2Ansi(4);
            '5' : LastMCIValue := Pipe2Ansi(5);
            '6' : LastMCIValue := Pipe2Ansi(6);
            '7' : LastMCIValue := Pipe2Ansi(7);
            '8' : LastMCIValue := Pipe2Ansi(8);
            '9' : LastMCIValue := Pipe2Ansi(9);
          End;
    '1' : Case Code[2] of
            '0' : LastMCIValue := Pipe2Ansi(10);
            '1' : LastMCIValue := Pipe2Ansi(11);
            '2' : LastMCIValue := Pipe2Ansi(12);
            '3' : LastMCIValue := Pipe2Ansi(13);
            '4' : LastMCIValue := Pipe2Ansi(14);
            '5' : LastMCIValue := Pipe2Ansi(15);
            '6' : LastMCIValue := Pipe2Ansi(16);
            '7' : LastMCIValue := Pipe2Ansi(17);
            '8' : LastMCIValue := Pipe2Ansi(18);
            '9' : LastMCIValue := Pipe2Ansi(19);
          End;
    '2' : Case Code[2] of
            '0' : LastMCIValue := Pipe2Ansi(20);
            '1' : LastMCIValue := Pipe2Ansi(21);
            '2' : LastMCIValue := Pipe2Ansi(22);
            '3' : LastMCIValue := Pipe2Ansi(23);
          End;
    'A' : Case Code[2] of
            'G' : LastMCIValue := strI2S(DaysAgo(TBBSCore(Core).User.ThisUser.Birthday) DIV 365);
            'S' : LastMCIValue := OutON(TBBSCore(Core).User.ThisUser.SigUse);
            'V' : LastMCIValue := OutYN(Chat.Available);
          End;
    'B' : Case Code[2] of
            'D' : If TBBSCore(Core).LocalMode Then
                    LastMCIValue := 'LOCAL' {++lang add these to lang file }
                  Else
                    LastMCIValue := 'TELNET'; {++lang }
            'E' : LastMCIValue := ^G;
            'I' : LastMCIValue := DateJulian2Str(TBBSCore(Core).User.ThisUser.Birthday, TBBSCore(Core).User.ThisUser.DateType);
            'N' : LastMCIValue := Config.BBSName;
            'S' : OutBS(1, True);
          End;
    'C' : Case Code[2] of
            'L' : AnsiClear;
            'M' : LastMCIValue := OutON(TBBSCore(Core).User.ThisUser.UseFullChat);
            'R' : OutRawLn ('');
            'S' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.Calls);
            'T' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.CallsToday);
          End;
    'D' : Case Code[2] of
            'A' : LastMCIValue := DateDos2Str(CurDateDos, TBBSCore(Core).User.ThisUser.DateType);
            'E' : Begin
                    BufFlush;
                    WaitMS(500);
                  End;
            'F' : Begin
                    FmtString := True;
                    FmtType   := 5;
                  End;
            'I' : Begin
                    FmtString := True;
                    FmtType   := 16;
                  End;
            'K' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.DLk);
            'L' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.DLs);
            'T' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.DLsToday);
          End;
    'F' : Case Code[2] of
            'B' : LastMCIValue := TBBSCore(Core).FileBase.FBase.Name;
            'G' : LastMCIValue := TBBSCore(Core).FileBase.FGroup.Name;
            'K' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.ULk);
            'O' : LastMCIValue := DateDos2Str(TBBSCore(Core).User.ThisUser.FirstOn, TBBSCore(Core).User.ThisUser.DateType);
            'U' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.ULs);
          End;
    'H' : Case Code[2] of
            'K' : LastMCIValue := OutON(TBBSCore(Core).User.ThisUser.HotKeys);
          End;
    'I' : Case Code[2] of
            'F' : UseInField := False;
            'N' : Begin
                    FmtString := True;
                    FmtType   := 12;
                  End;
            'L' : LastMCIValue := OutON(Chat.Invisible);
            'S' : Begin
                    FmtString := True;
                    FmtType   := 14;
                  End;
          End;
    'K' : Case Code[2] of
            'T' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.DLkToday);
          End;
    'L' : Case Code[2] of
            'O' : LastMCIValue := DateDos2Str(TBBSCore(Core).User.ThisUser.LastOn, TBBSCore(Core).User.ThisUser.DateType);
          End;
    'M' : Case Code[2] of
            'B' : LastMCIValue := TBBSCore(Core).Msgs.MBase.Name;
            'E' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.Emails);
            'G' : LastMCIValue := TBBSCore(Core).Msgs.Group.Name;
            'L' : LastMCIValue := OutON(TBBSCore(Core).User.ThisUser.UseLBIndex);
            'N' : LastMCIValue := Config.NetDesc[TBBSCore(Core).Msgs.MBase.NetAddr];
            'P' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.Posts);
            'T' : LastMCIValue := strI2S(TBBSCore(Core).Msgs.GetTotalMessages(TBBSCore(Core).Msgs.MBase));
          End;
    'N' : Case Code[2] of
            'D' : LastMCIValue := strI2S(TBBSCore(Core).NodeNum);
            'E' : LastMCIValue := strI2S(TBBSCore(Core).MinutesUntilEvent(TBBSCore(Core).NextEvent.ExecTime));
          End;
    'O' : Case Code[2] of
            'S' : LastMCIValue := OSID;
          End;
    'P' : Case Code[2] of
            'A' : PauseScreen;
            'B' : PurgeInputBuffer;
            'C' : Begin
                    A := 0;
                    If TBBSCore(Core).User.ThisUser.Calls > 0 Then
                      A := Round(TBBSCore(Core).User.ThisUser.Posts / TBBSCore(Core).User.ThisUser.Calls * 100);
                    LastMCIValue := strI2S(A);
                  End;
            'I' : BufAddChar('|');
            'N' : Repeat Until GetKey <> '';
            'O' : AllowPause := False;
            'W' : LastMCIValue := strI2S(Config.PWChange);
          End;
    'Q' : Case Code[2] of
            'A' : LastMCIValue := TBBSCore(Core).User.ThisUser.Archive;
            'L' : LastMCIValue := OutYN (TBBSCore(Core).User.ThisUser.QwkFiles);
            'O' : ShowRandomQuote;
          End;
    'R' : Case Code[2] of
            'D' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.DLRatio);
            'K' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.DLkRatio);
            'P' : Begin
                    FmtString := True;
                    FmtType   := 13;
                  End;
          End;
    'S' : Case Code[2] of
            'B' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.MaxTB);
            'C' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.MaxCalls);
            'D' : LastMCIValue := TBBSCore(Core).User.Security.Desc;
            'K' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.MaxDLK);
            'L' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.Security);
            'N' : LastMCIValue := Config.SysopName;
            'P' : Begin
                    A := Round(TBBSCore(Core).User.Security.PCRatio / 100 * 100);
                    LastMCIValue := strI2S(A);
                  End;
            'T' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.Time);
            'X' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.MaxDLs);
          End;
    'T' : Case Code[2] of
            '0'..
            '9' : LastMCIValue := Attr2Ansi(Session.Lang.Colors[strS2I(Code[2])]);
            'B' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.TimeBank);
            'C' : LastMCIValue := strI2S(Config.SystemCalls);
            'E' : If Graphics = 1 Then LastMCIValue := 'Ansi' Else LastMCIValue := 'Ascii'; //++lang
            'I' : LastMCIValue := TimeDos2Str(CurDateDos, True);
            'L' : LastMCIValue := strI2S(TBBSCore(Core).TimeLeft);
            'O' : LastMCIValue := strI2S(TBBSCore(Core).ElapsedTime);
          End;
    'U' : Case Code[2] of
            '#' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.PermIdx);
            '1' : LastMCIValue := TBBSCore(Core).User.ThisUser.OptionData[1];
            '2' : LastMCIValue := TBBSCore(Core).User.ThisUser.OptionData[2];
            '3' : LastMCIValue := TBBSCore(Core).User.ThisUser.OptionData[3];
            'A' : LastMCIValue := TBBSCore(Core).User.ThisUser.Address;
            'B' : Case TBBSCore(Core).User.ThisUser.FileList of
                    0 : LastMCIValue := 'Normal';
                    1 : LastMCIValue := 'Lightbar'; {++lang}
                  End;
            'C' : LastMCIValue := TBBSCore(Core).User.ThisUser.City;
            'D' : LastMCIValue := TBBSCore(Core).User.ThisUser.DataPhone;
            'E' : Case TBBSCore(Core).User.ThisUser.EditType of
                    0 : LastMCIValue := 'Line'; {++lang}
                    1 : LastMCIValue := 'Full';
                    2 : LastMCIValue := 'Ask';
                  End;
            'F' : LastMCIValue := DateTypeStr[TBBSCore(Core).User.ThisUser.DateType];
            'G' : If TBBSCore(Core).User.ThisUser.Gender = 'M' Then
                    LastMCIValue := 'Male'
                  Else
                    LastMCIValue := 'Female';  {++lang}
            'H' : LastMCIValue := TBBSCore(Core).User.ThisUser.Handle;
            'I' : LastMCIValue := TBBSCore(Core).User.ThisUser.UserInfo;
            'J' : Case TBBSCore(Core).User.ThisUser.MReadType of
                    0 : LastMCIValue := 'Normal';
                    1 : LastMCIValue := 'Lightbar'; {++lang}
                  End;
            'K' : LastMCIValue := TBBSCore(Core).User.ThisUser.Email;
            'L' : LastMCIValue := TBBSCore(Core).Lang.Desc;
            'M' : LastMCIValue := OutON(TBBSCore(Core).User.ThisUser.UseLBMIdx);
            'N' : LastMCIValue := TBBSCore(Core).User.ThisUser.RealName;
            'P' : LastMCIValue := TBBSCore(Core).User.ThisUser.HomePhone;
            'Q' : Case TBBSCore(Core).User.ThisUser.UseLBQuote of
                    False : LastMCIValue := 'Standard';
                    True  : LastMCIValue := 'Lightbar'; {++langfile++}
                  End;
            'S' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.ScreenSize);
            'X' : LastMCIValue := TBBSCore(Core).UserHostInfo;
            'Y' : LastMCIValue := TBBSCore(Core).UserIPInfo;
            'Z' : LastMCIValue := TBBSCore(Core).User.ThisUser.ZipCode;
          End;
    'V' : Case Code[2] of
            'R' : LastMCIValue := mysVersion;
          End;
    'X' : Case Code[2] of
            'D' : If DateValid(Session.User.ThisUser.Expires) Then
                    LastMCIValue := strI2S(Abs(CurDateJulian - DateStr2Julian(Session.User.ThisUser.Expires)))
                  Else
                    LastMCIValue := '0';
            'S' : LastMCIValue := strI2S(Session.User.ThisUser.ExpiresTo);
            'X' : LastMCIValue := '';
          End;
    '[' : Case Code[2] of
            'A' : Begin
                    FmtString := True;
                    FmtType   := 8;
                  End;
            'B' : Begin
                    FmtString := True;
                    FmtType   := 9;
                  End;
            'C' : Begin
                    FmtString := True;
                    FmtType   := 10;
                  End;
            'D' : Begin
                    FmtString := True;
                    FmtType   := 11;
                  End;
            'K' : AnsiClrEOL;
            'L' : Begin
                    FmtString := True;
                    FmtType   := 15;
                  End;
            'X' : Begin
                    FmtString := True;
                    FmtType   := 6;
                  End;
            'Y' : Begin
                    FmtString := True;
                    FmtType   := 7;
                  End;
          End;
  Else
    Result := False;
  End;

  If Display And (LastMCIValue <> #255) Then
    OutPipe(LastMCIValue);
End;

Procedure TBBSIO.OutFull (Str : String);
Var
  A : Byte;
  B : Byte;
  D : DirStr;
  N : NameStr;
  E : ExtStr;
Begin
  A := 1;

  While A <= Length(Str) Do Begin
    If (Str[A] = '|') and (A < Length(Str) - 1) Then Begin

      If Not ParseMCI (True, Copy(Str, A + 1, 2)) Then Begin
        BufAddChar(Str[A]);
        Inc(A);
        Continue;
      End;

      Inc (A, 2);

      If FmtString Then Begin
        If FmtType = 5 Then Begin
          FmtString := False;

          B := A + 1;

          While (Str[B] <> ' ') and (Str[B] <> '|') and (B <= Length(Str)) Do
            Inc (B);

          FSplit  (strStripLOW(Copy(Str, A + 1, B - A - 1)), D, N, E);
          OutFile (TBBSCore(Core).Lang.TextPath + N + E, True, 0);

          A := B;

          Continue;
        End;

        FmtLen := strS2I(Copy(Str, A + 1, 2));
        Inc (A, 2);

        Case FmtType of
          4 : Begin
                Inc (A);
                FmtString := False;
                BufAddStr (strRep(Str[A], FmtLen));
              End;
          6 : Begin
                AnsiMoveX (FmtLen);
                FmtString := False;
              End;
          7 : Begin
                AnsiMoveY (FmtLen);
                FmtString := False;
              End;
          8 : Begin
                AnsiMoveY (Screen.CursorY - FmtLen);
                FmtString := False;
              End;
          9 : Begin
                AnsiMoveY (Screen.CursorY + FmtLen);
                FmtString := False;
              End;
          10: Begin
                AnsiMoveX (Screen.CursorX + FmtLen);
                FmtString := False;
              End;
          11: Begin
                AnsiMoveX (Screen.CursorX - FmtLen);
                FmtString := False;
              End;
          12: Begin
                UseInLimit := True;
                InLimit    := FmtLen;
                FmtString  := False;
              End;
          13: Begin
                PausePtr  := FmtLen;
                FmtString := False;
              End;
          14: Begin
                UseInSize := True;
                InSize    := FmtLen;
                FmtString := False;
              End;
          15: Begin
                While Screen.CursorX > FmtLen Do
                  OutBS(1, True);

                FmtString := False;
              End;
          17: Begin
                Inc (A);
                FmtString := False;

                If Screen.CursorX < FmtLen Then
                  BufAddStr (strRep(Str[A], FmtLen - Screen.CursorX + 1));
              End;
        End;
      End;
    End Else
      BufAddChar (Str[A]);

    Inc(A);
  End;
End;

Procedure TBBSIO.OutFullLn (Str : String);
Begin
  OutFull (Str + #13#10);
  Inc (PausePtr);
End;

Procedure TBBSIO.AnsiClrEOL;
Begin
  BufAddStr (#27 + '[K');
End;

Function TBBSIO.Pipe2Ansi (Color: Byte) : String;
Var
  CurFG  : Byte;
  CurBG  : Byte;
  Prefix : String[2];
Begin
  Result := '';

  If Graphics = 0 Then Exit;

  CurBG  := (Screen.TextAttr SHR 4) AND 7;
  CurFG  := Screen.TextAttr AND $F;
  Prefix := '';

  If Color < 16 Then Begin
    If Color = CurFG Then Exit;

//    Screen.TextAttr := Color + CurBG * 16;

    If (Color < 8) and (CurFG > 7) Then Prefix := '0;';
    If (Color > 7) and (CurFG < 8) Then Prefix := '1;';
    If Color > 7 Then Dec(Color, 8);

    Case Color of
      00: Result := #27 + '[' + Prefix + '30';
      01: Result := #27 + '[' + Prefix + '34';
      02: Result := #27 + '[' + Prefix + '32';
      03: Result := #27 + '[' + Prefix + '36';
      04: Result := #27 + '[' + Prefix + '31';
      05: Result := #27 + '[' + Prefix + '35';
      06: Result := #27 + '[' + Prefix + '33';
      07: Result := #27 + '[' + Prefix + '37';
    End;

    If Prefix <> '0;' Then
      Result := Result + 'm'
    Else
      Case CurBG of
        00: Result := Result + ';40m';
        01: Result := Result + ';44m';
        02: Result := Result + ';42m';
        03: Result := Result + ';46m';
        04: Result := Result + ';41m';
        05: Result := Result + ';45m';
        06: Result := Result + ';43m';
        07: Result := Result + ';47m';
      End;
  End Else Begin
    If (Color - 16) = CurBG Then Exit;

//    Screen.TextAttr := CurFG + (Color - 16) * 16;

    Case Color of
      16: Result := #27 + '[40m';
      17: Result := #27 + '[44m';
      18: Result := #27 + '[42m';
      19: Result := #27 + '[46m';
      20: Result := #27 + '[41m';
      21: Result := #27 + '[45m';
      22: Result := #27 + '[43m';
      23: Result := #27 + '[47m';
    End;
  End;
End;

Function TBBSIO.Attr2Ansi (Attr: Byte) : String;
Begin
  Result := '';

  If Graphics = 0 Then Exit;

  Result := Pipe2Ansi(Attr AND $F) + Pipe2Ansi(((Attr SHR 4) AND 7) + 16);
End;

Procedure TBBSIO.AnsiColor (A : Byte);
Begin
  If Graphics = 0 Then Exit;

  BufAddStr(Attr2Ansi(A));
End;

Procedure TBBSIO.AnsiGotoXY (X: Byte; Y: Byte);
Begin
  If Graphics = 0 Then Exit;

  If X = 0 Then X := Screen.CursorX;
  If Y = 0 Then Y := Screen.CursorY;

  BufAddStr (#27'[' + strI2S(Y) + ';' + strI2S(X) + 'H');
End;

Procedure TBBSIO.AnsiClear;
Begin
  If Graphics > 0 Then
    BufAddStr (#27 + '[2J')
  Else
    BufAddChar (#12);

  PausePtr := 1;
End;

Function TBBSIO.OutYN (Y: Boolean) : String;
Begin
  If Y Then OutYN := 'Yes' Else OutYN := 'No'; {++lang?}
End;

Function TBBSIO.OutON (O : Boolean) : String;
Begin
  If O Then OutON := 'On' Else OutON := 'Off'; {++lang}
End;

Procedure TBBSIO.OutFile (FName : String; DoPause: Boolean; Speed: Byte);
Var
  Buffer  : Array[1..4096] of Char;
  BufPos  : LongInt;
  BufSize : LongInt;
  dFile   : File;
  Ext     : String[4];
  Code    : String[2];
  Old     : Boolean;
  Str     : String;
  Ch      : Char;
  Done    : Boolean;

  Function GetChar : Char;
  Begin
    If BufPos = BufSize Then Begin
      BlockRead (dFile, Buffer, SizeOf(Buffer), BufSize);

      BufPos := 0;

      If BufSize = 0 Then Begin
        Done      := True;
        Buffer[1] := #26;
      End;
    End;

    Inc (BufPos);

    Result := Buffer[BufPos];
  End;

Begin
  If Pos(PathChar, FName) = 0 Then
    FName := TBBSCore(Core).Lang.TextPath + FName;

  If Pos('.', FName) > 0 Then
    Ext := ''
  Else
  If (Graphics = 1) and (FileExist(FName + '.ans')) Then
    Ext := '.ans'
  Else
    Ext := '.asc';

  If FileExist(FName + Copy(Ext, 1, 3) + '1') Then Begin
    Repeat
      BufPos := Random(9);
      If BufPos = 0 Then
        Code := Ext[Length(Ext)]
      Else
        Code := strI2S(BufPos);
    Until FileExist(FName + Copy(Ext, 1, 3) + Code);

    Ext := Copy(Ext, 1, 3) + Code;
  End;

  Assign (dFile, FName + Ext);
  {$I-} Reset(dFile, 1); {$I+}
  If IoResult <> 0 Then Begin
    NoFile := True;
    Exit;
  End;

  NoFile       := False;
  Old          := AllowPause;
  AllowPause   := DoPause;
  PausePtr     := 1;
  Done         := False;
  BufPos       := 0;
  BufSize      := 0;
  Ch           := #0;
  BaudEmulator := Speed;

  While Not Done Do Begin
    Ch := GetChar;

    If BaudEmulator > 0 Then Begin
      BufFlush;

      If BufPos MOD BaudEmulator = 0 Then WaitMS(6);
    End;

    Case Ch of
      #10 : Begin
              BufAddChar (#10);
              Inc (PausePtr);

              If (PausePtr = TBBSCore(Core).User.ThisUser.ScreenSize) and (AllowPause) Then
                Case MorePrompt of
                  'N' : Break;
                  'C' : AllowPause := False;
                End;
            End;
      #26 : Break;
      '|' : Begin
              Code := GetChar;
              Code := Code + GetChar;

              If Not ParseMCI(True, Code) Then Begin
                BufAddStr('|' + Code);
                Continue;
              End;

              If FmtString Then Begin
                If FmtType = 5 Then Begin
                  FmtString := False;
                  Str       := '';

                  While Not Done Do Begin
                    Ch := GetChar;
                    If Ch in [#10, '|'] Then Break;
                    Str := Str + GetChar;
                  End;

                  OutFile (TBBSCore(Core).Lang.TextPath + strStripLOW(Str), True, 0);

                  Continue;
                End;

                Code   := GetChar;
                Code   := Code + GetChar;
                FmtLen := strS2I(Code);

                Case FmtType of
                  4 : Begin
                        BufAddStr (strRep(GetChar, FmtLen));
                        FmtString := False;
                      End;
                  6 : Begin
                        AnsiMoveX (FmtLen);
                        FmtString := False;
                      End;
                  7 : Begin
                        AnsiMoveY (FmtLen);
                        FmtString := False;
                      End;
                  8 : Begin
                        AnsiMoveY (Screen.CursorY - FmtLen);
                        FmtString := False;
                      End;
                  9 : Begin
                        AnsiMoveY (Screen.CursorY + FmtLen);
                        FmtString := False;
                      End;
                  10: Begin
                        AnsiMoveX (Screen.CursorX + FmtLen);
                        FmtString := False;
                      End;
                  11: Begin
                        AnsiMoveX (Screen.CursorX - FmtLen);
                        FmtString := False;
                      End;
                  12: Begin
                        UseInLimit := True;
                        InLimit    := FmtLen;
                        FmtString  := False;
                      End;
                  13: Begin
                        PausePtr  := FmtLen;
                        FmtString := True;
                      End;
                  14: Begin
                        UseInSize := True;
                        InSize    := FmtLen;
                        FmtString := False;
                      End;
                  15: Begin
                        While Screen.CursorX > FmtLen Do
                          OutBS(1, True);

                        FmtString := False;
                      End;
                  16: Begin
                        BaudEmulator := FmtLen;
                        FmtString    := False;
                      End;
                  17: Begin
                        FmtString := False;

                        If Screen.CursorX < FmtLen Then
                          BufAddStr (strRep(GetChar, FmtLen - Screen.CursorX + 1));
                      End;
                End;
              End;
            End;
    Else
      BufAddChar(Ch);
    End;
  End;

  AllowPause := Old;
  Close (dFile);

  BufFlush;
End;

{$IFDEF UNIX}
Function TBBSIO.InKey (Wait: LongInt) : Char;
Begin
  Result  := #255;
  IsArrow := False;

  If Input.KeyWait(Wait) Then Begin
    Result     := Input.ReadKey;
    LocalInput := True;

    If Result = #0 Then Begin
      Result := Input.ReadKey;

      If (AllowArrow) and (Result in [#71..#73, #75, #77, #79..#83]) Then Begin
        IsArrow := True;
        Exit;
      End;

      Result := #255;
    End;
  End;
End;
{$ENDIF}

{$IFDEF WINDOWS}
Function TBBSIO.InKey (Wait: LongInt) : Char;
Var
  Handles : Array[0..1] of THandle;
  InType  : Byte;
Begin
  Result := #255;

  Handles[0] := Input.ConIn;

  If Not TBBSCore(Core).LocalMode Then Begin
    If TBBSCore(Core).Client.DataWaiting Then
      InType := 2
    Else Begin
      Handles[1] := SocketEvent;

      WSAResetEvent  (Handles[1]);
      WSAEventSelect (TBBSCore(Core).Client.FSocketHandle, Handles[1], FD_READ OR FD_CLOSE);

      Case WaitForMultipleObjects(2, @Handles, False, Wait) of
        WAIT_OBJECT_0     : InType := 1;
        WAIT_OBJECT_0 + 1 : InType := 2;
      Else
        Exit;
      End;
    End;
  End Else
    Case WaitForSingleObject (Handles[0], Wait) of
      WAIT_OBJECT_0 : InType := 1;
    Else
      Exit;
    End;

  Case InType of
    1 : Begin // LOCAL input event
          If Not Input.ProcessQueue Then Exit;

          Result     := Input.ReadKey;
          LocalInput := True;
          IsArrow    := False;

          If Result = #0 Then Begin
            Result := Input.ReadKey;

            If (AllowArrow) and (Result in [#71..#73, #75, #77, #79..#83]) and (Screen.Active) Then Begin
              IsArrow := True;
              Exit;
            End;

            ProcessSysopCommand(Result);

            Result := #255;
          End;

          If Not Screen.Active Then Result := #255;
        End;
    2 : Begin // SOCKET read event
          If TBBSCore(Core).Client.ReadBuf(Result, 1) < 0 Then Begin
            TBBSCore(Core).SystemLog ('User dropped carrier');
            Halt(0);
          End;

          LocalInput := False;

          If AllowArrow Then Begin
            IsArrow := True;

            Case Result of
              #03 : Result := #81; { pgdn  }
              #04 : Result := #77; { right }
              #05 : Result := #72; { up    }
              #18 : Result := #73; { pgup  }
              #19 : Result := #75; { left  }
              #24 : Result := #80; { down  }
              #27 : Begin
                      If Not TBBSCore(Core).Client.DataWaiting Then WaitMS(25);
                      If Not TBBSCore(Core).Client.DataWaiting Then WaitMS(25);
                      If TBBSCore(Core).Client.DataWaiting Then Begin
                        If TBBSCore(Core).Client.ReadChar = '[' Then
                          Case TBBSCore(Core).Client.ReadChar of
                            'A' : Result := #72; { ansi up     }
                            'B' : Result := #80; { ansi down   }
                            'C' : Result := #77; { ansi right  }
                            'D' : Result := #75; { ansi left   }
                            'H' : Result := #71; { ansi home   }
                            'K' : Result := #79; { ansi end    }
                            'V' : Result := #73; { ansi pageup }
                            'U' : Result := #81; { ansi pgdown }
                           End;
                      End Else
                        IsArrow := False;
                    End;
              #127: Result := #83; { delete }
            Else
              IsArrow := False;
            End;
          End;
        End;
  End;
End;
{$ENDIF}

Function TBBSIO.GetKey : Char;
Var
  TimeCount : LongInt;
  LastSec   : LongInt;
Begin
  Result := #255;

  TBBSCore(Core).TimeOut := TimerSeconds;

  BufFlush;

  Repeat
    If LastSec <> TimerSeconds Then Begin

      If GetKeyFunc(False) Then Begin
        Result := #02;
        Exit;
      End;

      LastSec := TimerSeconds;

      If InMacro Then
        If InMacroPos <= Length(InMacroStr) Then Begin
          Result := InMacroStr[InMacroPos];
          Inc (InMacroPos);
          Exit;
        End Else
          InMacro := False;

      If TBBSCore(Core).CheckTimeOut Then
        If TimerSeconds - TBBSCore(Core).TimeOut >= Config.Inactivity Then Begin
          TBBSCore(Core).SystemLog('Inactivity timeout');
          OutFullLn (TBBSCore(Core).GetPrompt(136));
          Halt(0);
        End;

      If Session.AllowMessages And Not Session.InMessage Then Begin
        Dec (Session.MessageCheck);

        If Session.MessageCheck = 0 Then Begin
          CheckNodeMessages;

          Session.MessageCheck := mysMessageThreshold;
        End;
      End;

      TimeCount := TBBSCore(Core).TimeLeft;

      If TimeCount <> Session.LastTimeLeft Then Begin
        Session.LastTimeLeft := TimeCount;

        {$IFNDEF UNIX}
        UpdateStatusLine(StatusPtr, '');
        {$ENDIF}

        If TBBSCore(Core).TimerOn Then Begin
          If TimeCount = 5 Then Begin
            If Not TBBSCore(Core).TimeChecked Then Begin
              TBBSCore(Core).TimeChecked := True;
              OutFullLn (TBBSCore(Core).GetPrompt(134));
            End;
          End Else
          If TimeCount < 1 Then Begin
            If Not TBBSCore(Core).TimeChecked Then Begin
              TBBSCore(Core).TimeChecked := True;
              OutFullLn (TBBSCore(Core).GetPrompt(135));
              TBBSCore(Core).SystemLog ('User ran out of time');
              Halt(0);
            End;
          End Else
            TBBSCore(Core).TimeChecked := False;
        End;

        If TBBSCore(Core).NextEvent.Active Then
          If (TBBSCore(Core).MinutesUntilEvent(TBBSCore(Core).NextEvent.ExecTime) = TBBSCore(Core).NextEvent.Warning) And
             (Not TBBSCore(Core).EventWarn) And (TBBSCore(Core).NextEvent.Forced) Then Begin
               TBBSCore(Core).EventWarn := True;
               OutFullLn (TBBSCore(Core).GetPrompt(133));
          End;
      End;
    End;

    Result := InKey(1000);
  Until Result <> #255;
End;

Function TBBSIO.GetYNL (Str: String; Yes: Boolean) : Boolean;
Var
  Ch   : Char;
  X    : Byte;
  Temp : Boolean;
Begin
  PurgeInputBuffer;

  OutFull (Str);

  Temp       := AllowArrow;
  AllowArrow := True;
  X          := Screen.CursorX;

  Repeat
    AnsiMoveX (X);

    If Yes Then
      OutFull (TBBSCore(Core).GetPrompt(316))
    Else
      OutFull (TBBSCore(Core).GetPrompt(317));

    Ch := UpCase(GetKey);

    If IsArrow Then Begin
      If Ch = #77 Then Yes := False;
      If Ch = #75 Then Yes := True;
    End Else
    If Ch = #13 Then Break Else
    If Ch = #32 Then Yes := Not Yes Else
    If Ch = 'Y' Then Begin
      Yes := True;

      AnsiMoveX (X);
      OutFull   (TBBSCore(Core).GetPrompt(316));

      Break;
    End Else
    If Ch = 'N' Then Begin
      Yes := False;

      AnsiMoveX (X);
      OutFull   (TBBSCore(Core).GetPrompt(317));

      Break;
    End;
  Until False;

  OutRawLn('');

  AllowArrow := Temp;
  Result     := Yes;
End;

Function TBBSIO.GetYN (Str: String; Yes: Boolean) : Boolean;
Begin
  If (TBBSCore(Core).Lang.Flags AND ThmLightbarYN <> 0) and (Graphics = 1) Then Begin
    GetYN := GetYNL(Str, Yes);
    Exit;
  End;

  OutFull (Str);

  Case OneKey(#13'YN', False) of
    'Y' : Yes := True;
    'N' : Yes := False;
  End;

  OutFullLn (OutYN(Yes));

  Result := Yes;
End;

Function TBBSIO.GetPW (Str: String; BadStr: String; PW: String) : Boolean;
Var
  Loop : Byte;
  Temp : String[15];
Begin
  Result := True;

  If PW = '' Then Exit;

  Loop := 0;

  Repeat
    OutFull (Str);
    Temp := GetInput(15, 15, 16, '');
    If Temp = PW Then
      Exit
    Else Begin
      OutFullLn(BadStr);
      Inc (Loop);

      If (TBBSCore(Core).User.ThisUser.Handle <> '') and (Loop = 1) Then
        TBBSCore(Core).SystemLog ('User: ' + TBBSCore(Core).User.ThisUser.Handle);

      TBBSCore(Core).SystemLog ('Bad PW: ' + Temp);
    End;
  Until Loop = Config.PWAttempts;

  Result := False;
End;

Function TBBSIO.OneKey (Str: String; Echo: Boolean): Char;
Var
  Ch : Char;
Begin
  PurgeInputBuffer;

  Repeat
    Ch := UpCase(GetKey);
  Until Pos (Ch, Str) > 0;

  If Echo Then OutRawLn (Ch);

  Result := Ch;
End;

Function TBBSIO.GetInput (Field, Max, Mode: Byte; Default: String) : String;
(*
{ input modes: }
{ 1 = standard input
{ 2 = upper case }
{ 3 = proper }
{ 4 = usa phone number }
{ 5 = date }
{ 6 = password }
{ 7 = lower cased }
{ 8 = user defined input }
{ 9 = standard input with no CRLF }
*)
Var
  FieldCh   : Char;
  Ch        : Char;
  Str       : String;
  StrPos    : Integer;
  xPos      : Byte;
  Junk      : Integer;
  CurPos    : Integer;
  ArrowSave : Boolean;
  BackPos   : Byte;
  BackSaved : String;

  Procedure pWrite (Str : String);
  Begin
    If (Mode = 6) and (Str <> '') Then
      BufAddStr (strRep(TBBSCore(Core).Lang.EchoChar, Length(Str)))
    Else
      BufAddStr (Str);
  End;

  Procedure ReDraw;
  Begin
    AnsiMoveX (xPos);

    pWrite (Copy(Str, Junk, Field));
    If UseInField Then AnsiColor(TBBSCore(Core).Lang.FieldColor2);
    pWrite (strRep(FieldCh, Field - Length(Copy(Str, Junk, Field))));
    If UseInField Then AnsiColor(TBBSCore(Core).Lang.FieldColor1);

    AnsiMoveX (xPos + CurPos - 1);
  End;

  Procedure ReDrawPart;
  Begin
    pWrite (Copy(Str, StrPos, Field - CurPos + 1));
    If UseInField Then AnsiColor(TBBSCore(Core).Lang.FieldColor2);
    pWrite (strRep(FieldCh, (Field - CurPos + 1) - Length(Copy(Str, StrPos, Field - CurPos + 1))));
    If UseInField Then AnsiColor(TBBSCore(Core).Lang.FieldColor1);

    AnsiMoveX (xPos + CurPos - 1);
  End;

  Procedure ScrollRight;
  Begin
    Inc (Junk, Field DIV 2); {scroll size}
    If Junk > Length(Str) Then Junk := Length(Str);
    If Junk > Max Then Junk := Max;
    CurPos := StrPos - Junk + 1;
    ReDraw;
  End;

  Procedure ScrollLeft;
  Begin
    Dec (Junk, Field DIV 2); {scroll size}
    If Junk < 1 Then Junk := 1;
    CurPos := StrPos - Junk + 1;
    ReDraw;
  End;

  Procedure AddChar (Ch : Char);
  Begin
    If CurPos > Field then ScrollRight;

    Insert (Ch, Str, StrPos);
    If StrPos < Length(Str) Then ReDrawPart;

    Inc (StrPos);
    Inc (CurPos);

    pWrite (Ch);
  End;

Begin
  If UseInLimit Then Begin
    Field := InLimit;
    UseInLimit := False;
  End;

  If UseInSize Then Begin
    UseInSize := False;
    If InSize <= Max Then Max := InSize;
  End;

  xPos    := Screen.CursorX;
  FieldCh := ' ';

  // this is poorly implemented but to expand on it will require MPL
  // programs to change. :(  we are stuck at the cap for input types
  // because of this.

  If Mode > 10 Then Begin
    Dec (Mode, 10);

    If UseInField and (Graphics = 1) Then Begin
      FieldCh := TBBSCore(Core).Lang.FieldChar;

      AnsiColor (TBBSCore(Core).Lang.FieldColor2);
      BufAddStr (strRep(FieldCh, Field));
      AnsiColor (TBBSCore(Core).Lang.FieldColor1);
      AnsiMoveX (xPos);
    End Else
      UseInField := False;
  End Else
    UseInField := False;

  If Mode = 8 Then
    Case Config.UserNameFormat of
      0 : Mode := 1;
      1 : Mode := 2;
      2 : Mode := 7;
      3 : Mode := 3;
    End;

  ArrowSave  := AllowArrow;
  AllowArrow := (Mode in [1..3, 7..9]) and (Graphics > 0);

  BackPos := 0;
  Str     := Default;
  StrPos  := Length(Str) + 1;
  Junk    := StrPos - Field;

  If Junk < 1 Then Junk := 1;

  CurPos := StrPos - Junk + 1;

  PWrite (Copy(Str, Junk, Field));

  PurgeInputBuffer;

  Repeat
    Ch := GetKey;

    If IsArrow Then Begin
      Case Ch of
        #71 : If StrPos > 1 Then Begin
                StrPos := 1;
                Junk   := 1;
                CurPos := 1;
                ReDraw;
              End;
        #72 : If (BackPos < mysMaxInputHistory) And (BackPos < InputPos) Then Begin
                Inc (BackPos);

                If BackPos = 1 Then BackSaved := Str;

                Str := InputData[BackPos];
                StrPos := Length(Str) + 1;
                Junk   := StrPos - Field;
                If Junk < 1 Then Junk := 1;
                CurPos := StrPos - Junk + 1;
                ReDraw;
              End;
        #75 : If StrPos > 1 Then Begin
                If CurPos = 1 Then ScrollLeft;
                Dec (StrPos);
                Dec (CurPos);
                If CurPos < 1 then CurPos := 1;
                AnsiMoveX (Screen.CursorX - 1);
              End;
        #77 : If StrPos < Length(Str) + 1 Then Begin
                If (CurPos = Field) and (StrPos < Length(Str)) Then ScrollRight;
                Inc (CurPos);
                Inc (StrPos);
                AnsiMoveX (Screen.CursorX + 1);
              End;
        #79 : Begin
                StrPos := Length(Str) + 1;
                Junk   := StrPos - Field;
                If Junk < 1 Then Junk := 1;
                CurPos := StrPos - Junk + 1;
                ReDraw;
              End;
        #80 : If (BackPos > 0) Then Begin
                Dec (BackPos);

                If BackPos = 0 Then
                  Str := BackSaved
                Else
                  Str := InputData[BackPos];

                StrPos := Length(Str) + 1;
                Junk   := StrPos - Field;
                If Junk < 1 Then Junk := 1;
                CurPos := StrPos - Junk + 1;
                ReDraw;
              End;
        #83 : If (StrPos <= Length(Str)) and (Length(Str) > 0) Then Begin
                Delete(Str, StrPos, 1);
                ReDrawPart;
              End;
      End;
    End Else
      Case Ch of
        #02 : ReDraw;
        #08 : If StrPos > 1 Then Begin
                Dec    (StrPos);
                Delete (Str, StrPos, 1);

                If CurPos = 1 Then
                  ScrollLeft
                Else
                If StrPos = Length(Str) + 1 Then Begin
                  If UseInField Then AnsiColor(TBBSCore(Core).Lang.FieldColor2);
                  BufAddStr (#8 + FieldCh + #8);
                  If UseInField Then AnsiColor(TBBSCore(Core).Lang.FieldColor1);
                  Dec (CurPos);
                End Else Begin
                  BufAddChar (#8);
                  Dec (CurPos);
                  ReDrawPart;
                End;
              End;
        #13 : Break;
        ^Y  : Begin
                Str    := '';
                StrPos := 1;
                Junk   := 1;
                CurPos := 1;
                ReDraw;
              End;
        #32..
        #254: If Length(Str) < Max Then
              Case Mode of
                1 : AddChar (Ch);
                2 : AddChar (UpCase(Ch));
                3 : Begin
                      If (CurPos = 1) or (Str[StrPos-1] in [' ', '.']) Then
                        Ch := UpCase(Ch)
                      Else
                        Ch := LoCase(Ch);

                      AddChar(Ch);
                    End;
                4 : If (Ord(Ch) > 47) and (Ord(Ch) < 58) Then
                      Case StrPos of
                        4,8 : Begin
                                AddChar ('-');
                                AddChar (Ch);
                              End;
                        3,7 : Begin
                                AddChar (Ch);
                                AddChar ('-');
                              End;
                      Else
                        AddChar(Ch);
                      End;
                5 : If (Ord(Ch) > 47) and (Ord(Ch) < 58) Then
                      Case StrPos of
                        2,5 : Begin
                                AddChar (Ch);
                                AddChar ('/');
                              End;
                        3,6 : Begin
                                AddChar ('/');
                                AddChar (Ch);
                              End;
                      Else
                        AddChar (Ch);
                      End;
                6 : AddChar(UpCase(Ch));
                7 : AddChar(LoCase(Ch));
                9 : AddChar(Ch);
              End;
      End;
  Until False;

  If Mode <> 6 Then Begin
    For Junk := 4 DownTo 2 Do
      InputData[Junk] := InputData[Junk - 1];

    InputData[1] := Str;

    If InputPos < mysMaxInputHistory Then Inc(InputPos);
  End;

  If Mode = 9 Then
    OutFull ('|16')
  Else
    OutFullLn ('|16');

  Case Mode of
    5 : Case TBBSCore(Core).User.ThisUser.DateType of  { Convert to MM/DD/YY }
          {DD/MM/YY}
          2 : Str := Copy(Str, 4, 2) + '/' + Copy(Str, 1, 2) + '/' + Copy(Str, 7, 2);
          {YY/DD/MM}
          3 : Str := Copy(Str, 7, 2) + '/' + Copy(Str, 4, 2) + '/' + Copy(Str, 1, 2);
        End;
  End;

  UseInField := True;
  AllowArrow := ArrowSave;
  Result     := Str;
End;

Function TBBSIO.InXY (X, Y, Field, Max, Mode: Byte; Default: String) : String;
Begin
  If Graphics = 0 Then
    OutFull ('|CR: ')
  Else
    AnsiGotoXY (X, Y);

  InXY := GetInput (Field, Max, Mode, Default);
End;

Function TBBSIO.DrawPercent (Bar: RecPercent; Part, Whole: SmallInt; Var Percent : SmallInt) : String;
Var
  FillSize : Byte;
  Attr     : Byte;
Begin
  Attr := Screen.TextAttr;

  Screen.TextAttr := 0;  // kludge to force it to return full ansi codes

  If (Part = 0) or (Whole = 0) or (Part > Whole) Then Begin
    FillSize := 0;
    Percent  := 0;
//    FillSize := Bar.BarLen;
//    Percent  := 100;
// this needs work...
  End Else Begin
    FillSize := Round(Part / Whole * Bar.BarLength);
    Percent  := Round(Part / Whole * 100);
  End;

  Result := Attr2Ansi(Bar.HiAttr) + strRep(Bar.HiChar, FillSize) +
            Attr2Ansi(Bar.LoAttr) + strRep(Bar.LoChar, Bar.BarLength - FillSize) +
            Attr2Ansi(Attr);
End;

{$IFDEF UNIX}
Procedure TBBSIO.RemoteRestore (Var Image: TConsoleImageRec);
Var
  CountX : Byte;
  CountY : Byte;
Begin
  For CountY := Image.Y1 to Image.Y2 Do Begin
    Session.io.AnsiGotoXY (Image.X1, CountY);

    For CountX := Image.X1 to Image.X2 Do Begin
      Session.io.AnsiColor(Image.Data[CountY][CountX].Attributes);
      Session.io.BufAddChar(Image.Data[CountY][CountX].UnicodeChar);
    End;
  End;

  Session.io.AnsiColor  (Image.CursorA);
  Session.io.AnsiGotoXY (Image.CursorX, Image.CursorY);

  Session.io.BufFlush;
End;
{$ELSE}
Procedure TBBSIO.RemoteRestore (Var Image: TConsoleImageRec);
Var
  CountX   : Byte;
  CountY   : Byte;
  BufPos   : Integer;
  Buffer   : Array[1..SizeOf(TConsoleScreenRec) DIV 2] of Word Absolute Image.Data;
  TempChar : Char;
Begin
  BufPos := 1;

  For CountY := Image.Y1 to Image.Y2 Do Begin
    Session.io.AnsiGotoXY (Image.X1, CountY);

    For CountX := Image.X1 to Image.X2 Do Begin

      Session.io.AnsiColor(Buffer[BufPos+1]);

      TempChar := Char(Buffer[BufPos]);

      If TempChar = #0 Then TempChar := ' ';

      Session.io.BufAddChar(TempChar);
      Inc (BufPos, 2);
    End;
  End;

  Session.io.AnsiColor  (Image.CursorA);
  Session.io.AnsiGotoXY (Image.CursorX, Image.CursorY);

  Session.io.BufFlush;
End;
{$ENDIF}

Function TBBSIO.StrMci (Str: String) : String;
Var
  Count : Byte;
  Code  : String[2];
Begin
  Result := '';
  Count  := 1;

  While Count <= Length(Str) Do Begin
    If (Str[Count] = '|') and (Count < Length(Str) - 1) Then Begin
      Code := Copy(Str, Count + 1, 2);
      Inc (Count, 2);
      Case Code[1] of
        '0' : Result := Result + '|' + Code;
        '1' : Result := Result + '|' + Code;
        '2' : Result := Result + '|' + Code;
      Else
        If ParseMCI(False, Code) Then
          Result := Result + LastMCIValue
        Else
          Result := Result + '|' + Code;
      End;
    End Else
      Result := Result + Str[Count];

    Inc(Count);
  End;
End;

Procedure TBBSIO.PurgeInputBuffer;
Begin
  While Input.KeyPressed Do Input.ReadKey;
  {$IFDEF WINDOWS}
  If Not TBBSCore(Core).LocalMode Then TBBSCore(Core).Client.PurgeInputData;
  {$ENDIF}
End;

{$IFDEF WINDOWS}
Procedure TBBSIO.LocalScreenDisable;
Begin
  Screen.ClearScreenNoUpdate;
  Screen.WriteXYNoUpdate(1, 1, 7, 'Screen disabled. Press ALT-V to view user');
  Screen.Active := False;
End;

Procedure TBBSIO.LocalScreenEnable;
Begin
  Screen.Active := True;
  Screen.ShowBuffer;
  UpdateStatusLine(StatusPtr, '');
End;
{$ENDIF}

End.