jaildesigner-jailgames/asteroids
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

First commit

Browse Source
This commit is contained in:
Raimon Zamora
2022-08-13 10:08:47 +02:00
parent 6b594bdb30
commit 4396f65ba3
3 changed files with 426 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

151
ASTEROID.PAS Executable file
View File

@@ -0,0 +1,151 @@
uses crt,keyboard;
const
marge_dalt=10;
marge_baix=192;
marge_esq=7;
marge_dret=312;
type
ipunt=RECORD r,angle:real; END;
punt=RECORD x,y:integer; END;
triangle=RECORD p1,p2,p3:ipunt;
centre:punt;
angle:real;
velocitat:real;
END;
procedure MCGA;
begin
asm
mov ax,0013h
int 10h
end;
directvideo:= false;
end;
procedure Text;
begin
asm
mov ax,0003h
int 10h
end;
end;
procedure WaitRetrace; 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;
procedure posa(x,y:word;color:byte);
begin
mem[$A000:y*320+x]:=color;
end;
procedure linea(x1,y1,x2,y2,color:word);
function sign(x:integer):integer; {like sgn(x) in basic}
begin if x<0 then sign:=-1 else if x>0 then sign:=1 else sign:=0 end;
var
x,y,count,xs,ys,xm,ym:integer;
begin
x:=x1;y:=y1;
xs:=x2-x1; ys:=y2-y1;
xm:=sign(xs); ym:=sign(ys);
xs:=abs(xs); ys:=abs(ys);
posa(x,y,color);
if xs > ys
then begin {flat line <45 deg}
count:=-(xs div 2);
while (x <> x2 ) do begin
count:=count+ys;
x:=x+xm;
if count>0 then begin
y:=y+ym;
count:=count-xs;
end;
posa(x,y,color);
end;
end
else begin {steep line >=45 deg}
count:=-(ys div 2);
while (y <> y2 ) do begin
count:=count+xs;
y:=y+ym;
if count>0 then begin
x:=x+xm;
count:=count-ys;
end;
posa(x,y,color);
end;
end;
end;
procedure rota_tri(tri:triangle;angul,velocitat:real;color:byte);
var x1,x2,x3,y1,y2,y3:word;
begin
x1:=round((tri.p1.r+velocitat/2)*cos(tri.p1.angle+angul))+tri.centre.x;
x2:=round((tri.p2.r+velocitat/2)*cos(tri.p2.angle+angul+velocitat/5))+tri.centre.x;
x3:=round((tri.p3.r+velocitat/2)*cos(tri.p3.angle+angul-velocitat/5))+tri.centre.x;
y1:=round((tri.p1.r+velocitat/2)*sin(tri.p1.angle+angul))+tri.centre.y;
y2:=round((tri.p2.r+velocitat/2)*sin(tri.p2.angle+angul+velocitat/5))+tri.centre.y;
y3:=round((tri.p3.r+velocitat/2)*sin(tri.p3.angle+angul-velocitat/5))+tri.centre.y;
linea(x1,y1,x2,y2,color);
linea(x1,y1,x3,y3,color);
linea(x3,y3,x2,y2,color);
end;
var nau:triangle;
ang:real;
ch:char;
Dx,Dy:word;
begin
nau.p1.r:=6;nau.p1.angle:=3*pi/2;
nau.p2.r:=6;nau.p2.angle:=pi/4;
nau.p3.r:=6;nau.p3.angle:=(3*pi)/4;
nau.angle:=0;
nau.centre.x:=160;nau.centre.y:=100;
instalarkb;
mcga;
repeat
waitretrace;
rota_tri(nau,nau.angle,nau.velocitat,0);
if teclapuls(KEYarrowright) then nau.angle:=nau.angle+0.157079632;
if teclapuls(KEYarrowleft) then nau.angle:=nau.angle-0.157079632;
if teclapuls(KEYarrowup) then begin
if nau.velocitat<3 then nau.velocitat:=nau.velocitat+0.1;
end;
Dy:=round(nau.velocitat*sin(nau.angle-pi/2))+nau.centre.y;
Dx:=round(nau.velocitat*cos(nau.angle-pi/2))+nau.centre.x;
if (dy>marge_dalt) and (dy<marge_baix) then
nau.centre.y:=Dy;
if (dx>marge_esq) and (dx<marge_dret) then
nau.centre.x:=Dx;
if (nau.velocitat>0.05) then nau.velocitat:=nau.velocitat-0.05;
rota_tri(nau,nau.angle,nau.velocitat,2);
until teclapuls(keyesc);
desinstalarkb;
text;
end.

BIN
Asteroids.ico Executable file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.2 KiB

275
KEYBOARD.PAS Executable file
View File

