mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 00:09:32 +02:00
+ started integrating my fpterm terminal emulator (from https://sourceforge.net/projects/fpterm/)
as a part of FPC's packages, for potential use and future integration with the console IDE, Lazarus, WebAssembly, Pas2Js, etc. This commit adds the first unit: System.Terminal.Base
This commit is contained in:
Nikolay Nikolov
parent
00ae194e0a
commit
25c1112898
2
packages/fcl-fpterm/Makefile
Normal file
2
packages/fcl-fpterm/Makefile
Normal file
@ -0,0 +1,2 @@
|
||||
PACKAGE_NAME=fcl-fpterm
|
||||
include ../build/Makefile.pkg
|
||||
380
packages/fcl-fpterm/src/system.terminal.base.pas
Normal file
380
packages/fcl-fpterm/src/system.terminal.base.pas
Normal file
@ -0,0 +1,380 @@
|
||||
{ This file is part of fpterm - a terminal emulator, written in Free Pascal
|
||||
|
||||
Copyright (C) 2022, 2024 Nikolay Nikolov <nickysn@users.sourceforge.net>
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU Library General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or (at your
|
||||
option) any later version with the following modification:
|
||||
|
||||
As a special exception, the copyright holders of this library give you
|
||||
permission to link this library with independent modules to produce an
|
||||
executable, regardless of the license terms of these independent modules,and
|
||||
to copy and distribute the resulting executable under terms of your choice,
|
||||
provided that you also meet, for each linked independent module, the terms
|
||||
and conditions of the license of that module. An independent module is a
|
||||
module which is not derived from or based on this library. If you modify
|
||||
this library, you may extend this exception to your version of the library,
|
||||
but you are not obligated to do so. If you do not wish to do so, delete this
|
||||
exception statement from your version.
|
||||
|
||||
This program 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 Library General Public License
|
||||
for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public License
|
||||
along with this library; if not, write to the Free Software Foundation,
|
||||
Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.
|
||||
}
|
||||
|
||||
unit System.Terminal.Base;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
{$modeswitch advancedrecords+}
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
TPointingDeviceButton = (
|
||||
pdButton1, { left mouse button }
|
||||
pdButton2, { right mouse button }
|
||||
pdButton3, { middle mouse button }
|
||||
pdButton4, { mouse wheel rotated forward (scroll up) }
|
||||
pdButton5, { mouse wheel rotated backward (scroll down) }
|
||||
pdButton6, { mouse horizontal scroll wheel rotated left }
|
||||
pdButton7, { mouse horizontal scroll wheel rotated right }
|
||||
pdButton8, { "back" button ("X button 1") }
|
||||
pdButton9, { "forward" button ("X button 2") }
|
||||
pdButton10,
|
||||
pdButton11,
|
||||
pdButton12,
|
||||
pdButton13,
|
||||
pdButton14,
|
||||
pdButton15);
|
||||
TPointingDeviceButtonState = set of TPointingDeviceButton;
|
||||
TPointingDeviceEvent = record
|
||||
X, Y: Integer;
|
||||
ButtonState: TPointingDeviceButtonState;
|
||||
end;
|
||||
|
||||
TShiftStateElement = (
|
||||
ssShift, { either Left or Right Shift is pressed }
|
||||
ssLeftShift,
|
||||
ssRightShift,
|
||||
ssCtrl, { either Left or Right Ctrl is pressed }
|
||||
ssLeftCtrl,
|
||||
ssRightCtrl,
|
||||
ssAlt, { either Left or Right Alt is pressed, but *not* AltGr }
|
||||
ssLeftAlt,
|
||||
ssRightAlt, { only on keyboard layouts, without AltGr }
|
||||
ssAltGr, { only on keyboard layouts, with AltGr instead of Right Alt }
|
||||
ssCapsLockPressed,
|
||||
ssCapsLockOn,
|
||||
ssNumLockPressed,
|
||||
ssNumLockOn,
|
||||
ssScrollLockPressed,
|
||||
ssScrollLockOn
|
||||
);
|
||||
TShiftState = set of TShiftStateElement;
|
||||
TKeyEvent = record
|
||||
VirtualKeyCode: Word; { device-independent identifier of the key }
|
||||
VirtualScanCode: Word; { device-dependent value, generated by the keyboard }
|
||||
UnicodeChar: WideChar; { the translated Unicode character }
|
||||
AsciiChar: AnsiChar; { the translated ASCII character }
|
||||
ShiftState: TShiftState;
|
||||
Flags: Byte;
|
||||
end;
|
||||
|
||||
TRenditionFlag = (
|
||||
rfBold,
|
||||
rfFaint,
|
||||
rfItalicized,
|
||||
rfUnderlined,
|
||||
rfBlinkSlow,
|
||||
rfBlinkFast,
|
||||
rfInverse,
|
||||
rfInvisible,
|
||||
rfCrossedOut,
|
||||
rfDoublyUnderlined
|
||||
);
|
||||
TRenditionFlags = set of TRenditionFlag;
|
||||
TColor = (
|
||||
cBlack,
|
||||
cBlue,
|
||||
cGreen,
|
||||
cCyan,
|
||||
cRed,
|
||||
cMagenta,
|
||||
cBrown,
|
||||
cLightGray,
|
||||
cDarkGray,
|
||||
cLightBlue,
|
||||
cLightGreen,
|
||||
cLightCyan,
|
||||
cLightRed,
|
||||
cLightMagenta,
|
||||
cYellow,
|
||||
cWhite,
|
||||
cColor16, cColor17, cColor18, cColor19, cColor20, cColor21, cColor22, cColor23,
|
||||
cColor24, cColor25, cColor26, cColor27, cColor28, cColor29, cColor30, cColor31,
|
||||
cColor32, cColor33, cColor34, cColor35, cColor36, cColor37, cColor38, cColor39,
|
||||
cColor40, cColor41, cColor42, cColor43, cColor44, cColor45, cColor46, cColor47,
|
||||
cColor48, cColor49, cColor50, cColor51, cColor52, cColor53, cColor54, cColor55,
|
||||
cColor56, cColor57, cColor58, cColor59, cColor60, cColor61, cColor62, cColor63,
|
||||
cColor64, cColor65, cColor66, cColor67, cColor68, cColor69, cColor70, cColor71,
|
||||
cColor72, cColor73, cColor74, cColor75, cColor76, cColor77, cColor78, cColor79,
|
||||
cColor80, cColor81, cColor82, cColor83, cColor84, cColor85, cColor86, cColor87,
|
||||
cColor88, cColor89, cColor90, cColor91, cColor92, cColor93, cColor94, cColor95,
|
||||
cColor96, cColor97, cColor98, cColor99, cColor100, cColor101, cColor102, cColor103,
|
||||
cColor104, cColor105, cColor106, cColor107, cColor108, cColor109, cColor110, cColor111,
|
||||
cColor112, cColor113, cColor114, cColor115, cColor116, cColor117, cColor118, cColor119,
|
||||
cColor120, cColor121, cColor122, cColor123, cColor124, cColor125, cColor126, cColor127,
|
||||
cColor128, cColor129, cColor130, cColor131, cColor132, cColor133, cColor134, cColor135,
|
||||
cColor136, cColor137, cColor138, cColor139, cColor140, cColor141, cColor142, cColor143,
|
||||
cColor144, cColor145, cColor146, cColor147, cColor148, cColor149, cColor150, cColor151,
|
||||
cColor152, cColor153, cColor154, cColor155, cColor156, cColor157, cColor158, cColor159,
|
||||
cColor160, cColor161, cColor162, cColor163, cColor164, cColor165, cColor166, cColor167,
|
||||
cColor168, cColor169, cColor170, cColor171, cColor172, cColor173, cColor174, cColor175,
|
||||
cColor176, cColor177, cColor178, cColor179, cColor180, cColor181, cColor182, cColor183,
|
||||
cColor184, cColor185, cColor186, cColor187, cColor188, cColor189, cColor190, cColor191,
|
||||
cColor192, cColor193, cColor194, cColor195, cColor196, cColor197, cColor198, cColor199,
|
||||
cColor200, cColor201, cColor202, cColor203, cColor204, cColor205, cColor206, cColor207,
|
||||
cColor208, cColor209, cColor210, cColor211, cColor212, cColor213, cColor214, cColor215,
|
||||
cColor216, cColor217, cColor218, cColor219, cColor220, cColor221, cColor222, cColor223,
|
||||
cColor224, cColor225, cColor226, cColor227, cColor228, cColor229, cColor230, cColor231,
|
||||
cColor232, cColor233, cColor234, cColor235, cColor236, cColor237, cColor238, cColor239,
|
||||
cColor240, cColor241, cColor242, cColor243, cColor244, cColor245, cColor246, cColor247,
|
||||
cColor248, cColor249, cColor250, cColor251, cColor252, cColor253, cColor254, cColor255,
|
||||
cDefaultForeground,
|
||||
cDefaultBackground
|
||||
);
|
||||
|
||||
{ TAttribute }
|
||||
|
||||
TAttribute = record
|
||||
ForegroundColor: TColor;
|
||||
BackgroundColor: TColor;
|
||||
RenditionFlags: TRenditionFlags;
|
||||
|
||||
procedure SetForegroundColorRGB(ARed, AGreen, ABlue: Integer);
|
||||
procedure SetBackgroundColorRGB(ARed, AGreen, ABlue: Integer);
|
||||
end;
|
||||
|
||||
const
|
||||
DefaultAttribute: TAttribute = (
|
||||
ForegroundColor: cDefaultForeground;
|
||||
BackgroundColor: cDefaultBackground;
|
||||
RenditionFlags: []
|
||||
);
|
||||
|
||||
type
|
||||
TExtendedGraphemeCluster = UnicodeString;
|
||||
|
||||
{ TCell }
|
||||
|
||||
TCell = record
|
||||
private
|
||||
function GetErased: Boolean;
|
||||
procedure SetErased(AValue: Boolean);
|
||||
public
|
||||
Attribute: TAttribute;
|
||||
ExtendedGraphemeCluster: TExtendedGraphemeCluster;
|
||||
|
||||
property Erased: Boolean read GetErased write SetErased;
|
||||
end;
|
||||
TScreenBuffer = (sbNormal, sbAlternate);
|
||||
TC0Char = #$00..#$1F;
|
||||
TC1Char = #$80..#$9F;
|
||||
|
||||
const
|
||||
C0_NUL = #$00;
|
||||
C0_SOH = #$01;
|
||||
C0_STX = #$02;
|
||||
C0_ETX = #$03;
|
||||
C0_EOT = #$04;
|
||||
C0_ENQ = #$05;
|
||||
C0_ACK = #$06;
|
||||
C0_BEL = #$07;
|
||||
C0_BS = #$08;
|
||||
C0_HT = #$09;
|
||||
C0_LF = #$0A;
|
||||
C0_VT = #$0B;
|
||||
C0_FF = #$0C;
|
||||
C0_CR = #$0D;
|
||||
C0_SO = #$0E;
|
||||
C0_LS1 = C0_SO;
|
||||
C0_SI = #$0F;
|
||||
C0_LS0 = C0_SI;
|
||||
C0_DLE = #$10;
|
||||
C0_DC1 = #$11;
|
||||
C0_DC2 = #$12;
|
||||
C0_DC3 = #$13;
|
||||
C0_DC4 = #$14;
|
||||
C0_NAK = #$15;
|
||||
C0_SYN = #$16;
|
||||
C0_ETB = #$17;
|
||||
C0_CAN = #$18;
|
||||
C0_EM = #$19;
|
||||
C0_SUB = #$1A;
|
||||
C0_ESC = #$1B;
|
||||
C0_IS4 = #$1C;
|
||||
C0_IS3 = #$1D;
|
||||
C0_IS2 = #$1E;
|
||||
C0_IS1 = #$1F;
|
||||
|
||||
C1_BPH = #$82;
|
||||
C1_NBH = #$83;
|
||||
C1_IND = #$84; { deprecated }
|
||||
C1_NEL = #$85;
|
||||
C1_SSA = #$86;
|
||||
C1_ESA = #$87;
|
||||
C1_HTS = #$88;
|
||||
C1_HTJ = #$89;
|
||||
C1_VTS = #$8A;
|
||||
C1_PLD = #$8B;
|
||||
C1_PLU = #$8C;
|
||||
C1_RI = #$8D;
|
||||
C1_SS2 = #$8E;
|
||||
C1_SS3 = #$8F;
|
||||
C1_DCS = #$90;
|
||||
C1_PU1 = #$91;
|
||||
C1_PU2 = #$92;
|
||||
C1_STS = #$93;
|
||||
C1_CCH = #$94;
|
||||
C1_MW = #$95;
|
||||
C1_SPA = #$96;
|
||||
C1_EPA = #$97;
|
||||
C1_SOS = #$98;
|
||||
C1_SCI = #$9A;
|
||||
C1_CSI = #$9B;
|
||||
C1_ST = #$9C;
|
||||
C1_OSC = #$9D;
|
||||
C1_PM = #$9E;
|
||||
C1_APC = #$9F;
|
||||
|
||||
function Cell(ExtendedGraphemeCluster: TExtendedGraphemeCluster; Attribute: TAttribute): TCell;
|
||||
function ErasedCell(Attribute: TAttribute): TCell;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
PaletteData: array [0..255] of Uint32 =
|
||||
($000000, $0000AA, $00AA00, $00AAAA, $AA0000, $AA00AA, $AA5500, $AAAAAA,
|
||||
$555555, $5555FF, $55FF55, $55FFFF, $FF5555, $FF55FF, $FFFF55, $FFFFFF,
|
||||
|
||||
{ 6x6x6 colour cube }
|
||||
$000000, $00005f, $000087, $0000af, $0000d7, $0000ff,
|
||||
$005f00, $005f5f, $005f87, $005faf, $005fd7, $005fff,
|
||||
$008700, $00875f, $008787, $0087af, $0087d7, $0087ff,
|
||||
$00af00, $00af5f, $00af87, $00afaf, $00afd7, $00afff,
|
||||
$00d700, $00d75f, $00d787, $00d7af, $00d7d7, $00d7ff,
|
||||
$00ff00, $00ff5f, $00ff87, $00ffaf, $00ffd7, $00ffff,
|
||||
|
||||
$5f0000, $5f005f, $5f0087, $5f00af, $5f00d7, $5f00ff,
|
||||
$5f5f00, $5f5f5f, $5f5f87, $5f5faf, $5f5fd7, $5f5fff,
|
||||
$5f8700, $5f875f, $5f8787, $5f87af, $5f87d7, $5f87ff,
|
||||
$5faf00, $5faf5f, $5faf87, $5fafaf, $5fafd7, $5fafff,
|
||||
$5fd700, $5fd75f, $5fd787, $5fd7af, $5fd7d7, $5fd7ff,
|
||||
$5fff00, $5fff5f, $5fff87, $5fffaf, $5fffd7, $5fffff,
|
||||
|
||||
$870000, $87005f, $870087, $8700af, $8700d7, $8700ff,
|
||||
$875f00, $875f5f, $875f87, $875faf, $875fd7, $875fff,
|
||||
$878700, $87875f, $878787, $8787af, $8787d7, $8787ff,
|
||||
$87af00, $87af5f, $87af87, $87afaf, $87afd7, $87afff,
|
||||
$87d700, $87d75f, $87d787, $87d7af, $87d7d7, $87d7ff,
|
||||
$87ff00, $87ff5f, $87ff87, $87ffaf, $87ffd7, $87ffff,
|
||||
|
||||
$af0000, $af005f, $af0087, $af00af, $af00d7, $af00ff,
|
||||
$af5f00, $af5f5f, $af5f87, $af5faf, $af5fd7, $af5fff,
|
||||
$af8700, $af875f, $af8787, $af87af, $af87d7, $af87ff,
|
||||
$afaf00, $afaf5f, $afaf87, $afafaf, $afafd7, $afafff,
|
||||
$afd700, $afd75f, $afd787, $afd7af, $afd7d7, $afd7ff,
|
||||
$afff00, $afff5f, $afff87, $afffaf, $afffd7, $afffff,
|
||||
|
||||
$d70000, $d7005f, $d70087, $d700af, $d700d7, $d700ff,
|
||||
$d75f00, $d75f5f, $d75f87, $d75faf, $d75fd7, $d75fff,
|
||||
$d78700, $d7875f, $d78787, $d787af, $d787d7, $d787ff,
|
||||
$d7af00, $d7af5f, $d7af87, $d7afaf, $d7afd7, $d7afff,
|
||||
$d7d700, $d7d75f, $d7d787, $d7d7af, $d7d7d7, $d7d7ff,
|
||||
$d7ff00, $d7ff5f, $d7ff87, $d7ffaf, $d7ffd7, $d7ffff,
|
||||
|
||||
$ff0000, $ff005f, $ff0087, $ff00af, $ff00d7, $ff00ff,
|
||||
$ff5f00, $ff5f5f, $ff5f87, $ff5faf, $ff5fd7, $ff5fff,
|
||||
$ff8700, $ff875f, $ff8787, $ff87af, $ff87d7, $ff87ff,
|
||||
$ffaf00, $ffaf5f, $ffaf87, $ffafaf, $ffafd7, $ffafff,
|
||||
$ffd700, $ffd75f, $ffd787, $ffd7af, $ffd7d7, $ffd7ff,
|
||||
$ffff00, $ffff5f, $ffff87, $ffffaf, $ffffd7, $ffffff,
|
||||
|
||||
{ grayscale }
|
||||
$080808, $121212, $1c1c1c, $262626, $303030, $3a3a3a, $444444, $4e4e4e,
|
||||
$585858, $626262, $6c6c6c, $767676, $808080, $8a8a8a, $949494, $9e9e9e,
|
||||
$a8a8a8, $b2b2b2, $bcbcbc, $c6c6c6, $d0d0d0, $dadada, $e4e4e4, $eeeeee);
|
||||
|
||||
function Cell(ExtendedGraphemeCluster: TExtendedGraphemeCluster;
|
||||
Attribute: TAttribute): TCell;
|
||||
begin
|
||||
Result.ExtendedGraphemeCluster := ExtendedGraphemeCluster;
|
||||
Result.Attribute := Attribute;
|
||||
end;
|
||||
|
||||
function ErasedCell(Attribute: TAttribute): TCell;
|
||||
begin
|
||||
Result.ExtendedGraphemeCluster := '';
|
||||
Result.Attribute := Attribute;
|
||||
end;
|
||||
|
||||
function FindClosestColor(ARed, AGreen, ABlue: Integer): Byte;
|
||||
var
|
||||
CRed, CGreen, CBlue: Byte;
|
||||
I: Integer;
|
||||
SqrDist, BestSqrDist: QWord;
|
||||
begin
|
||||
Result := 0;
|
||||
BestSqrDist := High(BestSqrDist);
|
||||
for I := 0 to 255 do
|
||||
begin
|
||||
CRed := Byte(PaletteData[I] shr 16);
|
||||
CGreen := Byte(PaletteData[I] shr 8);
|
||||
CBlue := Byte(PaletteData[I]);
|
||||
SqrDist := Sqr(QWord(ARed - CRed)) + Sqr(QWord(AGreen - CGreen)) + Sqr(QWord(ABlue - CBlue));
|
||||
if SqrDist < BestSqrDist then
|
||||
begin
|
||||
BestSqrDist := SqrDist;
|
||||
Result := I;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TCell }
|
||||
|
||||
function TCell.GetErased: Boolean;
|
||||
begin
|
||||
Result := ExtendedGraphemeCluster = '';
|
||||
end;
|
||||
|
||||
procedure TCell.SetErased(AValue: Boolean);
|
||||
begin
|
||||
if AValue then
|
||||
ExtendedGraphemeCluster := ''
|
||||
else
|
||||
begin
|
||||
if ExtendedGraphemeCluster = '' then
|
||||
ExtendedGraphemeCluster := ' ';
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TAttribute }
|
||||
|
||||
procedure TAttribute.SetForegroundColorRGB(ARed, AGreen, ABlue: Integer);
|
||||
begin
|
||||
ForegroundColor := TColor(FindClosestColor(ARed, AGreen, ABlue));
|
||||
end;
|
||||
|
||||
procedure TAttribute.SetBackgroundColorRGB(ARed, AGreen, ABlue: Integer);
|
||||
begin
|
||||
BackgroundColor := TColor(FindClosestColor(ARed, AGreen, ABlue));
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -161,3 +161,4 @@
|
||||
add_wasm_oi(ADirectory+IncludeTrailingPathDelimiter('wasm-oi'));
|
||||
add_fcl_jsonschema(ADirectory+IncludeTrailingPathDelimiter('fcl-jsonschema'));
|
||||
add_ptckvm(ADirectory+IncludeTrailingPathDelimiter('ptckvm'));
|
||||
add_fcl_fpterm(ADirectory+IncludeTrailingPathDelimiter('fcl-fpterm'));
|
||||
|
||||
@ -912,3 +912,9 @@ begin
|
||||
{$include ptckvm/fpmake.pp}
|
||||
end;
|
||||
|
||||
procedure add_fcl_fpterm(const ADirectory: string);
|
||||
begin
|
||||
with Installer do
|
||||
{$include fcl-fpterm/fpmake.pp}
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user