paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-04 13:50:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ introduced TEnhancedVideoCell.EnhancedVideoAttributes, based on ECMA-48 and xterm

Browse Source
This commit is contained in:
Nikolay Nikolov 2022-03-17 18:57:37 +02:00
parent a68884f750
commit 5121e2c259
2 changed files with 52 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
packages/rtl-console/src/inc/video.inc
View File

@ -25,7 +25,8 @@ operator = (const a,b : TEnhancedVideoCell) res: Boolean;
begin
res:=(a.FForegroundColor=b.FForegroundColor) and
(a.FBackgroundColor=b.FBackgroundColor) and
(a.ExtendedGraphemeCluster = b.ExtendedGraphemeCluster);
(a.EnhancedVideoAttributes=b.EnhancedVideoAttributes) and
(a.ExtendedGraphemeCluster=b.ExtendedGraphemeCluster);
end;
function TEnhancedVideoCell.GetAttribute: Byte;
@ -39,6 +40,16 @@ begin
FBackgroundColor := Attr shr 4;
end;
function TEnhancedVideoCell.GetEnhancedVideoAttributes: TEnhancedVideoAttributes;
begin
GetEnhancedVideoAttributes := TEnhancedVideoAttributes(Word(FInternalAttributes and $7FFF));
end;
procedure TEnhancedVideoCell.SetEnhancedVideoAttributes(AEnhancedVideoAttributes: TEnhancedVideoAttributes);
begin
FInternalAttributes := (FInternalAttributes and $8000) or (Word(AEnhancedVideoAttributes) and $7FFF);
end;
function TEnhancedVideoCell.GetForegroundColor: Byte;
begin
GetForegroundColor := FForegroundColor;
@ -61,7 +72,7 @@ end;
function TEnhancedVideoCell.GetExtendedGraphemeCluster: UnicodeString;
begin
if (FAttributes and $8000) = 0 then
if (FInternalAttributes and $8000) = 0 then
GetExtendedGraphemeCluster := EGC_SingleChar
else
GetExtendedGraphemeCluster := UnicodeString(EGC_WideStr);
@ -71,18 +82,18 @@ procedure TEnhancedVideoCell.SetExtendedGraphemeCluster(const AExtendedGraphemeC
begin
if Length(AExtendedGraphemeCluster) = 1 then
begin
if (FAttributes and $8000) <> 0 then
if (FInternalAttributes and $8000) <> 0 then
begin
FAttributes := FAttributes and $7FFF;
FInternalAttributes := FInternalAttributes and $7FFF;
UnicodeString(EGC_WideStr) := '';
end;
EGC_SingleChar := AExtendedGraphemeCluster[1];
end
else
begin
if (FAttributes and $8000) = 0 then
if (FInternalAttributes and $8000) = 0 then
begin
FAttributes := FAttributes or $8000;
FInternalAttributes := FInternalAttributes or $8000;
EGC_WideStr := nil;
end;
UnicodeString(EGC_WideStr) := AExtendedGraphemeCluster;
@ -91,14 +102,14 @@ end;
class operator TEnhancedVideoCell.Initialize(var evc: TEnhancedVideoCell);
begin
evc.FAttributes := 0;
evc.FInternalAttributes := 0;
evc.ForegroundColor := 0;
evc.BackgroundColor := 0;
end;
class operator TEnhancedVideoCell.Finalize(var evc: TEnhancedVideoCell);
begin
if (evc.FAttributes and $8000) <> 0 then
if (evc.FInternalAttributes and $8000) <> 0 then
UnicodeString(evc.EGC_WideStr) := '';
end;
@ -106,13 +117,14 @@ Procedure fpc_UnicodeStr_Incr_Ref(S : Pointer); external name 'FPC_UNICODESTR_IN
class operator TEnhancedVideoCell.AddRef(var evc: TEnhancedVideoCell);
begin
if (evc.FAttributes and $8000) <> 0 then
if (evc.FInternalAttributes and $8000) <> 0 then
fpc_UnicodeStr_Incr_Ref(evc.EGC_WideStr);
end;
class operator TEnhancedVideoCell.Copy(constref aSrc: TEnhancedVideoCell; var aDst: TEnhancedVideoCell);
begin
aDst.ExtendedGraphemeCluster := aSrc.ExtendedGraphemeCluster;
aDst.EnhancedVideoAttributes := aSrc.EnhancedVideoAttributes;
aDst.FForegroundColor := aSrc.FForegroundColor;
aDst.FBackgroundColor := aSrc.FBackgroundColor;
end;

32
packages/rtl-console/src/inc/videoh.inc
View File

@ -28,6 +28,33 @@ type
TVideoBuf = array[0..{$ifdef CPU16}16382{$else}32759{$endif}] of TVideoCell;
PVideoBuf = ^TVideoBuf;
TEnhancedVideoAttribute = (
{ Bold or increased intensity, VT100, xterm }
evaBold,
{ Faint, decreased intensity or second color, ECMA-48 2nd, xterm }
evaFaint,
{ Italicized, ECMA-48 2nd, xterm }
evaItalicized,
{ Singly underlined, VT100, xterm }
evaUnderlined,
{ Slowly blinking (less than 150 per minute), EMCA 48 2nd, VT100, xterm }
evaBlinkSlow,
{ Rapidly blinking (150 per minute or more), ECMA-48 2nd }
evaBlinkFast,
{ Inverse (negative image), VT100, xterm }
evaInverse,
{ Concealed characters, ECMA-48 2nd, VT300, xterm }
evaInvisible,
{ Crossed-out (characters still legible but marked as to be deleted), ECMA-48 3rd, xterm }
evaCrossedOut,
{ Doubly underlined, ECMA-48 3d }
evaDoublyUnderlined
);
{$push}
{$packset 2}
TEnhancedVideoAttributes = set of TEnhancedVideoAttribute;
{$pop}
TEnhancedVideoCell = record
private
class operator Initialize(var evc: TEnhancedVideoCell);
@ -38,6 +65,8 @@ type
procedure SetExtendedGraphemeCluster(const AExtendedGraphemeCluster: UnicodeString);
function GetAttribute: Byte;
procedure SetAttribute(Attr: Byte);
function GetEnhancedVideoAttributes: TEnhancedVideoAttributes;
procedure SetEnhancedVideoAttributes(AEnhancedVideoAttributes: TEnhancedVideoAttributes);
function GetForegroundColor: Byte;
procedure SetForegroundColor(AForegroundColor: Byte);
function GetBackgroundColor: Byte;
@ -45,11 +74,12 @@ type
public
property ExtendedGraphemeCluster: UnicodeString read GetExtendedGraphemeCluster write SetExtendedGraphemeCluster;
property Attribute: Byte read GetAttribute write SetAttribute;
property EnhancedVideoAttributes: TEnhancedVideoAttributes read GetEnhancedVideoAttributes write SetEnhancedVideoAttributes;
property ForegroundColor: Byte read GetForegroundColor write SetForegroundColor;
property BackgroundColor: Byte read GetBackgroundColor write SetBackgroundColor;
private
FAttributes: Word;
FInternalAttributes: Word;
FForegroundColor : Byte;
FBackgroundColor : Byte;
case integer of