@@ -0,0 +1,275 @@
{
-----------------------------------------------------
File: Keyboard.Pas
By: Ronny Wester, ronny@rat.se
Unit to check up/down status of individual key flags.
Written from code I got off rec.games.programmer.
Sorry, I lost the name of the poster.
As most of this code is scancode-dependent some keys
may not be where they "should" on your keyboard.
-----------------------------------------------------
}
unit Keyboard;
interface
uses Dos;
const
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;
keyNames : array [0..255] of PChar =
( { $00 } nil, 'Esc', '1', '2', '3', '4', '5', '6',
{ $08 } '7', '8', '9', '0', '+', 'Apostrophe', 'Backspace', 'Tab',
{ $10 } 'Q', 'W', 'E', 'R', 'T', 'Y', 'U', 'I',
{ $18 } 'O', 'P', '<27>', '?', 'Enter', 'Left Ctrl', 'A', 'S',
{ $20 } 'D', 'F', 'G', 'H', 'J', 'K', 'L', '<27>',
{ $28 } '<27>', '''', 'Left shift', '<', 'Z', 'X', 'C', 'V',
{ $30 } 'B', 'N', 'M', ',', '.', '-', 'Right shift', '* (pad)',
{ $38 } 'Alt', 'Space', 'Caps Lock', 'F1', 'F2', 'F3', 'F4', 'F5',
{ $40 } 'F6', 'F7', 'F8', 'F9', 'F10', 'Num Lock', 'Scroll Lock', '7 (pad)',
{ $48 } '8 (pad)', '9 (pad)', '- (pad)', '4 (pad)', '5 (pad)', '6 (pad)', '+ (pad)', '1 (pad)',
{ $50 } '2 (pad)', '3 (pad)', '0 (pad)', ', (pad)', 'SysRq', nil, nil, 'F11', 'F12',
{ $59 } nil, nil, nil, nil, nil, nil, nil,
{ $60 } nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil,
{ $70 } nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil,
{ $80 } nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil,
{ $90 } nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, 'Enter (pad)', 'Right Ctrl', nil, nil,
{ $A0 } nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil,
{ $B0 } nil, nil, nil, nil, nil, '/ (pad)', nil, 'PrtScr', 'Alt Gr', nil, nil, nil, nil, nil, nil, nil,
{ $C0 } nil, nil, nil, nil, nil, nil, nil, 'Home',
{ $C8 } 'Up arrow', 'Page Up', nil, 'Left arrow', nil, 'Right arrow', nil, 'End',
{ $D0 } 'Down arrow', nil, 'Insert', 'Delete', nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil,
{ $E0 } nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil,
{ $F0 } nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil
);
procedure InstalarKb;
procedure DesinstalarKb;
function TeclaPuls( b : byte ) : Boolean;
function QTeclaPuls : Boolean;
function AgarrarTecla : Byte;
procedure BorrarKb;
procedure EscriuKb;
implementation
var
uOldInt9 : Pointer; { saves location of old OldInt9 vector }
uKeys : array [0..255] of Boolean; { array that holds key values }
e0Flag : Byte;
uExitProc : Pointer;
{$F+}
procedure NewInt9; interrupt; assembler;
asm
cli
in al, $60 { get scan code from keyboard port }
cmp al, $E0 { al = $E0 key ? }
jne @@SetScanCode
mov [e0Flag], 128
mov al, 20h { Send 'generic' EOI to PIC }
out 20h, al
jmp @@exit
@@SetScanCode:
mov bl, al { Save scancode in BL }
and bl, 01111111b
add bl, [e0Flag]
xor bh, bh
and al, 10000000b { keep break bit, if set }
xor al, 10000000b { flip bit, 1 means pressed, 0 no }
rol al, 1 { move breakbit to bit 0 }
mov [offset uKeys + bx], al
mov [e0Flag], 0
mov al, 20h { send EOI to PIC }
out 20h, al
@@exit:
sti
end;
{$F-}
procedure InstalarKb;
begin
GetIntVec( $09, uOldInt9); { save old location of INT 09 handler }
SetIntVec( $09, Addr( NewInt9)); { point to new routine }
FillChar( uKeys, SizeOf( uKeys), 0); { clear the keys array }
end;
procedure DesinstalarKb;
begin
SetIntVec( $09, uOldInt9); { point back to original routine }
uOldInt9 := nil;
end;
function TeclaPuls( b : byte ) : Boolean;
begin
TeclaPuls := uKeys[b];
end;
function QTeclaPuls : Boolean;
var b : Integer;
begin
QTeclaPuls := True;
for b := 0 to 255 do
if uKeys[b] and (keyNames[b] <> nil) then
Exit;
QTeclaPuls := False;
end;
function AgarrarTecla : Byte;
var b : Integer;
begin
AgarrarTecla := 0;
for b := 1 to 255 do
if uKeys[b] and (keyNames[b] <> nil) then
begin
AgarrarTecla := b;
Exit;
end;
end;
procedure BorrarKb;
begin
FillChar( uKeys, SizeOf( uKeys), 0); { clear the keys array }
end;
{$F+}
procedure CleanUp;
begin
ExitProc := uExitProc;
if uOldInt9 <> nil then
DesinstalarKb;
end;
procedure EscriuKb;
var b:byte;
begin
for b := 0 to 255 do
if uKeys[b] and (keyNames[b] <> nil) then
write(keyNames[b],' | ');
writeln;
end;
{$F-}
begin
uExitProc := ExitProc;
ExitProc := @CleanUp;
uOldInt9 := nil;
end.