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

+ initial attempt at defining an enhanced video cell record for the Unicode support in the video unit

Browse Source 
git-svn-id: branches/unicodekvm@48465 -
This commit is contained in:
nickysn 2021-01-31 13:57:46 +00:00
parent ee3c4629aa
commit b8dfa1b8e6
2 changed files with 94 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -11,6 +11,73 @@
**********************************************************************}
{ TEnhancedVideoCell }
function TEnhancedVideoCell.GetAttribute: Byte;
begin
GetAttribute := Byte(FAttributes);
end;
procedure TEnhancedVideoCell.SetAttribute(Attr: Byte);
begin
FAttributes := (FAttributes and $FF00) or Attr;
end;
function TEnhancedVideoCell.GetExtendedGraphemeCluster: WideString;
begin
if (FAttributes and $8000) = 0 then
GetExtendedGraphemeCluster := EGC_SingleChar
else
GetExtendedGraphemeCluster := WideString(EGC_WideStr);
end;
procedure TEnhancedVideoCell.SetExtendedGraphemeCluster(const AExtendedGraphemeCluster: WideString);
begin
if Length(AExtendedGraphemeCluster) = 1 then
begin
if (FAttributes and $8000) <> 0 then
begin
FAttributes := FAttributes and $7FFF;
WideString(EGC_WideStr) := '';
end;
EGC_SingleChar := AExtendedGraphemeCluster[1];
end
else
begin
if (FAttributes and $8000) = 0 then
begin
FAttributes := FAttributes or $8000;
EGC_WideStr := nil;
end;
WideString(EGC_WideStr) := AExtendedGraphemeCluster;
end;
end;
class operator TEnhancedVideoCell.Initialize(var evc: TEnhancedVideoCell);
begin
evc.FAttributes := 0;
end;
class operator TEnhancedVideoCell.Finalize(var evc: TEnhancedVideoCell);
begin
if (evc.FAttributes and $8000) <> 0 then
WideString(evc.EGC_WideStr) := '';
end;
procedure fpc_WideStr_Incr_Ref(var S: Pointer); external name 'FPC_WIDESTR_INCR_REF';
class operator TEnhancedVideoCell.AddRef(var evc: TEnhancedVideoCell);
begin
if (evc.FAttributes and $8000) <> 0 then
fpc_WideStr_Incr_Ref(evc.EGC_WideStr);
end;
class operator TEnhancedVideoCell.Copy(constref aSrc: TEnhancedVideoCell; var aDst: TEnhancedVideoCell);
begin
aDst.ExtendedGraphemeCluster := aSrc.ExtendedGraphemeCluster;
aDst.FAttributes := aSrc.FAttributes;
end;
Const
LockUpdateScreen : Integer = 0;

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

@ -11,6 +11,9 @@
**********************************************************************}
{$mode objfpc}
{$modeswitch advancedrecords}
type
PVideoMode = ^TVideoMode;
TVideoMode = record
@ -25,6 +28,30 @@ type
TVideoBuf = array[0..{$ifdef CPU16}16382{$else}32759{$endif}] of TVideoCell;
PVideoBuf = ^TVideoBuf;
TEnhancedVideoCell = record
private
class operator Initialize(var evc: TEnhancedVideoCell);
class operator Finalize(var evc: TEnhancedVideoCell);
class operator AddRef(var evc: TEnhancedVideoCell);
class operator Copy(constref aSrc: TEnhancedVideoCell; var aDst: TEnhancedVideoCell);
function GetExtendedGraphemeCluster: WideString;
procedure SetExtendedGraphemeCluster(const AExtendedGraphemeCluster: WideString);
function GetAttribute: Byte;
procedure SetAttribute(Attr: Byte);
public
property ExtendedGraphemeCluster: WideString read GetExtendedGraphemeCluster write SetExtendedGraphemeCluster;
property Attribute: Byte read GetAttribute write SetAttribute;
private
FAttributes: Word;
case integer of
0: (EGC_SingleChar: WideChar);
1: (EGC_WideStr: Pointer);
end;
PEnhancedVideoCell = ^TEnhancedVideoCell;
TEnhancedVideoBuf = array of TEnhancedVideoCell;
TVideoDriver = Record
InitDriver : Procedure;
DoneDriver : Procedure;