Browse Source

+ implemented enhanced video attributes in the Unix video unit
+ added test for the enhanced video attributes

Nikolay Nikolov 3 years ago
parent
commit
921a72566f
2 changed files with 102 additions and 13 deletions
  1. 46 13
      packages/rtl-console/src/unix/video.pp
  2. 56 0
      packages/rtl-console/tests/video4.pp

+ 46 - 13
packages/rtl-console/src/unix/video.pp

@@ -365,11 +365,37 @@ end;
 
 
 const  ansitbl:array[0..7] of char='04261537';
 const  ansitbl:array[0..7] of char='04261537';
 
 
-function attr2ansi(Fg,Bg,OFg,OBg:byte):string;
+function attr2ansi(Fg,Bg:byte;Attr:TEnhancedVideoAttributes;OFg,OBg:byte;OAttr:TEnhancedVideoAttributes):string;
+const
+  AttrOnOffStr: array [TEnhancedVideoAttribute, Boolean] of string = (
+    ('22;','1;'),
+    ('22;','2;'),
+    ('23;','3;'),
+    ('24;','4;'),
+    ('25;','5;'),
+    ('25;','6;'),
+    ('27;','7;'),
+    ('28;','8;'),
+    ('29;','9;'),
+    ('24;','21;'));
 var
 var
   tmpS: string;
   tmpS: string;
+  A: TEnhancedVideoAttribute;
 begin
 begin
   attr2ansi:=#27'[';
   attr2ansi:=#27'[';
+
+  if Attr<>OAttr then
+  begin
+    { turn off old attributes first }
+    for A := Low(TEnhancedVideoAttribute) to High(TEnhancedVideoAttribute) do
+      if (not (A in Attr)) and (A in OAttr) then
+        attr2ansi:=attr2ansi+AttrOnOffStr[A,False];
+    { then, turn on new attributes }
+    for A := Low(TEnhancedVideoAttribute) to High(TEnhancedVideoAttribute) do
+      if (A in Attr) and (not (A in OAttr)) then
+        attr2ansi:=attr2ansi+AttrOnOffStr[A,True];
+  end;
+
   if (Fg > 15) or (Bg > 15) then
   if (Fg > 15) or (Bg > 15) then
     begin
     begin
       if Fg<>OFg then
       if Fg<>OFg then
@@ -443,8 +469,10 @@ var
   eol,
   eol,
   x,y,
   x,y,
   LastX,LastY : longint;
   LastX,LastY : longint;
-  SpaceFg, SpaceBg,
+  SpaceFg, SpaceBg : byte;
+  SpaceAttr: TEnhancedVideoAttributes;
   LastFg, LastBg : byte;
   LastFg, LastBg : byte;
+  LastAttr: TEnhancedVideoAttributes;
   LastLineWidth : Longint;
   LastLineWidth : Longint;
   p,pold   : penhancedvideocell;
   p,pold   : penhancedvideocell;
   LastCharWasDoubleWidth: Boolean;
   LastCharWasDoubleWidth: Boolean;
@@ -489,20 +517,21 @@ var
     end;
     end;
   end;
   end;
 
 
-  procedure OutClr(Fg,Bg:byte);
+  procedure OutClr(Fg,Bg:byte;Attr:TEnhancedVideoAttributes);
   begin
   begin
-    if (Fg=LastFg) and (Bg=LastBg) then
+    if (Fg=LastFg) and (Bg=LastBg) and (Attr=LastAttr) then
      exit;
      exit;
-    OutData(Attr2Ansi(Fg,Bg,LastFg,LastBg));
+    OutData(Attr2Ansi(Fg,Bg,Attr,LastFg,LastBg,LastAttr));
     LastFg:=Fg;
     LastFg:=Fg;
     LastBg:=Bg;
     LastBg:=Bg;
+    LastAttr:=Attr;
   end;
   end;
 
 
   procedure OutSpaces;
   procedure OutSpaces;
   begin
   begin
     if (Spaces=0) then
     if (Spaces=0) then
      exit;
      exit;
