From ec6eebb2a5a5e0a01367e6d9b22dd28200b874b2 Mon Sep 17 00:00:00 2001 From: Scott Duensing Date: Wed, 4 Mar 2026 17:15:11 -0600 Subject: [PATCH] Add TrueType font support with 4-tier font selection and documentation Replace the inherited Font property with a FontSize property that drives a multi-tier font selection strategy for pixel-perfect OEM rendering: Terminal raster (exact size) > Perfect DOS VGA 437 (multiples of 8px) > Terminal raster (nearest) > stock OEM fallback. Add DxBuf uniform character spacing to ExtTextOut for correct TrueType monospace rendering. Bundle the Perfect DOS VGA 437 font (cmap converted from format 6 to format 0 for Win 3.1 compatibility). Size the test form dynamically from terminal dimensions. Add component documentation. Co-Authored-By: Claude Opus 4.6 --- .gitattributes | 2 +- delphi/KPANSI.PAS | 140 +++++++++++++---- delphi/KPANSI.md | 333 ++++++++++++++++++++++++++++++++++++++++ delphi/KPCOMM.md | 139 +++++++++++++++++ delphi/TESTMAIN.PAS | 40 ++--- delphi/fonts/DOSVGA.TTF | 3 + delphi/fonts/DOSVGA.TXT | 104 +++++++++++++ 7 files changed, 703 insertions(+), 58 deletions(-) create mode 100644 delphi/KPANSI.md create mode 100644 delphi/KPCOMM.md create mode 100644 delphi/fonts/DOSVGA.TTF create mode 100644 delphi/fonts/DOSVGA.TXT diff --git a/.gitattributes b/.gitattributes index 8c31031..92d4714 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1,7 +1,6 @@ # Git LFS - binary files *.bmp filter=lfs diff=lfs merge=lfs -text *.DRV filter=lfs diff=lfs merge=lfs -text - # Force LF line endings on source files *.c text eol=lf *.h text eol=lf @@ -9,3 +8,4 @@ *.def text eol=lf makefile text eol=lf *.TXT text eol=lf +*.TTF filter=lfs diff=lfs merge=lfs -text diff --git a/delphi/KPANSI.PAS b/delphi/KPANSI.PAS index ee051c6..3aa29e8 100644 --- a/delphi/KPANSI.PAS +++ b/delphi/KPANSI.PAS @@ -85,6 +85,7 @@ type { Terminal dimensions } FCols: Integer; { Number of columns (default 80) } 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) } { Cursor visibility (DEC ?25h/l) } @@ -105,7 +106,6 @@ type FLiveDC: HDC; { Non-zero during render pass in WriteDeferredBuf } procedure AllocLine(Line: PTermLine); - procedure CMFontChanged(var Msg: TMessage); message cm_FontChanged; procedure CreatePaintFont; procedure DeleteChars(N: Integer); procedure DeleteLines(N: Integer); @@ -128,15 +128,18 @@ type procedure ResizeScreen; procedure SetCols(Value: Integer); procedure SetCursorVisible(Value: Boolean); + procedure SetFontSize(Value: Integer); procedure SetRows(Value: Integer); procedure SetScrollbackSize(Value: Integer); procedure TrimScrollback; procedure UpdateScrollbar; + procedure WriteDeferred(const S: string); procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message wm_EraseBkgnd; procedure WMGetDlgCode(var Msg: TMessage); message wm_GetDlgCode; procedure WMVScroll(var Msg: TWMScroll); message wm_VScroll; protected procedure CreateParams(var Params: TCreateParams); override; + procedure CreateWnd; override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyPress(var Key: Char); override; procedure Paint; override; @@ -148,10 +151,7 @@ type procedure FlipToScreen; procedure TickBlink; procedure Write(const S: string); - procedure WriteDeferred(const S: string); procedure WriteDeferredBuf(Buf: PChar; Len: Integer); - property CellWidth: Integer read FCellWidth; - property CellHeight: Integer read FCellHeight; property CursorCol: Integer read FCursorCol; property CursorRow: Integer read FCursorRow; published @@ -161,7 +161,7 @@ type write SetScrollbackSize default 500; property CursorVisible: Boolean read FCursorVisible write SetCursorVisible default True; - property Font; + property FontSize: Integer read FFontSize write SetFontSize default 12; property Color default clBlack; property OnKeyData: TKeyDataEvent read FOnKeyData write FOnKeyData; property TabStop default True; @@ -194,8 +194,6 @@ const { Blink toggle interval in milliseconds (cursor + text blink). } 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) } ETO_OPAQUE = $0002; @@ -305,12 +303,6 @@ begin end; -procedure TKPAnsi.CMFontChanged(var Msg: TMessage); -begin - inherited; - RecalcCellSize; -end; - constructor TKPAnsi.Create(AOwner: TComponent); var @@ -331,14 +323,11 @@ begin FAttrFG := 7; FCellWidth := 8; FCellHeight := 18; + FFontSize := 12; FBlinkOn := True; FLastBlinkTick := GetTickCount; FWrapMode := 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 } for I := 0 to FRows - 1 do @@ -355,6 +344,8 @@ var LF: TLogFont; ActualLF: TLogFont; NewFont: HFont; + BaseH: Integer; + Delta: Integer; begin { Free previous font (stock fonts must not be deleted) } if (FPaintFont <> 0) and not FStockFont then @@ -362,32 +353,89 @@ begin FPaintFont := 0; 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); - LF.lfHeight := Font.Height; + LF.lfWeight := FW_NORMAL; LF.lfPitchAndFamily := FIXED_PITCH or FF_MODERN; - 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); + BaseH := MulDiv(FFontSize, Screen.PixelsPerInch, 72); + { 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); if NewFont <> 0 then begin - { Verify Windows actually gave us an OEM charset font } GetObject(NewFont, SizeOf(ActualLF), @ActualLF); - if ActualLF.lfCharSet = OEM_CHARSET then + if (ActualLF.lfCharSet = OEM_CHARSET) and + (ActualLF.lfHeight = BaseH) then FPaintFont := NewFont else DeleteObject(NewFont); 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 begin FPaintFont := GetStockObject(OEM_FIXED_FONT); @@ -406,6 +454,13 @@ begin end; +procedure TKPAnsi.CreateWnd; +begin + inherited CreateWnd; + RecalcCellSize; +end; + + procedure TKPAnsi.DeleteChars(N: Integer); var Line: PTermLine; @@ -1846,11 +1901,16 @@ var RunBG: Byte; RunBuf: array[0..255] of Char; RunLen: Integer; + DxBuf: array[0..255] of Integer; R: TRect; RowY: Integer; begin 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) } if FScrollPos <> 0 then begin @@ -1926,7 +1986,7 @@ begin R.Right := (RunStart + RunLen) * FCellWidth; R.Bottom := RowY + FCellHeight; ExtTextOut(DC, RunStart * FCellWidth, RowY, ETO_OPAQUE, @R, - @RunBuf[0], RunLen, nil); + @RunBuf[0], RunLen, @DxBuf[0]); end; RunStart := Col; RunLen := 0; @@ -1948,7 +2008,7 @@ begin R.Right := (RunStart + RunLen) * FCellWidth; R.Bottom := RowY + FCellHeight; ExtTextOut(DC, RunStart * FCellWidth, RowY, ETO_OPAQUE, @R, - @RunBuf[0], RunLen, nil); + @RunBuf[0], RunLen, @DxBuf[0]); end; end; @@ -2019,6 +2079,20 @@ begin 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); begin if Value < 1 then diff --git a/delphi/KPANSI.md b/delphi/KPANSI.md new file mode 100644 index 0000000..d5226eb --- /dev/null +++ b/delphi/KPANSI.md @@ -0,0 +1,333 @@ +# 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. diff --git a/delphi/KPCOMM.md b/delphi/KPCOMM.md new file mode 100644 index 0000000..0e796a1 --- /dev/null +++ b/delphi/KPCOMM.md @@ -0,0 +1,139 @@ +# 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). diff --git a/delphi/TESTMAIN.PAS b/delphi/TESTMAIN.PAS index b87b838..09b51f1 100644 --- a/delphi/TESTMAIN.PAS +++ b/delphi/TESTMAIN.PAS @@ -6,7 +6,7 @@ unit TestMain; { Layout: toolbar row at top (port, settings, open/close, status), } { TKPAnsi terminal filling the rest of the form. Received serial data } { is polled from TKPComm.Input in a PeekMessage main loop; keystrokes } -{ from the terminal are sent out via TKPComm.Output. } +{ from the terminal are sent to the serial port via TKPComm.Output. } interface @@ -17,19 +17,15 @@ uses type TMainForm = class(TForm) private - { Components (owned by Self, freed automatically) } FComm: TKPComm; { Serial communications component } FAnsi: TKPAnsi; { ANSI terminal display } - - { Toolbar controls } - FLabelPort: TLabel; { "Port:" label } + FLabelPort: TLabel; { "Port:" caption } FEditPort: TEdit; { COM port number entry } - FLabelSettings: TLabel; { "Settings:" label } + FLabelSettings: TLabel; { "Settings:" caption } FEditSettings: TEdit; { Baud/parity/data/stop entry } FBtnOpen: TButton; { Opens the serial port } FBtnClose: TButton; { Closes the serial port } FLabelStatus: TLabel; { Displays "Open" or "Closed" } - FDone: Boolean; { True when WM_QUIT received } procedure AnsiKeyData(Sender: TObject; const Data: string); procedure BtnCloseClick(Sender: TObject); @@ -46,6 +42,7 @@ var implementation +{ OnKeyData handler: sends terminal keystrokes to the serial port } procedure TMainForm.AnsiKeyData(Sender: TObject; const Data: string); begin if FComm.PortOpen and (Length(Data) > 0) then @@ -67,6 +64,7 @@ begin end; +{ Reads port number and settings from the toolbar, opens the port } procedure TMainForm.BtnOpenClick(Sender: TObject); begin try @@ -89,10 +87,9 @@ begin Caption := 'KPComm ANSI Terminal'; BorderStyle := bsSingle; - { Serial component } FComm := TKPComm.Create(Self); - { Row 1: Port and Settings } + { Toolbar row } FLabelPort := TLabel.Create(Self); FLabelPort.Parent := Self; FLabelPort.Left := 8; @@ -144,19 +141,22 @@ begin FLabelStatus.Top := 12; FLabelStatus.Caption := 'Closed'; - { ANSI terminal } + { ANSI terminal -- FontSize controls the OEM terminal font point size. } + { The control auto-sizes Width/Height from FontSize, Cols, and Rows. } FAnsi := TKPAnsi.Create(Self); + FAnsi.FontSize := 12; FAnsi.Parent := Self; FAnsi.Left := 0; FAnsi.Top := 38; FAnsi.OnKeyData := AnsiKeyData; - end; +{ PeekMessage polling loop. Drains Windows messages, polls serial } +{ data from TKPComm, and yields CPU when idle. } procedure TMainForm.Run; const - BufSize = 2048; { Read buffer -- 8x larger than 255-byte string limit } + BufSize = 2048; var Msg: TMsg; Buf: array[0..BufSize - 1] of Char; @@ -173,7 +173,6 @@ begin FDone := False; while not FDone do begin - { Process all pending Windows messages (keyboard, paint, scrollbar) } while PeekMessage(Msg, 0, 0, 0, pm_Remove or pm_NoYield) do begin if Msg.message = wm_Quit then @@ -188,9 +187,7 @@ begin if FDone then Break; - { 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. } + { Read serial data into the terminal } HasData := False; if FComm.PortOpen then begin @@ -199,7 +196,6 @@ begin begin FAnsi.WriteDeferredBuf(@Buf, Len); HasData := True; - { Check for messages between chunks } while PeekMessage(Msg, 0, 0, 0, pm_Remove or pm_NoYield) do begin if Msg.message = wm_Quit then @@ -217,22 +213,18 @@ begin if FDone then Break; - { 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. } + { Update cursor blink and repaint any dirty rows } FAnsi.TickBlink; FAnsi.FlipToScreen; - { 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. } + { Yield CPU when no serial data is flowing } if not HasData then Yield; end; end; +{ Syncs button enabled state and status label with port open/closed } procedure TMainForm.UpdateStatus; begin if FComm.PortOpen then diff --git a/delphi/fonts/DOSVGA.TTF b/delphi/fonts/DOSVGA.TTF new file mode 100644 index 0000000..50f486d --- /dev/null +++ b/delphi/fonts/DOSVGA.TTF @@ -0,0 +1,3 @@ +version https://git-lfs.github.com/spec/v1 +oid sha256:3a79532a4c1b65062b6ec2c3d8b2d7a2b602d9ce68210c817879218590b12d30 +size 79128 diff --git a/delphi/fonts/DOSVGA.TXT b/delphi/fonts/DOSVGA.TXT new file mode 100644 index 0000000..81d4fa2 --- /dev/null +++ b/delphi/fonts/DOSVGA.TXT @@ -0,0 +1,104 @@ + / +/(_____________ ____ +\ /______)\ | | +:\ | / \:| |:::::::::: : .. . : .. . . :. . + \_____| / | \| |______ +___ / ________ \... . . . +\______________ \ | | /.. . . . . . + \ |__| / +--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^ +-------------------------------------------------------------------------------