OS/2 Shareware BBS: 10 Tools/10-Tools.zip/vp21beta.zip/ARTLSRC.RAR/WINCRT.PAS

Pascal/Delphi Source File | 2000-08-15 | 47KB | 1,831 lines

//█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█
//█                                                       █
//█      Virtual Pascal Runtime Library.  Version 2.1.    █
//█      OS/2 Presentation Manager CRT interface unit     █
//█      Win32 Windowed CRT interface unit                █
//█      DPMI32 simplified implementation                 █
//█      ─────────────────────────────────────────────────█
//█      Copyright (C) 1995-2000 vpascal.com              █
//█                                                       █
//▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
{$S-,R-,Q-,I-,Cdecl-,OrgName-,AlignRec-,Use32+,T-}

{$IFDEF DPMI32} {$DEFINE DPMI32_LINUX}{$ENDIF}
{$IFDEF Linux}  {$DEFINE DPMI32_LINUX}{$ENDIF}

unit WinCrt;

interface

uses
{$IFDEF OS2}
  Os2Def, Os2PmApi,
{$ENDIF OS2}
{$IFDEF WIN32}
  Windows,
{$ENDIF WIN32}
{$IFDEF DPMI32_LINUX}
  VpSysLow,
{$ENDIF DPMI32_LINUX}
  Strings, WinDos;

var
  WindowTitle: array[0..79] of Char;        { CRT window title }
  InactiveTitleBuf: array[0..79] of Char;   { CRT window inactive title }

{$IFDEF OS2}
const
  cw_UseDefault = Integer($8000);

const
  WindowOrg: PointL =                       { CRT window origin }
    (X: cw_UseDefault; Y: cw_UseDefault);
  WindowSize: PointL =                      { CRT window size }
    (X: cw_UseDefault; Y: cw_UseDefault);
  ScreenSize: PointL = (X: 80; Y: 25);      { Screen buffer dimensions }
  InactiveTitle: PChar = @InactiveTitleBuf; { Inactive window title }
  Cursor: PointL = (X: 0; Y: 0);            { Cursor location }
  Origin: PointL = (X: 0; Y: 0);            { Client area origin }
  FontId: ULong = 1;                        { Font Id }
  FontAttr: FAttrs = (                      { Font attributes }
    usRecordLength:  SizeOf(FAttrs);        { Size of the record }
    fsSelection:     0;                     { fattr_Sel_xxx }
    lMatch:          1;
    szFacename:      'System VIO';          { Fixed-pitch font }
    idRegistry:      0;
    usCodePage:      0;
    lMaxBaselineExt: 16;                    { Font Size: 16x8 }
    lAveCharWidth:   8;
    fsType:          0;                     { fattr_Type_xxx }
    fsFontUse:       0                      { fattr_FontUse_xxx }
  );
  CrtCreateFlags: ULong = fcf_TitleBar + fcf_SysMenu + fcf_SizeBorder +
    fcf_MinMax + fcf_TaskList + fcf_NoByteAlign + fcf_VertScroll + fcf_HorzScroll;
{$ENDIF OS2}
{$IFDEF WIN32}

const
  WindowOrg: TPoint =                       { CRT window origin }
    (X: cw_UseDefault; Y: cw_UseDefault);
  WindowSize: TPoint =                      { CRT window size }
    (X: cw_UseDefault; Y: cw_UseDefault);
  ScreenSize: TPoint = (X: 80; Y: 25);      { Screen buffer dimensions }
  Cursor: TPoint = (X: 0; Y: 0);            { Cursor location }
  Origin: TPoint = (X: 0; Y: 0);            { Client area origin }
  InactiveTitle: PChar = '(Inactive %s)';   { Inactive window title }

{$ENDIF WIN32}

{$IFDEF DPMI32_LINUX}
const                                       { $0700 = white on black }
  Wincrt_Cell:SmallWord=($1e00);            { $1e00 = yellow on blue }
{$ENDIF}

  AutoTracking: Boolean = True;             { Track cursor on Write? }
  CheckEOF: Boolean = False;                { Allow Ctrl-Z for EOF? }
  CheckBreak: Boolean = True;               { Allow Ctrl-C for break? }

procedure InitWinCrt;
procedure DoneWinCrt;

procedure WriteBuf(Buffer: PChar; Count: Word);
procedure WriteChar(Ch: Char);

function KeyPressed: Boolean;
function ReadKey: Char;
function ReadBuf(Buffer: PChar; Count: Word): Word;

procedure GotoXY(X, Y: Integer);
function WhereX: Integer;
function WhereY: Integer;
procedure ClrScr;
procedure ClrEol;

procedure CursorTo(X, Y: Integer);
procedure ScrollTo(X, Y: Integer);
procedure TrackCursor;

procedure AssignCrt(var F: Text);

{$IFDEF OS2}
{ CRT window procedures }

function CrtWinProc(Window: HWnd; Message: ULong; Mp1, Mp2: MParam): MResult; cdecl; export;
function FrameWndProc(Window: HWnd; Message: ULong; Mp1, Mp2: MParam): MResult; cdecl; export;

{$ENDIF}

implementation

{ Double word record }

type
  LongRec = record
    Lo, Hi: SmallInt;
  end;

{ Scroll key definition record }

type
  TScrollKey = record
    Key: Byte;
    Ctrl: Boolean;
    SBar: Byte;
    Action: Byte;
  end;

{ Return the smaller of two integer values }

function Min(X, Y: Integer): Integer;
begin
  if X < Y then Min := X else Min := Y;
end;

{ Return the larger of two integer values }

function Max(X, Y: Integer): Integer;
begin
  if X > Y then Max := X else Max := Y;
end;

{$IFDEF OS2}

const
  CrtWindow: HWnd = 0;                  { CRT window handle }
  CrtWindowFrame: HWnd = 0;             { CRT window frame handle }
  FirstLine: Integer = 0;               { First line in circular buffer }
  KeyCount: Integer = 0;                { Count of keys in KeyBuffer }
  Created: Boolean = False;             { CRT window created? }
  Focused: Boolean = False;             { CRT window focused? }
  Reading: Boolean = False;             { Reading from CRT window? }
  Painting: Boolean = False;            { Handling wm_Paint? }

var
  SaveExit: Pointer;                    { Saved exit procedure pointer }
  ScreenBuffer: PChar;                  { Screen buffer pointer }
  ClientSize: PointL;                   { Client area dimensions }
  MaxWindowSize: PointL;                { Maximum window size }
  Range: PointL;                        { Scroll bar ranges }
  CharSize: PointL;                     { Character cell size }
  CharDescent: Integer;                 { Character descent }
  DC: HDC;                              { Global device context }
  KeyBuffer: array[0..63] of Char;      { Keyboard type-ahead buffer }
  Anchor: HAB;                          { PM anchor block }
  MsgQue: HMQ;                          { PM message queue }
  PS: HPS;                              { Presentation space handle }
  VScrollBar: HWnd;                     { Vertical scrollbar handle }
  HScrollBar: HWnd;                     { Horizontal scrollbar handle }
  PR: RectL;                            { Painting rectangle }
  cyClient: Integer;                    { Client window height }
  OldFrameWndProc: FnWp;                { Standard frame window procedure }
  DesktopSize: PointL;                  { Size of the PM Desktop }

const
  CrtClassName: PChar = 'VPWinCrt';

const
  sb_Top        = 8;    { PM does not have these ones }
  sb_Bottom     = 9;