-    OutClr(SpaceFg,SpaceBg);
+    OutClr(SpaceFg,SpaceBg,SpaceAttr);
     OutData(Space(Spaces));
     OutData(Space(Spaces));
     LastX:=x;
     LastX:=x;
     LastY:=y;
     LastY:=y;
@@ -541,12 +570,14 @@ begin
 //  1.0.x: SendEscapeSeq(#27'[m'{#27'[H'});
 //  1.0.x: SendEscapeSeq(#27'[m'{#27'[H'});
   LastFg:=7;
   LastFg:=7;
   LastBg:=0;
   LastBg:=0;
+  LastAttr:=[];
   LastX:=-1;
   LastX:=-1;
   LastY:=-1;
   LastY:=-1;
   for y:=1 to ScreenHeight do
   for y:=1 to ScreenHeight do
    begin
    begin
      SpaceFg:=0;
      SpaceFg:=0;
      SpaceBg:=0;
      SpaceBg:=0;
+     SpaceAttr:=[];
      Spaces:=0;
      Spaces:=0;
      LastLineWidth:=ScreenWidth;
      LastLineWidth:=ScreenWidth;
      If (y=ScreenHeight) And (Console=ttyFreeBSD) {And :am: is on} Then
      If (y=ScreenHeight) And (Console=ttyFreeBSD) {And :am: is on} Then
@@ -586,14 +617,16 @@ begin
                    begin
                    begin
                      SpaceFg:=chattr.ForegroundColor;
                      SpaceFg:=chattr.ForegroundColor;
                      SpaceBg:=chattr.BackgroundColor;
                      SpaceBg:=chattr.BackgroundColor;
+                     SpaceAttr:=chattr.EnhancedVideoAttributes;
                    end;
                    end;
-                  if chattr.BackgroundColor=SpaceBg then
+                  if (chattr.BackgroundColor=SpaceBg) and (chattr.EnhancedVideoAttributes=SpaceAttr) then
                    chattr.ForegroundColor:=SpaceFg
                    chattr.ForegroundColor:=SpaceFg
                   else
                   else
                    begin
                    begin
                      OutSpaces;
                      OutSpaces;
                      SpaceFg:=chattr.ForegroundColor;
                      SpaceFg:=chattr.ForegroundColor;
                      SpaceBg:=chattr.BackgroundColor;
                      SpaceBg:=chattr.BackgroundColor;
+                     SpaceAttr:=chattr.EnhancedVideoAttributes;
                    end;
                    end;
                   inc(Spaces);
                   inc(Spaces);
                 end
                 end
@@ -606,8 +639,8 @@ begin
                       Chattr.Attr:= $ff xor Chattr.Attr;
                       Chattr.Attr:= $ff xor Chattr.Attr;
                       ChAttr.ch:=chr(ord(chattr.ch)+ord('A')-1);
                       ChAttr.ch:=chr(ord(chattr.ch)+ord('A')-1);
                     end;}
                     end;}
-                  if (LastFg<>chattr.ForegroundColor) or (LastBg<>chattr.BackgroundColor) then
-                   OutClr(chattr.ForegroundColor,chattr.BackgroundColor);
+                  if (LastFg<>chattr.ForegroundColor) or (LastBg<>chattr.BackgroundColor) or (LastAttr<>chattr.EnhancedVideoAttributes) then
+                   OutClr(chattr.ForegroundColor,chattr.BackgroundColor,chattr.EnhancedVideoAttributes);
                   OutData(transform(chattr.ExtendedGraphemeCluster));
                   OutData(transform(chattr.ExtendedGraphemeCluster));
                   if CurCharWidth=2 then
                   if CurCharWidth=2 then
                    begin
                    begin
