Browse Source

+ 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

Nikolay Nikolov 9 months ago
parent
commit
25c1112898

+ 2 - 0
packages/fcl-fpterm/Makefile

@@ -0,0 +1,2 @@
+PACKAGE_NAME=fcl-fpterm
+include ../build/Makefile.pkg

+ 380 - 0
packages/fcl-fpterm/src/system.terminal.base.pas

@@ -0,0 +1,380 @@
+{ This file is part of fpterm - a terminal emulator, written in Free Pascal
+
+  Copyright (C) 2022, 2024 Nikolay Nikolov <[email protected]>
+
+  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.
+

+ 1 - 0
packages/fpmake_add.inc

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

+ 6 - 0
packages/fpmake_proc.inc

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