Category : Pascal Source Code
Archive   : QWIK55.ZIP
Filename : QWIK55.PAS

{ =========================================================================== }
{ QWIK55.PAS - Unit for direct/virtual screen writing ver 5.5, 08-24-89 }
{ Copyright (c) 1986-1989 James H. LeMay, Eagle Performance Software }
{ For documentation on this file see QWIK55.DOC and QWIKREF.DOC. }
{ Only 46 bytes of global data is used. }
{ =========================================================================== }

{ R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ } { TP4 directives }
{$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-} { TP5 directives }

UNIT Qwik;

INTERFACE

var
VideoMode: byte absolute $0040:$0049; { Video mode: Mono=7, Color=0-3 }
VideoPage: byte absolute $0040:$0062; { Video page number }
EgaRows: byte absolute $0040:$0084; { Rows on screen (0-based) }
EgaFontSize: word absolute $0040:$0085; { Character cell height (1-based) }
EgaInfo: byte absolute $0040:$0087; { EGA info. See QWIKREF.DOC }
CRTcolumns: word absolute $0040:$004A; { Number of CRT columns (1-based) }

SystemID, { Equipment ID. See QWIKREF.DOC }
SubModelID, { Equipment ID. See QWIKREF.DOC }
CpuID, { Model number of Intel CPU }
QvideoMode: byte; { Video mode detected by QWIK }

{ Keep the following seven variables in order for save pointers. }
CRTrows, { Global variable of Rows/EgaRows (1-based!)}
CRTcols: byte; { Global variable of CRTcolumns (1-based) }
CRTsize: word; { Essentially size of CRT video buffer in bytes }
Qsnow: boolean; { Wait-for-retrace (snow) while QWIK writing }
QEosOfs, { End Of String offset after QWIK writing }
QScrOfs, { Screen offset for QWIK writing, normally = 0 }
QScrSeg: word; { Screen segment for QWIK writing }

QvideoPage, { Video page to which QWIK is writing }
MaxPage: byte; { Maximum possible page }
Page0seg: word; { Segment for page 0 for video card/buffer }
CardSeg: word; { Segment for page 0 for video card }
CardSnow, { Wait-for-retrace (snow) for video card }
HavePS2, { Using some type of IBM PS/2 equip }
Have3270: boolean; { Using IBM 3270 PC workstation hard/software }
EgaSwitches, { EGA card and monitor setup }
ActiveDispDev, { Active Display Device }
ActiveDispDev3270, { Active Display Device for IBM 3270 PC }
AltDispDev: byte; { Alternate Display Device }
AltDispDevPCC: word; { Alt Display Device for PC Convertible }
HercModel: byte; { Model of Hercules card. }
ScrollAttr: integer; { Attribute used to clear row in QEosLn }

type
VScrRecType =
record
Vrows, { Equivalent to CRTrows }
Vcols: byte; { Equivalent to CRTcols }
Vsize: word; { Equivalent to CRTsize }
Vsnow: boolean; { Equivalent to Qsnow }
VEosOfs: word; { Equivalent to QEosOfs }
VScrPtr: pointer; { Equivalent to QScrPtr }
end;

var
QScrRec: VScrRecType absolute CRTrows;
QScrPtr: pointer absolute QScrOfs;

const
{ Constants assigned by IBM: } { Arbitrarily assigned constants: }
NoDisplay = $00; VgaMono = $07; NoHerc = 0;
MdaMono = $01; VgaColor = $08; HgcMono = 1;
CgaColor = $02; DCC9 = $09; HgcPlus = 2;
DCC3 = $03; DCC10 = $0A; HercInColor = 3;
EgaColor = $04; McgaMono = $0B;
EgaMono = $05; McgaColor = $0C;
PgcColor = $06; Unknown = $FF;

Cpu8086 = $00; Cpu80286 = $02;
Cpu80186 = $01; Cpu80386 = $03;

{ The following duplicates the TP4 CRT unit text color constants which }
{ will automatically be used if the CRT unit is not used. }
Black = $00; DarkGray = $08;
Blue = $01; LightBlue = $09;
Green = $02; LightGreen = $0A;
Cyan = $03; LightCyan = $0B;
Red = $04; LightRed = $0C;
Magenta = $05; LightMagenta = $0D;
Brown = $06; Yellow = $0E;
LightGray = $07; White = $0F;
Blink = $80;

{ These are convenient background constants: }
BlackBG = $00; { Only needed for source code clarity. }
BlueBG = $10;
GreenBG = $20;
CyanBG = $30;
RedBG = $40;
MagentaBG = $50;
BrownBG = $60;
LightGrayBG = $70;
SameAttr = -1; { Suppresses attribute changes to the screen }

{ The following are constants used in SetCursor and ModCursor }
CursorOn = $0000; { Turns cursor on with same shape }
CursorOff = $2000; { Turns cursor off with same shape }
CursorBlink = $6000; { Creates erratic blinking for MDA/CGA }

