Copy Link
Add to Bookmark
Report
NULL mag Issue 09 26 Fast crt unit
this is DOS Turbo Pascal 6/7 unit for various advanced functions to be used in text mode. you have to use this unit, in order to compile the FILE and PLASMA demos, also included in this issue.
the original unit is from Nate Case [natedogg], but i also includedsome bits of mine and made some changes.
use Turbo Pascal 7, inside DOSBOX to compile it.
{ fast crt unit. fully compatible with old crt functions. }
{ most every function is hundreds times faster than borland's unit }
{ there are two added functions:
procedure fastout(x, y : byte; txt : string; colorattr : byte);
^- this is a fast direct screen write procedure
procedure fastpipe(x, y : byte; txt : string);
^- this is the same, except it parses pipe codes
}
{ 100% from scratch by Nate Case [natedogg] }
unit fastCrt;
{$I-,S-}
interface
const
{ CRT modes }
BW40 = 0; { 40x25 B/W on Color Adapter }
CO40 = 1; { 40x25 Color on Color Adapter }
BW80 = 2; { 80x25 B/W on Color Adapter }
CO80 = 3; { 80x25 Color on Color Adapter }
Mono = 7; { 80x25 on Monochrome Adapter }
Font8x8 = 256; { Add-in for ROM font }
{ Mode constants for 3.0 compatibility }
C40 = CO40;
C80 = CO80;
{ Foreground and background color constants }
Black = 0;
Blue = 1;
Green = 2;
Cyan = 3;
Red = 4;
Magenta = 5;
Brown = 6;
LightGray = 7;
{ Foreground color constants }
DarkGray = 8;
LightBlue = 9;
LightGreen = 10;
LightCyan = 11;
LightRed = 12;
LightMagenta = 13;
Yellow = 14;
White = 15;
{ Add-in for blinking }
Blink = 128;
EOL = #13#10;
CRLF = #13#10;
CSI = #27'[';
AnsiColours: Array[0..7] of Integer = (0, 4, 2, 6, 1, 5, 3, 7);
CHARS_ALL = '`1234567890-=\qwertyuiop[]asdfghjkl;''zxcvbnm,./~!@#$%^&*()_+|'+
'QWERTYUIOP{}ASDFGHJKL:"ZXCVBNM<>? ';
CHARS_ALPHA = 'qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM';
CHARS_NUMERIC = '1234567890.,+-';
CHARS_FILENAME = '1234567890-=\/qwertyuiop[]asdfghjkl;''zxcvbnm,.~!@#$%^&()_+'+
'QWERTYUIOP{}ASDFGHJKL:ZXCVBNM ';
keyHome = #71;
keyCursorUp = #72;
keyPgUp = #73;
keyCursorLeft = #75;
KeyNum5 = #76;
keyCursorRight = #77;
keyEnd = #79;
keyCursorDown = #80;
keyPgDn = #81;
KeyIns = #82;
KeyDel = #83;
KeyBackSpace = #8;
KeyTab = #9;
KeyEnter = #13;
KeyEsc = #27;
Keyforwardslash = #47;
Keyasterisk = #42;
Keyminus = #45;
Keyplus = #43;
KeyF1 = #59;
KeyF2 = #60;
KeyF3 = #61;
KeyF4 = #62;
KeyF5 = #63;
KeyF6 = #64;
KeyF7 = #65;
KeyF8 = #66;
KeyF9 = #67;
KeyF10 = #68;
KeyF11 = #69;
KeyF12 = #70;
keyCtrlA = #1;
keyCtrlB = #2;
{ KeyCtrlC = #3; }
keyCtrlD = #4;
keyCtrlE = #5;
keyCtrlF = #6;
keyCtrlG = #7;
keyCtrlH = #8;
keyCtrlI = #9;
keyCtrlJ = #10;
keyCtrlK = #11;
keyCtrlL = #12;
keyCtrlM = #13;
keyCtrlN = #14;
keyCtrlO = #15;
keyCtrlP = #16;
keyCtrlQ = #17;
keyCtrlR = #18;
keyCtrlS = #19;
keyCtrlT = #20;
keyCtrlU = #21;
keyCtrlV = #22;
keyCtrlW = #23;
keyCtrlX = #24;
keyCtrlY = #25;
keyCtrlZ = #26;
keyAlt1 = #248;
keyAlt2 = #249;
keyAlt3 = #250;
keyAlt4 = #251;
keyAlt5 = #252;
keyAlt6 = #253;
keyAlt7 = #254;
keyAlt8 = #255;
keyAlt9 = #134;
keyAlt0 = #135;
keyALTA = #30;
keyALTB = #48;
keyALTC = #46;
keyALTD = #32;
keyALTE = #18;
keyALTF = #33;
keyALTG = #34;
keyALTH = #35;
keyALTI = #23;
keyALTJ = #36;
keyALTK = #37;
keyALTL = #38;
keyALTM = #50;
keyALTN = #49;
keyALTO = #24;
keyALTP = #25;
keyALTQ = #16;
keyALTR = #19;
keyALTS = #31;
keyALTT = #20;
keyALTU = #22;
KeyAltV = #175;
KeyAltW = #17;
keyALTX = #45;
keyALTY = #21;
keyALTZ = #44;
var
{ Interface variables }
CheckBreak: Boolean; { Enable Ctrl-Break }
CheckEOF: Boolean; { Enable Ctrl-Z }
DirectVideo: Boolean; { Enable direct video addressing }
CheckSnow: Boolean; { Enable snow filtering }
LastMode: Word; { Current text mode }
TextAttr: Byte; { Current text attribute }
WindMin: Word; { Window upper left coordinates }
WindMax: Word; { Window lower right coordinates }
{ Interface procedures }
procedure enable_highbg;
procedure disable_highbg;
function keyPressed : boolean;
function readKey : char;
procedure textMode(mode: integer);
procedure window(X1, Y1, X2, Y2 : byte);
procedure gotoxy(x, y : byte);
function wherex : byte;
function wherey : byte;
procedure clrscr;
procedure clreol;
procedure insline;
procedure delline;
procedure textColor(color : byte);
procedure textBackground(color : byte);
procedure lowVideo;
procedure highVideo;
procedure normVideo;
procedure delay(ms : word);
procedure sound(hz : word);
procedure nosound;
procedure fastout(x,y: byte; s: string; attr: byte);
procedure fastpipe(x,y: byte; s: string);
Procedure CursorOn;
Procedure CursorOff;
procedure wait_retrace;
procedure xSetMode (Mode : word);
procedure restoreScreen(pageNum : byte);
procedure saveScreen(pageNum : byte);
function getcharat(x,y:byte):char;
function getattrat(x,y:byte):byte;
procedure writexy(x,y,a:byte; s:string);
Procedure WriteXYPipe (X, Y, Attr:Byte; Text: String);
implementation
const
maxscreens = 2; { 0-based }
type
buf = Array[1..4000] of Byte; { Screen Buffer Type }
var
screen : array [0..maxscreens] of ^buf;
sx, sy : array [0..maxscreens] of byte;
procedure wait_retrace; assembler;
label l1, l2;
asm
mov dx, 3DAh
@l1:
in al, dx
and al, 08h
jnz @l1
@l2:
in al, dx
and al, 08h
jz @l2
end;
Function S2I(N:String):integer;
Var
I,Code:Word;
Begin
S2I := -1;
Val (N,I,Code);
If Code<>0 Then Exit;
S2I:=I;
End;
function getcharat(x,y:byte):char;
var
ofs:word;
begin
ofs:=((y-1)*160) + ((x shl 1) -1);
getcharat:=chr(mem[$b800:ofs-1]);
end;
function getattrat(x,y:byte):byte;
var
ofs:word;
begin
ofs:=((y-1)*160) + ((x shl 1) -1);
getattrat:=mem[$b800:ofs];
end;
procedure centerline(s:string;y:byte);
begin
writexy(40-Length(s) div 2,y,TextAttr,s);
end;
procedure writexy(x,y,a:byte; s:string);
begin
fastout(x,y,s,a);
end;
function keyPressed : boolean; assembler;
asm
push ds
push sp
mov ah, 1
int 16h
mov al, 0
jz @t
mov al, 1
@t:
pop sp
pop ds
end;
function readKey : char; assembler;
asm
mov ah, 07h
int 21h
end;
procedure textMode(mode : integer); assembler;
asm
mov ax, [mode]
int 10h
mov lastmode, ax
end;
procedure window(X1, Y1, X2, Y2 : byte);
begin
if (X1 <= X2) and (Y1 <= Y2) then
begin
dec(X1);
dec(Y1);
if (X1 >= 0) and (Y1 >= 0) then
begin
dec(X2);
dec(Y2);
if (X2 < 80) and (Y2 < 25) then
begin
windMin := X1 + Y1 shl 8;
windMax := X2 + Y2 shl 8;
gotoxy(1, 1);
end;
end;
end;
end;
procedure gotoxy(x, y : byte);
begin
inc(x, lo(windmin) - 1);
inc(y, hi(windmin) - 1);
mem[$0040:$0050] := x;
mem[$0040:$0051] := y;
end;
function wherex : byte;
begin
wherex := mem[$0040:$0050] - lo(windmin) + 1;
end;
function wherey : byte;
begin
wherey := mem[$0040:$0051] - hi(windmin) + 1;
end;
procedure fillWord(var dest; count, data : word);
begin
inline($C4/$BE/dest/$8B/$8E/count/$8B/$86/data/$FC/$F3/$AB)
end;
procedure clrscr;
var offset, len, out : word; b : array [1..2] of byte absolute out;
begin
offset := 160 * (hi(windmin)+1) + lo(windmin) + lo(windmin) - 160;
len := (2 * ((lo(windmax)+1) * ((hi(windmax)+1)))) - offset;
b[1] := 0;
b[2] := textattr;
fillword(mem[$B800:offset], len div 2, out);
gotoxy(1, 1);
end;
procedure clreol;
var offset, len, out : word; b : array [1..2] of byte absolute out;
begin
offset := (mem[$0040:$0051] * 160) + (mem[$0040:$0050] * 2);
len := lo(windmax) - mem[$0040:$0050] + 2;
b[1] := 0;
b[2] := textattr;
fillword(mem[$B800:offset], len, out);
end;
{ this one could be re-written to be faster }
procedure insline;
var x1, y1, x2, y2 : byte;
begin
x1 := lo(windmin);
y1 := mem[$0040:$0051];
x2 := lo(windmax);
y2 := hi(windmax);
asm
mov ah, 07h
mov al, 01h
mov bh, textattr
mov ch, y1
mov cl, x1
mov dh, y2
mov dl, x2
int 10h
end;
end;
procedure delline;
var x1, y1, x2, y2 : byte;
begin
x1 := lo(windmin);
y1 := mem[$0040:$0051];
x2 := lo(windmax);
y2 := hi(windmax);
asm
mov ah, 06h
mov al, 01h
mov bh, textattr
mov ch, y1
mov cl, x1
mov dh, y2
mov dl, x2
int 10h
end;
end;
procedure textColor(color : byte);
begin
if color > white then color := (color and $0F) or $80;
textAttr := (textAttr and $70) or color;
end;
procedure textBackground(color : byte);
begin
textAttr := (textAttr and $8F) or ((color and $07) shl 4);
end;
procedure lowVideo;
begin
textAttr := textAttr and $F7;
end;
procedure highVideo;
begin
textAttr := textAttr or $08;
end;
procedure normVideo;
begin
textAttr := $07;
end;
procedure delay(ms : word); assembler;
asm
mov ax, 1000
mul ms
mov cx, dx
mov dx, ax
mov ah, 86h
int 15h
end;
procedure sound(hz : word); assembler;
asm
mov bx, hz
mov ax, 34DDh
mov dx, 0012h
cmp dx, bx
jnc @done
div bx
mov bx, ax
in al, 61h
test al, 3
jnz @do
or al, 3
out 61h, al
mov al, 0B6h
out 43h, al
@do:
mov al, bl
out 42h, al
mov al, bh
out 42h, al
@done:
end;
procedure nosound; assembler;
asm
in al, 61h
and al, $FC
out 61h, al
end;
procedure fastout(x,y: byte; s: string; attr: byte);
var ofs: word;
begin
ofs := ((y-1)*160)+((x shl 1)-1);
for x := 1 to ord(s[0]) do
begin
move(attr, mem[$B800:ofs], 1);
move(s[x], mem[$B800:ofs-1], 1);
inc(ofs, 2);
end;
end;
procedure fastpipe(x,y: byte; s: string);
var ofs: word;
a: byte;
code: integer;
begin
ofs := ((y-1)*160)+((x shl 1)-1);
for x := 1 to ord(s[0]) do
begin
if s[x] = '|' then
begin
val(copy(s,x+1,2),a,code);
inc(x,2);
end else
begin
move(a,mem[$B800:ofs], 1);
move(s[x],mem[$B800:ofs-1], 1);
inc(ofs, 2);
end;
end;
end;
Procedure WriteXYPipe (X, Y, Attr: Byte; Text: String);
Const
Seth = '|';
Var
Count : Byte;
Code : String[2];
CodeNum : integer;
OldAttr : Byte;
OldX : Byte;
OldY : Byte;
Begin
OldAttr := TextAttr;
OldX := WhereX;
OldY := WhereY;
GotoXY (X, Y);
TextAttr:=Attr;
Count := 1;
While Count <= Length(Text) Do Begin
If Text[Count] = Seth Then Begin
Code := Copy(Text, Count + 1, 2);
CodeNum := S2I(Code);
if CodeNum<0 Then Begin
Write(Text[Count]);
Count :=count+1;
End;
If (CodeNum>0) Or (Code='00') Then Begin
Count :=count+3;
If CodeNum in [00..15] Then
TextAttr := CodeNum + (TextAttr Div 16) * 16
Else
TextAttr :=((TextAttr Mod 16) + (CodeNum - 16) * 16);
End;
End Else Begin
system.Write(Text[Count]);
Count :=count+1;
End;
End;
TextAttr:=OldAttr;
GotoXY (OldX, OldY);
End;
Procedure CursorOff; Assembler;
Asm
mov ax,0100h
mov cx,2707h
int 10h
{mov ah,3
mov bx,0
int 10h
or ch,20h
mov ah,1
mov bx,0
int 10h}
End;
Procedure CursorOn; Assembler;
Asm
mov ax,0100h
mov cx,0506h
int 10h
{mov ah,3
mov bx,0
int 10h
or ch,255-20h
mov ah,1
mov bx,0
int 10h}
End;
procedure disable_highbg;
begin
asm
mov ax,1003h
mov bx,1h;
int 10h
end;
end;
procedure enable_highbg;
begin
asm
mov ax,1003h
mov bx,0h;
int 10h
end;
end;
procedure saveScreen(pageNum : byte);
begin
getmem(screen[pagenum], 4000);
move(mem[$B800:00], screen[pagenum]^, 4000);
sx[pagenum] := wherex;
sy[pagenum] := wherey;
end;
procedure restoreScreen(pageNum : byte);
begin
move(screen[pageNum]^, mem[$B800:00], 4000);
freeMem(screen[pageNum], 4000);
gotoxy(sx[pagenum], sy[pagenum]);
end;
procedure xSetMode (Mode : word);
begin
asm
mov ax,Mode;
int 10h
end;
end;
begin
directvideo := true;
lastmode := CO80;
textattr := $07;
windmin := 0;
windmax := 6223;
end.