@@ -642,8 +675,8 @@ begin
     OutData(#8);
     OutData(#8);
     {Output last char}
     {Output last char}
     chattr:=p[1];
     chattr:=p[1];
-    if (LastFg<>chattr.ForegroundColor) or (LastBg<>chattr.BackgroundColor) then
-     OutClr(chattr.ForegroundColor,chattr.BackgroundColor);
+    if (LastFg<>chattr.ForegroundColor) or (LastBg<>chattr.BackgroundColor) or (LastAttr<>chattr.EnhancedVideoAttributes) then
+     OutClr(chattr.ForegroundColor,chattr.BackgroundColor,chattr.EnhancedVideoAttributes);
     OutData(transform(chattr.ExtendedGraphemeCluster));
     OutData(transform(chattr.ExtendedGraphemeCluster));
     inc(LastX);
     inc(LastX);
 //    OutData(XY2Ansi(ScreenWidth-1,ScreenHeight,LastX,LastY));
 //    OutData(XY2Ansi(ScreenWidth-1,ScreenHeight,LastX,LastY));
@@ -651,8 +684,8 @@ begin
     OutData(#8+#27+'[1@');
     OutData(#8+#27+'[1@');
 
 
     chattr:=p^;
     chattr:=p^;
-    if (LastFg<>chattr.ForegroundColor) or (LastBg<>chattr.BackgroundColor) then
-     OutClr(chattr.ForegroundColor,chattr.BackgroundColor);
+    if (LastFg<>chattr.ForegroundColor) or (LastBg<>chattr.BackgroundColor) or (LastAttr<>chattr.EnhancedVideoAttributes) then
+     OutClr(chattr.ForegroundColor,chattr.BackgroundColor,chattr.EnhancedVideoAttributes);
     OutData(transform(chattr.ExtendedGraphemeCluster));
     OutData(transform(chattr.ExtendedGraphemeCluster));
     inc(LastX);
     inc(LastX);
    end;
    end;

+ 56 - 0
packages/rtl-console/tests/video4.pp

@@ -0,0 +1,56 @@
+{ test for the enhanced video attributes support }
+program video4;
+
+{$mode objfpc}{$H+}
+
+uses
+  video, keyboard;
+
+procedure TextOut(X, Y: Integer; const S: string; Attr: TEnhancedVideoAttributes);
+var
+  W, P, I, M: Integer;
+begin
+  P := ((X-1)+(Y-1)*ScreenWidth);
+  M := Length(S);
+  if (P+M) > ScreenWidth*ScreenHeight then
+    M := ScreenWidth*ScreenHeight-P;
+  for I := 1 to M do
+    with EnhancedVideoBuf[P+I-1] do
+    begin
+      ExtendedGraphemeCluster := S[I];
+      EnhancedVideoAttributes := Attr;
+    end;
+end;
+
+var
+  k: TKeyEvent;
+  X, Y: Integer;
+begin
+  InitKeyboard;
+  InitEnhancedVideo;
+  repeat
+    TextOut( 1,  4, 'vanilla', []);
+    TextOut( 6,  6, 'underline', [evaUnderlined]);
+    TextOut( 1,  8, 'blink', [evaBlinkSlow]);
+    TextOut( 6, 10, 'underline blink', [evaUnderlined, evaBlinkSlow]);
+    TextOut( 1, 12, 'negative', [evaInverse]);
+    TextOut( 6, 14, 'underline negative', [evaUnderlined, evaInverse]);
+    TextOut( 1, 16, 'blink negative', [evaBlinkSlow, evaInverse]);
+    TextOut( 6, 18, 'underline blink negative', [evaUnderlined, evaBlinkSlow, evaInverse]);
+    TextOut(40,  4, 'bold', [evaBold]);
+    TextOut(46,  6, 'bold underline', [evaBold, evaUnderlined]);
+    TextOut(40,  8, 'bold blink', [evaBold, evaBlinkSlow]);
+    TextOut(46, 10, 'bold underline blink', [evaBold, evaUnderlined, evaBlinkSlow]);
+    TextOut(40, 12, 'bold negative', [evaBold, evaInverse]);
+    TextOut(46, 14, 'bold underline negative', [evaBold, evaUnderlined, evaInverse]);
+    TextOut(40, 16, 'bold blink negative', [evaBold, evaBlinkSlow, evaInverse]);
+    TextOut(46, 18, 'bold underline blink negative', [evaBold, evaUnderlined, evaBlinkSlow, evaInverse]);
+    UpdateScreen(False);
+
+    k := GetKeyEvent;
+    k := TranslateKeyEvent(k);
+  until GetKeyEventChar(k) = 'q';
+  DoneEnhancedVideo;
+  DoneKeyboard;
+end.
+