home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
ASMCODE.ZIP
/
NEWCRT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-11-02
|
20KB
|
630 lines
{ ────────────────────────────────────────────────────────────────────────
This code is Copyright (c) 1994 by Jonathan E. Wright and AmoebaSoft.
To communicate with the author, send internet mail to: NELNO@DELPHI.COM
About this code:
A replacement for some of the stuff that Borland's CRT unit does, though
it lacks most of Borland's screen I/O stuff. But the good part is it
replaces the BIOS keyboard handler, therefore making the buffer 255
characters instead of 15 and allowing multiple keys to be pressed and
_sensed_ at one time. Perfect for video games.
If you use this code in any of your programs, or as a basis for anything
else you may write, please give credit to Nelno the Amoeba. A postcard
from your country or town would also be nice. Send it to:
Nelno
58 1/2 Woodland Rd.
Asheville, NC 28804-3823
USA
──────────────────────────────────────────────────────────────────────── }
UNIT NewCrt;
{$F+}
INTERFACE
USES
DOS, Types;
CONST
{ Timer constants }
IOCount : WORD = 0;
IOFlag : BYTE = 0;
IOLoops : WORD = 0;
TimerMult : WORD = 1;
Int08Flag : WORD = 1;
OrigRate : WORD = 1; { number of int 8's that will occur
before old int 8 vector is called }
{ NewCrt constants for KeyFlags array }
KeyPadMinus= $4A;
LeftArrow = $4B;
RightArrow = $4D;
KeyPadPlus = $4E;
UpArrow = $48;
DownArrow = $50;
Space = $39;
KeyPad5 = $4C;
Home = $47;
EndKey = $4F;
PageUp = $49;
PageDown = $51;
Insert = $52;
Delete = $53;
Escape = $01;
ScrollLock = $46;
F1 = $3B;
F2 = $3C;
F3 = $3D;
F4 = $3E;
F5 = $3F;
F6 = $40;
F7 = $41;
F8 = $42;
F9 = $43;
F10 = $44;
Quit : BOOLEAN = FALSE; { set if Alt-X is pressed }
{ if a corresponding key is pressed the byte indexed by that key's
scancode will be set to > 0. When the key is released it will be set
to 0. Checking this array allows multiple keys to be pressed at once }
KeyFlags : ARRAY [0..127] OF BYTE = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0);
KeyBuff : ARRAY [0..255] OF BYTE = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0);
KeyTran : ARRAY [0..127] OF BYTE = (000,027,049,050,051,052,053,054,055,
056,057,048,045,061,008,
009,113,119,101,114,116,121,117,105,
111,112,091,093,013,
000,097,115,100,102,103,104,106,107,
108,059,039,096,
000,000,122,120,099,118,098,110,109,
044,046,047,000,
{ spacebar row }
042,000,032,000,
{ function keys = scan code + 80h }
$BB,$BC,$BD,$BE,$BF,$C0,$C1,$C2,$C3,$C4,
{ Keypad = # code + 80 h }
$C5,$C6,$C7,$C8,$C9,045,$CB,$CC,$CD,043,$CF,
$D0,$D1,$D2,127,
{ Nothing }
000,000,000,
{ F11 & F12 }
197,198,
{ more Nothing }
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0);
ShiftTran : ARRAY [0..127] OF BYTE = (000,027,033,064,035,036,037,094,038,
042,040,041,095,043,008,
009,081,087,069,082,084,089,085,073,
079,080,123,125,013,
000,065,083,068,070,071,072,074,075,
076,058,034,126,
000,000,090,088,067,086,066,078,077,
060,062,063,000,
{ spacebar row }
042,000,032,000,
{ function keys = scan code + 80h }
187,188,189,190,191,192,193,194,195,196,
{ Keypad = # code + 80 h }
000,000,055,056,057,045,052,053,054,043,049,
050,051,048,046,
{ Nothing }
000,000,000,
{ F11 & F12 }
197,198,
{ more Nothing }
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0);
KeyBuffOn : BYTE = 1; { 0 = no buff, 1 = buffer all
2 = do not buffer function & keypad }
KeyHead : WORD = OFS (KeyBuff);
KeyTail : WORD = OFS (KeyBuff);
KeyChange : BYTE = 0;
KillFlag : BYTE = 0;
TYPE
RKeyFunc = FUNCTION : CHAR;
KeyPrsdFunc = FUNCTION : BOOLEAN;
{ newCrt variables and procedures }
VAR
Time : BYTE;
KeyPressed : KeyPrsdFunc;
ReadKey : RKeyFunc;
PROCEDURE ClrScr;
PROCEDURE InitKeyboard;
PROCEDURE RestoreKeyboard;
PROCEDURE Delay (ms:word);
PROCEDURE Sound (n : WORD);
PROCEDURE NoSound;
PROCEDURE StartTimer (ms : WORD);
PROCEDURE StopTimer;
PROCEDURE Beep;
PROCEDURE ClearBuff;
{ Timer variables and procedures }
VAR
Start : LONGINT;
Finish : LONGINT;
TotalTime : LONGINT;
PROCEDURE StartTime;
PROCEDURE StopTime;
PROCEDURE SetTimer0Rate (Multiplier : WORD);
IMPLEMENTATION
CONST
ScanCode : BYTE = 0;
VAR
OldInt9 : POINTER;
SavedExit : POINTER;
{$L KEY.OBJ}
FUNCTION KeyPrsd : BOOLEAN; EXTERNAL;
FUNCTION RKey : CHAR; EXTERNAL;
PROCEDURE NewInt9; EXTERNAL;
(* ********************************************************************** *)
PROCEDURE NewExit; FAR;
BEGIN
ExitProc := SavedExit;
RestoreKeyboard;
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE ClrScr; ASSEMBLER;
ASM
mov ah,02
xor dx,dx
xor bx,bx
int 10h { set cursor position }
mov ah,09
mov al,20h
xor bx,bx
mov bl,07
mov cx,2000
int 10h
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
FUNCTION BIOS_KeyPressed : BOOLEAN; ASSEMBLER;
ASM
CMP ScanCode,0
JNE @@1
MOV AH,1
INT 16H
MOV AL,0
JE @@2
@@1:
MOV AL,1
@@2:
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
FUNCTION BIOS_ReadKey : CHAR; ASSEMBLER;
ASM
MOV AL,ScanCode
MOV ScanCode,0
OR AL,AL
JNE @@1
XOR AH,AH
INT 16H
OR AL,AL
JNE @@1
MOV ScanCode,AH
OR AH,AH
JNE @@1
MOV AL,'C'-64
@@1:
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE InitKeyboard;
BEGIN
IF DebugKeys THEN Print ('InitKeyboard: Initializing keyboard...', $0F);
GetIntVec ($09, OldInt9);
IF DebugKeys THEN Print ('SetInt9 : Depriving BIOS...', $0F);
SetIntVec ($09, @NewInt9);
KeyPressed := KeyPrsd;
ReadKey := RKey;
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE RestoreKeyboard;
BEGIN
KeyPressed := BIOS_KeyPressed;
ReadKey := BIOS_ReadKey;
IF DebugKeys THEN Print ('RestoreInt9: Re-instating BIOS handler...', $0F);
SetIntVec ($09, OldInt9);
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE Sound (n : WORD);
VAR
F : WORD;
HF : BYTE;
LF : BYTE;
BEGIN
IF n >= 37 THEN
BEGIN
F := 1193280 DIV n;
HF := Hi (F);
LF := Lo (F);
Port [$43] := $B6;
Port [$42] := LF;
Port [$42] := HF;
asm
in al, 61h
or al, 3
out 61h, al
end;
END;
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE NoSound; ASSEMBLER;
ASM
in al, 61h
and al, 0FCh
out 61h, al
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE Delay (ms:word); ASSEMBLER;
ASM {machine independent delay function}
mov ax,1000
mul ms
mov cx,dx
mov dx,ax
mov ah,86h
int 15h
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE StartTimer (ms : WORD); ASSEMBLER;
ASM
mov Time,0
mov ah,83h
mov al,01
int 15h
mov ax,1000
mul ms
mov cx,dx
mov dx,ax
mov ax,ds
mov es,ax
mov bx,OFFSET Time
xor al,al
mov ah,83h
int 15h
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE StopTimer; ASSEMBLER;
ASM
mov ah,83h
mov al,01
int 15h
mov Time,0
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE Beep;
BEGIN
Sound (1000);
Delay (50);
NoSound;
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE ClearBuff;
VAR
I : BYTE;
Key : CHAR;
BEGIN
IF KeyPrsd THEN
REPEAT
Key := RKey;
UNTIL NOT (KeyPrsd);
Key := #0;
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE StartTime;
VAR
H, M, S, S100 : WORD;
BEGIN
GetTime (H, M, S, S100);
Start := LONGINT (H) * LONGINT (360000) + LONGINT (M) * LONGINT (6000) + LONGINT (S) * LONGINT (100) + LONGINT (S100);
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE StopTime;
VAR
H, M, S, S100 : WORD;
BEGIN
GetTime (H, M, S, S100);
Finish := LONGINT (H) * LONGINT (360000) + LONGINT (M) * LONGINT (6000) + LONGINT (S) * LONGINT (100) + LONGINT (S100);
TotalTime := Finish - Start;
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE IODelay; ASSEMBLER;
ASM
mov cx,IOCount
jcxz @IOInit
@IODelayLoop:
loop @IODelayLoop
mov sp,bp { exit procedure }
pop bp
ret
@IOInit:
mov ax,ds { put data segment in es }
mov es,ax
mov ax,8300h { wait interval }
mov cx,0
mov dx,5000 { delay 5ms }
mov bx,OFFSET IOFlag
int 15h { start delay }
jc @Int15Error
@IODelayLoop2:
test IOFlag,80h
jnz @DelayDone
jmp @NextLabel
@NextLabel:
loop @IODelayLoop2
mov ax,100
jmp @IOExit
@DelayDone:
mov ax,0FFFFh { get number of times looped }
sub ax,cx
mov IOLoops,ax
mov bx,1500 { adjustment factor }
xor dx,dx
div bx
cmp ax,0
je @IO1Delay { set at least 1 delay }
jmp @IOSet
@Int15Error:
or ah,ah { int 15 busy, try again }
jz @IOExit { if an old system, set 1 delay }
@IO1Delay:
mov ax,1
@IOSet:
mov IOCount,ax
@IOExit:
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
PROCEDURE SetTimer0Rate (Multiplier : WORD);
BEGIN
OrigRate := Multiplier;
ASM
mov bx,Multiplier
cmp bx,0
ja @Start
inc bx
mov Multiplier,bx
@Start:
mov TimerMult,bx
mov Int08Flag,bx
cli
mov al,36h { command for 16-bit port mode 3 }
out 43h,al
mov cx,IOCount
@IOD1:
loop @IOD1
mov ax,65535
xor dx,dx
div bx
out 40h,al { load timer 0 MSB }
mov cx,IOCount
@IOD2:
loop @IOD2
xchg al,ah
out 40h,al { load timer 0 LSB }
sti
END;
IF DebugKeys THEN PRINT ('SetTimer0Rate: ' + ST (TRUNC (Multiplier * 18.2)) + ' per second.', $0F);
END;
{ ╔═══════════════════════════════════════════════════════════════════════╗
║ ║
║ ║
╚═══════════════════════════════════════════════════════════════════════╝ }
BEGIN
SavedExit := ExitProc;
ExitProc := @NewExit;
IODelay;
IF DebugKeys THEN PRINT ('IODelay: IOCount is ' + ST (IOCount) + ', IOLoops was ' + ST (IOLoops) + '.', $0F);
InitKeyBoard;
END.
