{$IFNDEF OS2}
{$F+,B-,O+}
{$ENDIF}

Unit MainCOvr;

{*********************************************************}
{*                     MAINCOVR.PAS                      *}
{*                                                       *}
{*  Copyright (c) Konstantin Klyagin, 1995-98,           *}
{*                exspecially for Tornado BBS System     *}
{*                                                       *}
{*********************************************************}

Interface

Uses
{$IFDEF WIN32}
  Forms,
  Windows,
  WApro,
  Console,
  SysUtils,
{$ENDIF}
  MainComm,
  tGlob,
  tMisc,
  iEMSI,
  OpCrt,
  Parse,
  Parser,
  Objects,
  TimeTask;

Procedure InitMainCOvr;
Function fQuery (What: String; IsYes: Boolean; Flags: Byte): Boolean;

Implementation

{$IFDEF WIN32}
Uses
  tor32u;
{$ENDIF}

Procedure fComRead (Var S: String; Max: Integer; Options: Byte);
Var
  k                       : Char;
  Flag, CurAdded, Changed : Boolean;
  S1                      : String;
  MultiMsg                : tMsg;
  MLtimer, CurHistoryItem : LongInt;
  Index                   : Byte;

Procedure UpdateString;
Begin
  S1 := PString (ReadHistory^. At (CurHistoryItem))^;

  ComWrite (Replicate (#8, Index-1), 0);
  ComWrite (S1, 0);

  If Length (S)-Length (S1) > 0 Then
  Begin
    ComWrite (Replicate (' ', Length (S)-Length (S1)), 0);
    ComWrite (Replicate (#8, Length (S)-Length (S1)), 0);
  End;

  Index := Length (S1)+1;
  S := S1;
End;

Begin
{$IFDEF WIN32}
  Application. ProcessMessages;
  If Application. Terminated Then Exit;
  MainForm. Console1. ShowCursor;
  MainForm. Console1. Paint;
{$ENDIF}

  MLtimer := MidSec;

  If HotKeysStr <> '' Then
  If Not R. HotKeys Then
  Begin
    S := HotKeysStr;
    HotKeysStr := '';

    Case Mode Of
      Lower  : S := LoString (S);
      Upper  : S := UpString (S);
      Proper : S := PrString (S);
    End;

    ComWrite (S, 0);
    Exit;
  End Else
    HotKeysStr := '';

  ComWrite (S, 0);
  Index := Length (S)+1;
  CurHistoryItem := ReadHistory^. Count-1;
  CurAdded := False;
  Changed := False;

  While True Do
  Begin
    If EMSI. Allowed and Registering Then
    If Pos ('**EMSI_ICI', UpString (S)) <> 0 Then
    Begin
      ComWrite (#13#10, 0);
      DoIEMSI;
      S := R. Name;
      If S <> '' Then Exit;
    End;

    k := ComReadKey;
  {$IFDEF WIN32}
    If Application. Terminated Then Exit;
  {$ENDIF}
    If k = #0 Then Continue;

    If InConference Then
    If MidSec - MLtimer >= 5 Then
    Begin
      While mL_GetMsg (MultiMsg, mtConference) Do
      Begin

        If MultiMsg. MessageText [1] <> trcSysMsgPrefix Then
        Begin
          ComWrite (#13 + EmuColor ($0F), 0); ComWrite (EmuClrEOL, 0);
          ComWriteLn ('<' + MultiMsg. FromUserName + '> ' +
          EmuColor ($0B) + MultiMsg. MessageText, eoCodes)
        End Else
        Begin
          ComWrite (#13 + EmuColor ($0A), 0); ComWrite (EmuClrEOL, 0);
          ComWriteLn (Copy (MultiMsg. MessageText, 2, 255), eoCodes+eoMacro);
        End;

        ComWrite (EmuColor ($0B) + '> ' + EmuColor ($0F) + S, 0);
      End;

      While mL_GetMsg (MultiMsg, mtUserMsg) Do
      Begin
        ComWriteLn (#13#7 + EmuColor ($0C) + '[' + MultiMsg.
          FromUserName + ']' + EmuColor ($0B) + MultiMsg.
          MessageText, eoCodes);

        ComWrite (EmuColor ($0B) + '> ' + EmuColor ($0E) + S, 0);
      End;

      MLtimer := MidSec;
    End;

    Case k Of

    kbUp : If (Options and ofHistory <> 0) And
              (((CurHistoryItem > 0) And (ReadHistory^. Count > 1)) Or
                (CurHistoryItem = 0) And Not CurAdded) Then
           Begin
             If CurHistoryItem = ReadHistory^. Count-1 Then
             If CurAdded Then
             Begin
               ReadHistory^. AtRemove (ReadHistory^. Count-1);
               ReadHistory^. InsLine (S);
             End Else
             Begin
               ReadHistory^. InsLine (S);
               CurAdded := True;
               Inc (CurHistoryItem);
             End;

             Dec (CurHistoryItem);
             Changed := False;
             UpdateString;
           End;

  kbDown : If (Options and ofHistory <> 0) And
              (CurHistoryItem < ReadHistory^. Count-1) Then
           Begin
             Inc (CurHistoryItem);
             Changed := False;
             UpdateString;
           End;

 kbRight : If Index <= Length (S) Then
           Begin
             ComWrite (S [Index], 0);
             Inc (Index);
           End;

  kbLeft : If Index > 1 Then
           Begin
             ComWrite (#8, 0);
             Dec (Index);
           End;

  kbHome : Begin
             ComWrite (Replicate (#8, Index-1), 0);
             Index := 1;
           End;

   kbEnd : Begin
             ComWrite (Copy (S, Index, 255), 0);
             Index := Length (S)+1;
           End;

      #24: Begin
             ComWrite (Replicate (#8, Index-1), 0);
             ComWrite (Replicate (' ', Length (S)), 0);
             ComWrite (Replicate (#8, Length (S)), 0);
             Index := 1;
             S := '';
           End;

      #13: Begin
             If ((Options and ofAllowEmpty = 0) and
                (Length (Trim (S)) > 0)) or
                (Options and ofAllowEmpty <> 0) Then
             Begin
               If Options and ofSpaceAdd <> 0 Then ComWrite (EmuCursorRight (Max-Length (S)), 0);
               If (Options and ofHistory <> 0) And CurAdded Then
               Begin
                 ReadHistory^. AtRemove (ReadHistory^. Count-1);
                 If Changed Then ReadHistory^. InsLine (S);
               End;

               Exit;
             End;
           End;

      #8 : If (Length (S) > 0) And (Index > 1) Then
           Begin
             Dec (Index);
             Delete (S, Index, 1);
             Changed := True;

             If Index = Length (S)+1 Then ComWrite (#8' '#8, 0) Else
             Begin
               ComWrite (#8+Copy (S, Index, 255)+' ', 0);
               ComWrite (Replicate (#8, Length (S)-Index+2), 0);
             End;
           End;

   kbDel : If (Length (S) > 0) And (Index <= Length (S)) Then
           Begin
             Delete (S, Index, 1);
             ComWrite (Copy (S, Index, 255) + ' ', 0);
             ComWrite (Replicate (#8, Length (S)-Index+2), 0);
             Changed := True;
           End;

    Else
      If Not (k in InputAccept) Then Continue;

      If Length (S) < Max Then
      Begin
        Case Mode Of
          Lower  : k := LoCase (k);
          Upper  : k := UpCase (k);
          Proper : Begin
                     If (Length (S) > 0) And (S [Length (S)] in
                        [' ', '.', ',', '/', '-'])
                     Then k := UpCase (k) Else
                     If S = '' Then k := UpCase (k) Else k := LoCase (k);
                   End;
        End;

        Insert (k, S, Index);
        Changed := True;

        If Options and ofHistory <> 0 Then
        If Not CurAdded Then
        Begin
          CurHistoryItem := ReadHistory^. Count-1;
          ReadHistory^. InsLine (S);
          CurAdded := True;
        End Else
        Begin
          ReadHistory^. AtRemove (ReadHistory^. Count-1);
          ReadHistory^. InsLine (S);
          CurHistoryItem := ReadHistory^. Count-1;
        End;

        Inc (Index);
        ComWrite (k + Copy (S, Index, 255), 0);
        If Length (S)-Index+1 > 0 Then ComWrite (Replicate (#8, Length (S)-Index+1), 0);

        If Flag Then
        If WhereX >= 80 Then
        Begin
          Flag := False;
          WriteLn;
        End;

        If Not Flag Then
        If WhereX >= 80 Then Flag := True;
      End Else

        If InConference Then
        Begin
          If Pos (' ', S) <> 0 Then
          Begin
            S1 := ExtractWord (WordCount (S, [' ']), S, [' ']);
            S := TrimTrail (Copy (S, 1, Length (S) - Length (S1)));
          End Else
            S1 := '';

          KeyBufAdd (S1 + k);
          Exit;
        End;

    End;
  End;
End;

Procedure fComReadLn (Var S: String; Max: Integer; Options: Byte);
Begin
  fComRead (S, Max, Options);
  ComWriteLn ('', 0);
End;

Function fComMenu (Header, ChoiceStr: String; Items: PNotSortedCollection): String;
Var
  i, T1         : Integer;
  Flag          : Boolean;
  S, T          : String;
  j, x          : Byte;

Label
  SkipOutPut,
  Choice;

Begin
  fComMenu := '0';
  If Items^. Count = 0 Then Exit;

  i := 1;
  InitMore (3);

  Flag := False;
  If HotKeysStr <> '' Then GoTo SkipOutPut;

  ComWriteLn (Header + #13#10, eoMacro + eoCodes);

  While Items^. Count > i-1 Do
  Begin
  {$IFDEF WIN32}
    If Application. Terminated Then Exit;
  {$ENDIF}
    T := '';

    If Not Cnf. OneColMenus Then
    Begin
      ComWrite ('  ' + EmuColor (Cnf. ColorScheme [umNumber]) +
        LeftPadCh (Long2Str (i), ' ', 3) + EmuColor (Cnf.
        ColorScheme [umDot]) + '. ' + EmuColor (Cnf. ColorScheme
        [umItem]), eoMacro + eoCodes);

      S := PString (Items^. At (i-1))^;

      j := 1;
      x := WhereX;

      While (WhereX <= x+32) And (Length (S) >= j) Do
      Begin
        ComWrite (S [j], eoMacro+eoCodes);
        Inc (j);
      End;

      If Pos ('|', S) <> 0
      Then ComWrite ('  ', 0)
      Else ComWrite (Replicate (' ', 33-Length (ZeroMsg (S, True))), eoMacro + eoCodes);

      If Items^. Count > i
      Then
        ComWriteLn (EmuColor (Cnf. ColorScheme [umNumber]) + LeftPadCh (Long2Str
                   (i+1), ' ', 3) + EmuColor (Cnf. ColorScheme [umDot]) + '. ' +
                   EmuColor (Cnf. ColorScheme [umItem]) + PadCh (PString (Items^. At (i))^, ' ', 33),
                   eoMacro + eoCodes)
      Else
        ComWriteLn ('', 0);

      Inc (i, 2);
    End Else
    Begin
      ComWriteLn ('  ' + EmuColor (Cnf. ColorScheme [umNumber]) + LeftPadCh
                 (Long2Str (i), ' ', 3) + EmuColor (Cnf. ColorScheme [umDot]) + '. ' +
                 EmuColor (Cnf. ColorScheme [umItem]) + PString (Items^. At (i - 1))^,
                 eoMacro + eoCodes);
      Inc (i);
    End;

    If Not MoreNums (T, ChoiceStr) Then Exit;

    If Length (T) > 0 Then
    Begin
      Val (T, t1, Err);
      If ((Err <> 0) Or (t1 > Items^. Count) Or (t1 <= 0)) Then Continue;
      fComMenu := T;
      Exit;
    End;

  End;

  ComWriteLn ('', 0);

  ComWrite (ChoiceStr, eoMacro + eoCodes);
  GoTo Choice;

  SkipOutput:
  SetOutPut (False, False);
  Flag := True;

  Choice:
  t := '';
  ComReadLn (t, 4, ofAllowEmpty);
{$IFDEF WIN32}
  If Application. Terminated Then Exit;
{$ENDIF}
  If Flag Then SetOutPut (True, Not Local);

  Val (t, t1, err);
  If ((err <> 0) Or (t1 > Items^. Count) Or (t1 <= 0)) Then T := '';
  fComMenu := T;
End;

Procedure fSetProtocol (C: Char);
Var
  Hot, Avail, Select : Boolean;
  P : tConfigParser;
  Prots : PNotSortedCollection;
  PName, ProtStr : String;
  S3 : String;
  PKey : Char;
  i : LongInt;

Begin
  PName := '';
  ProtStr := '';
  Hot := HotKeysStr <> '';
  Select := (C = #0) And Not Hot;

  If ParserOpen (P, Cnf. ProtocolCTL, tpoWriteLog) Then
  Begin
    Prots := New (PNotSortedCollection, Init (8, 2));

    While Not ParserEnd (P) Do
    Begin
      S1 := ParserRead (P, S2);

      If (S2 = 'EXTERNAL') Or (ParserEnd (P) And (S2 = '')) Then
      Begin
        If PName <> '' Then
        If (PKey <> #255) And Avail Then
        Begin
          Prots^. Insert (NewStr (PKey + PName));
          ProtStr := ProtStr + PKey;
        End;

        PKey := #255;
        Avail := True;
        PName := '';
        S2 := '';
      End;

      If S2 = 'INTERNAL' Then
      Begin
          PKey := #0;

          If S1 = 'XMODEM'    Then PKey := '1' Else
          If S1 = 'XMODEMCRC' Then PKey := '2' Else
          If S1 = 'XMODEM1K'  Then PKey := '3' Else
          If S1 = 'XMODEM1KG' Then PKey := '4' Else
          If S1 = 'YMODEM'    Then PKey := '5' Else
          If S1 = 'YMODEMG'   Then PKey := '6' Else
          If S1 = 'ZMODEM'    Then PKey := '7' Else
          If S1 = 'ZMODEM8K'  Then PKey := '8';
        S3 := ExtractWord (3, P.S, [' ']);
        P. S := ExtractWord (1, P.S, [' ']) + ' ' + ExtractWord (2, P.S, [' ']);
        If Length (S3)>0 Then PKey := S3[1];
        Avail := False;
        ParserGetParam (P, tptBoolean, '', Avail);

        If Avail Then
        Begin
(*
          PKey := #0;

          If S1 = 'XMODEM'    Then PKey := '1' Else
          If S1 = 'XMODEMCRC' Then PKey := '2' Else
          If S1 = 'XMODEM1K'  Then PKey := '3' Else
          If S1 = 'XMODEM1KG' Then PKey := '4' Else
          If S1 = 'YMODEM'    Then PKey := '5' Else
          If S1 = 'YMODEMG'   Then PKey := '6' Else
          If S1 = 'ZMODEM'    Then PKey := '7' Else
          If S1 = 'ZMODEM8K'  Then PKey := '8';
*)
          If PKey <> #0 Then
          Begin
            Prots^. Insert (NewStr (PKey + ExtractWord (1, P. S, [' '])));
            ProtStr := ProtStr + PKey;
          End;
        End;
      End Else
      If S2 = '' Then
      Begin
        If S1 = 'NAME' Then ParserGetParam (P, tptString, '', PName) Else
        If S1 = 'AVAILABLE' Then ParserGetParam (P, tptBoolean, '', Avail) Else
        If S1 = 'SELECTION' Then
        Begin
          ParserGetParam (P, tptString, '', S1);
          If Length (S1) > 0 Then PKey := S1 [1] Else PKey := #255;
        End;
      End;
    End;

    ParserClose (P);

    If Length (ProtStr) = 1 Then C := ProtStr [1] Else
    If Select Then
    Begin
      ComWrite ('|' + lang (laSelectProtocol) + '|', eoMacro + eoCodes);

      For i := 0 To Prots^. Count-1 Do
      Begin
        S1 := PString (Prots^. At (i))^;
        ComWriteLn ('  \12[\14' + S1 [1] + '\12]\15 ' + Copy (S1, 2, 255), eoMacro+eoCodes);
      End;

      ComWriteLn ('', 0);
      ComWrite (lang (laYourChoice), eoMacro + eoCodes);

      Repeat
        ProcessChoices;
        C := UpCase (ComReadKey);
      {$IFDEF WIN32}
        If Application. Terminated Then Exit;
      {$ENDIF}
      Until Pos (C, ProtStr) <> 0;
    End;

    FillChar (ProtocolDef, SizeOf (ProtocolDef), 0);

    For i := 0 To Prots^. Count-1 Do
    Begin
      S1 := PString (Prots^. At (i))^;

      If S1 [1] = C Then
      With ProtocolDef Do
      Begin
        Name := Copy (S1, 2, 255);
        Available := True;
        Selection := C;
        Break;
      End;
    End;

    If ProtocolDef. Available Then
    If Not (C in ['1'..'8']) Then
    If ParserOpen (P, Cnf. ProtocolCTL, tpoWriteLog) Then
    Begin
      ProtocolDef. Name := '';

      While Not ParserEnd (P) Do
      Begin
        S1 := ParserRead (P, S2);

        If (S2 = 'EXTERNAL') Or (ParserEnd (P) And (S2 = '')) Then
        Begin
          If (ProtocolDef. Name <> '') And
             (ProtocolDef. Selection = C)
          Then Break;

          S2 := '';
        End;

        If S2 = '' Then
        With ProtocolDef Do
        Begin
          If S1 = 'NAME' Then ParserGetParam (P, tptString, '', Name) Else
          If S1 = 'AVAILABLE' Then ParserGetParam (P, tptBoolean, '', Available) Else
          If S1 = 'BATCH' Then ParserGetParam (P, tptBoolean, '', Batch) Else
          If S1 = 'LOG' Then
          Begin
            ParserGetParam (P, tptFilePath, '', S1);
            Log := DefaultName (S1, 'log', Cnf. Path);
          End Else
          If S1 = 'SELECTION' Then
          Begin
            ParserGetParam (P, tptString, '', S1);
            If Length (S1) > 0 Then Selection := S1 [1] Else Selection := #255;
          End Else
          If S1 = 'DL_COMMAND' Then ParserGetParam (P, tptString, '', DLCommand) Else
          If S1 = 'UL_COMMAND' Then ParserGetParam (P, tptString, '', ULCommand) Else
          If S1 = 'DL_KEYWORD' Then ParserGetParam (P, tptQuote, '', DLKeyWord) Else
          If S1 = 'UL_KEYWORD' Then ParserGetParam (P, tptQuote, '', ULKeyWord) Else
          If S1 = 'WORD_OFFSET' Then ParserGetParam (P, tptByte, '', WordOffs) Else
          If S1 = 'LIST' Then
          Begin
            ParserGetParam (P, tptFilePath, '', S1);
            List := DefaultName (S1, 'lst', Cnf. DoorInfoDir);
          End;
        End;

      End;

      ParserClose (P);
    End;

    Dispose (Prots, Done);
  End;

  If Select Then ComWriteLn (ProtocolDef. Name, 0);
  R. Protocol := C;
  UpdateUserMacro;
End;

Function fGetAnswer (Quest: String; Len, Options: Byte; Default: String): String;
Var
  ATT   : Byte;

Begin
  ATT := TextAttr;
  Frame;
  ComWrite (Quest, eoMacro + eoCodes);
  ComReadLn (Default, Len, Options);
  fGetAnswer := Default;
  ComWrite (EmuColor (Att), 0);
End;

Function fQuery (What: String; IsYes: Boolean; Flags: Byte): Boolean;
Var
  C                     : Char;
  MaxLength, YN_Len,
  YesPos, NoPos         : Byte;
  S                     : String [5];
  sYes, sNo             : String;

Procedure DrawYesNo;
Var
  S1, S2, S3: String;

Begin
  S1 := Copy (sYes, 1, YesPos-1);
  S2 := Copy (sYes, YesPos+1, 255);

  ComWrite (EmuColor ($1B) + ' ', 0);
  If S1 <> '' Then ComWrite (EmuColor ($1F) + S1, 0);
  ComWrite (EmuColor ($1E) + Copy (sYes, YesPos, 1), 0);
  If S2 <> '' Then ComWrite (EmuColor ($1F) + S2, 0);
  ComWrite (EmuColor ($1B) + ' ', 0);

  ComWrite (EmuColor ($0F) + '  ', 0);

  S1 := Copy (sNo, 1, NoPos-1);
  S2 := Copy (sNo, NoPos+1, 255);

  If S1 <> '' Then ComWrite (S1, 0);
  ComWrite (EmuColor ($0E) + Copy (sNo, NoPos, 1), 0);
  If S2 <> '' Then ComWrite (EmuColor ($0F) + S2, 0);
  ComWrite (' ', 0);
End;

Procedure DrawNoYes;
Var
  S1, S2, S3: String;

Begin
  S1 := Copy (sYes, 1, YesPos-1);
  S2 := Copy (sYes, YesPos+1, 255);

  ComWrite (EmuColor ($0F) + ' ', 0);
  If S1 <> '' Then ComWrite (S1, 0);
  ComWrite (EmuColor ($0E) + Copy (sYes, YesPos, 1), 0);
  If S2 <> '' Then ComWrite (EmuColor ($0F) + S2, 0);
  ComWrite ('  ', 0);

  S1 := Copy (sNo, 1, NoPos-1);
  S2 := Copy (sNo, NoPos+1, 255);

  ComWrite (EmuColor ($1B) + ' ', 0);
  If S1 <> '' Then ComWrite (EmuColor ($1F) + S1, 0);
  ComWrite (EmuColor ($1E) + Copy (sNo, NoPos, 1), 0);
  If S2 <> '' Then ComWrite (EmuColor ($1F) + S2, 0);
  ComWrite (EmuColor ($1B) + ' ', 0);
End;

Label
  NotValid;

Begin
  fQuery := False;
{$IFDEF WIN32}
  Application. ProcessMessages;
  If Application. Terminated Then Exit;
  MainForm. Console1. ShowCursor;
  MainForm. Console1. Paint;
{$ENDIF}
  If Flags and ofFramed <> 0 Then Frame;

  ComWrite (What + ' ', eoMacro + eoCodes);

  If (R. Emu <> teTty) And Cnf. YesNoStyle Then
  Begin
    sYes := ZeroMsg (lang (laYes), True);
    sNo := ZeroMsg (lang (laNo), True);
    S := UpString (lang (laYesNoKeys));
    YesPos := Pos (S [1], sYes);
    If YesPos = 0 Then YesPos := 1;
    NoPos := Pos (S [2], sNo);
    If NoPos = 0 Then NoPos := 1;
    If isYes Then DrawYesNo Else DrawNoYes;

    Repeat
      C := UpCase (ComReadKey);
      If C in [kbRight, kbLeft] Then
      Begin
        If (isYes And (C = kbLeft)) Or (Not isYes And (C = kbRight)) Then Continue;
        isYes := Not isYes;
        ComWrite (Replicate (#8, Length (sYes + sNo) + 5), 0);
        If isYes Then DrawYesNo Else DrawNoYes;
      End Else
      Begin
        S := lang (laYesNoKeys);
        If YesPos = 1 Then S := S + UpCase (sYes [1]);
        If NoPos = 1 Then S := S + UpCase (sNo [1]);

        If Pos (C,  S) > 0 Then
        Begin
          If (C = S [1]) Or ((C = UpCase (sYes [1])) And (YesPos = 1)) Then IsYes := True Else
          If (C = S [2]) Or ((C = UpCase (sNo [1])) And (NoPos = 1)) Then IsYes := False;
          Break;
        End;
      End;

    Until (C = #13) {$IFDEF WIN32} Or Application. Terminated {$ENDIF};

  {$IFDEF WIN32}
    If Application. Terminated Then Exit;
  {$ENDIF}

    MaxLength := Length (sYes + sNo) + 5;
    ComWrite (EmuColor ($07) + Replicate (#8, MaxLength), 0);

    If isYes
    Then ComWriteLn (PadCh (lang (laYes), ' ', MaxLength + 3), eoMacro + eoCodes)
    Else ComWriteLn (PadCh (lang (laNo),  ' ', MaxLength + 3), eoMacro + eoCodes);

    If Not (Flags and ofNoCR <> 0) Then ComWriteLn ('', 0);
    fQuery := isYes;
  End Else
  Begin
    If IsYes Then
    Begin
      ComWrite (lang (laYesNo), eoMacro + eoCodes);
      YN_Len := Length (ZeroMsg (lang (laYesNo), True));
    End Else
    Begin
      ComWrite (lang (laNoYes), eoMacro + eoCodes);
      YN_Len := Length (ZeroMsg (lang (laNoYes), True));
    End;

    NotValid:
    ProcessChoices;
    C := UpCase (ComReadKey);
  {$IFDEF WIN32}
    If Application. Terminated Then Exit;
  {$ENDIF}

    S := UpString (lang (laYesNoKeys));
    If Pos (C, S + #13) = 0 Then GoTo NotValid;

    If C = S [1] Then IsYes := True Else
    If C = S [2] Then IsYes := False;

    fQuery := IsYes;
    MaxLength := Length (ZeroMsg (lang (laYes), True));
    If MaxLength < Length (ZeroMsg (lang (laNo), True)) Then MaxLength := Length (ZeroMsg (lang (laNo), True));
    If MaxLength < 6 Then MaxLength := YN_Len + 1;
    Inc (MaxLength, 9);
    ComWrite (Replicate (#8, YN_Len), 0);

    If IsYes
    Then ComWriteLn (PadCh (lang (laYes), ' ', MaxLength), eoMacro + eoCodes)
    Else ComWriteLn (PadCh (lang (laNo),  ' ', MaxLength), eoMacro + eoCodes);

    ComWriteLn ('', 0);
  End;
End;

Function fQuery_YNQ (What: String): Char;
Var
  KeyO, TmpC            : Char;
  MaxLength, Att        : Byte;

Begin
  KeyO := ' ';
  ATT := TextAttr;
  ComWrite (What + ' ' + lang (laYesNoQuit), eoMacro + eoCodes);

  While (Pos (KeyO, UpString (lang (laYNQKeys)) + #13) = 0) Do
  Begin
    ProcessChoices;
    KeyO := UpCase (ComReadKey);
  {$IFDEF WIN32}
    If Application. Terminated Then Exit;
  {$ENDIF}
  End;

  If (KeyO = Copy (lang (laYNQKeys), 1, 1)) Or (KeyO = #13) Then TmpC := 'y' Else
  If KeyO = Copy (lang (laYNQKeys), 2, 1) Then TmpC := 'n' Else
  If KeyO = Copy (lang (laYNQKeys), 3, 1) Then TmpC := 'q';

  MaxLength := Length (ZeroMsg (lang (laYes), True));

  If MaxLength < Length (ZeroMsg (lang (laNo), True)) Then
    MaxLength := Length (ZeroMsg (lang (laNo), True));
  If MaxLength < Length (ZeroMsg (lang (laQuit), True)) Then
    MaxLength := Length (ZeroMsg (lang (laQuit), True));

  If MaxLength < 8 Then MaxLength := 8;
  Inc (MaxLength, 30);

  Case TmpC Of
    'y' : ComWriteLn (Replicate (#8, Length (ZeroMsg (lang (laYesNoQuit),
          True))) + PadCh (lang (laYes), ' ', MaxLength), eoMacro + eoCodes);
    'n' : ComWriteLn (Replicate (#8, Length (ZeroMsg (lang (laYesNoQuit),
          True))) + PadCh (lang (laNo), ' ', MaxLength), eoMacro + eoCodes);
    'q' : ComWriteLn (Replicate (#8, Length (ZeroMsg (lang (laYesNoQuit),
          True))) + PadCh (lang (laQuit), ' ', MaxLength), eoMacro + eoCodes);
  Else
    ComWrite ('', 0);
  End;

  fQuery_YNQ := TmpC;
  ComWrite (EmuColor (Att), 0);
End;

Function fMenuBar (Text, Hot: String): Byte;
Var
  Choice        : Char;
  Displayed     : Boolean;
  i             : Byte;

Label
  KeyLoop;

Begin
{$IFDEF WIN32}
  Application. ProcessMessages;
  If Application. Terminated Then Exit;
  MainForm. Console1. ShowCursor;
  MainForm. Console1. Paint;
{$ENDIF}

  Hot := UpString (Hot);

  If HotKeysStr = '' Then
  Begin
    Displayed := True;
    ComWrite (Text, eoMacro + eoCodes);
  End;

  KeyLoop:
  If Not Displayed Then ComWrite (Text, eoMacro + eoCodes);
  ProcessChoices;
  Choice := UpCase (ComReadKey);
{$IFDEF WIN32}
  If Application. Terminated Then Exit;
{$ENDIF}
  i := Pos (Choice, Hot);

  If i = 0 Then GoTo KeyLoop Else fMenuBar := i;
End;

Procedure fSmartLine;
Begin
  If R. Frames and (EmuGoToXY (1, 1) <> '') Then ComWriteLn ('', 0);
End;

Procedure fMessage (Mess: String);
Begin
  If Mess <> '' Then
  Begin
    ComWrite (#13, 0);
    ComWriteLn (Mess + #13#10, eoMacro + eoCodes)
  End Else
    ComWriteLn ('', eoCodes + eoMacro);

  ComWrite (lang (laEnterForCont), eoMacro + eoCodes);

  If HotKeysStr = '' Then
  While (ComReadKey <> #13) {$IFDEF WIN32} And Not Application. Terminated {$ENDIF} Do TimeSlice;

  ComWrite (#13, 0);
  ComWrite (EmuClrEoL, 0);
  ComWrite (#13, 0);
End;

Procedure fCls;
Var
  S : String [10];
  i : Byte;

Begin
  S := EmuCls;
  ScreenOut^. StartBuffering;
  For i := 1 To Length (S) Do ScreenOut^. OutByte (Byte (S [i]));
  ScreenOut^. StopBuffering;
End;

Procedure InitMainCOvr;
Begin
  ComRead := fComRead;
  ComReadLn := fComReadLn;
  ComMenu := fComMenu;
  SetProtocol := fSetProtocol;
  GetAnswer := fGetAnswer;
  Query := fQuery;
  Query_YNQ := fQuery_YNQ;
  MenuBar := fMenuBar;
  SmartLine := fSmartLine;
  Message := fMessage;
  Cls := fCls;
End;

End.