{ Scroll keys table }

const
  ScrollKeyCount = 12;
  ScrollKeys: array[1..ScrollKeyCount] of TScrollKey = (
    (Key: vk_Left;     Ctrl: False; SBar: sbs_Horz; Action: sb_LineUp),
    (Key: vk_Right;    Ctrl: False; SBar: sbs_Horz; Action: sb_LineDown),
    (Key: vk_Left;     Ctrl: True;  SBar: sbs_Horz; Action: sb_PageUp),
    (Key: vk_Right;    Ctrl: True;  SBar: sbs_Horz; Action: sb_PageDown),
    (Key: vk_Home;     Ctrl: False; SBar: sbs_Horz; Action: sb_Top),
    (Key: vk_End;      Ctrl: False; SBar: sbs_Horz; Action: sb_Bottom),
    (Key: vk_Up;       Ctrl: False; SBar: sbs_Vert; Action: sb_LineUp),
    (Key: vk_Down;     Ctrl: False; SBar: sbs_Vert; Action: sb_LineDown),
    (Key: vk_PageUp;   Ctrl: False; SBar: sbs_Vert; Action: sb_PageUp),
    (Key: vk_PageDown; Ctrl: False; SBar: sbs_Vert; Action: sb_PageDown),
    (Key: vk_Home;     Ctrl: True;  SBar: sbs_Vert; Action: sb_Top),
    (Key: vk_End;      Ctrl: True;  SBar: sbs_Vert; Action: sb_Bottom));

{ Allocate presentation space }

procedure InitPresentationSpace;
begin
  if Painting then
    PS := WinBeginPaint(CrtWindow, hNULL, @PR) else
    PS := WinGetPS(CrtWindow);
  GpiCreateLogFont(PS, nil, FontId, FontAttr);
  GpiSetCharSet(PS, FontId);
  GpiSetBackMix(PS, bm_OverPaint);
  GpiSetColor(PS, clr_Default);
  GpiSetBackColor(PS, clr_Background);
end;

{ Release presentation space }

procedure DonePresentationSpace;
begin
  GpiSetCharSet(PS, lcid_Default);
  if Painting then
    WinEndPaint(PS) else
    WinReleasePS(PS);
end;

{ Calculates window parameters: character size and descent, }
{ maximum window size                                       }

procedure GetWindowParams;
var
  Metrics: FontMetrics;
begin
  InitPresentationSpace;
  GpiQueryFontMetrics(PS, SizeOf(Metrics), Metrics);
  CharSize.X := Metrics.lAveCharWidth;
  CharSize.Y := Metrics.lMaxAscender + Metrics.lMaxDescender;
  CharDescent := Metrics.lMaxDescender;
  MaxWindowSize.X := ScreenSize.X * CharSize.X +
    WinQuerySysValue(hwnd_Desktop, sv_CxVScroll) +
    2 * WinQuerySysValue(hwnd_Desktop, sv_CxSizeBorder);
  MaxWindowSize.Y := ScreenSize.Y * CharSize.Y +
    WinQuerySysValue(hwnd_Desktop, sv_CyHScroll) +
    WinQuerySysValue(hwnd_Desktop, sv_CyTitleBar) +
    2 * WinQuerySysValue(hwnd_Desktop, sv_CySizeBorder);
  DonePresentationSpace;
end;

{ Enables/Disables specified system menu item }

procedure EnableSysMenuItem(Item: ULong; Enable: Boolean);
var
  Value: ULong;
begin
  if Enable then Value := 0 else Value := mia_Disabled;
  WinSendMsg(WinWindowFromID(CrtWindowFrame, fid_SysMenu),
    mm_SetItemAttr, Item + 1 shl 16, mia_Disabled + Value shl 16);
end;

{ Show cursor }

procedure ShowCursor;
begin
  WinCreateCursor(CrtWindow,
    (Cursor.X - Origin.X) * CharSize.X,                { X }
    cyClient - (Cursor.Y - Origin.Y + 1) * CharSize.Y, { Y }
    CharSize.X, 2, cursor_Solid + cursor_Flash, nil);
  WinShowCursor(CrtWindow, True);
end;

{ Hide cursor }

procedure HideCursor;
begin
  WinDestroyCursor(CrtWindow);
end;

{ Update scroll bars }

procedure SetScrollBars;
var
  Swap: Swp;
begin
  WinQueryWindowPos(CrtWindow, Swap);
  WinSendMsg(HScrollBar, sbm_SetScrollBar, Origin.X, 0 + Max(1, Range.X) shl 16);
  WinSendMsg(VScrollBar, sbm_SetScrollBar, Origin.Y, 0 + Max(1, Range.Y) shl 16);
  WinSendMsg(HScrollBar, sbm_SetThumbSize, Swap.cX + (ScreenSize.X * CharSize.X) shl 16, 0);
  WinSendMsg(VScrollBar, sbm_SetThumbSize, Swap.cY + (ScreenSize.Y * CharSize.Y) shl 16, 0);
end;

{ Terminate CRT window }

procedure Terminate;
begin
  if Focused and Reading then HideCursor;
  Halt(255);
end;

{ Set cursor position }

procedure CursorTo(X, Y: Integer);
begin
  Cursor.X := Max(0, Min(X, ScreenSize.X - 1));
  Cursor.Y := Max(0, Min(Y, ScreenSize.Y - 1));
end;

{ Scroll window to given origin }

procedure ScrollTo(X, Y: Integer);
begin
  if Created then
  begin
    X := Max(0, Min(X, Range.X));
    Y := Max(0, Min(Y, Range.Y));
    if (X <> Origin.X) or (Y <> Origin.Y) then
    begin
      if X <> Origin.X then WinSendMsg(HScrollBar, sbm_SetPos, X, 0);
      if Y <> Origin.Y then WinSendMsg(VScrollBar, sbm_SetPos, Y, 0);
      WinScrollWindow(CrtWindow,
        (Origin.X - X) * CharSize.X,
        (Y - Origin.Y) * CharSize.Y, nil, nil, 0, nil, sw_InvalidateRgn);
      Origin.X := X;
      Origin.Y := Y;
      WinUpdateWindow(CrtWindow);
    end;
  end;
end;

{ Scroll to make cursor visible }

procedure TrackCursor;
begin
  ScrollTo(Max(Cursor.X - ClientSize.X + 1, Min(Origin.X, Cursor.X)),
    Max(Cursor.Y - ClientSize.Y + 1, Min(Origin.Y, Cursor.Y)));
end;

{ Return pointer to location in screen buffer }

function ScreenPtr(X, Y: Integer): PChar;
begin
  Inc(Y, FirstLine);
  if Y >= ScreenSize.Y then Dec(Y, ScreenSize.Y);
  ScreenPtr := @ScreenBuffer[Y * ScreenSize.X + X];
end;

{ Update text on cursor line }

procedure ShowText(L, R: Integer);
var
  P: PointL;
begin
  if L < R then
  begin
    InitPresentationSpace;
    P.X := (L - Origin.X) * CharSize.X;
    P.Y := cyClient - (Cursor.Y - Origin.Y + 1) * CharSize.Y + CharDescent;
    GpiCharStringAt(PS, P, R - L, ScreenPtr(L, Cursor.Y));
    DonePresentationSpace;
  end;
end;

{ Write text buffer to CRT window }

procedure WriteBuf(Buffer: PChar; Count: Word);
var
  L, R: Integer;

