AI_Slop/WinComm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Compare commits

base: AI_Slop:ec6eebb2a5a5e0a01367e6d9b22dd28200b874b2
Branches Tags
AI_Slop:master
..
compare: AI_Slop:eebcf100ad45d92d03a253d4519ae394d15a145e
Branches Tags
AI_Slop:master

No commits in common. "ec6eebb2a5a5e0a01367e6d9b22dd28200b874b2" and "eebcf100ad45d92d03a253d4519ae394d15a145e" have entirely different histories.
ec6eebb2a5 ... eebcf100ad

8 changed files with 67 additions and 710 deletions
Show stats Expand all files Collapse all files

2
.gitattributes vendored
View file

@ -1,6 +1,7 @@
# Git LFS - binary files # Git LFS - binary files
*.bmp filter=lfs diff=lfs merge=lfs -text *.bmp filter=lfs diff=lfs merge=lfs -text
*.DRV filter=lfs diff=lfs merge=lfs -text *.DRV filter=lfs diff=lfs merge=lfs -text
# Force LF line endings on source files # Force LF line endings on source files
*.c text eol=lf *.c text eol=lf
*.h text eol=lf *.h text eol=lf
@ -8,4 +9,3 @@
*.def text eol=lf *.def text eol=lf
makefile text eol=lf makefile text eol=lf
*.TXT text eol=lf *.TXT text eol=lf
*.TTF filter=lfs diff=lfs merge=lfs -text

138
delphi/KPANSI.PAS
View file