InMultiTask: boolean = false; { True if SetMultiTask detects MT environ. }

var
{ These Cursor modes are set by Qinit as detected for the video card: }
CursorInitial, { Cursor detected at startup }
CursorUnderline, { Standard underline cursor }
CursorHalfBlock, { Usually used for Insert editing }
CursorBlock: word; { For those who have to squint }

procedure Qinit;

procedure Qwrite (Row,Col: byte; Attr: integer; aStr: string);
procedure QwriteC (Row,ColL,ColR: byte; Attr: integer; aStr: string);
procedure QwriteA (Row,Col: byte; Attr: integer; ArrayLength: word; VAR aStr);
procedure QwriteEos (Attr: integer; aStr: string);
procedure QwriteEosA (Attr: integer; ArrayLength: word; VAR aStr);

procedure Qfill (Row,Col,Rows,Cols: byte; Attr: integer; Ch: char);
procedure Qattr (Row,Col,Rows,Cols: byte; Attr: integer);
procedure QfillC (Row,ColL,ColR,Rows,Cols: byte; Attr: integer; Ch: char);
procedure QattrC (Row,ColL,ColR,Rows,Cols: byte; Attr: integer);
procedure QfillEos (Rows,Cols: byte; Attr: integer; Ch: char);
procedure QattrEos (Rows,Cols: byte; Attr: integer);

procedure QstoreToMem (Row,Col,Rows,Cols: byte; VAR Dest);
procedure QstoreToScr (Row,Col,Rows,Cols: byte; VAR Source);
procedure QScrToVscr (Row,Col,Rows,Cols,Vrow,Vcol,Vwidth: byte; VAR VscrPtr);
procedure QVscrToScr (Row,Col,Rows,Cols,Vrow,Vcol,Vwidth: byte; VAR VscrPtr);

function QreadStr (Row,Col,Cols: byte): string;
function QreadChar (Row,Col: byte): char;
function QreadAttr (Row,Col: byte): byte;

procedure QscrollUp (Row,Col,Rows,Cols: byte; BlankAttr: integer);
procedure QscrollDown (Row,Col,Rows,Cols: byte; BlankAttr: integer);

procedure QviewPage (PageNum: byte);
procedure QwritePage (PageNum: byte);

function GetCursor: word;
procedure SetCursor (Cursor: word);
procedure ModCursor (Bits13_14: word);
procedure GotoRC (Row,Col: byte);
function WhereR: byte;
function WhereC: byte;

procedure GotoEos;
function EosR: byte;
function EosC: byte;
procedure EosToRC (Row,Col: byte);
procedure EosToRCrel (Row,Col: integer);
procedure EosToCursor;
procedure EosLn;
procedure QEosLn;

procedure GetSubModelID; { Read docs before using! }
procedure SetMultiTask;


IMPLEMENTATION

var
FirstQinit: boolean; { True if Qinit is yet to be run }

{$L qinit.obj}
procedure Qinit; external;
{$L qwrites.obj}
procedure Qwrite; external;
procedure QwriteC; external;
procedure QwriteA; external;
procedure QwriteEos; external;
procedure QwriteEosA; external;
{$L qfills.obj}
procedure Qfill; external;
procedure Qattr; external;
procedure QfillC; external;
procedure QattrC; external;
procedure QfillEos; external;
procedure QattrEos; external;
procedure QfillsDisp3; external; { for Qscroll.obj only }
{$L qstores.obj}
procedure QstoreToMem; external;
procedure QstoreToScr; external;
procedure QScrToVscr; external;
procedure QVscrToScr; external;
{$L qreads.obj}
function QreadStr; external;
function QreadChar; external;
function QreadAttr; external;
{$L qscrolls.obj}
procedure QscrollUp; external;
procedure QscrollDown; external;
{$L qpages.obj}
procedure QviewPage; external;
procedure QwritePage; external;
{$L cursor.obj}
function GetCursor; external;
procedure SetCursor; external;
procedure ModCursor; external;
procedure GotoRC; external;
function WhereR; external;
function WhereC; external;
{$L eos.obj}
procedure EosRC; external; { for QEosLn.obj only }
procedure GotoEos; external;
function EosR; external;
function EosC; external;
procedure EosToRC; external;
procedure EosToRCrel; external;
procedure EosToCursor; external;
procedure EosLn; external;
{$L QEosLn.obj}
procedure QEosLn; external;
{$L cpuident.obj}
procedure GetCpuID; external; { Near }
{$L getsubid.obj}
procedure GetSubModelID; external; { Read docs before using! }
{$L SetMulti.obj }
procedure SetMultiTask; external;

BEGIN
SubModelID := 0; { Default to 0 }
FirstQinit := true; { True for first time to be run }
Qinit;
GetCpuID; { Required for Qscroll.obj }
END.