procedure NewLine;
begin
  ShowText(L, R);
  L := 0;
  R := 0;
  Cursor.X := 0;
  Inc(Cursor.Y);
  if Cursor.Y = ScreenSize.Y then
  begin
    Dec(Cursor.Y);
    Inc(FirstLine);
    if FirstLine = ScreenSize.Y then FirstLine := 0;
    FillChar(ScreenPtr(0, Cursor.Y)^, ScreenSize.X, ' ');
    WinScrollWindow(CrtWindow, 0, CharSize.Y, nil, nil, 0, nil, sw_InvalidateRgn);
    WinUpdateWindow(CrtWindow);
  end;
end;

begin
  InitWinCrt;
  L := Cursor.X;
  R := Cursor.X;
  while Count > 0 do
  begin
    case Buffer^ of
      #32..#255:
        begin
          ScreenPtr(Cursor.X, Cursor.Y)^ := Buffer^;
          Inc(Cursor.X);
          if Cursor.X > R then R := Cursor.X;
          if Cursor.X = ScreenSize.X then NewLine;
        end;
      #13:
        NewLine;
      #9:
        Cursor.X := (Cursor.X div 8)*8 + 8;
      #8:
        if Cursor.X > 0 then
        begin
          Dec(Cursor.X);
          ScreenPtr(Cursor.X, Cursor.Y)^ := ' ';
          if Cursor.X < L then L := Cursor.X;
        end;
      #7:
        WinAlarm(hwnd_Desktop, wa_Note);
    end;
    Inc(Buffer);
    Dec(Count);
  end;
  ShowText(L, R);
  if AutoTracking then TrackCursor;
end;

{ Write character to CRT window }

procedure WriteChar(Ch: Char);
begin
  WriteBuf(@Ch, 1);
end;

{ Return keyboard status }

function KeyPressed: Boolean;
var
  M: QMsg;
begin
  InitWinCrt;
  while WinPeekMsg(Anchor, M, 0, 0, 0, pm_Remove) do
  begin
    if M.Msg = wm_Quit then Terminate;
    WinDispatchMsg(Anchor, M);
  end;
  KeyPressed := KeyCount > 0;
end;

{ Read key from CRT window }

function ReadKey: Char;
begin
  TrackCursor;
  if not KeyPressed then
  begin
    Reading := True;
    if Focused then ShowCursor;
    repeat WinWaitMsg(Anchor, 0, 0) until KeyPressed;
    if Focused then HideCursor;
    Reading := False;
  end;
  ReadKey := KeyBuffer[0];
  Dec(KeyCount);
  Move(KeyBuffer[1], KeyBuffer[0], KeyCount);
end;

{ Read text buffer from CRT window }

function ReadBuf(Buffer: PChar; Count: Word): Word;
var
  Ch: Char;
  I: Word;