@ -85,7 +85,6 @@ type
{ Terminal dimensions } { Terminal dimensions }
FCols: Integer; { Number of columns (default 80) } FCols: Integer; { Number of columns (default 80) }
FRows: Integer; { Number of rows (default 25) } FRows: Integer; { Number of rows (default 25) }
FFontSize: Integer; { Font point size for OEM terminal font }
FScrollbackSize: Integer; { Max scrollback lines to retain (default 500) } FScrollbackSize: Integer; { Max scrollback lines to retain (default 500) }
{ Cursor visibility (DEC ?25h/l) } { Cursor visibility (DEC ?25h/l) }
@ -106,6 +105,7 @@ type
FLiveDC: HDC; { Non-zero during render pass in WriteDeferredBuf } FLiveDC: HDC; { Non-zero during render pass in WriteDeferredBuf }
procedure AllocLine(Line: PTermLine); procedure AllocLine(Line: PTermLine);
procedure CMFontChanged(var Msg: TMessage); message cm_FontChanged;
procedure CreatePaintFont; procedure CreatePaintFont;
procedure DeleteChars(N: Integer); procedure DeleteChars(N: Integer);
procedure DeleteLines(N: Integer); procedure DeleteLines(N: Integer);
@ -128,18 +128,15 @@ type
procedure ResizeScreen; procedure ResizeScreen;
procedure SetCols(Value: Integer); procedure SetCols(Value: Integer);
procedure SetCursorVisible(Value: Boolean); procedure SetCursorVisible(Value: Boolean);
procedure SetFontSize(Value: Integer);
procedure SetRows(Value: Integer); procedure SetRows(Value: Integer);
procedure SetScrollbackSize(Value: Integer); procedure SetScrollbackSize(Value: Integer);
procedure TrimScrollback; procedure TrimScrollback;
procedure UpdateScrollbar; procedure UpdateScrollbar;
procedure WriteDeferred(const S: string);
procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message wm_EraseBkgnd; procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message wm_EraseBkgnd;
procedure WMGetDlgCode(var Msg: TMessage); message wm_GetDlgCode; procedure WMGetDlgCode(var Msg: TMessage); message wm_GetDlgCode;
procedure WMVScroll(var Msg: TWMScroll); message wm_VScroll; procedure WMVScroll(var Msg: TWMScroll); message wm_VScroll;
protected protected
procedure CreateParams(var Params: TCreateParams); override; procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override; procedure KeyPress(var Key: Char); override;
procedure Paint; override; procedure Paint; override;
@ -151,6 +148,7 @@ type
procedure FlipToScreen; procedure FlipToScreen;
procedure TickBlink; procedure TickBlink;
procedure Write(const S: string); procedure Write(const S: string);
procedure WriteDeferred(const S: string);
procedure WriteDeferredBuf(Buf: PChar; Len: Integer); procedure WriteDeferredBuf(Buf: PChar; Len: Integer);
property CursorCol: Integer read FCursorCol; property CursorCol: Integer read FCursorCol;
property CursorRow: Integer read FCursorRow; property CursorRow: Integer read FCursorRow;
@ -161,7 +159,7 @@ type
write SetScrollbackSize default 500; write SetScrollbackSize default 500;
property CursorVisible: Boolean read FCursorVisible property CursorVisible: Boolean read FCursorVisible
write SetCursorVisible default True; write SetCursorVisible default True;
property FontSize: Integer read FFontSize write SetFontSize default 12; property Font;
property Color default clBlack; property Color default clBlack;
property OnKeyData: TKeyDataEvent read FOnKeyData write FOnKeyData; property OnKeyData: TKeyDataEvent read FOnKeyData write FOnKeyData;
property TabStop default True; property TabStop default True;
@ -194,6 +192,8 @@ const
{ Blink toggle interval in milliseconds (cursor + text blink). } { Blink toggle interval in milliseconds (cursor + text blink). }
BlinkMs = 500; BlinkMs = 500;
{ OUT_RASTER_PRECIS may not be defined in Delphi 1.0 WinTypes }
OutRasterPrecis = 6;
{ ExtTextOut option flag (may not be in Delphi 1.0 WinTypes) } { ExtTextOut option flag (may not be in Delphi 1.0 WinTypes) }
ETO_OPAQUE = $0002; ETO_OPAQUE = $0002;
@ -303,6 +303,12 @@ begin
end; end;
procedure TKPAnsi.CMFontChanged(var Msg: TMessage);
begin
inherited;
RecalcCellSize;
end;
constructor TKPAnsi.Create(AOwner: TComponent); constructor TKPAnsi.Create(AOwner: TComponent);
var var
@ -323,11 +329,14 @@ begin
FAttrFG := 7; FAttrFG := 7;
FCellWidth := 8; FCellWidth := 8;
FCellHeight := 18; FCellHeight := 18;
FFontSize := 12;
FBlinkOn := True; FBlinkOn := True;
FLastBlinkTick := GetTickCount; FLastBlinkTick := GetTickCount;
FWrapMode := True; FWrapMode := True;
FAllDirty := True; FAllDirty := True;
{ Set a monospace font -- OEM charset selected in CreatePaintFont }
Font.Name := 'Terminal';
Font.Size := 12;
Font.Pitch := fpFixed;
{ Allocate initial screen lines } { Allocate initial screen lines }
for I := 0 to FRows - 1 do for I := 0 to FRows - 1 do
@ -344,8 +353,6 @@ var
LF: TLogFont; LF: TLogFont;
ActualLF: TLogFont; ActualLF: TLogFont;
NewFont: HFont; NewFont: HFont;
BaseH: Integer;
Delta: Integer;
begin begin
{ Free previous font (stock fonts must not be deleted) } { Free previous font (stock fonts must not be deleted) }
if (FPaintFont <> 0) and not FStockFont then if (FPaintFont <> 0) and not FStockFont then
@ -353,89 +360,32 @@ begin
FPaintFont := 0; FPaintFont := 0;
FStockFont := False; FStockFont := False;
{ Build LOGFONT requesting OEM_CHARSET with raster precision for CP437 }
{ box-drawing, block elements, and other BBS ANSI art glyphs. Raster }
{ precision prevents the font mapper from substituting a TrueType font }
{ that might remap character codes through Unicode tables. }
FillChar(LF, SizeOf(LF), 0); FillChar(LF, SizeOf(LF), 0);
LF.lfWeight := FW_NORMAL; LF.lfHeight := Font.Height;
LF.lfPitchAndFamily := FIXED_PITCH or FF_MODERN; LF.lfPitchAndFamily := FIXED_PITCH or FF_MODERN;
BaseH := MulDiv(FFontSize, Screen.PixelsPerInch, 72); LF.lfCharSet := OEM_CHARSET;
LF.lfOutPrecision := OutRasterPrecis;
if fsBold in Font.Style then
LF.lfWeight := FW_BOLD
else
LF.lfWeight := FW_NORMAL;
StrPCopy(LF.lfFaceName, Font.Name);
{ Try Terminal raster at the exact requested size first. Terminal is }
{ pixel-perfect but only available at specific cell heights. }
LF.lfCharSet := OEM_CHARSET;
LF.lfHeight := BaseH;
StrPCopy(LF.lfFaceName, 'Terminal');
NewFont := CreateFontIndirect(LF); NewFont := CreateFontIndirect(LF);
if NewFont <> 0 then if NewFont <> 0 then
begin begin
{ Verify Windows actually gave us an OEM charset font }
GetObject(NewFont, SizeOf(ActualLF), @ActualLF); GetObject(NewFont, SizeOf(ActualLF), @ActualLF);
if (ActualLF.lfCharSet = OEM_CHARSET) and if ActualLF.lfCharSet = OEM_CHARSET then
(ActualLF.lfHeight = BaseH) then
FPaintFont := NewFont FPaintFont := NewFont
else else
DeleteObject(NewFont); DeleteObject(NewFont);
end; end;
{ If Terminal doesn't have the exact size, try Perfect DOS VGA 437. }
{ This TrueType CP437 font renders pixel-perfectly at cell height }
{ multiples of 8 (8, 16, 24, 32...). Install via Control Panel > }
{ Fonts before use. Request with DEFAULT_CHARSET so Win 3.1 doesn't }
{ reject the TrueType font in favor of a raster OEM substitute. }
if (FPaintFont = 0) and (BaseH >= 8) and (BaseH mod 8 = 0) then
begin
LF.lfCharSet := DEFAULT_CHARSET;
LF.lfHeight := BaseH;
StrPCopy(LF.lfFaceName, 'Perfect DOS VGA 437');
NewFont := CreateFontIndirect(LF);
if NewFont <> 0 then
begin
GetObject(NewFont, SizeOf(ActualLF), @ActualLF);
if StrIComp(ActualLF.lfFaceName, LF.lfFaceName) = 0 then
FPaintFont := NewFont
else
DeleteObject(NewFont);
end;
end;
{ Fall back to Terminal raster at the nearest available size. Search }
{ outward from the requested size (up then down). }
if FPaintFont = 0 then
begin
LF.lfCharSet := OEM_CHARSET;
StrPCopy(LF.lfFaceName, 'Terminal');
for Delta := 1 to 12 do
begin
LF.lfHeight := BaseH + Delta;
NewFont := CreateFontIndirect(LF);
if NewFont <> 0 then
begin
GetObject(NewFont, SizeOf(ActualLF), @ActualLF);
if (ActualLF.lfCharSet = OEM_CHARSET) and
(ActualLF.lfHeight = BaseH + Delta) then
begin
FPaintFont := NewFont;
Break;
end;
DeleteObject(NewFont);
end;
if (FPaintFont = 0) and (BaseH - Delta >= 4) then
begin
LF.lfHeight := BaseH - Delta;
NewFont := CreateFontIndirect(LF);
if NewFont <> 0 then
begin
GetObject(NewFont, SizeOf(ActualLF), @ActualLF);
if (ActualLF.lfCharSet = OEM_CHARSET) and
(ActualLF.lfHeight = BaseH - Delta) then
begin
FPaintFont := NewFont;
Break;
end;
DeleteObject(NewFont);
end;
end;
end;
end;
{ Last resort: stock OEM font }
if FPaintFont = 0 then if FPaintFont = 0 then
begin begin
FPaintFont := GetStockObject(OEM_FIXED_FONT); FPaintFont := GetStockObject(OEM_FIXED_FONT);
@ -454,13 +404,6 @@ begin
end; end;
procedure TKPAnsi.CreateWnd;
begin
inherited CreateWnd;
RecalcCellSize;
end;
procedure TKPAnsi.DeleteChars(N: Integer); procedure TKPAnsi.DeleteChars(N: Integer);
var var
Line: PTermLine; Line: PTermLine;
@ -1901,16 +1844,11 @@ var
RunBG: Byte; RunBG: Byte;
RunBuf: array[0..255] of Char; RunBuf: array[0..255] of Char;
RunLen: Integer; RunLen: Integer;
DxBuf: array[0..255] of Integer;
R: TRect; R: TRect;
RowY: Integer; RowY: Integer;
begin begin
RowY := Row * FCellHeight; RowY := Row * FCellHeight;
{ Fill character spacing array -- forces uniform cell width for TrueType }
for Col := 0 to FCols - 1 do
DxBuf[Col] := FCellWidth;
{ Determine which line to render (handles scrollback view) } { Determine which line to render (handles scrollback view) }
if FScrollPos <> 0 then if FScrollPos <> 0 then
begin begin
@ -1986,7 +1924,7 @@ begin
R.Right := (RunStart + RunLen) * FCellWidth; R.Right := (RunStart + RunLen) * FCellWidth;
R.Bottom := RowY + FCellHeight; R.Bottom := RowY + FCellHeight;
ExtTextOut(DC, RunStart * FCellWidth, RowY, ETO_OPAQUE, @R, ExtTextOut(DC, RunStart * FCellWidth, RowY, ETO_OPAQUE, @R,
@RunBuf[0], RunLen, @DxBuf[0]); @RunBuf[0], RunLen, nil);
end; end;
RunStart := Col; RunStart := Col;
RunLen := 0; RunLen := 0;
@ -2008,7 +1946,7 @@ begin
R.Right := (RunStart + RunLen) * FCellWidth; R.Right := (RunStart + RunLen) * FCellWidth;
R.Bottom := RowY + FCellHeight; R.Bottom := RowY + FCellHeight;
ExtTextOut(DC, RunStart * FCellWidth, RowY, ETO_OPAQUE, @R, ExtTextOut(DC, RunStart * FCellWidth, RowY, ETO_OPAQUE, @R,
@RunBuf[0], RunLen, @DxBuf[0]); @RunBuf[0], RunLen, nil);
end; end;
end; end;
@ -2079,20 +2017,6 @@ begin
end; end;
procedure TKPAnsi.SetFontSize(Value: Integer);
begin
if Value < 4 then
Value := 4;
if Value > 72 then
Value := 72;
if Value <> FFontSize then
begin
FFontSize := Value;
RecalcCellSize;
end;
end;
procedure TKPAnsi.SetRows(Value: Integer); procedure TKPAnsi.SetRows(Value: Integer);
begin begin
if Value < 1 then if Value < 1 then

333
delphi/KPANSI.md
View file

@ -1,333 +0,0 @@
# TKPAnsi - ANSI BBS Terminal Emulation Component
TKPAnsi is a visual Delphi 1.0 component providing ANSI/VT100 terminal
emulation with scrollback, cursor blinking, and ANSI music support. It is a
TCustomControl descendant that renders incoming data using standard ANSI
escape sequences for cursor positioning, color attributes, and screen
manipulation.
Installs to the **KP** component palette tab.
## Properties
### Published (Design-Time and Runtime)
| Property | Type | Default | Description |
|---|---|---|---|
| FontSize | Integer | 12 | Font point size (4-72). Controls the OEM terminal font size. The control auto-sizes Width and Height from FontSize, Cols, and Rows. |
| Cols | Integer | 80 | Terminal columns (1-256). |
| Rows | Integer | 25 | Terminal rows (1-255). |
| ScrollbackSize | Integer | 500 | Maximum scrollback history lines. |
| CursorVisible | Boolean | True | Show or hide the cursor (also controlled by DEC mode ?25h/l). |
| Color | TColor | clBlack | Control background color. |
| OnKeyData | TKeyDataEvent | nil | Keyboard data callback. |
| TabStop | Boolean | True | Accept keyboard focus. |
### Public (Read-Only)
| Property | Type | Description |
|---|---|---|
| CursorCol | Integer | Current 0-based cursor column. |
| CursorRow | Integer | Current 0-based cursor row. |
## Methods
### Public
| Method | Description |
|---|---|
| Create(AOwner) | Constructor. Allocates screen lines, initializes defaults. |
| Destroy | Destructor. Frees paint font, screen, and scrollback. |
| Clear | Moves the current screen to scrollback and allocates fresh blank lines. Resets the cursor to 0,0. |
| Reset | Resets all attributes and parse state, then calls Clear. |
| Write(S) | Parses the string and renders immediately. Convenience wrapper around WriteDeferredBuf + FlipToScreen. |
| WriteDeferredBuf(Buf, Len) | Parses a PChar buffer into the cell buffer, then renders dirty rows. Used for bulk serial data. |
| FlipToScreen | Renders all dirty rows to the screen DC. Handles coalesced scrolls, cursor ghost cleanup, and scrollbar updates. |
| TickBlink | Toggles cursor and text blink state every 500 ms using GetTickCount. Call from the application's main loop. |
## Events
### OnKeyData
```pascal
TKeyDataEvent = procedure(Sender: TObject; const Data: string) of object;
```
Fires when keyboard input produces data to send to the serial port.
| Key | Data sent |
|---|---|
| Printable characters | The character itself |
| CR, LF, BS, TAB, ESC | The control character |
| Arrow Up/Down/Right/Left | ESC[A / ESC[B / ESC[C / ESC[D |
| Home / End | ESC[H / ESC[K |
| Page Up / Page Down | ESC[V / ESC[U |
| Insert | ESC[@ |
| Delete | #127 |
| F1-F10 | ESC OP through ESC OY |
| ENQ (#5) | ESC[?1;0c (Device Attributes response) |
| DSR query (ESC[6n) | ESC[row;colR (cursor position report) |
## Types
### TParseState
```
psNormal Normal character input
psEscape Received ESC, awaiting next byte
psCSI In CSI sequence (ESC[...), parsing parameters
psCSIQuestion DEC private mode (ESC[?...)
psMusic Accumulating ANSI music string (ESC[M...^N)
```
### TTermCell
```pascal
TTermCell = record
Ch: Char; { Display character }
FG: Byte; { Foreground palette index 0-15 }
BG: Byte; { Background palette index 0-15 }
Bold: Boolean; { Bold attribute (FG +8 at render) }
Blink: Boolean; { Blink attribute (toggles on TickBlink) }
end;
```
### TTermLineRec
```pascal
TTermLineRec = record
Cells: array[0..255] of TTermCell;
end;
PTermLine = ^TTermLineRec;
```
### ANSI Color Palette
Standard 16-color ANSI palette in BGR TColor order:
```
0 Black 8 Dark Gray
1 Red 9 Bright Red
2 Green 10 Bright Green
3 Brown/Yellow 11 Bright Yellow
4 Blue 12 Bright Blue
5 Magenta 13 Bright Magenta
6 Cyan 14 Bright Cyan
7 Light Gray 15 Bright White
```
## ANSI Escape Sequences
### CSI Sequences (ESC[ params final-byte)
| Final | Name | Description |
|---|---|---|
| A | CUU | Cursor up P1 rows (default 1) |
| B | CUD | Cursor down P1 rows (default 1) |
| C | CUF | Cursor forward P1 columns (default 1) |
| D | CUB | Cursor back P1 columns (default 1) |
| H, f | CUP/HVP | Cursor position to row P1, column P2 (1-based) |
| J | ED | Erase display: 0=below, 1=above, 2=all |
| K | EL | Erase line: 0=to end, 1=from start, 2=entire |
| L | IL | Insert P1 blank lines at cursor |
| M | DL | Delete P1 lines at cursor |
| P | DCH | Delete P1 characters at cursor |
| S | SU | Scroll up P1 lines |
| T | SD | Scroll down P1 lines |
| @ | ICH | Insert P1 blank characters at cursor |
| m | SGR | Set graphic rendition (see below) |
| s | SCP | Save cursor position |
| u | RCP | Restore cursor position |
| c | DA | Device attributes (P1=0: respond ESC[?1;0c) |
| n | DSR | Device status report (P1=5: OK, P1=6: cursor pos) |
### SGR Codes (ESC[ code m)
| Code | Effect |
|---|---|
| 0 | Reset all attributes |
| 1 | Bold (maps FG index +8 for bright colors) |
| 5 | Blink (cell visibility toggles every 500 ms) |
| 7 | Reverse video (swap FG and BG at render) |
| 22 | Normal intensity (cancel bold) |
| 25 | Blink off |
| 27 | Reverse off |
| 30-37 | Foreground color (black, red, green, yellow, blue, magenta, cyan, white) |
| 40-47 | Background color (same order) |
### DEC Private Modes (ESC[? code h/l)
| Mode | h (set) | l (reset) |
|---|---|---|
| ?7 | Enable auto-wrap at right margin | Disable auto-wrap |
| ?25 | Show cursor | Hide cursor |
### Control Characters
| Char | Action |
|---|---|
| BEL (#7) | MessageBeep |
| BS (#8) | Cursor left one column |
| TAB (#9) | Advance to next tab stop (multiple of 8) |
| LF (#10) | Cursor down; scroll at bottom |
| CR (#13) | Cursor to column 0 |
| ENQ (#5) | Respond with device attributes |
## ANSI Music
ANSI music is triggered by `ESC[M` and terminated by `^N` (Ctrl-N, #14).
The string between these delimiters contains musical notation:
| Command | Description |
|---|---|
| T*n* | Set tempo in BPM (32-255) |
| L*n* | Set default note length (1=whole, 2=half, 4=quarter, 8=eighth) |
| O*n* | Set octave (0-7) |
| < / > | Shift octave down / up |
| A-G | Play note (optional # or + for sharp, - for flat) |
| P*n* | Pause for duration *n* |
Notes accept an optional duration digit after the letter (e.g., C4 = quarter
note C). A trailing dot adds 50% to the duration.
Uses the Windows 3.1 sound API: OpenSound, SetVoiceAccent, SetVoiceNote,
StartSound, CloseSound.
## Font Selection
CreatePaintFont selects the best available font for the requested FontSize.
The selection order ensures pixel-perfect rendering when possible:
1. **Terminal raster at the exact size.** If the Terminal font has a raster
at the requested cell height, use it. Terminal is pixel-perfect but only
available at specific heights (typically 12 and 24 pixels on VGA).
2. **Perfect DOS VGA 437 at multiples of 8.** If the requested cell height
is a multiple of 8 (8, 16, 24, 32, ...) and the font is installed, use
it. This TrueType CP437 font renders pixel-perfectly at these sizes.
Install `DOSVGA.TTF` via Control Panel > Fonts.
3. **Terminal raster at the nearest available size.** Search outward from
the requested height (alternating up and down) to find the closest
Terminal raster variant.
4. **Stock OEM_FIXED_FONT.** Last resort. Always available.
### Supported Point Sizes (96 DPI)
| FontSize | Cell Height | Font Used |
|---|---|---|
| 6 | 8 | Perfect DOS VGA 437 |
| 9 | 12 | Terminal raster |
| 12 | 16 | Perfect DOS VGA 437 |
| 18 | 24 | Terminal raster |
| 24 | 32 | Perfect DOS VGA 437 |
| 30 | 40 | Perfect DOS VGA 437 |
| 36 | 48 | Perfect DOS VGA 437 |
Other sizes fall back to the nearest Terminal raster height.
### Installing the Perfect DOS VGA 437 Font
1. Open Control Panel and double-click Fonts.
2. Click Add.
3. Browse to the directory containing `DOSVGA.TTF` and select it.
4. Click OK to install.
The font is free for personal and commercial use. See `fonts/DOSVGA.TXT`
for license details.
## Rendering Architecture
### Split-Phase Design
Rendering is split into parsing and drawing to avoid interleaving CPU work
with GDI kernel transitions:
1. **Parse phase** (ParseDataBuf): Pure CPU loop that fills the FScreen cell
buffer with characters and attributes. No GDI calls. Three inline fast
paths eliminate function-call overhead for printable runs, CSI parameter
accumulation, and common control characters (ESC, CR, LF).
2. **Render phase** (FlipToScreen or WriteDeferredBuf): Flushes coalesced
scrolls via a single ScrollDC call, then redraws only dirty rows via
RenderRow.
### Dirty Row Tracking
Each row has a boolean dirty flag (FDirtyRow). FAllDirty forces a full
redraw. DirtyBlinkRows marks only the cursor row and rows containing blink
cells, reducing blink overhead from ~63 ms to ~3 ms on a 486.
### RenderRow
Scans cells for color runs (consecutive cells with the same effective FG and
BG). Each run is drawn with a single ExtTextOut call using ETO_OPAQUE
(fills background and renders text in one operation). A DxBuf array forces
uniform character spacing for TrueType fonts.
### Scroll Coalescing
Multiple scroll-up operations during a parse batch are accumulated in
FPendingScrolls. The render phase issues one ScrollDC to shift on-screen
pixels, then only redraws the newly exposed bottom rows.
### Blink
Cursor and text blink are driven by TickBlink, which uses GetTickCount to
toggle FBlinkOn every 500 ms. No WM_TIMER is used. The application calls
TickBlink from its main loop.
## Scrollback Buffer
- **FScreen**: TList of PTermLine holding the active terminal display.
- **FScrollback**: TList of PTermLine holding history (up to ScrollbackSize).
- **FScrollPos**: 0 = live view, >0 = viewing history (lines scrolled back).
- Vertical scrollbar (WS_VSCROLL) allows the user to scroll through history.
- TrimScrollback batch-frees excess lines in a single pass.
## Usage Example
```pascal
FAnsi := TKPAnsi.Create(Self);
FAnsi.FontSize := 12;
FAnsi.Parent := Self;
FAnsi.Left := 0;
FAnsi.Top := 38;
FAnsi.OnKeyData := AnsiKeyData;
{ In the main loop: }
Len := FComm.ReadInputBuf(@Buf, BufSize);
if Len > 0 then
FAnsi.WriteDeferredBuf(@Buf, Len);
FAnsi.TickBlink;
FAnsi.FlipToScreen;
{ Size the form to fit: }
ClientWidth := FAnsi.Width;
ClientHeight := FAnsi.Top + FAnsi.Height;
```
## Platform Notes
- Targets Windows 3.1 / Delphi 1.0.
- Uses CS_OWNDC for a persistent device context (font and background mode
survive across GetDC/ReleaseDC cycles).
- Uses `{ }` comments (Delphi 1.0 does not support `//` comments).
- The Perfect DOS VGA 437 TrueType font requires Windows 3.1's TrueType
rasterizer. The font's cmap was converted from format 6 to format 0 and
its OS/2 table downgraded from version 3 to version 1 for Win 3.1
compatibility.
- Requested with DEFAULT_CHARSET (not OEM_CHARSET) to prevent Win 3.1's
font mapper from rejecting TrueType fonts in favor of raster substitutes.

139
delphi/KPCOMM.md
View file

@ -1,139 +0,0 @@
# TKPComm - Serial Communications Component
TKPComm is a non-visual Delphi 1.0 component providing serial port access
via the Windows 3.1 comm API. It is a TComponent descendant that wraps
OpenComm, ReadComm, WriteComm, and related functions into a property-driven
interface. The application polls for received data; there is no event-driven
notification infrastructure (no hidden window, no WM_COMMNOTIFY, no
OnComm event).
Installs to the **KP** component palette tab.
## Properties
### Published (Design-Time and Runtime)
| Property | Type | Default | Description |
|---|---|---|---|
| CommPort | Integer | 1 | Port number 1-16 (1=COM1, 2=COM2, etc.). Cannot be changed while port is open. |
| Settings | string | '9600,N,8,1' | Baud rate, parity, data bits, stop bits. Format: `baud,parity,databits,stopbits`. Can be changed while port is open to reconfigure on the fly. |
| PortOpen | Boolean | False | Opens or closes the serial port. Setting True calls OpenComm, BuildCommDCB, and SetCommState; False calls CloseComm. |
| InBufferSize | Integer | 4096 | Receive ring buffer size in bytes (minimum 64). Cannot be changed while port is open. |
| OutBufferSize | Integer | 4096 | Transmit ring buffer size in bytes (minimum 64). Cannot be changed while port is open. |
| Handshaking | THandshaking | hsNone | Flow control method (see below). Can be changed while port is open. |
| InputLen | Integer | 0 | Maximum bytes returned per Input read. 0 means up to 255 bytes. |
| InputMode | TInputMode | imText | Data reading mode. imBinary preserves embedded null bytes. |
| DTREnable | Boolean | True | Assert Data Terminal Ready when True. Toggled immediately if port is open. |
| RTSEnable | Boolean | True | Assert Request To Send when True. Toggled immediately if port is open. |
| NullDiscard | Boolean | False | Strip null bytes from received data. |
| EOFEnable | Boolean | False | Enable EOF character detection. |
| ParityReplace | string | '?' | Character substituted for parity errors. Empty string disables replacement. |
### Public (Runtime Only)
| Property | Type | Access | Description |
|---|---|---|---|
| Input | string | Read | Reads available data from the receive buffer. Limited to 255 bytes per call (Delphi short string). Use ReadInputBuf for larger reads. |
| Output | string | Write | Writes data to the transmit buffer. Raises an exception if the port is not open or the write fails. |
| InBufferCount | Integer | Read | Bytes currently waiting in the receive buffer. |
| OutBufferCount | Integer | Read | Bytes currently waiting in the transmit buffer. |
| Break | Boolean | Read/Write | Asserts or clears the break signal via SetCommBreak/ClearCommBreak. |
## Methods
### Public
| Method | Description |
|---|---|
| Create(AOwner) | Constructor. Initializes defaults; FCommId set to -1 (closed). |
| Destroy | Destructor. Closes the port if still open. |
| ReadInputBuf(Buf, BufSize): Integer | Reads up to BufSize bytes into a caller-supplied PChar buffer. Returns the number of bytes actually read. Bypasses the 255-byte short string limit of the Input property. |
## Types
### THandshaking
```
hsNone No flow control
hsXonXoff Software XON/XOFF (XON=$11, XOFF=$13)
hsRtsCts Hardware RTS/CTS
hsBoth Combined RTS/CTS and XON/XOFF
```
### TInputMode
```
imText Text mode (default)
imBinary Binary mode (preserves embedded nulls)
```
## DCB Flag Constants
Bit masks for the packed TDCB.Flags field:
| Constant | Value | Description |
|---|---|---|
| dcbBinary | $0001 | Binary mode (always set) |
| dcbRtsDisable | $0002 | RTS disabled |
| dcbParity | $0004 | Parity check/replacement |
| dcbOutxCtsFlow | $0008 | CTS output flow control |
| dcbOutxDsrFlow | $0010 | DSR output flow control |
| dcbDtrDisable | $0020 | DTR disabled |
| dcbOutX | $0040 | XON/XOFF output flow control |
| dcbInX | $0080 | XON/XOFF input flow control |
| dcbPeChar | $0100 | Parity error character replacement |
| dcbNull | $0200 | Null byte stripping |
| dcbChEvt | $0400 | Character event notification |
| dcbDtrflow | $0800 | DTR flow control |
| dcbRtsflow | $1000 | RTS flow control |
## Port Lifecycle
1. Create the component and set properties (CommPort, Settings, buffer sizes,
Handshaking, etc.).
2. Set `PortOpen := True`. This calls OpenComm, builds the DCB from
the Settings string, applies flow control, null discard, parity replace,
and asserts DTR/RTS.
3. Poll `Input` or call `ReadInputBuf` in the application's main loop.
Set `Output` to send data.
4. Set `PortOpen := False` to close. DTR and RTS are cleared, break is
released, and CloseComm is called.
5. The destructor closes the port automatically if still open.
## Usage Example
```pascal
FComm := TKPComm.Create(Self);
FComm.CommPort := 1;
FComm.Settings := '115200,N,8,1';
FComm.PortOpen := True;
{ In the main loop: }
Len := FComm.ReadInputBuf(@Buf, SizeOf(Buf));
if Len > 0 then
ProcessData(@Buf, Len);
{ To send data: }
FComm.Output := 'AT' + #13;
```
## Platform Notes
- Targets Windows 3.1 using the 16-bit comm API (OpenComm, ReadComm,
WriteComm, GetCommState, SetCommState, GetCommError,
EscapeCommFunction, BuildCommDCB).
- No notification infrastructure. The application must poll for data.
There is no hidden window, no WM_COMMNOTIFY handling, and
EnableCommNotification is not used.
- The Input property is limited to 255 bytes by Delphi 1.0's short
string type. Use ReadInputBuf for bulk reads (2048+ bytes per call).
- EscapeCommFunction returns 0 on success in the 16-bit API (opposite
of the Win32 convention).
- Uses `{ }` comments (Delphi 1.0 does not support `//` comments).

56
delphi/TESTMAIN.PAS
View file

@ -6,7 +6,7 @@ unit TestMain;
{ Layout: toolbar row at top (port, settings, open/close, status), } { Layout: toolbar row at top (port, settings, open/close, status), }
{ TKPAnsi terminal filling the rest of the form. Received serial data } { TKPAnsi terminal filling the rest of the form. Received serial data }
{ is polled from TKPComm.Input in a PeekMessage main loop; keystrokes } { is polled from TKPComm.Input in a PeekMessage main loop; keystrokes }
{ from the terminal are sent to the serial port via TKPComm.Output. } { from the terminal are sent out via TKPComm.Output. }
interface interface
@ -17,15 +17,19 @@ uses
type type
TMainForm = class(TForm) TMainForm = class(TForm)
private private
{ Components (owned by Self, freed automatically) }
FComm: TKPComm; { Serial communications component } FComm: TKPComm; { Serial communications component }
FAnsi: TKPAnsi; { ANSI terminal display } FAnsi: TKPAnsi; { ANSI terminal display }
FLabelPort: TLabel; { "Port:" caption }
{ Toolbar controls }
FLabelPort: TLabel; { "Port:" label }
FEditPort: TEdit; { COM port number entry } FEditPort: TEdit; { COM port number entry }
FLabelSettings: TLabel; { "Settings:" caption } FLabelSettings: TLabel; { "Settings:" label }
FEditSettings: TEdit; { Baud/parity/data/stop entry } FEditSettings: TEdit; { Baud/parity/data/stop entry }
FBtnOpen: TButton; { Opens the serial port } FBtnOpen: TButton; { Opens the serial port }
FBtnClose: TButton; { Closes the serial port } FBtnClose: TButton; { Closes the serial port }
FLabelStatus: TLabel; { Displays "Open" or "Closed" } FLabelStatus: TLabel; { Displays "Open" or "Closed" }
FDone: Boolean; { True when WM_QUIT received } FDone: Boolean; { True when WM_QUIT received }
procedure AnsiKeyData(Sender: TObject; const Data: string); procedure AnsiKeyData(Sender: TObject; const Data: string);
procedure BtnCloseClick(Sender: TObject); procedure BtnCloseClick(Sender: TObject);
@ -42,7 +46,6 @@ var
implementation implementation
{ OnKeyData handler: sends terminal keystrokes to the serial port }
procedure TMainForm.AnsiKeyData(Sender: TObject; const Data: string); procedure TMainForm.AnsiKeyData(Sender: TObject; const Data: string);
begin begin
if FComm.PortOpen and (Length(Data) > 0) then if FComm.PortOpen and (Length(Data) > 0) then
@ -64,7 +67,6 @@ begin
end; end;
{ Reads port number and settings from the toolbar, opens the port }
procedure TMainForm.BtnOpenClick(Sender: TObject); procedure TMainForm.BtnOpenClick(Sender: TObject);
begin begin
try try
@ -85,11 +87,14 @@ begin
inherited CreateNew(AOwner); inherited CreateNew(AOwner);
Caption := 'KPComm ANSI Terminal'; Caption := 'KPComm ANSI Terminal';
Width := 780;
Height := 560;
BorderStyle := bsSingle; BorderStyle := bsSingle;
{ Serial component }
FComm := TKPComm.Create(Self); FComm := TKPComm.Create(Self);
{ Toolbar row } { Row 1: Port and Settings }
FLabelPort := TLabel.Create(Self); FLabelPort := TLabel.Create(Self);
FLabelPort.Parent := Self; FLabelPort.Parent := Self;
FLabelPort.Left := 8; FLabelPort.Left := 8;
@ -141,22 +146,27 @@ begin
FLabelStatus.Top := 12; FLabelStatus.Top := 12;
FLabelStatus.Caption := 'Closed'; FLabelStatus.Caption := 'Closed';
{ ANSI terminal -- FontSize controls the OEM terminal font point size. } { ANSI terminal }
{ The control auto-sizes Width/Height from FontSize, Cols, and Rows. }
FAnsi := TKPAnsi.Create(Self); FAnsi := TKPAnsi.Create(Self);
FAnsi.FontSize := 12;
FAnsi.Parent := Self; FAnsi.Parent := Self;
FAnsi.Left := 0; FAnsi.Left := 0;
FAnsi.Top := 38; FAnsi.Top := 38;
FAnsi.OnKeyData := AnsiKeyData; FAnsi.OnKeyData := AnsiKeyData;
{ Font diagnostic: write known CP437 box-drawing characters. }
{ If the OEM font is working, you should see: }
{ Line 1: single-line box top +---+ }
{ Line 2: shade + full block ░▒▓█ }
{ Line 3: single-line box bottom +---+ }
{ If you see accented letters, the font is ANSI_CHARSET instead of }
{ OEM_CHARSET. }
FAnsi.Write(#$DA#$C4#$C4#$C4#$BF' '#$B0#$B1#$B2#$DB' '#$C0#$C4#$C4#$C4#$D9#13#10);
end; end;
{ PeekMessage polling loop. Drains Windows messages, polls serial }
{ data from TKPComm, and yields CPU when idle. }
procedure TMainForm.Run; procedure TMainForm.Run;
const const
BufSize = 2048; BufSize = 2048; { Read buffer -- 8x larger than 255-byte string limit }
var var
Msg: TMsg; Msg: TMsg;
Buf: array[0..BufSize - 1] of Char; Buf: array[0..BufSize - 1] of Char;
@ -164,15 +174,10 @@ var
HasData: Boolean; HasData: Boolean;
begin begin
Show; Show;
{ Size form to fit terminal + toolbar. Show triggers handle creation }
{ and RecalcCellSize, so FAnsi.Width/Height reflect measured font. }
ClientWidth := FAnsi.Width;
ClientHeight := FAnsi.Top + FAnsi.Height;
FDone := False; FDone := False;
while not FDone do while not FDone do
begin begin
{ Process all pending Windows messages (keyboard, paint, scrollbar) }
while PeekMessage(Msg, 0, 0, 0, pm_Remove or pm_NoYield) do while PeekMessage(Msg, 0, 0, 0, pm_Remove or pm_NoYield) do
begin begin
if Msg.message = wm_Quit then if Msg.message = wm_Quit then
@ -187,7 +192,9 @@ begin
if FDone then if FDone then
Break; Break;
{ Read serial data into the terminal } { Drain all available serial data. WriteDeferredBuf renders each }
{ character run immediately via ExtTextOut -- no deferred pass. }
{ Messages are checked between chunks so keyboard stays responsive. }
HasData := False; HasData := False;
if FComm.PortOpen then if FComm.PortOpen then
begin begin
@ -196,6 +203,7 @@ begin
begin begin
FAnsi.WriteDeferredBuf(@Buf, Len); FAnsi.WriteDeferredBuf(@Buf, Len);
HasData := True; HasData := True;
{ Check for messages between chunks }
while PeekMessage(Msg, 0, 0, 0, pm_Remove or pm_NoYield) do while PeekMessage(Msg, 0, 0, 0, pm_Remove or pm_NoYield) do
begin begin
if Msg.message = wm_Quit then if Msg.message = wm_Quit then
@ -213,18 +221,22 @@ begin
if FDone then if FDone then
Break; Break;
{ Update cursor blink and repaint any dirty rows } { Blink + dirty-row pass. During normal data flow, WriteDeferredBuf }
{ already rendered inline so FlipToScreen is a no-op. Only blink }
{ toggle (every 500ms) or scrollbar updates produce dirty rows here. }
FAnsi.TickBlink; FAnsi.TickBlink;
FAnsi.FlipToScreen; FAnsi.FlipToScreen;
{ Yield CPU when no serial data is flowing } { Yield CPU to other apps when no serial data is flowing. }
{ PM_NOYIELD keeps message draining fast; Yield here gives other }
{ apps a timeslice only when idle. During bulk data flow, HasData }
{ stays True and the loop runs at full speed. }
if not HasData then if not HasData then
Yield; Yield;
end; end;
end; end;
{ Syncs button enabled state and status label with port open/closed }
procedure TMainForm.UpdateStatus; procedure TMainForm.UpdateStatus;
begin begin
if FComm.PortOpen then if FComm.PortOpen then

BIN
delphi/fonts/DOSVGA.TTF (Stored with Git LFS)
View file

Binary file not shown.

104
delphi/fonts/DOSVGA.TXT
View file

@ -1,104 +0,0 @@
/
/(_____________ ____
\ /______)\ | |
:\ | / \:| |:::::::::: : .. . : .. . . :. .
\_____| / | \| |______
___ / ________ \... . . .
\______________ \ | | /.. . . . . .
\ |__| /
--x--x-----x----\______ |-/_____/-x--x-xx--x-- - -x -- - - -- - - -
. . . . . . . . . . . .\____|. . . . . .
-------------------------------------------------------------------------------
>> perfect dos vga 437 - general information >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-------------------------------------------------------------------------------
"Perfect DOS VGA 437" and "Perfect DOS VGA 437 Win" are truetype fonts
designed to emulate the MS-DOS/Text mode standard font, used on VGA monitors,
with the 437 Codepage (standard US/International). This is a "bitmap" font,
meaning it emulates a bitmap font and can only be used at a given size (8 or
multiples of it like 16, 24, 32, etc). It's optimized for Flash too, so it
won't produce antialias if used at round positions.
There are two fonts available. "Perfect DOS VGA 437" uses the original DOS
codepage 437. It should be used, for example, if you're opening DOS ASCII
files on notepad or another windows-based editor. Since it's faithful to the
original DOS codes, it won't accent correctly in windows ("é" would produce
something different, not an "e" with an acute).
There's also "Perfect DOS VGA 437 Win" which is the exactly same font adapted
to a windows codepage. This should use accented characters correctly but won't
work if you're opening a DOS-based text file.
UPDATE: this is a new version, updated in august/2008. It has fixed leading
metrics for Mac systems.
-------------------------------------------------------------------------------
>> perfect dos vga 437 - creation process >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-------------------------------------------------------------------------------
This font was created to be used on a Flash-based ANSi viewer I'm working. To
create it, I created a small Quick Basic program to write all characters on
screen,
CLS
FOR l = 0 TO 255
charWrite 1 + (l MOD 20), 1 + (l \ 20) * 6 + (l MOD 2), LTRIM$(RTRIM$(STR$(l))) + CHR$(l)
NEXT
SUB charWrite (lin, col, char$)
DEF SEG = &HB800
FOR i = 1 TO LEN(char$)
POKE ((lin - 1) * 160) + ((col - 2 + i) * 2), ASC(MID$(char$, i, 1))
IF (i = LEN(char$)) THEN POKE ((lin - 1) * 160) + ((col - 2 + i) * 2) + 1, 113
NEXT
END SUB
Then captured the text screen using SCREEN THIEF (a very, very old screen
capture TSR program which converts text screens to images accurately). I then
recreated the font polygon by polygon on Fontlab, while looking at the image
on Photoshop. No conversion took place.
-------------------------------------------------------------------------------
>> copyright and stuff >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-------------------------------------------------------------------------------
This is a free font/file, distribute as you wish to who you wish. You are free
to use it on a movie, a videogame, a video, a broadcast, without having to ask
my permission.
Please do not send me emails asking me to sign release forms if it require
any sort of scanning or digital compositing. It's a big chore. This license
file and a simple confirmation email should suffice as proof that you are
allowed to use it.
Of course I don't mind emails letting me know where something has been used.
Those are always gratifying!
Do NOT sell this font. It's not yours and you can't make money of it.
-------------------------------------------------------------------------------
>> author >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-------------------------------------------------------------------------------
Zeh Fernando
zeh@zehfernando.com
www.zehfernando.com
rorshack ^ maiden brazil
-------------------------------------------------------------------------------
>> other notes >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-------------------------------------------------------------------------------
The year is now 2021. I would be remiss not to mention these more modern font
packages:
https://int10h.org/oldschool-pc-fonts/fontlist/
They include VGA-like fonts and a bunch of other systems, easily supplanting
the need for "Perfect DOS VGA" and then some.
They use a Creative Commons license.
-------------------------------------------------------------------------------
^zehPULLSdahTRICK^kudosOUTtoWHOkeepsITreal^smashDAHfuckingENTAH!!!^lowres4ever^
-------------------------------------------------------------------------------

2
drv/commdrv.c
View file

@ -1252,7 +1252,7 @@ int16_t FAR PASCAL _export reccom(int16_t commId, void FAR *buf, int16_t len)
{ {
PortStateT *port; PortStateT *port;
uint8_t FAR *dst; uint8_t FAR *dst;
uint16_t bytesRead; int16_t bytesRead;
dbgInt16("KPCOMM: reccom Id", commId); dbgInt16("KPCOMM: reccom Id", commId);