Compare commits
No commits in common. "c8ccedf569da3a48574ae16ba40ba26c1095ed5c" and "5dd464eb1862d01fadc9c111aa98ff360d71605a" have entirely different histories.
c8ccedf569
...
5dd464eb18
7 changed files with 594 additions and 407 deletions
|
|
@ -45,77 +45,48 @@ type
|
|||
|
||||
TKPAnsi = class(TCustomControl)
|
||||
private
|
||||
{ Terminal buffer state }
|
||||
FScreen: TList; { Active screen lines (FRows PTermLine ptrs) }
|
||||
FScrollback: TList; { Scrollback history (up to FScrollbackSize) }
|
||||
|
||||
{ Cursor position (0-based row/col within the active screen) }
|
||||
FCursorRow: Integer; { Current row (0 = top) }
|
||||
FCursorCol: Integer; { Current column (0 = left) }
|
||||
FSaveCurRow: Integer; { Saved row for SCP/RCP (ESC[s / ESC[u) }
|
||||
FSaveCurCol: Integer; { Saved column for SCP/RCP }
|
||||
|
||||
{ Current text attributes (set by SGR escape sequences) }
|
||||
FAttrFG: Integer; { Foreground color index 0-7 }
|
||||
FAttrBG: Integer; { Background color index 0-7 }
|
||||
FAttrBold: Boolean; { Bold: maps FG to bright (index + 8) }
|
||||
FAttrBlink: Boolean; { Blink: cell toggles visibility on timer }
|
||||
FAttrReverse: Boolean; { Reverse video: swap FG/BG at render time }
|
||||
|
||||
{ ANSI escape sequence parser state }
|
||||
FParseState: TParseState; { Current parser state machine position }
|
||||
FParamStr: string; { Accumulated CSI parameter digits/semicolons }
|
||||
FMusicStr: string; { Accumulated ANSI music string (ESC[M..^N) }
|
||||
|
||||
{ Font metrics (measured from OEM charset paint font) }
|
||||
FCellWidth: Integer; { Character cell width in pixels (typically 8) }
|
||||
FCellHeight: Integer; { Character cell height in pixels (typ 12-16) }
|
||||
|
||||
{ Blink state }
|
||||
FBlinkOn: Boolean; { Cursor blink phase: True=visible }
|
||||
FLastBlinkTick: Longint; { GetTickCount value at last blink toggle }
|
||||
|
||||
{ Scrollback view }
|
||||
FScrollPos: Integer; { Lines scrolled back (0=live, >0=viewing history) }
|
||||
|
||||
{ Terminal modes }
|
||||
FWrapMode: Boolean; { Auto-wrap at right margin (DEC ?7h/l) }
|
||||
|
||||
{ Terminal dimensions }
|
||||
FCols: Integer; { Number of columns (default 80) }
|
||||
FRows: Integer; { Number of rows (default 25) }
|
||||
FScrollbackSize: Integer; { Max scrollback lines to retain (default 500) }
|
||||
|
||||
{ Cursor visibility (DEC ?25h/l) }
|
||||
FCursorVisible: Boolean; { True if cursor is shown }
|
||||
FLastCursorRow: Integer; { Previous cursor row for ghost cleanup }
|
||||
|
||||
{ Events }
|
||||
FOnKeyData: TKeyDataEvent; { Keyboard data callback (keys -> serial) }
|
||||
|
||||
{ Paint font }
|
||||
FPaintFont: HFont; { GDI font handle for OEM_CHARSET rendering }
|
||||
FStockFont: Boolean; { True if FPaintFont is a stock object (no delete) }
|
||||
|
||||
{ Dirty tracking: per-row flags for incremental rendering }
|
||||
FDirtyRow: array[0..255] of Boolean; { True = row needs re-render }
|
||||
FAllDirty: Boolean; { True = all rows need re-render }
|
||||
FScrollbarDirty: Boolean; { True = scrollbar range/position needs update }
|
||||
FTextBlinkOn: Boolean; { Text blink phase: True=visible, False=hidden }
|
||||
|
||||
{ Font atlas: glyph bitmaps + nibble lookup table (GlobalAlloc) }
|
||||
FGlyphBufH: THandle; { GlobalAlloc handle for glyph block (8256 bytes) }
|
||||
FGlyphBuf: Pointer; { Far ptr: offset 0..63 = nibble table, 64+ = glyphs }
|
||||
|
||||
{ Row pixel buffer: reusable 8bpp DIB for one terminal row }
|
||||
FRowBufH: THandle; { GlobalAlloc handle for pixel buffer }
|
||||
FRowBuf: Pointer; { Far ptr to pixel data (cols*cellW*cellH bytes) }
|
||||
FDibInfo: TDibInfo; { BITMAPINFO with 16-color ANSI palette }
|
||||
FRowBufSize: Integer; { Pixel buffer size in bytes }
|
||||
|
||||
{ Nibble table color cache: avoids rebuild when colors unchanged }
|
||||
FNibbleFG: Byte; { FG index currently in nibble table (255=invalid) }
|
||||
FNibbleBG: Byte; { BG index currently in nibble table (255=invalid) }
|
||||
FScreen: TList;
|
||||
FScrollback: TList;
|
||||
FCursorRow: Integer;
|
||||
FCursorCol: Integer;
|
||||
FSaveCurRow: Integer;
|
||||
FSaveCurCol: Integer;
|
||||
FAttrFG: Integer;
|
||||
FAttrBG: Integer;
|
||||
FAttrBold: Boolean;
|
||||
FAttrBlink: Boolean;
|
||||
FAttrReverse: Boolean;
|
||||
FParseState: TParseState;
|
||||
FParamStr: string;
|
||||
FMusicStr: string;
|
||||
FCellWidth: Integer;
|
||||
FCellHeight: Integer;
|
||||
FBlinkOn: Boolean;
|
||||
FTimerActive: Boolean;
|
||||
FScrollPos: Integer;
|
||||
FWrapMode: Boolean;
|
||||
FCols: Integer;
|
||||
FRows: Integer;
|
||||
FScrollbackSize: Integer;
|
||||
FCursorVisible: Boolean;
|
||||
FLastCursorRow: Integer;
|
||||
FOnKeyData: TKeyDataEvent;
|
||||
FPaintFont: HFont;
|
||||
FStockFont: Boolean;
|
||||
FBlinkCount: Integer;
|
||||
FUpdateCount: Integer;
|
||||
FPendingScroll: Integer;
|
||||
FDirtyRow: array[0..255] of Boolean;
|
||||
FAllDirty: Boolean;
|
||||
FTextBlinkOn: Boolean;
|
||||
FGlyphBufH: THandle;
|
||||
FGlyphBuf: Pointer;
|
||||
FRowBufH: THandle;
|
||||
FRowBuf: Pointer;
|
||||
FDibInfo: TDibInfo;
|
||||
FRowBufSize: Integer;
|
||||
FNibbleFG: Byte;
|
||||
FNibbleBG: Byte;
|
||||
procedure AllocLine(Line: PTermLine);
|
||||
procedure BuildAtlas;
|
||||
procedure ClearLine(Line: PTermLine);
|
||||
|
|
@ -134,6 +105,7 @@ type
|
|||
procedure EraseLine(Mode: Integer);
|
||||
procedure ExecuteCSI(FinalCh: Char);
|
||||
procedure ExecuteMusic;
|
||||
procedure FlipToScreen;
|
||||
procedure FreeLineList(List: TList);
|
||||
function GetCursorCol: Integer;
|
||||
function GetCursorRow: Integer;
|
||||
|
|
@ -154,6 +126,7 @@ type
|
|||
procedure UpdateScrollbar;
|
||||
procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message wm_EraseBkgnd;
|
||||
procedure WMGetDlgCode(var Msg: TMessage); message wm_GetDlgCode;
|
||||
procedure WMTimer(var Msg: TWMTimer); message wm_Timer;
|
||||
procedure WMVScroll(var Msg: TWMScroll); message wm_VScroll;
|
||||
protected
|
||||
procedure CreateParams(var Params: TCreateParams); override;
|
||||
|
|
@ -163,12 +136,11 @@ type
|
|||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure BeginUpdate;
|
||||
procedure Clear;
|
||||
procedure EndUpdate;
|
||||
procedure Reset;
|
||||
procedure FlipToScreen;
|
||||
procedure TickBlink;
|
||||
procedure Write(const S: string);
|
||||
procedure WriteDeferred(const S: string);
|
||||
property CursorCol: Integer read GetCursorCol;
|
||||
property CursorRow: Integer read GetCursorRow;
|
||||
published
|
||||
|
|
@ -208,8 +180,10 @@ const
|
|||
$00FFFFFF { 15 White (bright) }
|
||||
);
|
||||
|
||||
{ Blink toggle interval in milliseconds (cursor + text blink). }
|
||||
BlinkMs = 500;
|
||||
{ Blink timer interval. Win16 minimum is ~55 ms (18.2 Hz tick). }
|
||||
BlinkTimerMs = 55;
|
||||
{ Cursor and text blink toggle every 9 timer ticks (~500 ms). }
|
||||
BlinkInterval = 9;
|
||||
|
||||
{ OUT_RASTER_PRECIS may not be defined in Delphi 1.0 WinTypes }
|
||||
OutRasterPrecis = 6;
|
||||
|
|
@ -289,6 +263,12 @@ begin
|
|||
end;
|
||||
|
||||
|
||||
procedure TKPAnsi.BeginUpdate;
|
||||
begin
|
||||
Inc(FUpdateCount);
|
||||
end;
|
||||
|
||||
|
||||
procedure TKPAnsi.BuildAtlas;
|
||||
{ Render all 256 CP437 characters into a monochrome bitmap, then extract }
|
||||
{ per-glyph pixel masks into the glyph block at offset 64. Each glyph }
|
||||
|
|
@ -480,13 +460,15 @@ begin
|
|||
FCellWidth := 8;
|
||||
FCellHeight := 16;
|
||||
FBlinkOn := True;
|
||||
FLastBlinkTick := GetTickCount;
|
||||
FTimerActive := False;
|
||||
FScrollPos := 0;
|
||||
FWrapMode := True;
|
||||
FPaintFont := 0;
|
||||
FStockFont := False;
|
||||
FBlinkCount := 0;
|
||||
FUpdateCount := 0;
|
||||
FPendingScroll := 0;
|
||||
FAllDirty := True;
|
||||
FScrollbarDirty := False;
|
||||
FTextBlinkOn := True;
|
||||
FRowBufSize := 0;
|
||||
FGlyphBufH := 0;
|
||||
|
|
@ -643,6 +625,11 @@ end;
|
|||
|
||||
destructor TKPAnsi.Destroy;
|
||||
begin
|
||||
if FTimerActive and HandleAllocated then
|
||||
begin
|
||||
KillTimer(Handle, 1);
|
||||
FTimerActive := False;
|
||||
end;
|
||||
DestroyRowBuffers;
|
||||
if (FPaintFont <> 0) and not FStockFont then
|
||||
begin
|
||||
|
|
@ -742,13 +729,15 @@ begin
|
|||
AllocLine(Line);
|
||||
FScreen.Insert(0, Line);
|
||||
{ Scroll down is rare; just repaint everything }
|
||||
FAllDirty := True;
|
||||
FAllDirty := True;
|
||||
FPendingScroll := 0;
|
||||
end;
|
||||
|
||||
|
||||
procedure TKPAnsi.DoScrollUp;
|
||||
var
|
||||
Line: PTermLine;
|
||||
I: Integer;
|
||||
begin
|
||||
if FScreen.Count < FRows then
|
||||
Exit;
|
||||
|
|
@ -756,19 +745,39 @@ begin
|
|||
Line := FScreen[0];
|
||||
FScrollback.Add(Line);
|
||||
FScreen.Delete(0);
|
||||
{ TrimScrollback deferred to ParseData for batching }
|
||||
TrimScrollback;
|
||||
{ Add blank line at bottom }
|
||||
GetMem(Line, SizeOf(TTermLineRec));
|
||||
AllocLine(Line);
|
||||
FScreen.Add(Line);
|
||||
FScrollbarDirty := True;
|
||||
UpdateScrollbar;
|
||||
|
||||
{ Without ScrollDC, all rows must be re-rendered after a scroll }
|
||||
{ because the on-screen pixels haven't moved to match FScreen. }
|
||||
FAllDirty := True;
|
||||
Inc(FPendingScroll);
|
||||
if FPendingScroll >= FRows then
|
||||
begin
|
||||
{ Scrolled more than one screen; just repaint everything }
|
||||
FAllDirty := True;
|
||||
FPendingScroll := 0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ Shift dirty flags up to match the scrolled line positions }
|
||||
for I := 1 to FRows - 1 do
|
||||
FDirtyRow[I - 1] := FDirtyRow[I];
|
||||
FDirtyRow[FRows - 1] := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TKPAnsi.EndUpdate;
|
||||
begin
|
||||
Dec(FUpdateCount);
|
||||
if FUpdateCount <= 0 then
|
||||
begin
|
||||
FUpdateCount := 0;
|
||||
FlipToScreen;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TKPAnsi.EraseDisplay(Mode: Integer);
|
||||
|
|
@ -1223,7 +1232,8 @@ procedure TKPAnsi.FlipToScreen;
|
|||
var
|
||||
DC: HDC;
|
||||
Row: Integer;
|
||||
HasDirty: Boolean;
|
||||
R: TRect;
|
||||
ScrollY: Integer;
|
||||
begin
|
||||
if not HandleAllocated then
|
||||
Exit;
|
||||
|
|
@ -1232,17 +1242,27 @@ begin
|
|||
if FRowBuf = nil then
|
||||
Exit;
|
||||
|
||||
{ Scrollback view: force full redraw (line mapping changes) }
|
||||
{ Scrollback view: force full redraw, ignore pending scroll }
|
||||
if FScrollPos <> 0 then
|
||||
FAllDirty := True;
|
||||
|
||||
{ Deferred scrollbar update (batched from DoScrollUp) }
|
||||
if FScrollbarDirty then
|
||||
begin
|
||||
UpdateScrollbar;
|
||||
FScrollbarDirty := False;
|
||||
FAllDirty := True;
|
||||
FPendingScroll := 0;
|
||||
end;
|
||||
|
||||
{ Deferred scroll: shift existing screen pixels up }
|
||||
if (FPendingScroll > 0) and not FAllDirty then
|
||||
begin
|
||||
R.Left := 0;
|
||||
R.Top := 0;
|
||||
R.Right := FCols * FCellWidth;
|
||||
R.Bottom := FRows * FCellHeight;
|
||||
ScrollY := FPendingScroll * FCellHeight;
|
||||
DC := GetDC(Handle);
|
||||
ScrollDC(DC, 0, -ScrollY, R, R, 0, nil);
|
||||
ReleaseDC(Handle, DC);
|
||||
end;
|
||||
FPendingScroll := 0;
|
||||
|
||||
{ Dirty old cursor row to erase ghost when cursor moved between rows }
|
||||
if FCursorRow <> FLastCursorRow then
|
||||
begin
|
||||
|
|
@ -1253,22 +1273,6 @@ begin
|
|||
FLastCursorRow := FCursorRow;
|
||||
end;
|
||||
|
||||
{ Early exit: skip GetDC/ReleaseDC when nothing needs rendering }
|
||||
if not FAllDirty then
|
||||
begin
|
||||
HasDirty := False;
|
||||
for Row := 0 to FRows - 1 do
|
||||
begin
|
||||
if FDirtyRow[Row] then
|
||||
begin
|
||||
HasDirty := True;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
if not HasDirty then
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{ Interleaved render + blast: single buffer is reused per row }
|
||||
DC := GetDC(Handle);
|
||||
for Row := 0 to FRows - 1 do
|
||||
|
|
@ -1484,7 +1488,8 @@ begin
|
|||
Exit;
|
||||
|
||||
{ Full repaint: render each row into the shared buffer and blast it }
|
||||
FAllDirty := True;
|
||||
FPendingScroll := 0;
|
||||
FAllDirty := True;
|
||||
|
||||
for Row := 0 to FRows - 1 do
|
||||
begin
|
||||
|
|
@ -1504,90 +1509,28 @@ end;
|
|||
|
||||
|
||||
procedure TKPAnsi.ParseData(const S: string);
|
||||
{ Process incoming data with an inlined fast path for printable characters. }
|
||||
{ ~80% of BBS data is printable text in normal state. Inlining avoids the }
|
||||
{ per-character method call to ProcessChar, and caching the Line pointer }
|
||||
{ eliminates repeated TList lookups for consecutive chars on the same row. }
|
||||
{ }
|
||||
{ Does NOT call FlipToScreen -- the caller (Write) calls FlipToScreen }
|
||||
{ after ParseData returns, ensuring immediate rendering. }
|
||||
var
|
||||
I: Integer;
|
||||
Ch: Char;
|
||||
Line: PTermLine;
|
||||
FGIdx: Byte;
|
||||
BGIdx: Byte;
|
||||
I: Integer;
|
||||
begin
|
||||
Line := nil;
|
||||
|
||||
for I := 1 to Length(S) do
|
||||
begin
|
||||
Ch := S[I];
|
||||
|
||||
{ Fast path: printable character in normal state }
|
||||
if (FParseState = psNormal) and (Ch >= ' ') then
|
||||
begin
|
||||
if FCursorCol >= FCols then
|
||||
begin
|
||||
if FWrapMode then
|
||||
begin
|
||||
FCursorCol := 0;
|
||||
Inc(FCursorRow);
|
||||
if FCursorRow >= FRows then
|
||||
begin
|
||||
FCursorRow := FRows - 1;
|
||||
DoScrollUp;
|
||||
end;
|
||||
Line := nil;
|
||||
end
|
||||
else
|
||||
FCursorCol := FCols - 1;
|
||||
end;
|
||||
|
||||
if Line = nil then
|
||||
Line := FScreen[FCursorRow];
|
||||
|
||||
if FAttrBold then
|
||||
FGIdx := FAttrFG + 8
|
||||
else
|
||||
FGIdx := FAttrFG;
|
||||
BGIdx := FAttrBG;
|
||||
|
||||
if FAttrReverse then
|
||||
begin
|
||||
Line^.Cells[FCursorCol].FG := BGIdx;
|
||||
Line^.Cells[FCursorCol].BG := FGIdx;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Line^.Cells[FCursorCol].FG := FGIdx;
|
||||
Line^.Cells[FCursorCol].BG := BGIdx;
|
||||
end;
|
||||
Line^.Cells[FCursorCol].Ch := Ch;
|
||||
Line^.Cells[FCursorCol].Bold := FAttrBold;
|
||||
Line^.Cells[FCursorCol].Blink := FAttrBlink;
|
||||
FDirtyRow[FCursorRow] := True;
|
||||
Inc(FCursorCol);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ Slow path: control chars, escape sequences }
|
||||
Line := nil;
|
||||
ProcessChar(Ch);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Deferred scrollback trim -- batched from DoScrollUp }
|
||||
TrimScrollback;
|
||||
ProcessChar(S[I]);
|
||||
|
||||
{ Snap to bottom on new data }
|
||||
if FScrollPos <> 0 then
|
||||
begin
|
||||
FScrollPos := 0;
|
||||
FScrollbarDirty := True;
|
||||
FAllDirty := True;
|
||||
FScrollPos := 0;
|
||||
UpdateScrollbar;
|
||||
FAllDirty := True;
|
||||
end;
|
||||
|
||||
{ Reset cursor blink to visible on new data }
|
||||
FBlinkOn := True;
|
||||
|
||||
{ Render immediately -- no throttle. Data hits the screen as soon }
|
||||
{ as it arrives. BeginUpdate/EndUpdate suppresses intermediate }
|
||||
{ renders when the caller is batching multiple Write calls. }
|
||||
if FUpdateCount = 0 then
|
||||
FlipToScreen;
|
||||
end;
|
||||
|
||||
|
||||
|
|
@ -1875,6 +1818,13 @@ begin
|
|||
CreateRowBuffers;
|
||||
FAllDirty := True;
|
||||
|
||||
{ Start render/blink timer }
|
||||
if not FTimerActive then
|
||||
begin
|
||||
SetTimer(Handle, 1, BlinkTimerMs, nil);
|
||||
FTimerActive := True;
|
||||
end;
|
||||
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
|
|
@ -2262,28 +2212,15 @@ end;
|
|||
|
||||
|
||||
procedure TKPAnsi.TrimScrollback;
|
||||
{ Batch-optimized: free excess items, shift remainder down in one pass, }
|
||||
{ then shrink from the end. O(n) total vs O(k*n) for k front-deletions. }
|
||||
var
|
||||
Excess: Integer;
|
||||
I: Integer;
|
||||
Line: PTermLine;
|
||||
Line: PTermLine;
|
||||
begin
|
||||
Excess := FScrollback.Count - FScrollbackSize;
|
||||
if Excess <= 0 then
|
||||
Exit;
|
||||
{ Free the oldest lines }
|
||||
for I := 0 to Excess - 1 do
|
||||
while FScrollback.Count > FScrollbackSize do
|
||||
begin
|
||||
Line := FScrollback[I];
|
||||
Line := FScrollback[0];
|
||||
FreeMem(Line, SizeOf(TTermLineRec));
|
||||
FScrollback.Delete(0);
|
||||
end;
|
||||
{ Shift remaining items down in one pass }
|
||||
for I := 0 to FScrollback.Count - Excess - 1 do
|
||||
FScrollback[I] := FScrollback[I + Excess];
|
||||
{ Remove excess slots from the end (O(1) per deletion) }
|
||||
for I := 1 to Excess do
|
||||
FScrollback.Delete(FScrollback.Count - 1);
|
||||
end;
|
||||
|
||||
|
||||
|
|
@ -2320,18 +2257,20 @@ begin
|
|||
end;
|
||||
|
||||
|
||||
procedure TKPAnsi.TickBlink;
|
||||
var
|
||||
Now: Longint;
|
||||
procedure TKPAnsi.WMTimer(var Msg: TWMTimer);
|
||||
begin
|
||||
Now := GetTickCount;
|
||||
if Now - FLastBlinkTick >= BlinkMs then
|
||||
{ Blink counter: toggle cursor and text blink every BlinkInterval ticks }
|
||||
Inc(FBlinkCount);
|
||||
if FBlinkCount >= BlinkInterval then
|
||||
begin
|
||||
FLastBlinkTick := Now;
|
||||
FBlinkOn := not FBlinkOn;
|
||||
FTextBlinkOn := not FTextBlinkOn;
|
||||
FBlinkCount := 0;
|
||||
FBlinkOn := not FBlinkOn;
|
||||
FTextBlinkOn := not FTextBlinkOn;
|
||||
DirtyBlinkRows;
|
||||
end;
|
||||
|
||||
{ Render blink changes and any stale dirty rows }
|
||||
FlipToScreen;
|
||||
end;
|
||||
|
||||
|
||||
|
|
@ -2377,16 +2316,6 @@ end;
|
|||
|
||||
|
||||
procedure TKPAnsi.Write(const S: string);
|
||||
begin
|
||||
if Length(S) > 0 then
|
||||
begin
|
||||
ParseData(S);
|
||||
FlipToScreen;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TKPAnsi.WriteDeferred(const S: string);
|
||||
begin
|
||||
if Length(S) > 0 then
|
||||
ParseData(S);
|
||||
|
|
|
|||
|
|
@ -5,54 +5,80 @@ unit KPComm;
|
|||
{ TKPComm is a non-visual TComponent descendant providing RS-232 serial }
|
||||
{ I/O via the Windows 3.1 comm API. Installs to the "KP" palette tab. }
|
||||
{ }
|
||||
{ Port lifecycle: OpenComm -> BuildCommDCB + SetCommState -> CloseComm. }
|
||||
{ Port lifecycle: OpenComm -> BuildCommDCB + SetCommState -> }
|
||||
{ EnableCommNotification -> CloseComm. }
|
||||
{ }
|
||||
{ Data is read by polling Input (ReadComm) from a PeekMessage main loop }
|
||||
{ rather than through WM_COMMNOTIFY event dispatch. }
|
||||
{ WM_COMMNOTIFY messages are received through a hidden utility window }
|
||||
{ with a registered class and dispatched to ProcessReceiveNotify, }
|
||||
{ ProcessTransmitNotify, and ProcessEventNotify. }
|
||||
{ }
|
||||
{ Modem line status (CTS/DSR/CD) is tracked via shadow booleans toggled }
|
||||
{ on transition events from GetCommEventMask, since the 16-bit comm API }
|
||||
{ only provides transition events, not absolute line levels. }
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, WinTypes, WinProcs, Messages;
|
||||
|
||||
const
|
||||
{ Communication events }
|
||||
comEvReceive = 1;
|
||||
comEvSend = 2;
|
||||
comEvCTS = 3;
|
||||
comEvDSR = 4;
|
||||
comEvCD = 5;
|
||||
comEvRing = 6;
|
||||
comEvEOF = 7;
|
||||
|
||||
{ Error events }
|
||||
comEvtBreak = 1001;
|
||||
comEvtFrame = 1004;
|
||||
comEvtOverrun = 1006;
|
||||
comEvtRxOver = 1008;
|
||||
comEvtParity = 1009;
|
||||
comEvtTxFull = 1010;
|
||||
|
||||
type
|
||||
THandshaking = (hsNone, hsXonXoff, hsRtsCts, hsBoth);
|
||||
TInputMode = (imText, imBinary);
|
||||
|
||||
TKPComm = class(TComponent)
|
||||
private
|
||||
{ Port state }
|
||||
FCommId: Integer; { Comm port handle from OpenComm (-1 = closed) }
|
||||
|
||||
{ Configuration (published properties) }
|
||||
FCommPort: Integer; { Port number (1-based: 1=COM1, 2=COM2, ...) }
|
||||
FSettings: string; { Baud/parity/data/stop string (e.g. '9600,N,8,1') }
|
||||
FPortOpen: Boolean; { True while port is open and operational }
|
||||
FInBufferSize: Integer; { Receive ring buffer size in bytes }
|
||||
FOutBufferSize: Integer; { Transmit ring buffer size in bytes }
|
||||
FHandshaking: THandshaking; { Flow control mode (none/XonXoff/RtsCts/both) }
|
||||
FInputLen: Integer; { Max bytes per Input read (0=up to 255) }
|
||||
FInputMode: TInputMode; { Text or binary read mode }
|
||||
|
||||
{ Modem control lines }
|
||||
FDTREnable: Boolean; { DTR line state (True=asserted) }
|
||||
FRTSEnable: Boolean; { RTS line state (True=asserted) }
|
||||
|
||||
{ DCB options }
|
||||
FNullDiscard: Boolean; { Strip null bytes from received data }
|
||||
FEOFEnable: Boolean; { Detect EOF character in stream }
|
||||
FParityReplace: string; { Replacement char for parity errors ('' = none) }
|
||||
|
||||
{ Runtime state }
|
||||
FBreakState: Boolean; { True while break signal is being sent }
|
||||
|
||||
FCommId: Integer;
|
||||
FHWndNotify: HWnd;
|
||||
FCommPort: Integer;
|
||||
FSettings: string;
|
||||
FPortOpen: Boolean;
|
||||
FInBufferSize: Integer;
|
||||
FOutBufferSize: Integer;
|
||||
FRThreshold: Integer;
|
||||
FSThreshold: Integer;
|
||||
FHandshaking: THandshaking;
|
||||
FInputLen: Integer;
|
||||
FInputMode: TInputMode;
|
||||
FDTREnable: Boolean;
|
||||
FRTSEnable: Boolean;
|
||||
FNullDiscard: Boolean;
|
||||
FEOFEnable: Boolean;
|
||||
FParityReplace: string;
|
||||
FBreakState: Boolean;
|
||||
FCommEvent: Integer;
|
||||
FCTSState: Boolean;
|
||||
FDSRState: Boolean;
|
||||
FCDState: Boolean;
|
||||
FOnComm: TNotifyEvent;
|
||||
procedure ApplyHandshaking;
|
||||
procedure ApplyOptions;
|
||||
procedure ClosePort;
|
||||
procedure DoCommEvent(EventCode: Integer);
|
||||
function GetInBufferCount: Integer;
|
||||
function GetInput: string;
|
||||
function GetOutBufferCount: Integer;
|
||||
procedure OpenPort;
|
||||
procedure ProcessEventNotify;
|
||||
procedure ProcessReceiveNotify;
|
||||
procedure ProcessTransmitNotify;
|
||||
procedure SetBreak(Value: Boolean);
|
||||
procedure SetCommPort(Value: Integer);
|
||||
procedure SetDTREnable(Value: Boolean);
|
||||
|
|
@ -72,13 +98,19 @@ type
|
|||
property Output: string write SetOutput;
|
||||
property InBufferCount: Integer read GetInBufferCount;
|
||||
property OutBufferCount: Integer read GetOutBufferCount;
|
||||
property CDHolding: Boolean read FCDState;
|
||||
property CTSHolding: Boolean read FCTSState;
|
||||
property DSRHolding: Boolean read FDSRState;
|
||||
property Break: Boolean read FBreakState write SetBreak;
|
||||
property CommEvent: Integer read FCommEvent;
|
||||
published
|
||||
property CommPort: Integer read FCommPort write SetCommPort default 1;
|
||||
property Settings: string read FSettings write SetSettings;
|
||||
property PortOpen: Boolean read FPortOpen write SetPortOpen default False;
|
||||
property InBufferSize: Integer read FInBufferSize write SetInBufferSize default 4096;
|
||||
property OutBufferSize: Integer read FOutBufferSize write SetOutBufferSize default 4096;
|
||||
property RThreshold: Integer read FRThreshold write FRThreshold default 0;
|
||||
property SThreshold: Integer read FSThreshold write FSThreshold default 0;
|
||||
property Handshaking: THandshaking read FHandshaking write SetHandshaking default hsNone;
|
||||
property InputLen: Integer read FInputLen write FInputLen default 0;
|
||||
property InputMode: TInputMode read FInputMode write FInputMode default imText;
|
||||
|
|
@ -87,6 +119,7 @@ type
|
|||
property NullDiscard: Boolean read FNullDiscard write SetNullDiscard default False;
|
||||
property EOFEnable: Boolean read FEOFEnable write FEOFEnable default False;
|
||||
property ParityReplace: string read FParityReplace write SetParityReplace;
|
||||
property OnComm: TNotifyEvent read FOnComm write FOnComm;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
|
@ -94,6 +127,11 @@ procedure Register;
|
|||
implementation
|
||||
|
||||
const
|
||||
{ WM_COMMNOTIFY notification codes }
|
||||
CN_RECEIVE = $0001;
|
||||
CN_TRANSMIT = $0002;
|
||||
CN_EVENT = $0004;
|
||||
|
||||
{ DCB Flags field bit masks. The Windows 3.1 DCB packs thirteen 1-bit }
|
||||
{ fields into a single UINT (Word) at offset 12 of the structure. }
|
||||
{ Delphi 1.0 maps this UINT to TDCB.Flags. }
|
||||
|
|
@ -111,6 +149,46 @@ const
|
|||
dcbDtrflow = $0800;
|
||||
dcbRtsflow = $1000;
|
||||
|
||||
{ Hidden notification window class name }
|
||||
NotifyClassName = 'KPCommNotify';
|
||||
|
||||
var
|
||||
NotifyClassRegistered: Boolean;
|
||||
|
||||
|
||||
{ ----------------------------------------------------------------------- }
|
||||
{ Hidden notification window procedure }
|
||||
{ }
|
||||
{ Receives WM_COMMNOTIFY from the comm driver. Retrieves the TKPComm }
|
||||
{ instance pointer stored in the window's extra bytes (offset 0) and }
|
||||
{ dispatches to the appropriate Process* method. }
|
||||
{ ----------------------------------------------------------------------- }
|
||||
|
||||
function NotifyWndProc(Wnd: HWnd; Msg: Word;
|
||||
WParam: Word; LParam: Longint): Longint; export;
|
||||
var
|
||||
Comm: TKPComm;
|
||||
NotifyCode: Word;
|
||||
begin
|
||||
if Msg = wm_CommNotify then
|
||||
begin
|
||||
Comm := TKPComm(GetWindowLong(Wnd, 0));
|
||||
if (Comm <> nil) and Comm.FPortOpen and (Comm.FCommId >= 0) then
|
||||
begin
|
||||
NotifyCode := Word(LParam);
|
||||
if (NotifyCode and CN_RECEIVE) <> 0 then
|
||||
Comm.ProcessReceiveNotify;
|
||||
if (NotifyCode and CN_TRANSMIT) <> 0 then
|
||||
Comm.ProcessTransmitNotify;
|
||||
if (NotifyCode and CN_EVENT) <> 0 then
|
||||
Comm.ProcessEventNotify;
|
||||
end;
|
||||
Result := 0;
|
||||
end
|
||||
else
|
||||
Result := DefWindowProc(Wnd, Msg, WParam, LParam);
|
||||
end;
|
||||
|
||||
|
||||
{ ----------------------------------------------------------------------- }
|
||||
{ TKPComm }
|
||||
|
|
@ -187,6 +265,7 @@ end;
|
|||
|
||||
procedure TKPComm.ClosePort;
|
||||
begin
|
||||
{ Set FPortOpen first to prevent stale WM_COMMNOTIFY processing }
|
||||
FPortOpen := False;
|
||||
|
||||
if FCommId >= 0 then
|
||||
|
|
@ -201,6 +280,16 @@ begin
|
|||
CloseComm(FCommId);
|
||||
FCommId := -1;
|
||||
end;
|
||||
|
||||
if FHWndNotify <> 0 then
|
||||
begin
|
||||
DestroyWindow(FHWndNotify);
|
||||
FHWndNotify := 0;
|
||||
end;
|
||||
|
||||
FCTSState := False;
|
||||
FDSRState := False;
|
||||
FCDState := False;
|
||||
end;
|
||||
|
||||
|
||||
|
|
@ -208,11 +297,14 @@ constructor TKPComm.Create(AOwner: TComponent);
|
|||
begin
|
||||
inherited Create(AOwner);
|
||||
FCommId := -1;
|
||||
FHWndNotify := 0;
|
||||
FCommPort := 1;
|
||||
FSettings := '9600,N,8,1';
|
||||
FPortOpen := False;
|
||||
FInBufferSize := 4096;
|
||||
FOutBufferSize := 4096;
|
||||
FRThreshold := 0;
|
||||
FSThreshold := 0;
|
||||
FHandshaking := hsNone;
|
||||
FInputLen := 0;
|
||||
FInputMode := imText;
|
||||
|
|
@ -222,6 +314,10 @@ begin
|
|||
FEOFEnable := False;
|
||||
FParityReplace := '?';
|
||||
FBreakState := False;
|
||||
FCommEvent := 0;
|
||||
FCTSState := False;
|
||||
FDSRState := False;
|
||||
FCDState := False;
|
||||
end;
|
||||
|
||||
|
||||
|
|
@ -233,6 +329,14 @@ begin
|
|||
end;
|
||||
|
||||
|
||||
procedure TKPComm.DoCommEvent(EventCode: Integer);
|
||||
begin
|
||||
FCommEvent := EventCode;
|
||||
if Assigned(FOnComm) then
|
||||
FOnComm(Self);
|
||||
end;
|
||||
|
||||
|
||||
function TKPComm.GetInBufferCount: Integer;
|
||||
var
|
||||
Stat: TComStat;
|
||||
|
|
@ -287,9 +391,12 @@ end;
|
|||
|
||||
procedure TKPComm.OpenPort;
|
||||
var
|
||||
WC: TWndClass;
|
||||
DCB: TDCB;
|
||||
Buf: array[0..255] of Char;
|
||||
Setting: string;
|
||||
RxTh: Integer;
|
||||
TxTh: Integer;
|
||||
begin
|
||||
{ Open the comm port }
|
||||
StrPCopy(Buf, 'COM' + IntToStr(FCommPort));
|
||||
|
|
@ -340,10 +447,134 @@ begin
|
|||
else
|
||||
EscapeCommFunction(FCommId, CLRRTS);
|
||||
|
||||
{ Register notification window class (once per process) }
|
||||
if not NotifyClassRegistered then
|
||||
begin
|
||||
FillChar(WC, SizeOf(WC), 0);
|
||||
WC.lpfnWndProc := @NotifyWndProc;
|
||||
WC.cbWndExtra := SizeOf(Longint);
|
||||
WC.hInstance := HInstance;
|
||||
WC.lpszClassName := NotifyClassName;
|
||||
if not RegisterClass(WC) then
|
||||
begin
|
||||
CloseComm(FCommId);
|
||||
FCommId := -1;
|
||||
raise Exception.Create('RegisterClass failed');
|
||||
end;
|
||||
NotifyClassRegistered := True;
|
||||
end;
|
||||
|
||||
{ Create hidden notification window and store Self for dispatch }
|
||||
FHWndNotify := CreateWindow(NotifyClassName, '', ws_Popup,
|
||||
0, 0, 0, 0, 0, 0, HInstance, nil);
|
||||
if FHWndNotify = 0 then
|
||||
begin
|
||||
CloseComm(FCommId);
|
||||
FCommId := -1;
|
||||
raise Exception.Create('CreateWindow failed');
|
||||
end;
|
||||
SetWindowLong(FHWndNotify, 0, Longint(Self));
|
||||
|
||||
{ Enable event mask for modem status, errors, and breaks }
|
||||
SetCommEventMask(FCommId,
|
||||
ev_CTS or ev_DSR or ev_RLSD or ev_Ring or
|
||||
ev_Err or ev_Break or ev_RxChar);
|
||||
|
||||
{ Enable comm notifications -- -1 disables the notification }
|
||||
if FRThreshold > 0 then
|
||||
RxTh := FRThreshold
|
||||
else
|
||||
RxTh := -1;
|
||||
if FSThreshold > 0 then
|
||||
TxTh := FSThreshold
|
||||
else
|
||||
TxTh := -1;
|
||||
EnableCommNotification(FCommId, FHWndNotify, RxTh, TxTh);
|
||||
|
||||
{ Reset modem line shadow state }
|
||||
FCTSState := False;
|
||||
FDSRState := False;
|
||||
FCDState := False;
|
||||
|
||||
FPortOpen := True;
|
||||
end;
|
||||
|
||||
|
||||
procedure TKPComm.ProcessEventNotify;
|
||||
var
|
||||
EvtMask: Word;
|
||||
Stat: TComStat;
|
||||
ErrFlags: Integer;
|
||||
begin
|
||||
EvtMask := GetCommEventMask(FCommId,
|
||||
ev_CTS or ev_DSR or ev_RLSD or ev_Ring or ev_Err or ev_Break);
|
||||
|
||||
if (EvtMask and ev_Break) <> 0 then
|
||||
DoCommEvent(comEvtBreak);
|
||||
|
||||
{ Modem line shadow state: toggle on each transition event. }
|
||||
{ The 16-bit comm API only provides transition events, not }
|
||||
{ absolute line levels. }
|
||||
if (EvtMask and ev_CTS) <> 0 then
|
||||
begin
|
||||
FCTSState := not FCTSState;
|
||||
DoCommEvent(comEvCTS);
|
||||
end;
|
||||
|
||||
if (EvtMask and ev_DSR) <> 0 then
|
||||
begin
|
||||
FDSRState := not FDSRState;
|
||||
DoCommEvent(comEvDSR);
|
||||
end;
|
||||
|
||||
if (EvtMask and ev_RLSD) <> 0 then
|
||||
begin
|
||||
FCDState := not FCDState;
|
||||
DoCommEvent(comEvCD);
|
||||
end;
|
||||
|
||||
if (EvtMask and ev_Ring) <> 0 then
|
||||
DoCommEvent(comEvRing);
|
||||
|
||||
if (EvtMask and ev_Err) <> 0 then
|
||||
begin
|
||||
ErrFlags := GetCommError(FCommId, Stat);
|
||||
if (ErrFlags and ce_Frame) <> 0 then
|
||||
DoCommEvent(comEvtFrame);
|
||||
if (ErrFlags and ce_Overrun) <> 0 then
|
||||
DoCommEvent(comEvtOverrun);
|
||||
if (ErrFlags and ce_RxOver) <> 0 then
|
||||
DoCommEvent(comEvtRxOver);
|
||||
if (ErrFlags and ce_RxParity) <> 0 then
|
||||
DoCommEvent(comEvtParity);
|
||||
if (ErrFlags and ce_TxFull) <> 0 then
|
||||
DoCommEvent(comEvtTxFull);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TKPComm.ProcessReceiveNotify;
|
||||
begin
|
||||
if FRThreshold <= 0 then
|
||||
Exit;
|
||||
{ WM_COMMNOTIFY with CN_RECEIVE means data is available -- the driver }
|
||||
{ already checked the threshold. No need to call GetCommError here. }
|
||||
DoCommEvent(comEvReceive);
|
||||
end;
|
||||
|
||||
|
||||
procedure TKPComm.ProcessTransmitNotify;
|
||||
var
|
||||
Stat: TComStat;
|
||||
begin
|
||||
if FSThreshold <= 0 then
|
||||
Exit;
|
||||
GetCommError(FCommId, Stat);
|
||||
if Integer(Stat.cbOutQue) <= FSThreshold then
|
||||
DoCommEvent(comEvSend);
|
||||
end;
|
||||
|
||||
|
||||
procedure TKPComm.SetBreak(Value: Boolean);
|
||||
begin
|
||||
FBreakState := Value;
|
||||
|
|
@ -426,7 +657,7 @@ begin
|
|||
begin
|
||||
Written := WriteComm(FCommId, @Value[1], Length(Value));
|
||||
if Written < 0 then
|
||||
raise Exception.Create('WriteComm failed');
|
||||
DoCommEvent(comEvtTxFull);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
|
|
|||
|
|
@ -8,5 +8,5 @@ uses
|
|||
|
||||
begin
|
||||
Application.CreateForm(TMainForm, MainForm);
|
||||
MainForm.Run;
|
||||
Application.Run;
|
||||
end.
|
||||
|
|
|
|||
|
|
@ -5,8 +5,8 @@ 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. }
|
||||
{ is fed to the terminal via TKPAnsi.Write; keystrokes from the terminal }
|
||||
{ are sent out via TKPComm.Output. }
|
||||
|
||||
interface
|
||||
|
||||
|
|
@ -17,27 +17,22 @@ 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 }
|
||||
FEditPort: TEdit; { COM port number entry }
|
||||
FLabelSettings: TLabel; { "Settings:" label }
|
||||
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 }
|
||||
FComm: TKPComm;
|
||||
FAnsi: TKPAnsi;
|
||||
FLabelPort: TLabel;
|
||||
FEditPort: TEdit;
|
||||
FLabelSettings: TLabel;
|
||||
FEditSettings: TEdit;
|
||||
FBtnOpen: TButton;
|
||||
FBtnClose: TButton;
|
||||
FLabelStatus: TLabel;
|
||||
procedure AnsiKeyData(Sender: TObject; const Data: string);
|
||||
procedure BtnCloseClick(Sender: TObject);
|
||||
procedure BtnOpenClick(Sender: TObject);
|
||||
procedure CommEvent(Sender: TObject);
|
||||
procedure UpdateStatus;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
procedure Run;
|
||||
end;
|
||||
|
||||
var
|
||||
|
|
@ -70,9 +65,10 @@ end;
|
|||
procedure TMainForm.BtnOpenClick(Sender: TObject);
|
||||
begin
|
||||
try
|
||||
FComm.CommPort := StrToInt(FEditPort.Text);
|
||||
FComm.Settings := FEditSettings.Text;
|
||||
FComm.PortOpen := True;
|
||||
FComm.CommPort := StrToInt(FEditPort.Text);
|
||||
FComm.Settings := FEditSettings.Text;
|
||||
FComm.RThreshold := 1;
|
||||
FComm.PortOpen := True;
|
||||
except
|
||||
on E: Exception do
|
||||
FAnsi.Write('Open failed: ' + E.Message + #13#10);
|
||||
|
|
@ -82,6 +78,31 @@ begin
|
|||
end;
|
||||
|
||||
|
||||
procedure TMainForm.CommEvent(Sender: TObject);
|
||||
var
|
||||
S: string;
|
||||
begin
|
||||
case FComm.CommEvent of
|
||||
comEvReceive:
|
||||
begin
|
||||
{ Drain all available data in a single update batch. This }
|
||||
{ suppresses per-Write rendering so we get one paint at the }
|
||||
{ end instead of one per 255-byte chunk. }
|
||||
FAnsi.BeginUpdate;
|
||||
try
|
||||
repeat
|
||||
S := FComm.Input;
|
||||
if Length(S) > 0 then
|
||||
FAnsi.Write(S);
|
||||
until Length(S) = 0;
|
||||
finally
|
||||
FAnsi.EndUpdate;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
constructor TMainForm.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited CreateNew(AOwner);
|
||||
|
|
@ -93,6 +114,7 @@ begin
|
|||
|
||||
{ Serial component }
|
||||
FComm := TKPComm.Create(Self);
|
||||
FComm.OnComm := CommEvent;
|
||||
|
||||
{ Row 1: Port and Settings }
|
||||
FLabelPort := TLabel.Create(Self);
|
||||
|
|
@ -155,66 +177,15 @@ begin
|
|||
|
||||
{ Font diagnostic: write known CP437 box-drawing characters. }
|
||||
{ If the OEM font is working, you should see: }
|
||||
{ Line 1: single-line box top +---+ }
|
||||
{ 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. }
|
||||
{ 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;
|
||||
|
||||
|
||||
procedure TMainForm.Run;
|
||||
var
|
||||
Msg: TMsg;
|
||||
S: string;
|
||||
HasData: Boolean;
|
||||
begin
|
||||
Show;
|
||||
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
|
||||
begin
|
||||
FDone := True;
|
||||
Break;
|
||||
end;
|
||||
TranslateMessage(Msg);
|
||||
DispatchMessage(Msg);
|
||||
end;
|
||||
|
||||
if FDone then
|
||||
Break;
|
||||
|
||||
{ Poll serial data -- read one chunk per iteration }
|
||||
HasData := False;
|
||||
if FComm.PortOpen then
|
||||
begin
|
||||
S := FComm.Input;
|
||||
if Length(S) > 0 then
|
||||
begin
|
||||
FAnsi.WriteDeferred(S);
|
||||
HasData := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Tick blink (dirties rows if interval elapsed), then render }
|
||||
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. }
|
||||
if not HasData then
|
||||
Yield;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TMainForm.UpdateStatus;
|
||||
begin
|
||||
if FComm.PortOpen then
|
||||
|
|
|
|||
|
|
@ -193,7 +193,7 @@ static void readPortConfig(int16_t commId, uint16_t FAR *baseAddr, uint8_t F
|
|||
static uint16_t readSystemIni(const char FAR *section, const char FAR *key, uint16_t defVal);
|
||||
|
||||
// -----------------------------------------------------------------------
|
||||
// Port base addresses and IRQ defaults (overridden by SYSTEM.INI)
|
||||
// Port base addresses and IRQ table
|
||||
// -----------------------------------------------------------------------
|
||||
static const uint16_t portBase[MAX_PORTS] = {
|
||||
COM1_BASE, COM2_BASE, COM3_BASE, COM4_BASE
|
||||
|
|
@ -204,18 +204,25 @@ static const uint8_t portIrq[MAX_PORTS] = {
|
|||
};
|
||||
|
||||
// -----------------------------------------------------------------------
|
||||
// Global port state array -- one PortStateT per COM port.
|
||||
// Accessed from both application context and ISR context.
|
||||
// Segment address loaded into DS by ISR entry points (isr3/isr4).
|
||||
// Global port state array
|
||||
// -----------------------------------------------------------------------
|
||||
PortStateT ports[MAX_PORTS];
|
||||
|
||||
// -----------------------------------------------------------------------
|
||||
// DLL instance handle (saved in LibMain for resource loading)
|
||||
// Global instance handle
|
||||
// -----------------------------------------------------------------------
|
||||
static HANDLE ghInstance = NULL;
|
||||
|
||||
// ISR hit counter for diagnostics (incremented in isr4, wraps at 65535)
|
||||
// -----------------------------------------------------------------------
|
||||
// Dynamically resolved PostMessage
|
||||
//
|
||||
// comm.drv is loaded from [boot] before USER.EXE, so we can't have a
|
||||
// static import for PostMessage. Resolve it on first use via
|
||||
// GetProcAddress(GetModuleHandle("USER"), "PostMessage").
|
||||
// -----------------------------------------------------------------------
|
||||
PostMessageProcT pfnPostMessage = NULL;
|
||||
|
||||
// ISR hit counter for diagnostics
|
||||
volatile uint16_t isrHitCount = 0;
|
||||
|
||||
|
||||
|
|
@ -715,27 +722,40 @@ void enableFifo(PortStateT *port)
|
|||
|
||||
// -----------------------------------------------------------------------
|
||||
// enableNotification - Register window for WM_COMMNOTIFY (ordinal 100)
|
||||
//
|
||||
// Retained as a no-op stub for API compatibility. Stores threshold
|
||||
// values but nothing reads them -- polling replaces notifications.
|
||||
// -----------------------------------------------------------------------
|
||||
int16_t FAR PASCAL _export enableNotification(int16_t commId, HWND hwnd, int16_t rxThresh, int16_t txThresh)
|
||||
{
|
||||
PortStateT *port;
|
||||
|
||||
dbgInt16("KPCOMM: enableNotif Id", commId);
|
||||
dbgHex16("KPCOMM: enableNotif hwnd", (uint16_t)hwnd);
|
||||
dbgInt16("KPCOMM: enableNotif rxTh", rxThresh);
|
||||
dbgInt16("KPCOMM: enableNotif txTh", txThresh);
|
||||
|
||||
if (commId < 0 || commId >= MAX_PORTS) {
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
port = &ports[commId];
|
||||
if (!port->isOpen) {
|
||||
dbgStr("KPCOMM: enableNotif not open\r\n");
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
// Lazily resolve PostMessage from USER.EXE
|
||||
// (not available at boot when comm.drv is loaded from [boot])
|
||||
if (!pfnPostMessage) {
|
||||
HMODULE hUser = GetModuleHandle("USER");
|
||||
if (hUser) {
|
||||
pfnPostMessage = (PostMessageProcT)GetProcAddress(hUser, "PostMessage");
|
||||
}
|
||||
}
|
||||
|
||||
port->hwndNotify = hwnd;
|
||||
port->rxNotifyThresh = rxThresh;
|
||||
port->txNotifyThresh = txThresh;
|
||||
|
||||
dbgStr("KPCOMM: enableNotif OK\r\n");
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
|
|
@ -1043,21 +1063,21 @@ static void initPortState(PortStateT *port, int16_t commId)
|
|||
trigKey[11] = 'E';
|
||||
trigKey[12] = 'R';
|
||||
trigKey[13] = '\0';
|
||||
rxTrigger = readSystemIni("386Enh", trigKey, 1);
|
||||
rxTrigger = readSystemIni("386Enh", trigKey, 8);
|
||||
}
|
||||
switch (rxTrigger) {
|
||||
case 1:
|
||||
port->fifoTrigger = FCR_TRIG_1;
|
||||
break;
|
||||
case 4:
|
||||
port->fifoTrigger = FCR_TRIG_4;
|
||||
break;
|
||||
case 8:
|
||||
port->fifoTrigger = FCR_TRIG_8;
|
||||
break;
|
||||
case 14:
|
||||
port->fifoTrigger = FCR_TRIG_14;
|
||||
break;
|
||||
case 1:
|
||||
case 8:
|
||||
default:
|
||||
port->fifoTrigger = FCR_TRIG_1;
|
||||
port->fifoTrigger = FCR_TRIG_8;
|
||||
break;
|
||||
}
|
||||
|
||||
|
|
|
|||
117
drv/commdrv.h
117
drv/commdrv.h
|
|
@ -322,87 +322,86 @@ typedef struct {
|
|||
|
||||
// -----------------------------------------------------------------------
|
||||
// Port state structure
|
||||
//
|
||||
// One per COM port. Accessed from both application context (reccom,
|
||||
// sndcom, etc.) and ISR context (handleRx, handleTx).
|
||||
// Fields shared between contexts are protected by _disable()/_enable().
|
||||
// -----------------------------------------------------------------------
|
||||
typedef struct {
|
||||
// Stock-compatible ComDEB -- must be at offset 0.
|
||||
// cevt (SetCommEventMask) returns a FAR pointer to this.
|
||||
// Third-party code reads msrShadow at offset 35 (KB Q101417).
|
||||
// Stock-compatible ComDEB -- must be kept synchronized.
|
||||
// cevt returns a FAR pointer to this.
|
||||
ComDebT comDeb;
|
||||
|
||||
// Hardware identification (from SYSTEM.INI or defaults)
|
||||
uint16_t baseAddr; // UART base I/O address (e.g. 0x03F8 for COM1)
|
||||
uint8_t irq; // IRQ number (3 for COM2/4, 4 for COM1/3)
|
||||
int16_t commId; // Port index (0=COM1, 1=COM2, 2=COM3, 3=COM4)
|
||||
uint8_t isOpen; // Nonzero while port is open (guards ISR dispatch)
|
||||
uint8_t is16550; // Nonzero if 16550 FIFO detected at init
|
||||
uint8_t fifoEnabled; // Nonzero if FIFO use enabled (COMnFIFO in SYSTEM.INI)
|
||||
uint8_t fifoTrigger; // RX FIFO trigger level FCR bits (FCR_TRIG_*)
|
||||
uint16_t baseAddr; // UART base I/O address
|
||||
uint8_t irq; // IRQ number (3 or 4)
|
||||
int16_t commId; // Port ID (0=COM1, 1=COM2, ...)
|
||||
uint8_t isOpen; // Port open flag
|
||||
uint8_t is16550; // 16550 FIFO detected
|
||||
uint8_t fifoEnabled; // FIFO enabled (COMnFIFO setting)
|
||||
uint8_t fifoTrigger; // RX FIFO trigger FCR bits (FCR_TRIG_*)
|
||||
|
||||
// Receive ring buffer (GlobalAlloc'd GMEM_FIXED for ISR stability)
|
||||
HGLOBAL rxBufH; // GlobalAlloc handle (for GlobalFree on close)
|
||||
uint8_t FAR *rxBuf; // Far pointer to buffer data
|
||||
uint16_t rxSize; // Buffer capacity in bytes
|
||||
uint16_t rxHead; // Write position -- ISR increments
|
||||
uint16_t rxTail; // Read position -- reccom increments
|
||||
uint16_t rxCount; // Bytes in buffer (ISR increments, reccom decrements)
|
||||
// Ring buffers (GlobalAlloc'd GMEM_FIXED)
|
||||
HGLOBAL rxBufH; // Receive buffer handle
|
||||
uint8_t FAR *rxBuf; // Receive ring buffer
|
||||
uint16_t rxSize; // Buffer size
|
||||
uint16_t rxHead; // Write position (ISR writes)
|
||||
uint16_t rxTail; // Read position (app reads)
|
||||
uint16_t rxCount; // Bytes in buffer
|
||||
|
||||
// Transmit ring buffer (GlobalAlloc'd GMEM_FIXED for ISR stability)
|
||||
HGLOBAL txBufH; // GlobalAlloc handle (for GlobalFree on close)
|
||||
uint8_t FAR *txBuf; // Far pointer to buffer data
|
||||
uint16_t txSize; // Buffer capacity in bytes
|
||||
uint16_t txHead; // Write position -- sndcom increments
|
||||
uint16_t txTail; // Read position -- ISR (handleTx) increments
|
||||
uint16_t txCount; // Bytes in buffer (sndcom increments, ISR decrements)
|
||||
HGLOBAL txBufH; // Transmit buffer handle
|
||||
uint8_t FAR *txBuf; // Transmit ring buffer
|
||||
uint16_t txSize; // Buffer size
|
||||
uint16_t txHead; // Write position (app writes)
|
||||
uint16_t txTail; // Read position (ISR reads)
|
||||
uint16_t txCount; // Bytes in buffer
|
||||
|
||||
// Serial parameters (cached from DCB at inicom/setcom time)
|
||||
uint16_t baudRate; // Baud rate (raw or CBR_* index for >32767)
|
||||
uint8_t byteSize; // Data bits per character (5-8)
|
||||
uint8_t parity; // Parity mode (NOPARITY, ODDPARITY, EVENPARITY, ...)
|
||||
uint8_t stopBits; // Stop bits (ONESTOPBIT, TWOSTOPBITS)
|
||||
// DCB shadow
|
||||
uint16_t baudRate; // Current baud rate
|
||||
uint8_t byteSize; // Data bits (5-8)
|
||||
uint8_t parity; // Parity mode
|
||||
uint8_t stopBits; // Stop bits
|
||||
|
||||
// Flow control state (managed by ISR and application code)
|
||||
uint8_t hsMode; // Handshaking mode (HS_NONE/XONXOFF/RTSCTS/BOTH)
|
||||
uint8_t txStopped; // Nonzero = TX halted (received XOFF or CTS dropped)
|
||||
uint8_t rxStopped; // Nonzero = we sent XOFF or dropped RTS
|
||||
uint8_t xonChar; // XON character to send/recognize (default 0x11 DC1)
|
||||
uint8_t xoffChar; // XOFF character to send/recognize (default 0x13 DC3)
|
||||
uint16_t xoffLim; // Assert flow control when rxCount > rxSize - xoffLim
|
||||
uint16_t xonLim; // Release flow control when rxCount < xonLim
|
||||
// Flow control state
|
||||
uint8_t hsMode; // Handshaking mode
|
||||
uint8_t txStopped; // TX halted by flow control
|
||||
uint8_t rxStopped; // We sent XOFF / dropped RTS
|
||||
uint8_t xonChar; // XON character (default 0x11)
|
||||
uint8_t xoffChar; // XOFF character (default 0x13)
|
||||
uint16_t xoffLim; // Send XOFF when rxCount > rxSize - xoffLim
|
||||
uint16_t xonLim; // Send XON when rxCount < xonLim
|
||||
|
||||
// Modem control line shadow (tracks EscapeCommFunction calls)
|
||||
uint8_t dtrState; // Nonzero = DTR is asserted
|
||||
uint8_t rtsState; // Nonzero = RTS is asserted (when not flow-controlled)
|
||||
// Modem control shadow
|
||||
uint8_t dtrState; // DTR line state
|
||||
uint8_t rtsState; // RTS line state (when not flow-controlled)
|
||||
|
||||
// Error accumulator (sticky CE_* bits, cleared by stacom/GetCommError)
|
||||
uint16_t errorFlags; // Accumulated CE_RXOVER, CE_OVERRUN, CE_FRAME, etc.
|
||||
// Error accumulator
|
||||
uint16_t errorFlags; // CE_* error flags (sticky until read)
|
||||
|
||||
// WM_COMMNOTIFY event notification (stored for API compat, not used)
|
||||
HWND hwndNotify; // Target window for PostMessage (0=disabled)
|
||||
// Event notification
|
||||
HWND hwndNotify; // Window for WM_COMMNOTIFY
|
||||
int16_t rxNotifyThresh; // CN_RECEIVE threshold (-1=disabled)
|
||||
int16_t txNotifyThresh; // CN_TRANSMIT threshold (-1=disabled)
|
||||
|
||||
// ISR chaining and PIC management
|
||||
void (FAR *prevIsr)(void); // Previous ISR vector (restored on unhook)
|
||||
uint8_t irqMask; // PIC mask bit for this IRQ (1 << irq)
|
||||
uint8_t breakState; // Nonzero while break signal is active on line
|
||||
// ISR state
|
||||
void (FAR *prevIsr)(void); // Previous ISR in chain
|
||||
uint8_t irqMask; // PIC mask bit for this IRQ
|
||||
uint8_t breakState; // Break signal active
|
||||
|
||||
// Priority transmit (XON/XOFF flow control characters)
|
||||
int16_t txImmediate; // -1=none, 0..255=char to send before buffered data
|
||||
// Priority transmit
|
||||
int16_t txImmediate; // -1=none, else char to send immediately
|
||||
|
||||
// Full DCB copy (returned by getdcb, updated by setcom)
|
||||
DCB dcb;
|
||||
// DCB copy for GetCommState
|
||||
DCB dcb; // Full DCB for GETDCB/SETCOM
|
||||
} PortStateT;
|
||||
|
||||
// -----------------------------------------------------------------------
|
||||
// Global port state array (one entry per COM port, indexed by commId)
|
||||
// Global port state array
|
||||
// -----------------------------------------------------------------------
|
||||
extern PortStateT ports[MAX_PORTS];
|
||||
|
||||
// ISR hit counter for diagnostics (incremented in isr4, wraps at 65535)
|
||||
// -----------------------------------------------------------------------
|
||||
// Dynamically resolved PostMessage (USER.EXE not loaded at boot)
|
||||
// -----------------------------------------------------------------------
|
||||
typedef BOOL (FAR PASCAL *PostMessageProcT)(HWND, UINT, WPARAM, LPARAM);
|
||||
extern PostMessageProcT pfnPostMessage;
|
||||
|
||||
// ISR hit counter for diagnostics
|
||||
extern volatile uint16_t isrHitCount;
|
||||
|
||||
// -----------------------------------------------------------------------
|
||||
|
|
|
|||
55
drv/isr.c
55
drv/isr.c
|
|
@ -10,6 +10,7 @@
|
|||
// Prototypes
|
||||
// -----------------------------------------------------------------------
|
||||
static void checkFlowRx(PortStateT *port);
|
||||
static void checkNotify(PortStateT *port);
|
||||
static void handleLsr(PortStateT *port, uint8_t lsr);
|
||||
static void handleMsr(PortStateT *port);
|
||||
static void handleRx(PortStateT *port, uint8_t lsr);
|
||||
|
|
@ -20,17 +21,11 @@ void _far _interrupt isr4(void);
|
|||
|
||||
// -----------------------------------------------------------------------
|
||||
// Saved previous ISR vectors for IRQ3 and IRQ4
|
||||
//
|
||||
// When we hook an IRQ via DPMI, the original vector is saved here so
|
||||
// unhookIsr can restore it. Only saved/restored on first-use/last-use
|
||||
// of each IRQ (ref-counted for shared IRQs like COM1+COM3).
|
||||
// -----------------------------------------------------------------------
|
||||
static void (_far _interrupt *prevIsr3)(void) = NULL; // Original IRQ3 vector
|
||||
static void (_far _interrupt *prevIsr4)(void) = NULL; // Original IRQ4 vector
|
||||
static void (_far _interrupt *prevIsr3)(void) = NULL;
|
||||
static void (_far _interrupt *prevIsr4)(void) = NULL;
|
||||
|
||||
// Reference counts: how many open ports share each IRQ.
|
||||
// hookIsr increments; unhookIsr decrements. Vector is only
|
||||
// installed/restored when the count transitions through 0.
|
||||
// Track how many ports are using each IRQ so we know when to unhook
|
||||
static int16_t irq3RefCount = 0;
|
||||
static int16_t irq4RefCount = 0;
|
||||
|
||||
|
|
@ -81,6 +76,46 @@ static void checkFlowRx(PortStateT *port)
|
|||
}
|
||||
|
||||
|
||||
// -----------------------------------------------------------------------
|
||||
// checkNotify - Post WM_COMMNOTIFY if threshold conditions met
|
||||
//
|
||||
// Called at end of ISR dispatch, outside the IIR loop.
|
||||
// Uses PostMessage to avoid reentrancy issues.
|
||||
// -----------------------------------------------------------------------
|
||||
static void checkNotify(PortStateT *port)
|
||||
{
|
||||
uint16_t notifyBits;
|
||||
|
||||
if (!port->hwndNotify) {
|
||||
return;
|
||||
}
|
||||
|
||||
notifyBits = 0;
|
||||
|
||||
// CN_RECEIVE: rxCount crossed threshold from below
|
||||
if (port->rxNotifyThresh >= 0 && port->rxCount >= (uint16_t)port->rxNotifyThresh) {
|
||||
notifyBits |= CN_RECEIVE;
|
||||
}
|
||||
|
||||
// CN_TRANSMIT: space available crossed threshold
|
||||
if (port->txNotifyThresh >= 0) {
|
||||
uint16_t txFree = port->txSize - port->txCount;
|
||||
if (txFree >= (uint16_t)port->txNotifyThresh) {
|
||||
notifyBits |= CN_TRANSMIT;
|
||||
}
|
||||
}
|
||||
|
||||
// CN_EVENT: any event bits accumulated
|
||||
if (port->comDeb.evtWord & port->comDeb.evtMask) {
|
||||
notifyBits |= CN_EVENT;
|
||||
}
|
||||
|
||||
if (notifyBits && pfnPostMessage) {
|
||||
pfnPostMessage(port->hwndNotify, WM_COMMNOTIFY, (WPARAM)port->commId, (LPARAM)notifyBits);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
// -----------------------------------------------------------------------
|
||||
// handleLsr - Process line status errors
|
||||
// -----------------------------------------------------------------------
|
||||
|
|
@ -396,6 +431,8 @@ void isrDispatch(PortStateT *port)
|
|||
port->comDeb.qOutCount = port->txCount;
|
||||
port->comDeb.qOutHead = port->txHead;
|
||||
port->comDeb.qOutTail = port->txTail;
|
||||
|
||||
checkNotify(port);
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue