869 lines
20 KiB
ObjectPascal
869 lines
20 KiB
ObjectPascal
// ====================================================================
|
|
// Mystic BBS Software Copyright 1997-2013 By James Coyle
|
|
// ====================================================================
|
|
//
|
|
// This file is part of Mystic BBS.
|
|
//
|
|
// Mystic BBS is free software: you can redistribute it and/or modify
|
|
// it under the terms of the GNU General Public License as published by
|
|
// the Free Software Foundation, either version 3 of the License, or
|
|
// (at your option) any later version.
|
|
//
|
|
// Mystic BBS is distributed in the hope that it will be useful,
|
|
// but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
// GNU General Public License for more details.
|
|
//
|
|
// You should have received a copy of the GNU General Public License
|
|
// along with Mystic BBS. If not, see <http://www.gnu.org/licenses/>.
|
|
//
|
|
// ====================================================================
|
|
Unit m_Output_Linux;
|
|
|
|
{$I M_OPS.PAS}
|
|
|
|
Interface
|
|
|
|
Uses
|
|
TermIO,
|
|
BaseUnix,
|
|
m_Types;
|
|
|
|
Const
|
|
ConIn = 0;
|
|
ConOut = 1;
|
|
ConBufSize = 4096;
|
|
|
|
Type
|
|
TOutputLinux = Class
|
|
Private
|
|
TermInfo : TermIos;
|
|
TermInRaw : Boolean;
|
|
TermOutRaw : Boolean;
|
|
TermXSize : LongInt;
|
|
TermYSize : LongInt;
|
|
OutBuffer : Array[1..ConBufSize] of Char;
|
|
FTextAttr : Byte;
|
|
FWinTop : Byte;
|
|
FCursorX : Byte;
|
|
FCursorY : Byte;
|
|
|
|
Procedure SetTextAttr (Attr: Byte);
|
|
Public
|
|
OutBufPos : Word;
|
|
ScreenSize : Byte;
|
|
Buffer : TConsoleScreenRec;
|
|
Active : Boolean;
|
|
SavedTerm : TermIOS;
|
|
FWinBot : Byte;
|
|
|
|
Function AttrToAnsi (Attr: Byte) : String;
|
|
Procedure BufFlush;
|
|
Procedure BufAddStr (Str: String);
|
|
Procedure SaveRawSettings (Var TIo: TermIos);
|
|
Procedure RestoreRawSettings (TIo: TermIos);
|
|
Procedure SetRawMode (SetOn: Boolean);
|
|
Procedure GetOriginalTermSize;
|
|
Procedure WriteXY (X, Y, A: Byte; Text: String);
|
|
Procedure WriteXYPipe (X, Y, Attr, Pad: Integer; Text: String);
|
|
Procedure GetScreenImage (X1, Y1, X2, Y2: Byte; Var Image: TConsoleImageRec);
|
|
Procedure PutScreenImage (Image: TConsoleImageRec);
|
|
Procedure LoadScreenImage (Var DataPtr; Len, Width, X, Y: Integer);
|
|
|
|
Constructor Create (A: Boolean);
|
|
Destructor Destroy; Override;
|
|
Procedure ClearScreen; Virtual;
|
|
Procedure ScrollWindow; Virtual;
|
|
Procedure ClearEOL;
|
|
Procedure CursorXYRaw (X, Y: Byte);
|
|
Procedure CursorXY (X, Y: Byte);
|
|
Procedure SetWindow (X1, Y1, X2, Y2: Byte; Home: Boolean);
|
|
Procedure SetScreenSize (Mode: Byte);
|
|
Procedure SetWindowTitle (Str: String);
|
|
Procedure WriteChar (Ch: Char);
|
|
Procedure WriteLine (Str: String);
|
|
Procedure WriteLineRec (YPos: Integer; Line: TConsoleLineRec);
|
|
Procedure WriteStr (Str: String);
|
|
Procedure RawWriteStr (Str: String);
|
|
Function ReadCharXY (X, Y: Byte) : Char;
|
|
Function ReadAttrXY (X, Y: Byte) : Byte;
|
|
Procedure ShowBuffer;
|
|
|
|
Property TextAttr : Byte Read FTextAttr Write SetTextAttr;
|
|
Property CursorX : Byte Read FCursorX;
|
|
Property CursorY : Byte Read FCursorY;
|
|
End;
|
|
|
|
Implementation
|
|
|
|
Uses
|
|
m_Strings;
|
|
|
|
Procedure TOutputLinux.WriteLineRec (YPos: Integer; Line: TConsoleLineRec);
|
|
Var
|
|
Count : LongInt;
|
|
Begin
|
|
CursorXY(1, YPos);
|
|
|
|
For Count := 1 to 80 Do
|
|
BufAddStr(AttrToAnsi(Line[Count].Attributes) + Line[Count].UnicodeChar);
|
|
|
|
BufFlush;
|
|
|
|
// For Count := 1 to 80 Do Begin
|
|
// FTextAttr := Line[Count].Attributes;
|
|
// WriteChar(Line[Count].UnicodeChar);
|
|
// End;
|
|
|
|
Buffer[YPos] := Line;
|
|
End;
|
|
|
|
Constructor TOutputLinux.Create (A: Boolean);
|
|
Begin
|
|
Inherited Create;
|
|
|
|
// SaveRawSettings(SavedTerm);
|
|
|
|
SetRawMode(True);
|
|
|
|
GetOriginalTermSize;
|
|
|
|
Active := A;
|
|
OutBufPos := 0;
|
|
FTextAttr := 7;
|
|
FWinTop := 1;
|
|
FWinBot := 25;
|
|
ScreenSize := 25;
|
|
|
|
RawWriteStr (#27 + '(U' + #27 + '[0m');
|
|
|
|
ClearScreen;
|
|
End;
|
|
|
|
Destructor TOutputLinux.Destroy;
|
|
Begin
|
|
WriteLine('');
|
|
|
|
BufFlush;
|
|
|
|
// RestoreRawSettings(SavedTerm);
|
|
|
|
SetWindow (1, 1, TermXSize, TermYSize, False);
|
|
CursorXY (FCursorX, FCursorY);
|
|
SetRawMode (False);
|
|
|
|
Inherited Destroy;
|
|
End;
|
|
|
|
Const
|
|
AnsiTable : String[8] = '04261537';
|
|
|
|
Procedure TOutputLinux.GetOriginalTermSize;
|
|
Var
|
|
Str : String;
|
|
Ch : Char;
|
|
FDSIN : TFDSET;
|
|
Begin
|
|
RawWriteStr (#27 + '[18t');
|
|
|
|
Str := '';
|
|
|
|
Repeat
|
|
fpFD_ZERO (FDSIN);
|
|
fpFD_SET (0, FDSIN);
|
|
|
|
If fpSelect (1, @FDSIN, NIL, NIL, 250) > 0 Then Begin
|
|
fpRead (0, Ch, 1);
|
|
|
|
If Ch <> 't' Then
|
|
Str := Str + Ch;
|
|
|
|
If Length(Str) > 13 Then Break;
|
|
End Else
|
|
Break;
|
|
Until Ch = 't';
|
|
|
|
TermXSize := strS2I(strWordGet(2, Str, ';'));
|
|
TermYSize := strS2I(strWordGet(2, Str, ';'));
|
|
|
|
If (TermXSize <= 0) or (TermYSize <= 0) Then Begin
|
|
TermXSize := 80;
|
|
TermYSize := 25;
|
|
End;
|
|
End;
|
|
|
|
(*
|
|
Function TOutputLinux.AttrToAnsi (Attr: Byte) : String;
|
|
Var
|
|
Str : String[16];
|
|
OldFG : LongInt;
|
|
OldBG : LongInt;
|
|
FG : LongInt;
|
|
BG : LongInt;
|
|
|
|
Procedure AddSep (Ch: Char);
|
|
Begin
|
|
If Length(Str) > 0 Then
|
|
Str := Str + ';';
|
|
Str := Str + Ch;
|
|
End;
|
|
|
|
Begin
|
|
If Attr = FTextAttr Then Begin
|
|
AttrToAnsi := '';
|
|
Exit;
|
|
End;
|
|
|
|
Str := '';
|
|
FG := Attr and $F;
|
|
BG := Attr shr 4;
|
|
OldFG := FTextAttr and $F;
|
|
OldBG := FTextAttr shr 4;
|
|
|
|
If (OldFG <> 7) or (FG = 7) or ((OldFG > 7) and (FG < 8)) or ((OldBG > 7) and (BG < 8)) Then Begin
|
|
Str := '0';
|
|
OldFG := 7;
|
|
OldBG := 0;
|
|
End;
|
|
|
|
If (FG > 7) and (OldFG < 8) Then Begin
|
|
AddSep('1');
|
|
OldFG := OldFG or 8;
|
|
End;
|
|
|
|
If (BG and 8) <> (OldBG and 8) Then Begin
|
|
AddSep('5');
|
|
OldBG := OldBG or 8;
|
|
End;
|
|
|
|
If (FG <> OldFG) Then Begin
|
|
AddSep('3');
|
|
Str := Str + AnsiTable[(FG and 7) + 1];
|
|
End;
|
|
|
|
If (BG <> OldBG) Then Begin
|
|
AddSep('4');
|
|
Str := Str + AnsiTable[(BG and 7) + 1];
|
|
End;
|
|
|
|
FTextAttr := FG + BG * 16;
|
|
AttrToAnsi := #27 + '[' + Str + 'm';
|
|
End;
|
|
*)
|
|
|
|
Function TOutputLinux.AttrToAnsi (Attr: Byte) : String;
|
|
Var
|
|
OldFG : LongInt;
|
|
OldBG : LongInt;
|
|
FG : LongInt;
|
|
BG : LongInt;
|
|
|
|
Procedure AddSep (Ch: Char);
|
|
Begin
|
|
If Length(Result) > 0 Then
|
|
Result := Result + ';';
|
|
|
|
Result := Result + Ch;
|
|
End;
|
|
|
|
Begin
|
|
Result := '';
|
|
|
|
If Attr = FTextAttr Then Exit;
|
|
|
|
FG := Attr and $F;
|
|
BG := Attr shr 4;
|
|
OldFG := FTextAttr and $F;
|
|
OldBG := FTextAttr shr 4;
|
|
|
|
If (OldFG <> 7) or (FG = 7) or ((OldFG > 7) and (FG < 8)) or ((OldBG > 7) and (BG < 8)) Then Begin
|
|
Result := '0';
|
|
OldFG := 7;
|
|
OldBG := 0;
|
|
End;
|
|
|
|
If (FG > 7) and (OldFG < 8) Then Begin
|
|
AddSep('1');
|
|
|
|
OldFG := OldFG or 8;
|
|
End;
|
|
|
|
If (BG and 8) <> (OldBG and 8) Then Begin
|
|
AddSep('5');
|
|
|
|
OldBG := OldBG or 8;
|
|
End;
|
|
|
|
If (FG <> OldFG) Then Begin
|
|
AddSep('3');
|
|
|
|
Result := Result + AnsiTable[(FG and 7) + 1];
|
|
End;
|
|
|
|
If (BG <> OldBG) Then Begin
|
|
AddSep('4');
|
|
|
|
Result := Result + AnsiTable[(BG and 7) + 1];
|
|
End;
|
|
|
|
FTextAttr := FG + BG * 16;
|
|
Result := #27 + '[' + Result + 'm';
|
|
End;
|
|
|
|
Procedure TOutputLinux.BufFlush;
|
|
Begin
|
|
If OutBufPos > 0 Then Begin
|
|
If Active Then fpWrite (ConOut, OutBuffer[1], OutBufPos);
|
|
OutBufPos := 0;
|
|
End;
|
|
End;
|
|
|
|
Procedure TOutputLinux.BufAddStr (Str: String);
|
|
Var
|
|
Count : LongInt;
|
|
Begin
|
|
For Count := 1 to Length(Str) Do Begin
|
|
Inc (OutBufPos);
|
|
OutBuffer[OutBufPos] := Str[Count];
|
|
If OutBufPos = ConBufSize Then BufFlush;
|
|
End;
|
|
End;
|
|
|
|
Procedure TOutputLinux.SetTextAttr (Attr: Byte);
|
|
Begin
|
|
If Attr = FTextAttr Then Exit;
|
|
|
|
BufAddStr(AttrToAnsi(Attr));
|
|
|
|
// FTextAttr := Attr;
|
|
End;
|
|
|
|
Procedure TOutputLinux.CursorXYRaw (X, Y: Byte);
|
|
Begin
|
|
If (Y < 1) Then Y := 1 Else
|
|
If (Y > ScreenSize) Then Y := ScreenSize;
|
|
If (X < 1) Then X := 1 Else
|
|
If (X > 80) Then X := 80;
|
|
|
|
BufAddStr(#27 + '[' + strI2S(Y) + ';' + strI2S(X) + 'H');
|
|
BufFlush;
|
|
|
|
FCursorX := X;
|
|
FCursorY := Y;
|
|
End;
|
|
|
|
Procedure TOutputLinux.CursorXY (X, Y: Byte);
|
|
Begin
|
|
If (Y < 1) Then Y := 1 Else
|
|
If (Y > FWinBot) Then Y := FWinBot; {changed 109a4}
|
|
// If (Y > ScreenSize) Then Y := ScreenSize;
|
|
If (X < 1) Then X := 1 Else
|
|
If (X > 80) Then X := 80;
|
|
|
|
BufAddStr(#27 + '[' + strI2S(Y) + ';' + strI2S(X) + 'H');
|
|
BufFlush;
|
|
|
|
FCursorX := X;
|
|
FCursorY := Y;
|
|
End;
|
|
|
|
Procedure TOutputLinux.ClearScreen;
|
|
Var
|
|
Fill : TCharInfo;
|
|
Count : Byte;
|
|
Begin
|
|
BufFlush;
|
|
|
|
Fill.Attributes := FTextAttr;
|
|
Fill.UnicodeChar := ' ';
|
|
|
|
If (FWinTop = 1) and (FWinBot = {25}ScreenSize) Then Begin
|
|
BufAddStr(#27 + '[2J');
|
|
FillWord (Buffer, SizeOf(Buffer) DIV 2, Word(Fill));
|
|
End Else Begin
|
|
For Count := FWinTop to FWinBot Do Begin
|
|
BufAddStr (#27 + '[' + strI2S(Count) + ';1H' + #27 + '[K');
|
|
FillWord (Buffer[Count][1], SizeOf(TConsoleLineRec) DIV 2, Word(Fill));
|
|
End;
|
|
End;
|
|
|
|
CursorXY (1, FWinTop);
|
|
End;
|
|
|
|
Procedure TOutputLinux.SetScreenSize (Mode: Byte);
|
|
Begin
|
|
FWinBot := Mode;
|
|
ScreenSize := Mode;
|
|
|
|
BufFlush;
|
|
RawWriteStr(#27 + '[8;' + strI2S(Mode) + ';80t');
|
|
SetWindow(1, 1, 80, Mode, False);
|
|
//need to figure this out.
|
|
|
|
//esc[8;h;w
|
|
End;
|
|
|
|
Procedure TOutputLinux.SetWindow (X1, Y1, X2, Y2: Byte; Home: Boolean);
|
|
Begin
|
|
// X1 and X2 are ignored in Linux and are only here for compatibility
|
|
// reasons.
|
|
|
|
FWinTop := Y1;
|
|
FWinBot := Y2;
|
|
|
|
BufAddStr (#27 + '[' + strI2S(Y1) + ';' + strI2S(Y2) + 'r');
|
|
BufFlush;
|
|
|
|
If Home Then CursorXY (1, Y1);
|
|
|
|
If (FCursorY > Y2) Then CursorXY (CursorX, Y2);
|
|
|
|
// If Home or (FCursorY < Y1) or (FCursorY > Y2) Then CursorXY(1, Y1);
|
|
{ this home thing is shady. compare it to win. going from 50 to 25 }
|
|
{ will screw up the buffers - this has to be more elegant. }
|
|
End;
|
|
|
|
Procedure TOutputLinux.SetWindowTitle (Str: String);
|
|
Begin
|
|
RawWriteStr (#27 + ']0;' + Str + #07);
|
|
End;
|
|
|
|
Procedure TOutputLinux.ClearEOL;
|
|
Var
|
|
Fill : TCharInfo;
|
|
Begin
|
|
BufAddStr(#27 + '[K');
|
|
|
|
Fill.Attributes := FTextAttr;
|
|
Fill.UnicodeChar := ' ';
|
|
|
|
FillWord (Buffer[CursorY][CursorX], (80 - CursorX) * 2, Word(Fill));
|
|
End;
|
|
|
|
Procedure TOutputLinux.ScrollWindow;
|
|
Begin
|
|
Move (Buffer[2][1], Buffer[1][1], SizeOf(TConsoleLineRec) * (FWinBot - 1));
|
|
FillChar(Buffer[FWinBot][1], SizeOf(TConsoleLineRec), 0);
|
|
End;
|
|
|
|
Procedure TOutputLinux.WriteChar (Ch: Char);
|
|
Var
|
|
A : Byte;
|
|
Begin
|
|
If Ch <> #10 Then BufAddStr(Ch);
|
|
|
|
Case Ch of
|
|
#08 : If FCursorX > 1 Then
|
|
Dec(FCursorX);
|
|
#10 : Begin
|
|
If FCursorY < FWinBot Then Begin
|
|
BufAddStr(Ch);
|
|
Inc (FCursorY)
|
|
End Else Begin
|
|
A := FTextAttr;
|
|
SetTextAttr(7);
|
|
BufAddStr(Ch);
|
|
ScrollWindow;
|
|
SetTextAttr(A);
|
|
End;
|
|
|
|
FCursorX := 1;
|
|
CursorXY(FCursorX, FCursorY);
|
|
|
|
BufFlush;
|
|
End;
|
|
#13 : FCursorX := 1;
|
|
Else
|
|
Buffer[FCursorY][FCursorX].Attributes := FTextAttr;
|
|
Buffer[FCursorY][FCursorX].UnicodeChar := Ch;
|
|
|
|
If FCursorX < 80 Then
|
|
Inc (FCursorX)
|
|
Else Begin
|
|
FCursorX := 1;
|
|
|
|
If FCursorY < FWinBot Then
|
|
Inc (FCursorY)
|
|
Else Begin
|
|
ScrollWindow;
|
|
BufFlush;
|
|
End;
|
|
// Else
|
|
// ScrollWindow;
|
|
|
|
// BufFlush;
|
|
End;
|
|
End;
|
|
End;
|
|
|
|
Procedure TOutputLinux.WriteStr (Str: String);
|
|
Var
|
|
Count : Byte;
|
|
Begin
|
|
For Count := 1 to Length(Str) Do
|
|
WriteChar(Str[Count]);
|
|
|
|
BufFlush;
|
|
End;
|
|
|
|
Procedure TOutputLinux.WriteLine (Str: String);
|
|
Var
|
|
Count : Byte;
|
|
Begin
|
|
Str := Str + #13#10;
|
|
|
|
For Count := 1 To Length(Str) Do
|
|
WriteChar(Str[Count]);
|
|
|
|
BufFlush;
|
|
End;
|
|
|
|
Procedure TOutputLinux.RawWriteStr (Str: String);
|
|
Begin
|
|
fpWrite (ConOut, Str[1], Length(Str));
|
|
End;
|
|
|
|
Procedure TOutputLinux.SaveRawSettings (Var TIo: TermIos);
|
|
Begin
|
|
With TIo Do Begin
|
|
TermInRaw :=
|
|
((c_iflag and (IGNBRK or BRKINT or PARMRK or ISTRIP or
|
|
INLCR or IGNCR or ICRNL or IXON)) = 0) and
|
|
((c_lflag and (ECHO or ECHONL or ICANON or ISIG or IEXTEN)) = 0);
|
|
TermOutRaw :=
|
|
((c_oflag and OPOST) = 0) and
|
|
((c_cflag and (CSIZE or PARENB)) = 0) and
|
|
((c_cflag and CS8) <> 0);
|
|
End;
|
|
End;
|
|
|
|
Procedure TOutputLinux.RestoreRawSettings (TIo: TermIos);
|
|
Begin
|
|
With TIo Do Begin
|
|
If TermInRaw Then Begin
|
|
c_iflag := c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or
|
|
INLCR or IGNCR or ICRNL or IXON));
|
|
c_lflag := c_lflag and
|
|
(not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
|
|
End;
|
|
|
|
If TermOutRaw Then Begin
|
|
c_oflag := c_oflag and not(OPOST);
|
|
c_cflag := c_cflag and not(CSIZE or PARENB) or CS8;
|
|
End;
|
|
End;
|
|
End;
|
|
|
|
Procedure TOutputLinux.SetRawMode (SetOn: Boolean);
|
|
Var
|
|
Tio : TermIos;
|
|
Begin
|
|
If SetOn Then Begin
|
|
TCGetAttr(1, Tio);
|
|
SaveRawSettings(Tio);
|
|
TermInfo := Tio;
|
|
CFMakeRaw(Tio);
|
|
End Else Begin
|
|
RestoreRawSettings(TermInfo);
|
|
Tio := TermInfo;
|
|
End;
|
|
|
|
TCSetAttr(1, TCSANOW, Tio);
|
|
End;
|
|
|
|
Function TOutputLinux.ReadCharXY (X, Y: Byte) : Char;
|
|
Begin
|
|
ReadCharXY := Buffer[Y][X].UnicodeChar;
|
|
End;
|
|
|
|
Function TOutputLinux.ReadAttrXY (X, Y: Byte) : Byte;
|
|
Begin
|
|
ReadAttrXY := Buffer[Y][X].Attributes;
|
|
End;
|
|
|
|
Procedure TOutputLinux.WriteXY (X, Y, A: Byte; Text: String);
|
|
Var
|
|
OldAttr : Byte;
|
|
OldX : Byte;
|
|
OldY : Byte;
|
|
Count : Byte;
|
|
Begin
|
|
If X > 80 Then Exit;
|
|
|
|
OldAttr := FTextAttr;
|
|
OldX := FCursorX;
|
|
OldY := FCursorY;
|
|
|
|
CursorXYRaw (X, Y);
|
|
SetTextAttr (A);
|
|
|
|
For Count := 1 to Length(Text) Do
|
|
If FCursorX <= 80 Then Begin
|
|
Buffer[FCursorY][FCursorX].Attributes := FTextAttr;
|
|
Buffer[FCursorY][FCursorX].UnicodeChar := Text[Count];
|
|
|
|
Inc (FCursorX);
|
|
|
|
BufAddStr(Text[Count]);
|
|
End Else
|
|
Break;
|
|
|
|
SetTextAttr (OldAttr);
|
|
CursorXYRaw (OldX, OldY);
|
|
|
|
BufFlush;
|
|
End;
|
|
|
|
Procedure TOutputLinux.WriteXYPipe (X, Y, Attr, Pad: Integer; Text: String);
|
|
|
|
Procedure AddChar (Ch: Char);
|
|
Begin
|
|
If CursorX > 80 Then Exit;
|
|
|
|
Buffer[CursorY][CursorX].Attributes := FTextAttr;
|
|
Buffer[CursorY][CursorX].UnicodeChar := Ch;
|
|
|
|
BufAddStr(Ch);
|
|
|
|
Inc (FCursorX);
|
|
End;
|
|
|
|
Var
|
|
Count : Byte;
|
|
Code : String[2];
|
|
CodeNum : Byte;
|
|
OldAttr : Byte;
|
|
OldX : Byte;
|
|
OldY : Byte;
|
|
Begin
|
|
OldAttr := FTextAttr;
|
|
OldX := FCursorX;
|
|
OldY := FCursorY;
|
|
|
|
CursorXYRaw (X, Y);
|
|
SetTextAttr (Attr);
|
|
|
|
Count := 1;
|
|
|
|
While Count <= Length(Text) Do Begin
|
|
If Text[Count] = '|' Then Begin
|
|
Code := Copy(Text, Count + 1, 2);
|
|
CodeNum := strS2I(Code);
|
|
|
|
If (Code = '00') or ((CodeNum > 0) and (CodeNum < 24) and (Code[1] <> '&') and (Code[1] <> '$')) Then Begin
|
|
Inc (Count, 2);
|
|
If CodeNum in [00..15] Then
|
|
SetTextAttr (CodeNum + ((FTextAttr SHR 4) AND 7) * 16)
|
|
Else
|
|
SetTextAttr ((FTextAttr AND $F) + (CodeNum - 16) * 16);
|
|
End Else Begin
|
|
AddChar(Text[Count]);
|
|
Dec (Pad);
|
|
End;
|
|
End Else Begin
|
|
AddChar(Text[Count]);
|
|
Dec (Pad);
|
|
End;
|
|
|
|
If Pad = 0 Then Break;
|
|
|
|
Inc (Count);
|
|
End;
|
|
|
|
While Pad > 0 Do Begin
|
|
AddChar(' ');
|
|
Dec(Pad);
|
|
End;
|
|
|
|
SetTextAttr (OldAttr);
|
|
CursorXYRaw (OldX, OldY);
|
|
|
|
BufFlush;
|
|
End;
|
|
|
|
Procedure TOutputLinux.GetScreenImage (X1, Y1, X2, Y2: Byte; Var Image: TConsoleImageRec);
|
|
//Var
|
|
// Count : Byte;
|
|
Begin
|
|
// If X2 > 80 Then X2 := 80;
|
|
// If Y2 > FWinBot Then Y2 := FWinBot;
|
|
|
|
FillChar(Image, SizeOf(Image), #0);
|
|
|
|
Image.Data := Buffer;
|
|
// For Count := Y1 to Y2 Do Begin
|
|
// Image.Data[Count] := Buffer[Count];
|
|
|
|
Image.CursorX := FCursorX;
|
|
Image.CursorY := FCursorY;
|
|
Image.CursorA := FTextAttr;
|
|
Image.X1 := X1;
|
|
Image.X2 := X2;
|
|
Image.Y1 := Y1;
|
|
Image.Y2 := Y2;
|
|
End;
|
|
|
|
Procedure TOutputLinux.PutScreenImage (Image: TConsoleImageRec);
|
|
Var
|
|
CountX : Byte;
|
|
CountY : Byte;
|
|
OT, OB : Byte;
|
|
Begin
|
|
OT := FWinTop;
|
|
OB := FWinBot;
|
|
|
|
SetWindow (1, 1, 80, ScreenSize, False);
|
|
|
|
For CountY := Image.Y1 to Image.Y2 Do Begin
|
|
CursorXY (Image.X1, CountY);
|
|
|
|
// Move (Image.Data[CountY][Image.X1], Buffer[CountY + Image.Y1 - 1][Image.X1], (Image.X2 - Image.X1 + 1) * SizeOf(TCharInfo));
|
|
|
|
For CountX := Image.X1 to Image.X2 Do Begin
|
|
SetTextAttr(Image.Data[CountY][CountX].Attributes);
|
|
BufAddStr(Image.Data[CountY][CountX].UnicodeChar);
|
|
Buffer[CountY][CountX] := Image.Data[CountY][CountX];
|
|
End;
|
|
End;
|
|
|
|
SetTextAttr (Image.CursorA);
|
|
CursorXY (Image.CursorX, Image.CursorY);
|
|
SetWindow (1, OT, 80, OB, False);
|
|
|
|
BufFlush;
|
|
End;
|
|
|
|
(*
|
|
Procedure TOutputLinux.GetScreenImage (X1, Y1, X2, Y2: Byte; Var Image: TConsoleImageRec);
|
|
Var
|
|
Count : Byte;
|
|
Line : Byte;
|
|
Temp : TConsoleLineRec;
|
|
Begin
|
|
Line := 1;
|
|
|
|
If X2 > 80 Then X2 := 80;
|
|
If Y2 > FWinBot Then Y2 := FWinBot;
|
|
|
|
FillChar(Image, SizeOf(Image), #0);
|
|
|
|
For Count := Y1 to Y2 Do Begin
|
|
Move (Buffer[Count][X1], Image.Data[Line][1], (X2 - X1 + 1) * SizeOf(TCharInfo));
|
|
Inc (Line);
|
|
End;
|
|
|
|
Image.CursorX := FCursorX;
|
|
Image.CursorY := FCursorY;
|
|
Image.CursorA := FTextAttr;
|
|
Image.X1 := X1;
|
|
Image.X2 := X2;
|
|
Image.Y1 := Y1;
|
|
Image.Y2 := Y2;
|
|
End;
|
|
|
|
Procedure TOutputLinux.PutScreenImage (Var Image: TConsoleImageRec);
|
|
Var
|
|
CountX : Byte;
|
|
CountY : Byte;
|
|
Begin
|
|
For CountY := 1 to (Image.Y2 - Image.Y1 + 1) Do Begin
|
|
CursorXY (Image.X1, CountY + Image.Y1 - 1);
|
|
|
|
Move (Image.Data[CountY][1], Buffer[CountY + Image.Y1 - 1][Image.X1], (Image.X2 - Image.X1 + 1) * SizeOf(TCharInfo));
|
|
|
|
For CountX := 1 to (Image.X2 - Image.X1 + 1) Do Begin
|
|
SetTextAttr(Image.Data[CountY][CountX].Attributes);
|
|
BufAddStr(Image.Data[CountY][CountX].UnicodeChar);
|
|
End;
|
|
End;
|
|
|
|
SetTextAttr (Image.CursorA);
|
|
CursorXY (Image.CursorX, Image.CursorY);
|
|
|
|
BufFlush;
|
|
End;
|
|
*)
|
|
|
|
Procedure TOutputLinux.LoadScreenImage (Var DataPtr; Len, Width, X, Y: Integer);
|
|
Var
|
|
Image : TConsoleImageRec;
|
|
Data : Array[1..8000] of Byte Absolute DataPtr;
|
|
PosX : Word;
|
|
PosY : Byte;
|
|
Attrib : Byte;
|
|
Count : Word;
|
|
A : Byte;
|
|
B : Byte;
|
|
C : Byte;
|
|
Begin
|
|
PosX := 1;
|
|
PosY := 1;
|
|
Attrib := 7;
|
|
Count := 1;
|
|
|
|
FillChar(Image.Data, SizeOf(Image.Data), #0);
|
|
|
|
While (Count <= Len) Do begin
|
|
Case Data[Count] of
|
|
00..
|
|
15 : Attrib := Data[Count] + ((Attrib SHR 4) and 7) * 16;
|
|
16..
|
|
23 : Attrib := (Attrib And $F) + (Data[Count] - 16) * 16;
|
|
24 : Begin
|
|
Inc (PosY);
|
|
PosX := 1;
|
|
End;
|
|
25 : Begin
|
|
Inc (Count);
|
|
|
|
For A := 0 to Data[Count] Do Begin
|
|
Image.Data[PosY][PosX].UnicodeChar := ' ';
|
|
Image.Data[PosY][PosX].Attributes := Attrib;
|
|
|
|
Inc (PosX);
|
|
End;
|
|
End;
|
|
26 : Begin
|
|
A := Data[Count + 1];
|
|
B := Data[Count + 2];
|
|
|
|
Inc (Count, 2);
|
|
|
|
For C := 0 to A Do Begin
|
|
Image.Data[PosY][PosX].UnicodeChar := Char(B);
|
|
Image.Data[PosY][PosX].Attributes := Attrib;
|
|
|
|
Inc (PosX);
|
|
End;
|
|
End;
|
|
27..
|
|
31 : ;
|
|
Else
|
|
Image.Data[PosY][PosX].UnicodeChar := Char(Data[Count]);
|
|
Image.Data[PosY][PosX].Attributes := Attrib;
|
|
|
|
Inc (PosX);
|
|
End;
|
|
|
|
Inc(Count);
|
|
End;
|
|
|
|
If PosY > ScreenSize Then PosY := ScreenSize;
|
|
|
|
Image.CursorX := PosX;
|
|
Image.CursorY := PosY;
|
|
Image.CursorA := Attrib;
|
|
Image.X1 := X;
|
|
Image.X2 := Width;
|
|
Image.Y1 := Y;
|
|
Image.Y2 := PosY;
|
|
|
|
PutScreenImage(Image);
|
|
End;
|
|
|
|
Procedure TOutputLinux.ShowBuffer;
|
|
Begin
|
|
End;
|
|
|
|
End.
|