Browse Source

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

Nikolay Nikolov 3 years ago
parent
commit
5121e2c259
2 changed files with 52 additions and 10 deletions
  1. 21 9
      packages/rtl-console/src/inc/video.inc
  2. 31 1
      packages/rtl-console/src/inc/videoh.inc

+ 21 - 9
packages/rtl-console/src/inc/video.inc

@@ -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;

+ 31 - 1
packages/rtl-console/src/inc/videoh.inc

@@ -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