begin
  I := 0;
  repeat
    Ch := ReadKey;
    case Ch of
      #8:
        if I > 0 then
        begin
          Dec(I);
          WriteChar(#8);
        end;
      #32..#255:
        if I < Count - 2 then
        begin
          Buffer[I] := Ch;
          Inc(I);
          WriteChar(Ch);
        end;
    end;
  until (Ch = #13) or (CheckEOF and (Ch = #26));
  Buffer[I] := Ch;
  Inc(I);
  if Ch = #13 then
  begin
    Buffer[I] := #10;
    Inc(I);
    WriteChar(#13);
  end;
  TrackCursor;
  ReadBuf := I;
end;

{ Set cursor position }

procedure GotoXY(X, Y: Integer);
begin
  CursorTo(X - 1, Y - 1);
end;

{ Return cursor X position }

function WhereX: Integer;
begin
  WhereX := Cursor.X + 1;
end;

{ Return cursor Y position }

function WhereY: Integer;
begin
  WhereY := Cursor.Y + 1;
end;

{ Clear screen }

procedure ClrScr;
begin
  InitWinCrt;
  FillChar(ScreenBuffer^, ScreenSize.X * ScreenSize.Y, ' ');
  Cursor.X := 0; Cursor.Y := 0;
  Origin.X := 0; Origin.Y := 0;
  SetScrollBars;
  WinInvalidateRect(CrtWindow, nil, False);
  WinUpdateWindow(CrtWindow);
end;

{ Clear to end of line }

procedure ClrEol;
begin
  InitWinCrt;
  FillChar(ScreenPtr(Cursor.X, Cursor.Y)^, ScreenSize.X - Cursor.X, ' ');
  ShowText(Cursor.X, ScreenSize.X);
end;

{ wm_Create message handler }

procedure WindowCreate;
begin
  Created := True;
  CrtWindowFrame := WinQueryWindow(CrtWindow, qw_Parent);
  GetMem(ScreenBuffer, ScreenSize.X * ScreenSize.Y);
  FillChar(ScreenBuffer^, ScreenSize.X * ScreenSize.Y, ' ');
  if not CheckBreak then EnableSysMenuItem(sc_Close, False);
  VScrollBar := WinWindowFromID(CrtWindowFrame, fid_VertScroll);
  HScrollBar := WinWindowFromID(CrtWindowFrame, fid_HorzScroll);
  GetWindowParams;
end;

{ wm_Paint message handler }

procedure WindowPaint;
var
  X1, X2, Y1, Y2: Integer;
  P: PointL;
  R: RectL;
begin
  Painting := True;
  InitPresentationSpace;
  X1 := Max(0, PR.xLeft div CharSize.X + Origin.X);
  X2 := Min(ScreenSize.X,
    (PR.xRight + CharSize.X - 1) div CharSize.X + Origin.X);
  Y1 := Max(0, (cyClient - PR.yTop) div CharSize.Y + Origin.Y);
  Y2 := Min(ScreenSize.Y,
    (cyClient - PR.yBottom + CharSize.Y - 1) div CharSize.Y + Origin.Y);
  while Y1 < Y2 do
  begin
    P.X := (X1 - Origin.X) * CharSize.X;
    P.Y := cyClient - (Y1 - Origin.Y + 1) * CharSize.Y + CharDescent;
    GpiCharStringAt(PS, P, X2 - X1, ScreenPtr(X1, Y1));
    Inc(Y1);
  end;
  R := PR;
  R.yTop := P.Y - CharDescent;
  if R.yTop > R.yBottom then WinFillRect(PS, R, clr_Background);
  R := PR;
  R.xLeft := (X2 - Origin.X) * CharSize.X;
  if R.xLeft < R.xRight then WinFillRect(PS, R, clr_Background);
  DonePresentationSpace;
  Painting := False;
end;

{ wm_VScroll and wm_HScroll message handler }

procedure WindowScroll(Which, Action, Thumb: Integer);
var
  X, Y: Integer;

function GetNewPos(Pos, Page, Range: Integer): Integer;
begin
  case Action of
    sb_LineUp: GetNewPos := Pos - 1;
    sb_LineDown: GetNewPos := Pos + 1;
    sb_PageUp: GetNewPos := Pos - Page;
    sb_PageDown: GetNewPos := Pos + Page;
    sb_SliderPosition: GetNewPos := Thumb;
    sb_Top: GetNewPos := 0;
    sb_Bottom: GetNewPos := Range;
  else
    GetNewPos := Pos;
  end;
end;

begin
  X := Origin.X;
  Y := Origin.Y;
  case Which of
    sbs_Horz: X := GetNewPos(X, ClientSize.X div 2, Range.X);
    sbs_Vert: Y := GetNewPos(Y, ClientSize.Y, Range.Y);
  end;
  ScrollTo(X, Y);
end;

{ wm_Size message handler }

procedure WindowResize(X, Y: Integer);
begin
  if Focused and Reading then HideCursor;
  cyClient := Y;
  ClientSize.X := X div CharSize.X;
  ClientSize.Y := Y div CharSize.Y;
  Range.X := Max(0, ScreenSize.X - ClientSize.X);
  Range.Y := Max(0, ScreenSize.Y - ClientSize.Y);
  Origin.X := Min(Origin.X, Range.X);
  Origin.Y := Min(Origin.Y, Range.Y);
  SetScrollBars;
  if Focused and Reading then ShowCursor;
end;

{ wm_Char message handler when characters are entered }

procedure WindowChar(Ch: Char);
begin
  if KeyCount < SizeOf(KeyBuffer) then
  begin
    KeyBuffer[KeyCount] := Ch;
    Inc(KeyCount);
  end;
end;

{ wm_Char message handler when non-character keys are pressed }

procedure WindowKeyDown(KeyDown: Word; CtrlDown: Boolean);
var
  I: Integer;
begin
  for I := 1 to ScrollKeyCount do
    with ScrollKeys[I] do
      if (Key = KeyDown) and (Ctrl = CtrlDown) then
      begin
        WindowScroll(SBar, Action, 0);
        Exit;
      end;
end;

{ wm_SetFocus message handler }

procedure WindowSetFocus(AFocused: Boolean);
begin
  Focused := AFocused;
  if Reading then
    if AFocused then ShowCursor else HideCursor;
end;

{ wm_Close message handler }

procedure WindowClose;
begin
  FreeMem(ScreenBuffer, ScreenSize.X * ScreenSize.Y);
  Cursor.X := 0; Cursor.Y := 0;
  Origin.X := 0; Origin.Y := 0;
  WinPostMsg(CrtWindow, wm_Quit, 0, 0);
  Created := False;
end;

{ CRT window procedure }

function CrtWinProc(Window: HWnd; Message: ULong; Mp1, Mp2: MParam): MResult;
begin
  CrtWinProc := 0;
  CrtWindow := Window;
  case Message of
    wm_Create: WindowCreate;
    wm_Paint: WindowPaint;
    wm_VScroll: WindowScroll(sbs_Vert, LongRec(Mp2).Hi, LongRec(Mp2).Lo);
    wm_HScroll: WindowScroll(sbs_Horz, LongRec(Mp2).Hi, LongRec(Mp2).Lo);
    wm_Size: WindowResize(LongRec(Mp2).Lo, LongRec(Mp2).Hi);
    wm_Char:
      if (CharMsgMp1(Mp1).fs and kc_KeyUp) = 0 then
      begin                                                     { Key is down }
        if CheckBreak then                                      { Break enabled }
          if (CharMsgMp2(Mp2).VKey = vk_Break) or               { Ctrl-Break }
            (((CharMsgMp1(Mp1).fs and kc_Ctrl) <> 0) and
             ((CharMsgMp2(Mp2).Chr = Ord('C')) or               { Ctrl-C }
              (CharMsgMp2(Mp2).Chr = Ord('c')))) then Terminate;{ Ctrl-c }
        if (CharMsgMp2(Mp2).Chr > 0) and (CharMsgMp2(Mp2).Chr <= 255) and
          ((CharMsgMp1(Mp1).fs and (kc_Ctrl + kc_Alt)) = 0)
          then WindowChar(Chr(CharMsgMp2(Mp2).Chr))
          else WindowKeyDown(CharMsgMp2(Mp2).VKey, (CharMsgMp1(Mp1).fs and kc_Ctrl) <> 0);
      end;
    wm_SetFocus: WindowSetFocus(LongRec(Mp2).Lo <> 0);
    wm_Close: WindowClose;
  else
    CrtWinProc := WinDefWindowProc(Window, Message, Mp1, Mp2);
  end;
end;

{ CRT window frame procedure }

function FrameWndProc(Window: HWnd; Message: ULong; Mp1, Mp2: MParam): MResult;
begin
  FrameWndProc := OldFrameWndProc(Window, Message, Mp1, Mp2);
  case Message of
    wm_AdjustWindowPos:
      with PSwp(Mp1)^ do
      if (Fl and swp_Size) <> 0 then
      begin
        cX := Min(cX, MaxWindowSize.X);
        cY := Min(cy, MaxWindowSize.Y);
        if (Fl and swp_Maximize) <> 0 then
        begin
          X := (DesktopSize.X - cX) div 2;
          Y := (DesktopSize.Y - cY) div 2;
        end;
      end;
    wm_QueryTrackInfo:
      with PTrackInfo(Mp2)^ do
      begin
        ptlMaxTrackSize.X := MaxWindowSize.X;
        ptlMaxTrackSize.Y := MaxWindowSize.Y;
      end;
  end;
end;

{ Text file device driver output function }

function CrtOutput(var F: TTextRec): Integer; far;
begin
  if F.BufPos <> 0 then
  begin
    WriteBuf(PChar(F.BufPtr), F.BufPos);
    F.BufPos := 0;
    KeyPressed;
  end;
  CrtOutput := 0;
end;

{ Text file device driver input function }

function CrtInput(var F: TTextRec): Integer; far;
begin
  F.BufEnd := ReadBuf(PChar(F.BufPtr), F.BufSize);
  F.BufPos := 0;
  CrtInput := 0;
end;

{ Text file device driver close function }

function CrtClose(var F: TTextRec): Integer; far;
begin
  CrtClose := 0;
end;

{ Text file device driver open function }

function CrtOpen(var F: TTextRec): Integer; far;
begin
  if F.Mode = fmInput then
  begin
    F.InOutFunc := @CrtInput;
    F.FlushFunc := nil;
  end else
  begin
    F.Mode := fmOutput;
    F.InOutFunc := @CrtOutput;
    F.FlushFunc := @CrtOutput;
  end;
  F.CloseFunc := @CrtClose;
  CrtOpen := 0;
end;

{ Assign text file to CRT device }

procedure AssignCrt(var F: Text);
begin
  with TTextRec(F) do
  begin
    Handle := $FFFFFFFF;
    Mode := fmClosed;
    BufSize := SizeOf(Buffer);
    BufPtr := @Buffer;
    OpenFunc := @CrtOpen;
    Name[0] := #0;
  end;
end;

{ Create CRT window if required }

procedure InitWinCrt;
var
  InitSize: PointL;
begin
  if not Created then
  begin
    DesktopSize.X := WinQuerySysValue(hwnd_Desktop, sv_CxScreen);
    DesktopSize.Y := WinQuerySysValue(hwnd_Desktop, sv_CyScreen);
    CrtWindowFrame := WinCreateStdWindow(hwnd_Desktop, 0, CrtCreateFlags,
      CrtClassName, WindowTitle, 0, 0, 0, @CrtWindow);
    InitSize.X := (DesktopSize.X * 3) div 4;
    InitSize.Y := (DesktopSize.Y * 3) div 4;
    if WindowSize.X = cw_UseDefault then WindowSize := InitSize;
    WindowSize.X := Min(MaxWindowSize.X, WindowSize.X);
    WindowSize.Y := Min(MaxWindowSize.Y, WindowSize.Y);
    if WindowOrg.X = cw_UseDefault then
    begin
      WindowOrg.X := (DesktopSize.X - WindowSize.X) div 2;
      WindowOrg.Y := (DesktopSize.Y - WindowSize.Y) div 2;
    end;
    WinSetWindowPos(
      CrtWindowFrame, hNULL,
      WindowOrg.X, WindowOrg.Y,
      WindowSize.X, WindowSize.Y,
      swp_Move + swp_Size + swp_Activate + swp_Show);
    Pointer(@OldFrameWndProc) := WinSubclassWindow(CrtWindowFrame, FrameWndProc);
  end;
end;

{ Destroy CRT window if required }

procedure DoneWinCrt;
begin
  if Created then
  begin
    WinDestroyWindow (Anchor);
    WinDestroyMsgQueue (MsgQue);
    WinTerminate (Anchor);
  end;
  Halt(0);
end;

{ WinCrt unit exit procedure }

procedure ExitWinCrt; far;
var
  Message: QMsg;
begin
  ExitProc := SaveExit;
  if Created and (ErrorAddr = nil) then
  begin
    WinSetWindowText(CrtWindowFrame, InactiveTitle);
    EnableSysMenuItem(sc_Close, True);
    CheckBreak := False;
    while WinGetMsg(Anchor, Message, 0, 0, 0) do WinDispatchMsg(Anchor, Message);
  end;
end;

begin
  Anchor := WinInitialize(0);
  MsgQue := WinCreateMsgQueue(Anchor, 0);
  if MsgQue = 0 then Halt(254);
  WinRegisterClass(Anchor, CrtClassName, CrtWinProc, cs_SizeRedraw, 0);
  AssignCrt(Input);
  Reset(Input);
  AssignCrt(Output);
  Rewrite(Output);
  GetArgStr(WindowTitle, 0, SizeOf(WindowTitle));
  StrPCopy(InactiveTitleBuf, '(Inactive ' + ParamStr(0) + ')');
  SaveExit := ExitProc;
  ExitProc := @ExitWinCrt;

{$ENDIF OS2}
{$IFDEF WIN32}
  // Win32 implementation

{ MinMaxInfo array }

type
  PMinMaxInfo = ^TMinMaxInfo;
  TMinMaxInfo = array[0..4] of TPoint;

{ CRT window procedure }

function CrtWinProc(Window: HWnd; Message, WParam: Word;
  LParam: Longint): Longint; stdcall; forward;

{ CRT window class }

const
  CrtClass: TWndClass = (
    style: cs_HRedraw + cs_VRedraw;
    lpfnWndProc: @CrtWinProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: nil;
    lpszClassName: 'TPWinCrt');

const
  CrtWindow: HWnd = 0;                  { CRT window handle }
  FirstLine: Integer = 0;               { First line in circular buffer }
  KeyCount: Integer = 0;                { Count of keys in KeyBuffer }
  Created: Boolean = False;             { CRT window created? }
  Focused: Boolean = False;             { CRT window focused? }
  Reading: Boolean = False;             { Reading from CRT window? }
  Painting: Boolean = False;            { Handling wm_Paint? }

var
  SaveExit: Pointer;                    { Saved exit procedure pointer }
  ScreenBuffer: PChar;                  { Screen buffer pointer }
  ClientSize: TPoint;                   { Client area dimensions }
  Range: TPoint;                        { Scroll bar ranges }
  CharSize: TPoint;                     { Character cell size }
  CharAscent: Integer;                  { Character ascent }
  DC: HDC;                              { Global device context }
  PS: TPaintStruct;                     { Global paint structure }
  SaveFont: HFont;                      { Saved device context font }
  KeyBuffer: array[0..63] of Char;      { Keyboard type-ahead buffer }

{ Scroll keys table }

const
  ScrollKeyCount = 12;
  ScrollKeys: array[1..ScrollKeyCount] of TScrollKey = (
    (Key: vk_Left;  Ctrl: False; SBar: sb_Horz; Action: sb_LineUp),
    (Key: vk_Right; Ctrl: False; SBar: sb_Horz; Action: sb_LineDown),
    (Key: vk_Left;  Ctrl: True;  SBar: sb_Horz; Action: sb_PageUp),
    (Key: vk_Right; Ctrl: True;  SBar: sb_Horz; Action: sb_PageDown),
    (Key: vk_Home;  Ctrl: False; SBar: sb_Horz; Action: sb_Top),
    (Key: vk_End;   Ctrl: False; SBar: sb_Horz; Action: sb_Bottom),
    (Key: vk_Up;    Ctrl: False; SBar: sb_Vert; Action: sb_LineUp),
    (Key: vk_Down;  Ctrl: False; SBar: sb_Vert; Action: sb_LineDown),
    (Key: vk_Prior; Ctrl: False; SBar: sb_Vert; Action: sb_PageUp),
    (Key: vk_Next;  Ctrl: False; SBar: sb_Vert; Action: sb_PageDown),
    (Key: vk_Home;  Ctrl: True;  SBar: sb_Vert; Action: sb_Top),
    (Key: vk_End;   Ctrl: True;  SBar: sb_Vert; Action: sb_Bottom));

{ Allocate device context }

procedure InitDeviceContext;
begin
  if Painting then
    DC := BeginPaint(CrtWindow, PS) else
    DC := GetDC(CrtWindow);
  SaveFont := SelectObject(DC, GetStockObject(System_Fixed_Font));
  SetTextColor(DC, GetSysColor(color_WindowText));
  SetBkColor(DC, GetSysColor(color_Window));
end;

{ Release device context }

procedure DoneDeviceContext;
begin
  SelectObject(DC, SaveFont);
  if Painting then
    EndPaint(CrtWindow, PS) else
    ReleaseDC(CrtWindow, DC);
end;

{ Show caret }

procedure ShowCursor;
begin
  CreateCaret(CrtWindow, 0, CharSize.X, 2);
  SetCaretPos((Cursor.X - Origin.X) * CharSize.X,
    (Cursor.Y - Origin.Y) * CharSize.Y + CharAscent);
  ShowCaret(CrtWindow);
end;

{ Hide caret }

procedure HideCursor;
begin
  DestroyCaret;
end;

{ Update scroll bars }

procedure SetScrollBars;
begin
  SetScrollRange(CrtWindow, sb_Horz, 0, Max(1, Range.X), False);
  SetScrollPos(CrtWindow, sb_Horz, Origin.X, True);
  SetScrollRange(CrtWindow, sb_Vert, 0, Max(1, Range.Y), False);
  SetScrollPos(CrtWindow, sb_Vert, Origin.Y, True);
end;

{ Terminate CRT window }

procedure Terminate;
begin
  if Focused and Reading then HideCursor;
  Halt(255);
end;

{ Set cursor position }

procedure CursorTo(X, Y: Integer);
begin
  Cursor.X := Max(0, Min(X, ScreenSize.X - 1));
  Cursor.Y := Max(0, Min(Y, ScreenSize.Y - 1));
end;

{ Scroll window to given origin }

procedure ScrollTo(X, Y: Integer);
begin
  if Created then
  begin
    X := Max(0, Min(X, Range.X));
    Y := Max(0, Min(Y, Range.Y));
    if (X <> Origin.X) or (Y <> Origin.Y) then
    begin
      if X <> Origin.X then SetScrollPos(CrtWindow, sb_Horz, X, True);
      if Y <> Origin.Y then SetScrollPos(CrtWindow, sb_Vert, Y, True);
      ScrollWindow(CrtWindow,
        (Origin.X - X) * CharSize.X,
        (Origin.Y - Y) * CharSize.Y, nil, nil);
      Origin.X := X;
      Origin.Y := Y;
      UpdateWindow(CrtWindow);
    end;
  end;
end;

{ Scroll to make cursor visible }

procedure TrackCursor;
begin
  ScrollTo(Max(Cursor.X - ClientSize.X + 1, Min(Origin.X, Cursor.X)),
    Max(Cursor.Y - ClientSize.Y + 1, Min(Origin.Y, Cursor.Y)));
end;

{ Return pointer to location in screen buffer }

function ScreenPtr(X, Y: Integer): PChar;
begin
  Inc(Y, FirstLine);
  if Y >= ScreenSize.Y then Dec(Y, ScreenSize.Y);
  ScreenPtr := @ScreenBuffer[Y * ScreenSize.X + X];
end;

{ Update text on cursor line }

procedure ShowText(L, R: Integer);
const
  z = 100;
const
  Tabs : Array[0..9] of Longint =
    ( 1*z, 2*z, 3*z, 4*z, 5*z, 6*z, 7*z, 8*z, 9*z, 10*z );
begin
  if L < R then
  begin
    InitDeviceContext;
    TabbedTextOut(DC, (L - Origin.X) * CharSize.X,
      (Cursor.Y - Origin.Y) * CharSize.Y,
      ScreenPtr(L, Cursor.Y), R - L,
      // Tab settings
      0, nil, 0);
    DoneDeviceContext;
  end;
end;

{ Write text buffer to CRT window }

procedure WriteBuf(Buffer: PChar; Count: Word);
var
  L, R: Integer;

procedure NewLine;
begin
  ShowText(L, R);
  L := 0;
  R := 0;
  Cursor.X := 0;
  Inc(Cursor.Y);
  if Cursor.Y = ScreenSize.Y then
  begin
    Dec(Cursor.Y);
    Inc(FirstLine);
    if FirstLine = ScreenSize.Y then FirstLine := 0;
    FillChar(ScreenPtr(0, Cursor.Y)^, ScreenSize.X, ' ');
    ScrollWindow(CrtWindow, 0, -CharSize.Y, nil, nil);
    UpdateWindow(CrtWindow);
  end;
end;

begin
  InitWinCrt;
  L := Cursor.X;
  R := Cursor.X;
  while Count > 0 do
  begin
    case Buffer^ of
      #32..#255:
        begin
          ScreenPtr(Cursor.X, Cursor.Y)^ := Buffer^;
          Inc(Cursor.X);
          if Cursor.X > R then R := Cursor.X;
          if Cursor.X = ScreenSize.X then NewLine;
        end;
      #13:
        NewLine;
      #8:
        if Cursor.X > 0 then
        begin
          Dec(Cursor.X);
          ScreenPtr(Cursor.X, Cursor.Y)^ := ' ';
          if Cursor.X < L then L := Cursor.X;
        end;
      #7:
        MessageBeep(0);
    end;
    Inc(Buffer);
    Dec(Count);
  end;
  ShowText(L, R);
  if AutoTracking then TrackCursor;
end;

{ Write character to CRT window }

procedure WriteChar(Ch: Char);
begin
  WriteBuf(@Ch, 1);
end;

{ Return keyboard status }

function KeyPressed: Boolean;
var
  M: TMsg;
begin
  InitWinCrt;
  while PeekMessage(M, 0, 0, 0, pm_Remove) do
  begin
    if M.Message = wm_Quit then Terminate;
    TranslateMessage(M);
    DispatchMessage(M);
  end;
  KeyPressed := KeyCount > 0;
end;

{ Read key from CRT window }

function ReadKey: Char;
begin
  TrackCursor;
  if not KeyPressed then
  begin
    Reading := True;
    if Focused then ShowCursor;
    repeat WaitMessage until KeyPressed;
    if Focused then HideCursor;
    Reading := False;
  end;
  ReadKey := KeyBuffer[0];
  Dec(KeyCount);
  Move(KeyBuffer[1], KeyBuffer[0], KeyCount);
end;

{ Read text buffer from CRT window }

function ReadBuf(Buffer: PChar; Count: Word): Word;
var
  Ch: Char;
  I: Word;
begin
  I := 0;
  repeat
    Ch := ReadKey;
    case Ch of
      #8:
        if I > 0 then
        begin
          Dec(I);
          WriteChar(#8);
        end;
      #32..#255:
        if I < Count - 2 then
        begin
          Buffer[I] := Ch;
          Inc(I);
          WriteChar(Ch);
        end;
    end;
  until (Ch = #13) or (CheckEOF and (Ch = #26));
  Buffer[I] := Ch;
  Inc(I);
  if Ch = #13 then
  begin
    Buffer[I] := #10;
    Inc(I);
    WriteChar(#13);
  end;
  TrackCursor;
  ReadBuf := I;
end;

{ Set cursor position }

procedure GotoXY(X, Y: Integer);
begin
  CursorTo(X - 1, Y - 1);
end;

{ Return cursor X position }

function WhereX: Integer;
begin
  WhereX := Cursor.X + 1;
end;

{ Return cursor Y position }

function WhereY: Integer;
begin
  WhereY := Cursor.Y + 1;
end;

{ Clear screen }

procedure ClrScr;
begin
  InitWinCrt;
  FillChar(ScreenBuffer^, ScreenSize.X * ScreenSize.Y, ' ');
  Cursor.X := 0;
  Cursor.Y := 0;
  Origin.X := 0;
  Origin.Y := 0;
  SetScrollBars;
  InvalidateRect(CrtWindow, nil, True);
  UpdateWindow(CrtWindow);
end;

{ Clear to end of line }

procedure ClrEol;
begin
  InitWinCrt;
  FillChar(ScreenPtr(Cursor.X, Cursor.Y)^, ScreenSize.X - Cursor.X, ' ');
  ShowText(Cursor.X, ScreenSize.X);
end;

{ wm_Create message handler }

procedure WindowCreate;
begin
  Created := True;
  GetMem(ScreenBuffer, ScreenSize.X * ScreenSize.Y);
  FillChar(ScreenBuffer^, ScreenSize.X * ScreenSize.Y, ' ');
  if not CheckBreak then
    EnableMenuItem(GetSystemMenu(CrtWindow, False), sc_Close,
      mf_Disabled + mf_Grayed);
end;

{ wm_Paint message handler }

procedure WindowPaint;
var
  X1, X2, Y1, Y2: Integer;
begin
  Painting := True;
  InitDeviceContext;
  X1 := Max(0, PS.rcPaint.left div CharSize.X + Origin.X);
  X2 := Min(ScreenSize.X,
    (PS.rcPaint.right + CharSize.X - 1) div CharSize.X + Origin.X);
  Y1 := Max(0, PS.rcPaint.top div CharSize.Y + Origin.Y);
  Y2 := Min(ScreenSize.Y,
    (PS.rcPaint.bottom + CharSize.Y - 1) div CharSize.Y + Origin.Y);
  while Y1 < Y2 do
  begin
    TextOut(DC, (X1 - Origin.X) * CharSize.X, (Y1 - Origin.Y) * CharSize.Y,
      ScreenPtr(X1, Y1), X2 - X1);
    Inc(Y1);
  end;
  DoneDeviceContext;
  Painting := False;
end;

{ wm_VScroll and wm_HScroll message handler }

procedure WindowScroll(Which, Action, Thumb: Integer);
var
  X, Y: Integer;

function GetNewPos(Pos, Page, Range: Integer): Integer;
begin
  case Action of
    sb_LineUp: GetNewPos := Pos - 1;
    sb_LineDown: GetNewPos := Pos + 1;
    sb_PageUp: GetNewPos := Pos - Page;
    sb_PageDown: GetNewPos := Pos + Page;
    sb_Top: GetNewPos := 0;
    sb_Bottom: GetNewPos := Range;
    sb_ThumbPosition: GetNewPos := Thumb;
  else
    GetNewPos := Pos;
  end;
end;

begin
  X := Origin.X;
  Y := Origin.Y;
  case Which of
    sb_Horz: X := GetNewPos(X, ClientSize.X div 2, Range.X);
    sb_Vert: Y := GetNewPos(Y, ClientSize.Y, Range.Y);
  end;
  ScrollTo(X, Y);
end;

{ wm_Size message handler }

procedure WindowResize(X, Y: Integer);
begin
  if Focused and Reading then HideCursor;
  ClientSize.X := X div CharSize.X;
  ClientSize.Y := Y div CharSize.Y;
  Range.X := Max(0, ScreenSize.X - ClientSize.X);
  Range.Y := Max(0, ScreenSize.Y - ClientSize.Y);
  Origin.X := Min(Origin.X, Range.X);
  Origin.Y := Min(Origin.Y, Range.Y);
  SetScrollBars;
  if Focused and Reading then ShowCursor;
end;

{ wm_GetMinMaxInfo message handler }

procedure WindowMinMaxInfo(MinMaxInfo: PMinMaxInfo);
var
  X, Y: Integer;
  Metrics: TTextMetric;
begin
  InitDeviceContext;
  GetTextMetrics(DC, Metrics);
  CharSize.X := Metrics.tmMaxCharWidth;
  CharSize.Y := Metrics.tmHeight + Metrics.tmExternalLeading;
  CharAscent := Metrics.tmAscent;
  X := Min(ScreenSize.X * CharSize.X + GetSystemMetrics(sm_CXVScroll),
    GetSystemMetrics(sm_CXScreen)) + GetSystemMetrics(sm_CXFrame) * 2;
  Y := Min(ScreenSize.Y * CharSize.Y + GetSystemMetrics(sm_CYHScroll) +
    GetSystemMetrics(sm_CYCaption), GetSystemMetrics(sm_CYScreen)) +
    GetSystemMetrics(sm_CYFrame) * 2;
  MinMaxInfo^[1].x := X;
  MinMaxInfo^[1].y := Y;
  MinMaxInfo^[3].x := CharSize.X * 16 + GetSystemMetrics(sm_CXVScroll) +
    GetSystemMetrics(sm_CXFrame) * 2;
  MinMaxInfo^[3].y := CharSize.Y * 4 + GetSystemMetrics(sm_CYHScroll) +
    GetSystemMetrics(sm_CYFrame) * 2 + GetSystemMetrics(sm_CYCaption);
  MinMaxInfo^[4].x := X;
  MinMaxInfo^[4].y := Y;
  DoneDeviceContext;
end;

{ wm_Char message handler }

procedure WindowChar(Ch: Char);
begin
  if CheckBreak and (Ch = #3) then Terminate;
  if KeyCount < SizeOf(KeyBuffer) then
  begin
    KeyBuffer[KeyCount] := Ch;
    Inc(KeyCount);
  end;
end;

{ wm_KeyDown message handler }

procedure WindowKeyDown(KeyDown: Byte);
var
  CtrlDown: Boolean;
  I: Integer;
begin
  if CheckBreak and (KeyDown = vk_Cancel) then Terminate;
  CtrlDown := GetKeyState(vk_Control) < 0;
  for I := 1 to ScrollKeyCount do
    with ScrollKeys[I] do
      if (Key = KeyDown) and (Ctrl = CtrlDown) then
      begin
        WindowScroll(SBar, Action, 0);
        Exit;
      end;
end;

{ wm_SetFocus message handler }

procedure WindowSetFocus;
begin
  Focused := True;
  if Reading then ShowCursor;
end;

{ wm_KillFocus message handler }

procedure WindowKillFocus;
begin
  if Reading then HideCursor;
  Focused := False;
end;

{ wm_Destroy message handler }

procedure WindowDestroy;
begin
  FreeMem(ScreenBuffer, ScreenSize.X * ScreenSize.Y);
  Cursor.X := 0;
  Cursor.Y := 0;
  Origin.X := 0;
  Origin.Y := 0;
  PostQuitMessage(0);
  Created := False;
end;

{ CRT window procedure }

function CrtWinProc(Window: HWnd; Message, WParam: Word;
  LParam: Longint): Longint;
begin
  CrtWinProc := 0;
  CrtWindow := Window;
  case Message of
    wm_Create: WindowCreate;
    wm_Paint: WindowPaint;
    wm_VScroll: WindowScroll(sb_Vert, WParam, LongRec(LParam).Lo);
    wm_HScroll: WindowScroll(sb_Horz, WParam, LongRec(LParam).Lo);
    wm_Size: WindowResize( LongRec(LParam).Lo, LongRec(LParam).Hi);
    wm_GetMinMaxInfo: WindowMinMaxInfo(PMinMaxInfo(LParam));
    wm_Char: WindowChar(Char(WParam));
    wm_KeyDown: WindowKeyDown(Byte(WParam));
    wm_SetFocus: WindowSetFocus;
    wm_KillFocus: WindowKillFocus;
    wm_Destroy: WindowDestroy;
  else
    CrtWinProc := DefWindowProc(Window, Message, WParam, LParam);
  end;
end;

{ Text file device driver output function }

function CrtOutput(var F: TTextRec): Integer; far;
begin
  if F.BufPos <> 0 then
  begin
    WriteBuf(PChar(F.BufPtr), F.BufPos);
    F.BufPos := 0;
    KeyPressed;
  end;
  CrtOutput := 0;
end;

{ Text file device driver input function }

function CrtInput(var F: TTextRec): Integer; far;
begin
  F.BufEnd := ReadBuf(PChar(F.BufPtr), F.BufSize);
  F.BufPos := 0;
  CrtInput := 0;
end;

{ Text file device driver close function }

function CrtClose(var F: TTextRec): Integer; far;
begin
  CrtClose := 0;
end;

{ Text file device driver open function }

function CrtOpen(var F: TTextRec): Integer; far;
begin
  if F.Mode = fmInput then
  begin
    F.InOutFunc := @CrtInput;
    F.FlushFunc := nil;
  end else
  begin
    F.Mode := fmOutput;
    F.InOutFunc := @CrtOutput;
    F.FlushFunc := @CrtOutput;
  end;
  F.CloseFunc := @CrtClose;
  CrtOpen := 0;
end;

{ Assign text file to CRT device }

procedure AssignCrt(var F: Text);
begin
  with TTextRec(F) do
  begin
    Handle := $FFFF;
    Mode := fmClosed;
    BufSize := SizeOf(Buffer);
    BufPtr := @Buffer;
    OpenFunc := @CrtOpen;
    Name[0] := #0;
  end;
end;

{ Create CRT window if required }

procedure InitWinCrt;
begin
  if not Created then
  begin
    CrtWindow := CreateWindow(
      CrtClass.lpszClassName,
      WindowTitle,
      ws_OverlappedWindow + ws_HScroll + ws_VScroll,
      WindowOrg.X, WindowOrg.Y,
      WindowSize.X, WindowSize.Y,
      0,
      0,
      HInstance,
      nil);
    ShowWindow(CrtWindow, CmdShow);
    UpdateWindow(CrtWindow);
  end;
end;

{ Destroy CRT window if required }

procedure DoneWinCrt;
begin
  if Created then DestroyWindow(CrtWindow);
  Halt(0);
end;

{ WinCrt unit exit procedure }

procedure ExitWinCrt; far;
var
  P: PChar;
  Message: TMsg;
  Title: array[0..127] of Char;
begin
  ExitProc := SaveExit;
  if Created and (ErrorAddr = nil) then
  begin
    P := WindowTitle;
    WVSPrintF(Title, InactiveTitle, P);
    SetWindowText(CrtWindow, Title);
    EnableMenuItem(GetSystemMenu(CrtWindow, False), sc_Close, mf_Enabled);
    CheckBreak := False;
    while GetMessage(Message, 0, 0, 0) do
    begin
      TranslateMessage(Message);
      DispatchMessage(Message);
    end;
  end;
end;

begin
  if HPrevInst = 0 then
  begin
    CrtClass.hInstance := HInstance;
    CrtClass.hIcon := LoadIcon(0, idi_Application);
    CrtClass.hCursor := LoadCursor(0, idc_Arrow);
    CrtClass.hbrBackground := color_Window + 1;
    RegisterClass(CrtClass);
  end;
  AssignCrt(Input);
  Reset(Input);
  AssignCrt(Output);
  Rewrite(Output);
  GetModuleFileName(HInstance, WindowTitle, SizeOf(WindowTitle));
  OemToAnsi(WindowTitle, WindowTitle);
  SaveExit := ExitProc;
  ExitProc := @ExitWinCrt;
{$ENDIF WIN32}

{$IFDEF DPMI32_LINUX}

procedure InitWinCrt;
  begin
  end;

procedure DoneWinCrt;
  begin
  end;

procedure WriteBuf(Buffer: PChar; Count: Word);
  const
    clear_char  :char=' ';
  var
    MaxX,MaxY,f :word;
    x,y,t       :smallword;

procedure NewLine;
  begin
    x:=0;
    if y+1>=MaxY then
      SysScrollUp(0,0,MaxX-1,MaxY-1,1,WinCrt_Cell)
    else
      Inc(y);
  end;

begin
  SysGetVideoModeInfo(MaxX,MaxY,f);
  SysGetCurPos(x,y);
  while Count > 0 do
    begin
      case Buffer^ of
        #32..#255:
          begin
            SysWrtCharStrAtt(Buffer,1,x,y,Mem[Ofs(WinCrt_Cell)+1]);
            Inc(x);
            if x>=MaxX then
              Newline;
          end;
      #13:
        NewLine;
      #9:
        begin
          T:=x;
          repeat
            SysWrtCharStrAtt(@clear_char,1,x,y,Mem[Ofs(WinCrt_Cell)+1]);
            Inc(x);
            if x>=MaxX then
              Newline;
            Inc(T);
          until (T mod 8)=0;
        end;
      #8:
        if x>0 then
          begin
            Dec(x);
            SysWrtCharStrAtt(Addr(clear_char),1,x,y,Mem[Ofs(WinCrt_Cell)+1]);
          end;
      #7:
        SysBeep;
      end;

      Inc(Buffer);
      Dec(Count);
    end;

  SysTVSetCurPos(x,y);
end;

procedure WriteChar(Ch: Char);
  begin
    WriteBuf(@Ch, 1);
  end;

function KeyPressed: Boolean;
  begin
    KeyPressed:=SysKeyPressed;
  end;

function ReadKey: Char;
  begin
    ReadKey:=SysReadKey;
  end;

function ReadBuf(Buffer: PChar; Count: Word): Word;
var
  Ch: Char;
  I: Word;
begin
  I := 0;
  repeat
    Ch := ReadKey;
    case Ch of
      #8:
        if I > 0 then
        begin
          Dec(I);
          WriteChar(#8);
        end;
      #32..#255:
        if I < Count - 2 then
        begin
          Buffer[I] := Ch;
          Inc(I);
          WriteChar(Ch);
        end;
    end;
  until (Ch = #13) or (CheckEOF and (Ch = #26));
  Buffer[I] := Ch;
  Inc(I);
  if Ch = #13 then
  begin
    Buffer[I] := #10;
    Inc(I);
    WriteChar(#13);
  end;
  TrackCursor;
  ReadBuf := I;
end;

procedure GotoXY(X, Y: Integer);
  begin
    CursorTo(X - 1, Y - 1);
  end;

function WhereX: Integer;
  var
    x,y         :smallword;
  begin
    SysGetCurPos(x,y);
    WhereX:=x+1;
  end;

function WhereY: Integer;
  var
    x,y         :smallword;
  begin
    SysGetCurPos(x,y);
    WhereY:=y+1;
  end;

procedure ClrScr;
  var
    MaxX,MaxY,f :word;
  begin
    SysGetVideoModeInfo(MaxX,MaxY,f);
    SysScrollUp(0,0,MaxX-1,MaxY-1,MaxY,WinCrt_Cell);
    CursorTo(0,0);
  end;

procedure ClrEol;
  var
    maxx,maxy,f :word;
    x,y         :smallword;
    fill        :array[0..132] of char;
  begin
    SysGetVideoModeInfo(MaxX,MaxY,f);
    SysGetCurPos(x,y);
    FillChar(fill,SizeOf(fill),0);
    SysWrtCharStrAtt(@fill,MaxX-x,x,y,Mem[Ofs(WinCrt_Cell)+1]);
  end;

procedure CursorTo(X, Y: Integer);
  begin
    SysTVSetCurPos(x,y);
  end;

procedure ScrollTo(X, Y: Integer);
  begin
    // not implemented
  end;

procedure TrackCursor;
  begin
  end;

function CrtOutput(var F: TTextRec): Integer; far;
begin
  if F.BufPos <> 0 then
  begin
    WriteBuf(PChar(F.BufPtr), F.BufPos);
    F.BufPos := 0;
    KeyPressed;
  end;
  CrtOutput := 0;
end;

{ Text file device driver input function }

function CrtInput(var F: TTextRec): Integer; far;
begin
  F.BufEnd := ReadBuf(PChar(F.BufPtr), F.BufSize);
  F.BufPos := 0;
  CrtInput := 0;
end;

{ Text file device driver close function }

function CrtClose(var F: TTextRec): Integer; far;
begin
  CrtClose := 0;
end;

{ Text file device driver open function }

function CrtOpen(var F: TTextRec): Integer; far;
begin
  if F.Mode = fmInput then
  begin
    F.InOutFunc := @CrtInput;
    F.FlushFunc := nil;
  end else
  begin
    F.Mode := fmOutput;
    F.InOutFunc := @CrtOutput;
    F.FlushFunc := @CrtOutput;
  end;
  F.CloseFunc := @CrtClose;
  CrtOpen := 0;
end;

{ Assign text file to CRT device }

procedure AssignCrt(var F: Text);
begin
  with TTextRec(F) do
  begin
    Handle := $FFFFFFFF;
    Mode := fmClosed;
    BufSize := SizeOf(Buffer);
    BufPtr := @Buffer;
    OpenFunc := @CrtOpen;
    Name[0] := #0;
  end;
end;


begin
  AssignCrt(Input);
  Reset(Input);
  AssignCrt(Output);
  Rewrite(Output);
{$ENDIF DPMI32_LINUX}


end.