Files
pepe-runner-ascii/original_turbopascal/JINPUT.PAS
T

638 lines
17 KiB
ObjectPascal
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
{Unitat per al teclat, joystick i mouse}
{Ultima actualitzacio 19-02-2000}
unit JInput;
interface
const
(*//////////////////////////CONSTANTS DEL TECLAT\\\\\\\\\\\\\\\\\\\\\\\\*)
{El codi de SCAN es que s'activa quan es polsa una tecla}
keySysReq = $54;
keyCapsLock = $3A;
keyNumLock = $45;
keyScrollLock = $46;
keyLeftCtrl = $1D;
keyLeftAlt = $38;
keyLeftShift = $2A;
keyRightCtrl = $9D;
keyAltGr = $B8;
keyRightShift = $36;
keyEsc = $01;
keyBackspace = $0E;
keyEnter = $1C;
keySpace = $39;
keyTab = $0F;
keyF1 = $3B;
keyF2 = $3C;
keyF3 = $3D;
keyF4 = $3E;
keyF5 = $3F;
keyF6 = $40;
keyF7 = $41;
keyF8 = $42;
keyF9 = $43;
keyF10 = $44;
keyF11 = $57;
keyF12 = $58;
keyA = $1E;
keyB = $30;
keyC = $2E;
keyD = $20;
keyE = $12;
keyF = $21;
keyG = $22;
keyH = $23;
keyI = $17;
keyJ = $24;
keyK = $25;
keyL = $26;
keyM = $32;
keyN = $31;
keyO = $18;
keyP = $19;
keyQ = $10;
keyR = $13;
keyS = $1F;
keyT = $14;
keyU = $16;
keyV = $2F;
keyW = $11;
keyX = $2D;
keyY = $15;
keyZ = $2C;
key1 = $02;
key2 = $03;
key3 = $04;
key4 = $05;
key5 = $06;
key6 = $07;
key7 = $08;
key8 = $09;
key9 = $0A;
key0 = $0B;
keyMinus = $0C;
keyEqual = $0D;
keyLBracket = $1A;
keyRBracket = $1B;
keySemicolon = $27;
keyTick = $28;
keyApostrophe = $29;
keyBackslash = $2B;
keyComma = $33;
keyPeriod = $34;
keySlash = $35;
keyInsert = $D2;
keyDelete = $D3;
keyHome = $C7;
keyEnd = $CF;
keyPageUp = $C9;
keyArrowLeft = $CB;
keyArrowRight = $CD;
keyArrowUp = $C8;
keyArrowDown = $D0;
keyKeypad0 = $52;
keyKeypad1 = $4F;
keyKeypad2 = $50;
keyKeypad3 = $51;
keyKeypad4 = $4B;
keyKeypad5 = $4C;
keyKeypad6 = $4D;
keyKeypad7 = $47;
keyKeypad8 = $48;
keyKeypad9 = $49;
keyKeypadComma = $53;
keyKeypadStar = $37;
keyKeypadMinus = $4A;
keyKeypadPlus = $4E;
keyKeypadEnter = $9C;
keyCtrlPrtScr = $B7;
keyShiftPrtScr = $B7;
keyKeypadSlash = $B5;
{El codi de BREAK es el que s'activa quan es solta una tecla}
BREAK_Esc=1+128;
BREAK_1=2+128;
BREAK_2=3+128;
BREAK_3=4+128;
BREAK_4=5+128;
BREAK_5=6+128;
BREAK_6=7+128;
BREAK_7=8+128;
BREAK_8=9+128;
BREAK_9=10+128;
BREAK_0=11+128;
BREAK_Menos=12+128; {potser este siga l'apostrof}
BREAK_Igual=13+128; {potser este siga l'exclamacio}
BREAK_Backsp=14+128;
BREAK_Tab=15+128;
BREAK_Q=16+128;
BREAK_W=17+128;
BREAK_E=18+128;
BREAK_R=19+128;
BREAK_T=20+128;
BREAK_Y=21+128;
BREAK_U=22+128;
BREAK_I=23+128;
BREAK_O=24+128;
BREAK_P=25+128;
BREAK_LeftBraket=26+128;
BREAK_RightBraket=27+128;
BREAK_Enter=28+128;
BREAK_Control=29+128;
BREAK_A=30+128;
BREAK_S=31+128;
BREAK_D=32+128;
BREAK_F=33+128;
BREAK_G=34+128;
BREAK_H=35+128;
BREAK_J=36+128;
BREAK_K=37+128;
BREAK_L=38+128;
BREAK_SemiColon=39+128;{potser la ¥}
BREAK_Apostrof=40+128;{potser }
BREAK_Tilde=41+128;{potser ‡}
BREAK_LeftShift=42+128;
BREAK_Back_Slash=43+128;{potser < }
BREAK_Z=44+128;
BREAK_X=45+128;
BREAK_C=46+128;
BREAK_V=47+128;
BREAK_B=48+128;
BREAK_N=49+128;
BREAK_M=50+128;
BREAK_Coma=51+128;
BREAK_Punt=52+128;
BREAK_ForwardSlash=53+128;{potser -}
BREAK_RightShift=54+128;
BREAK_PrintScrn=55+128;
BREAK_Alt=56+128;
BREAK_Sp=57+128;
BREAK_CapsLock=58+128;
BREAK_F1=59+128;
BREAK_F2=60+128;
BREAK_F3=61+128;
BREAK_F4=62+128;
BREAK_F5=63+128;
BREAK_F6=64+128;
BREAK_F7=65+128;
BREAK_F8=66+128;
BREAK_F9=67+128;
BREAK_F10=68+128;
BREAK_F11=87+128;
BREAK_F12=88+128;
BREAK_NumLock=69+128;
BREAK_ScrollLock=70+128;
BREAK_Home=71+128;
BREAK_Up=72+128;
BREAK_PgUp=73+128;
BREAK_NumMenos=74+128;
BREAK_Left=75+128;
BREAK_Num5=76+128;
BREAK_Right=77+128;
BREAK_NumMes=78+128;
BREAK_End=79+128;
BREAK_Down=80+128;
BREAK_PgDn=81+128;
BREAK_Ins=82+128;
BREAK_Del=83+128;
{Mascares per a tecles de control cridant a int 16h}
SHIFT_R=$0001;
SHIFT_L=$0002;
CONTROL=$0004;
ALT =$0008;
SCROLL_LOCK_ON=$0010;
NUM_LOCK_ON=$0020;
CAPS_LOCK_ON=$0040;
INSERT_MODE=$0080;
CONTROL_L=$0100;
ALT_L=$0200;
CONTROL_R=$0400;
ALT_R=$0800;
SCROLL_LOCK_OFF=$1000;
NUM_LOCK_OFF=$2000;
CAPS_LOCK_OFF=$4000;
SYS_REQ_DWN=$8000;
KEYBOARD_INT=$09;
KEY_BUFFER=$60;
KEY_CONTROL=$61;
INT_CONTROL=$20;
NomTECLES:array[1..101] of PChar=
{1}('Esc','1','2','3','4','5','6','7','8','9'
{11},'0','-','=','Backsp','Tab','Q','W','E','R','T'
{21},'Y','U','I','O','P','[',']','Enter','Control','A'
{31},'S','D','F','G','H','J','K','L',';','Apostrof'
{41},'Tilde','LeftShift','\','Z','X','C','V','B','N','M'
{51},',','.','/','RightShift','Print Screen','Alt',' ','CapsLock','F1','F2'
{61},'F3','F4','F5','F6','F7','F8','F9','F10','NumLock','ScrollLock'
{71},'Home','Up','PgUp','-','Left','Num5','Right','+','End','Down'
{81},'Page Down','Insert','Del',nil,nil,nil,'F11','F12',nil,nil
{91},nil,nil,nil,nil,nil,nil,nil,nil,nil,nil,nil);
(*//////////////////////////CONSTANTS DEL MOUSE\\\\\\\\\\\\\\\\\\\\\\\\*)
MBLeft=$01; {Boto esquerre del mouse}
MBRight=$02; {Boto dret del mouse}
(*/////////////////////////CONSTANTS DEL JOYSTICK\\\\\\\\\\\\\\\\\\\\\\\\*)
JoyPort=$201; {Port del Joystick}
Button1_1=$10; {boto 1 del Joystick 1}
Button1_2=$20; {boto 2 del Joystick 1}
Button2_1=$40; {boto 1 del Joystick 2}
Button2_2=$80; {boto 2 del Joystick 2}
Joystick1=$01; {ID del Joystick 1}
Joystick2=$02; {ID del Joystick 2}
Joystick1_X=$01; {Eix X del Joystick 1}
Joystick1_Y=$02; {Eix Y del Joystick 1}
Joystick2_X=$04; {Eix X del Joystick 2}
Joystick2_Y=$08; {Eix Y del Joystick 2}
Joy1_CAL=1; {ID Calibrar Joystick 1}
Joy2_CAL=2; {ID Calibrar Joystick 2}
var
{­­ ATENCIO TOTES ESTES VARIABLES SON UNICAMENT DE LECTURA !!}
{QUALSEVOL MODIFICACIO SOBRE ELLES POT CAUSAR DESASTRES I FINS I TOT
CATASTROFRES MUNDIALS.SI LES MODIFIQUES ES BAIX LA TEUA RESPONASABILITAT}
(*/////////////////////////VARIABLES DEL TECLAT\\\\\\\\\\\\\\\\\\\\\\\\*)
TECLA:word; {RESERVED}
TAULATECLES:array[1..101] of byte;{RESERVED}
OLD_KB_ISR:pointer; {Punter al antic vector d'interrupcio}
(*/////////////////////////VARIABLES DEL JOYSTICK\\\\\\\\\\\\\\\\\\\\\\\\*)
{les variables joy* guarden els valors despres de la calibracio}
{valors per al JOYSTICK1}
joy1_MAX_X, {Valor quan X es maxima DRETA}
joy1_MAX_Y, {Valor quan Y es maxima AVALL}
joy1_MIN_X, {Valor quan X es minima ESQUERRA}
joy1_MIN_Y, {Valor quan Y es minima AMUNT}
joy1_cx, {Valor quan X esta centrat}
joy1_cy, {Valor quan Y esta centrat}
{valors per al JOYSTICK2}
joy2_MAX_X, {Valor quan X es maxima DRETA}
joy2_MAX_Y, {Valor quan Y es maxima AVALL}
joy2_MIN_X, {Valor quan X es minima ESQUERRA}
joy2_MIN_Y, {Valor quan Y es minima AMUNT}
joy2_cx, {Valor quan X esta centrat}
joy2_cy:word; {Valor quan Y esta centrat}
(*/////////////////////////FUNCIONS DEL TECLAT\\\\\\\\\\\\\\\\\\\\\\\\*)
procedure InstalarKB;
{Funcio : Activa la nova interrupcio del teclat}
procedure DesinstalarKB;
{Funcio : Restaura l'antiga interrupcio del teclat}
Function TeclaPuls(Key:byte):boolean;
{Entrada: Key -> codi SCAN de tecla
Eixida : TRUE si esta polsada, FALSE si no
Funcio : Saber si una tecla esta siguent polsada}
Function QTeclaPuls:boolean;
{Eixida : TRUE si hi ha alguna tecla polsada, FALSE si no
Funcio : Saber si alguna tecla esta siguent polsada}
function AgarrarTecla:byte;
{Eixida : Codi SCAN de la tecla que esta siguent polsada
Funcio : Tornar el codi SCAN de la tecla que esta siguent polsada}
procedure EscriuTecla;
{Funcio : Escriure una cadena en pantalla depenent de la tecla}
(*/////////////////////////FUNCIONS DEL MOUSE\\\\\\\\\\\\\\\\\\\\\\\\*)
Function MouseReset:word;
{Eixida : 0,Driver instalúlat , $FFFF driver no instalúlat
Funcio : intentar activar el mouse}
Function NumButtons:word;
{Eixida : nombre de botons
Funcio : averiguar el nombre de botons del mouse}
Procedure ShowMouse;
{Funcio : Mostra el mouse en la pantalla}
Procedure HideMouse;
{Funcio : oculta el mouse}
Function GetMouseX:word;
{Eixida : Coordenada en l'eix X on es troba el mouse
Funcio : Obtindre la coordenada X del Mouse}
Function GetMouseY:word;
{Eixida : Coordenada en l'eix Y on es troba el mouse
Funcio : Obtindre la coordenada Y del Mouse}
function EstatBoto(button:word):word;
{Entrada: Codi de boto del mouse, definit en les constants
Eixida : 0 si no esta polsat, distint en cas contrari
Funcio : Saber si hi ha un boto polsat o no}
procedure SetMousePos(x,y:word);
{Entrada: Coordenada x i y on volem posar el mouse
Funcio : Colocar el mouse}
procedure SetMouseZone(x0,y0,x1,y1:word);
{Entrada: x0 -> x minima per definir la zona
y0 -> y minima per definir la zona
x1 -> x maxima per definir la zona
y1 -> y maxima per definir la zona
Funcio : Tancar al mouse dins d'una zona per que no isca}
procedure SetMouseInterruptRate(Code:word);
{Entrada: Code
0 No interrupts
1 30 ints per second
2 50 ints per second
3 100 ints per second
4 200 ints per second
Funcio : Canviar les peticions d'interrupcio que fa el mouse}
procedure SetMouseSensitivity(Xsens,Ysens:word);
{Entrada: XSens -> (1..32767)
Ysens -> (1..32767)
Funcio : Canviar la sensitivitat de mouse}
procedure SetMouseDoubleSpeed(Speed:word);
{Entrada: Speed -> velocitat en mickeys per segon
Funcio : Canviar la velocitat}
(*/////////////////////////FUNCIONS DEL JOYSTICK\\\\\\\\\\\\\\\\\\\\\\\\*)
function JBotons(button:word):word;
{Entrada: button -> Codi del boto
Eixida : 0, boto no polsat <>0,boto polsat
Funcio : Averiguar si un boto esta polsat}
function Joystick(stick:word):word;
{Entrada: Stick -> JOYSTICK?_? constants dalt definides
Eixida : Valor que podem comparar en el valor de les variables de calibracio
Funcio : Torna un valor depenent de l'estat de l'eix }
Procedure JoyCalibrate(stick:word);
{Entrada: stick -> Codi del Joystick (Joy1_CAL o Joy2_CAL)
Funcio : Calibrar el joystick}
function JoyAvaliable(stick:word):boolean;
{Entrada: stick -> Codi del Joystick (Joystick1 o Joystick2)
Eixida : FLASE si no hi detecta un joystick
Funcio : Averiguar si hi ha un joystick}
implementation
uses dos;
(*/////////////////////////FUNCIONS DEL TECLAT\\\\\\\\\\\\\\\\\\\\\\\\*)
procedure NEWKB;interrupt;assembler;
asm
cli
in al, KEY_BUFFER {obtindre la tecla polsada}
xor ah,ah
mov TECLA,ax {guardar la tecla}
in al,KEY_CONTROL {accedir al registre de control}
or al,82h {posar els bits adequats per fer un reset
en el biestable del teclat}
out KEY_CONTROL,al {enviar les noves dades al registre}
and al,7Fh
out KEY_CONTROL,al {Fer el reset}
{Actualitzacio de la taula de tecles}
mov bx,tecla
cmp bx,128
jg @breakcode
mov byte ptr TAULATECLES[bx-1],1
jmp @end
@breakcode:
sub bx,128
mov byte ptr TAULATECLES[bx-1],0
@end:
mov al,20h
out INT_CONTROL,al
sti
end;
procedure waitACS;
begin
asm
mov ah,2
int 16h
and al,00001111b
jz @fi
@espera:
mov ah,2
int 16h
and al,00001111b {al->bit 7=Insert On
6=Caps Lock on
5=Num Lock on
4=scroll lock on
3=Alt key down
2=Control key down
1=left shift down
0=right shift down}
jnz @espera
@fi:
end;
end;
procedure InstalarKB;
var i:word;
begin
waitACS;
getintvec(KEYBOARD_INT,Old_KB_ISR);
setintvec(KEYBOARD_INT,@NEWKB);
Fillchar(TAULATECLES,sizeof(Taulatecles),0);
end;
procedure desinstalarKB;
begin
setintvec(KEYBOARD_INT,OLD_KB_ISR);
end;
Function TeclaPuls(Key:byte):boolean;
begin
if TAULATECLES[KEY]=1 then TeclaPuls:=TRUE else TeclaPuls:=FALSE;
end;
Function QTeclaPuls:boolean;
begin
if tecla>=128 then QTeclaPuls:=false else QTeclaPuls:=true;
end;
function AgarrarTecla:byte;
begin
if tecla<101 then AgarrarTecla:=tecla;
end;
procedure EscriuTecla;
begin
if tecla<128 then write(NomTecles[tecla]);
end;
(*/////////////////////////FUNCIONS DEL MOUSE\\\\\\\\\\\\\\\\\\\\\\\\*)
Function MouseReset:word;assembler;
{MouseReset=0 Driver no instalúlat}
{MouseReset=65535 Driver instalúlat}
asm
xor ax,ax
int 33h
end;
Function NumButtons:word;assembler;
asm
xor ax,ax
int 33h
mov ax,bx
end;
Procedure ShowMouse;assembler;
asm
mov ax,0001h
int 33h
end;
Procedure HideMouse;assembler;
asm
mov ax,0002h
int 33h
end;
Function GetMouseX:word;assembler;
{x -> (0..639)}
asm
mov ax,$0003
int 33h
mov ax,cx
end;
Function GetMouseY:word;assembler;
{y -> (0..199)}
asm
mov ax,$0003
int 33h
mov ax,dx
end;
function EstatBoto(button:word):word;assembler;
{Torna <>0 si esta polsat}
asm
mov ax,$0003
int 33h
mov ax,bx
and ax,button
end;
procedure SetMousePos(x,y:word);assembler;
asm
mov ax,$0004
mov cx,x
mov dx,y
int 33h
end;
procedure SetMouseZone(x0,y0,x1,y1:word);assembler;
asm
mov ax,$0007
mov cx,x0
mov dx,x1
int 33h
mov ax,$0008
mov cx,y0
mov dx,y1
int 33h
end;
procedure SetMouseInterruptRate(Code:word);assembler;
{Code
0 No interrupts
1 30 ints per second
2 50 ints per second
3 100 ints per second
4 200 ints per second
}
asm
mov ax,$001C
mov bx,code
int 33h
end;
procedure SetMouseSensitivity(Xsens,Ysens:word);assembler;
{XSens (1..32767}
{Ysens (1..32767}
asm
mov ax,$000F
mov cx,Xsens
mov dx,Ysens
int 33h
end;
procedure SetMouseDoubleSpeed(Speed:word);assembler;
asm
mov ax,$0013
mov dx,speed
int 33h
end;
(*/////////////////////////FUNCIONS DEL JOYSTICK\\\\\\\\\\\\\\\\\\\\\\\\*)
function JBotons(button:word):word;
begin
Port[Joyport]:=0;
JBotons:=(not Port[Joyport]) and Button;
end;
function Joystick(stick:word):word;assembler;
asm
cli
mov ah,byte ptr stick
xor al,al
xor cx,cx
mov dx,JOYPORT
out dx,al
@discharge:
in al,dx
test al,ah
loopne @discharge
sti
xor ax,ax
sub ax,cx
end;
Procedure JoyCalibrate(stick:word);
var xnew,ynew:word;
begin
if (Stick=JOY1_CAL) then
begin
joy1_MAX_X:=0;
joy1_MAX_Y:=0;
joy1_MIN_X:=10000;
joy1_MIN_Y:=10000;
{girar, deixar neutral i polsar un boto}
while (JBotons(button1_1) or JBotons(button1_2))=0 do
begin
xnew:=Joystick(Joystick1_X);
ynew:=Joystick(Joystick1_Y);
if (xnew>=joy1_Max_x) then joy1_Max_X:=xnew;
if (xnew<=joy1_Min_x) then joy1_Min_X:=xnew;
if (ynew>=joy1_Max_y) then joy1_Max_y:=ynew;
if (ynew<=joy1_Min_y) then joy1_Min_y:=ynew;
end;
{com l'usuari ha deixat el pad al centre deu estar al centre}
Joy1_cx:=xnew;
Joy1_cy:=ynew;
end
else if (stick=JOY2_CAL) then
begin
joy2_MAX_X:=0;
joy2_MAX_Y:=0;
joy2_MIN_X:=10000;
joy2_MIN_Y:=10000;
while (JBotons(button2_1) or JBotons(button2_2))=0 do
begin
xnew:=Joystick(Joystick2_X);
ynew:=Joystick(Joystick2_Y);
if (xnew>=joy2_Max_x) then joy2_Max_X:=xnew;
if (xnew<=joy2_Min_x) then joy2_Min_X:=xnew;
if (ynew>=joy2_Max_y) then joy2_Max_y:=ynew;
if (ynew<=joy2_Min_y) then joy2_Max_y:=ynew;
end;
{com l'usuari ha deixat el pad al centre deu estar al centre}
Joy2_cx:=xnew;
Joy2_cy:=ynew;
end;
end;
function JoyAvaliable(stick:word):boolean;
{torna un valor distint de 0 si existeix}
begin
if (stick=JOYSTICK1) then
JoyAvaliable:=(Joystick(Joystick1_X)<>$0000)
else if (stick=JOYSTICK2) then
JoyAvaliable:=(Joystick(Joystick2_X)<>$0000);
end;
begin
tecla:=128;
end.