Lập trình game trên pascal

Program ve_duong_tu_dong;
uses crt,graph;
type
diem = record
t_d:byte;
x: integer;
y:integer;
end;
var
n,i,j,gd,gm,x1,x2,y1,y2,l,m:integer;
a:array[1..100] of diem;
b,a1,c,b1:array[1..100] of integer;
fv:text;
procedure linenn(x1,y1,x2,y2:integer); { ve duong }
begin
setcolor(9);
setlinestyle(0,0,3);
settextstyle(4,0,1);
line(x1,y1,x2,y2); moveto(x2,y2);
moverel(-5,5); linerel(5,-5);
moverel(-5,-5);linerel(5,5);
delay(4000);
end;
procedure nhap_diem;
begin
write('nhap vao cac diem can ve(m< 23 vi file co 23 diem) m= '); readln(m);
for i:=1 to m do
begin
write('b1[',i,']='); readln(b1[i]);
end;
end;
Procedure mang_diem;
Begin
assign(fv,'d:\nut.txt');
reset(fv);
readln(fv,n);
begin
j:=0;
while not(seekeof(fv)) do
begin
j:=j+1;
readln(fv,a1[j],b[j],c[j]);
a[j].t_d:=a1[j];
a[j].x:=b[j];
a[j].y:=c[j];
end;
end;
close(fv);
End;
Begin
gd:=detect;
nhap_diem;
initgraph(gd,gm,'');
If GraphResult <> GrOk Then
Halt(1);
setbkcolor(white);
setcolor(red);
mang_diem;
i:=1;
while i< m do
begin
j:=i+1;
linenn(a[b1[i]].x,a[b1[i]].y,a[b1[j]].x,a[b1[j]].y);
i:=j;
end;
readln;
closegraph;
End.

uses crt;
const
edge=0; us=1; them=2; none=3;
gridsize=15;
maxmoves=200;
alphabet=96;
null=' ';
type
squares=edge..none;
smallint=0..gridsize;
byte=0..255;
cardinal=0..65535;
line=array[0..9] of squares;
var
grid: array[1..gridsize,1..gridsize] of squares;
name: array[squares] of char;
icol, irow: array[1..4] of -1..1;
play: packed array[1..maxmoves] of record
rowfield, colfield: smallint;
end;
v, vals: array[1..4] of integer;
i,j,r,c: smallint;
onboard: set of smallint;
move: cardinal;
endgame: squares;
yourturn: boolean;
topvalue: integer;
response: char;

program ranbo;
uses crt,dos;
type
TPoint=record
x,y:byte;
end;

ran=array[1..100] of TPoint; {tôi khai báo lai cho d? coi}

var
conran:ran;
x,y, x1,y1, l, huong :byte;
tocdo, diem :integer;
kt :char; {k0 dùng}
ranchet :boolean;
{-------------------------------------------------------}
procedure setcusor(bot,top:byte);
var
regs:registers;
begin
regs.ah:=1; regs.ch:=bot; regs.cl:=top;
intr($10,regs);
end;
{-------------------------------------------------------}
procedure ngaunhien;
begin
x1:=random(30)+5; y1:=random(20)+2;
kt:=chr(random(25)+65);
gotoxy(x1,y1); write(kt);
end;
{-------------------------------------------------------}
procedure vekhung;
var
j:byte;
begin
clrscr;
textcolor(white);
gotoxy(1,1);
for j:=1 to 40 do write(#177);

gotoxy(1,24);
for j:=1 to 40 do write(#177);

for j:=2 to 24 do
begin
gotoxy(1,j); write(#177);
gotoxy(40,j);write(#177);
end;
gotoxy(8,24);
textcolor(lightred);
writeln('Nhap phim Esc de thoat');
end;
{-------------------------------------------------------}
procedure ranchay;
var rk:char;
begin
if keypressed then {neu an co an phim thi}
begin
rk:=readkey; {b?n thi?u} {d?c xem phím nào v?a b?m}
if rk=#27 then halt(1); {neu la esc thoat}
if rk=#0 then rk:=readkey; {neu la phim dieu khien(control key), d?c lai de lay ma}
huong:=ord(rk);
end;

case huong of
80: inc(y);
72: dec(y);
77: inc(x);
75: dec(x);
end;

if (y=1) or(y=24) or(x=40) or(x=1) then ranchet:=true;
end;
{-------------------------------------------------------}
procedure init;
var
j:byte;
begin
randomize;
textmode(co40);
tocdo:=200;
diem:=0;
vekhung;
l:=3;
x:=10;y:=10;

huong:=0; {+ nen khoi tao huong}

for j:=1 to l+1 do
begin
conran[j].x:=30+j; conran[j].y:=10;
end;

ngaunhien;
setcusor(32,3);
ranchet:=false;
end;
{-------------------------------------------------------}
procedure thuchien;
var
i:byte;
begin
init;
i:=4;
repeat
ranchay;
dec(i);
gotoxy(conran[i].x,conran[i].y);
write(' ');
conran[i].x:=x; conran[i].y:=y;
textcolor(lightred);
gotoxy(4,1);
write(' DIEM ',diem);

if (diem>0) and ( diem mod 200=0) then
begin
diem:=diem+50;
gotoxy(6,12);
textcolor(white);
textbackground(red);
writeln('KHA LAM ! = MOI BAN TIEP TUC');
repeat until keypressed;
textbackground(0);
clrscr;
vekhung;
if tocdo>=100 then tocdo:=tocdo-50;
if diem>=400 then l:=3;
i:=l;
end;
if (x=x1) and (y=y1) then
begin
l:=l+1; ngaunhien;
diem:=diem+10;
end;
gotoxy(x1,y1);
write(kt);
textcolor(lightcyan);
gotoxy(conran[i].x,conran[i].y);
write(#219);
if i=1 then i:=l+1;
delay(tocdo);
until ranchet;
gotoxy(15,11); write(' BAN DA THUA ');
gotoxy(5,12);
write(' Nhan phim bat ki de choi tiep ');
end;

{-------------------------------------------------------}
BEGIN
repeat
clrscr;
thuchien;
kt:=readkey;
until kt=#27;
clrscr;
END.

{$G+}

const
vga:word=$a000;

type tbullet=array[0..1] of byte; {2 places for x,y coords, row and collom}
{yeah, i do records too, but this is easier for 'me' to follow}
label newgame; {been easier to 0 score, but i was doing other stuff}
var
bullet:tbullet;
x,y:integer; {bullet coords}
virscr:pointer;
score:integer;
fofs,fseg,Vaddr,px,py:word;
pbtimer,cenergy,penergy,range,cx,cy:integer;
cxd,cyd:shortint;

{ mouse routines ----------------------------------------------------------- }

function mouseinstalled:boolean; assembler; asm
xor ax,ax; int 33h; cmp ax,-1; je @skip; xor al,al; @skip: end;

function getmousex:word; assembler; asm
mov ax,3; int 33h; mov ax,cx end;

function getmousey:word; assembler; asm
mov ax,3; int 33h; mov ax,dx end;

function leftpressed:boolean; assembler; asm
mov ax,3; int 33h; and bx,1; mov ax,bx end;

function rightpressed:boolean; assembler; asm
mov ax,3; int 33h; and bx,2; mov ax,bx end;

procedure mousesensetivity(x,y:word); assembler; asm
mov ax,1ah; mov bx,x; mov cx,y; xor dx,dx; int 33h end;

{ video related routines --------------------------------------------------- }

procedure getfont; assembler; asm
mov ax,1130h; mov bh,1; int 10h; mov fseg,es; mov fofs,bp; end;

procedure writetxt(x,y:word; txt:string; where:word; col:byte);
var i,j,k:byte;
begin
for i:=1 to length(txt) do for j:=0 to 7 do for k:=0 to 7 do
if ((mem[fseg:fofs+ord(txt[i])*8+j] shl k) and 128) <> 0 then
mem[where:(y+j)*320+(i*8)+x+k]:=col;
end;

procedure Cls(where:word; col:byte);
begin
fillchar(mem[where:0],64000,col);
end;

procedure flip(src,dst:word); assembler; asm
push ds; mov ds,[src]; xor si,si; mov es,[dst]
xor di,di; mov cx,320*200/2; rep movsw; pop ds; end;

procedure putpixel(x,y:word; c:byte ); assembler; asm
mov es,[Vaddr]; mov ax,[y]; shl ax,6; mov di,ax; shl ax,2
add di,ax; add di,[x]; mov al,[c]; mov [es:di],al; end;

{ shit starts --------------------------------------------------------- }

procedure moveplayer;
var i:word;
begin
px:=getmousex shr 1; py:=getmousey;
if px<4 then px:=4 else if px>316 then px:=316;
py:=160;
if leftpressed then begin
i:=0; {goes here, resets with ea keypress}
if (i<1) and (y=0) then begin inc(i);
x:=px; {load bullet coords}
y:=py;
end;
end;
end;
procedure movebullets;
var a:word;
begin
for a:=0 to 1 do {why?}
if y>0 then begin {y starts at 160, from where players gun is, (x)}
dec(y,4); {4 seems to be the magic number}
if y=0 then begin {off screen?, then killem}
x:=0; y:=0; dec(penergy,4);
end;end;
if penergy<-1 then begin {get the last shot}
writetxt(90,96,' GAME OVER !',vga,1);
writetxt(84,116,'click right to replay',vga,15);
writetxt(84,126,' press esc to exit',vga,15);
end;
end;

procedure movetarget;
var i:word; rx,ry,difx,dify,big:integer;
begin
dec(range);
if range<0 then begin
range:=random(100);
case random(8) of
0:begin cxd:=-1; cyd:=-1; end;
1:begin cxd:=0; cyd:=-1; end;
2:begin cxd:=1; cyd:=-1; end;
3:begin cxd:=1; cyd:=0; end;
4:begin cxd:=1; cyd:=1; end;
5:begin cxd:=0; cyd:=1; end;
6:begin cxd:=-1; cyd:=1; end;
7:begin cxd:=-1; cyd:=0; end;
end;
end;
inc(cx,cxd);
inc(cy,cyd);
if cx<4 then begin cx:=4; range:=0; end
else if cx>304 then begin cx:=304; range:=0; end;
if cy<0 then begin cy:=0; range:=0; end
else if cy>100 then begin cy:=100; range:=0; end;
end;

procedure reset;
begin
fillchar(bullet,sizeof(bullet),0);
cx:=4+random(304); cy:=random(84);
range:=0;
score:=0;
cenergy:=100;
penergy:=100;
end;

procedure checkall;
var i:word; dx,dy:integer;
begin
i:=0; { player bullets hit target } if penergy>-1 then begin
while (i<1) and (x>0) do begin
dx:=(cx-x)+16; {target area}
dy:=(cy-y)+16;
if (dx >=0) and (dx <=16) and {start the goofy math!??}
(dy >=0) and (dy <=8) then begin {hit target?}
inc(score,10);
if (dx >=3) and (dx <=12) and
(dy >=0) and (dy <=8) then begin {hit target 2nd row?}
inc(score,10);
if (dx >=6) and (dx <=9) and
(dy >=0) and (dy <=8) then begin {hit target center?}
inc(score,10);
{ rigging here, only way i could make it work right? why?}
dec(cenergy,4);
if cenergy<0 then begin
writetxt(90,96,'aint this a piece of shit',vga,1);

repeat until 5<4;
end; end;
end; end;
inc(i);
end;end; end;

{ draw all stuff to screen ------------------------------------------------- }

procedure drawall;
var scorestr:string; lcbx,lcby,i,a,b:word;

begin
{ player }
putpixel(px,py,15);
putpixel(px-1,py+1,7);
putpixel(px+1,py+1,7);
putpixel(px-2,py+2,8);
putpixel(px+2,py+2,8);
{ target , yeah, i even drew this from the center out, got the same results}
for a:=0 to 15 do
for b:=0 to 15 do
putpixel(cx+a,cy+b,4);
for a:=3 to 12 do
for b:=3 to 12 do
putpixel(cx+a,cy+b,3);
for a:=6 to 9 do
for b:=6 to 9 do
putpixel(cx+a,cy+b,5);

{ player bullets }
for i:=0 to 1 do
if x>0 then begin
putpixel(x,y-2,15);
putpixel(x,y-1,4);
putpixel(x,y,4);
end;
{ score }
str(score,scorestr);
writetxt(10,190,scorestr,Vaddr,15);
{ penergy-bar }
for i:=199 downto (199-penergy) do begin
putpixel(1,i,8);
putpixel(2,i,14);
putpixel(3,i,8);
end;
while (port[$3da] and 8) <> 0 do;
while (port[$3da] and 8) = 0 do;
flip(Vaddr,vga);
end;


{ main --------------------------------------------------------------------- }

var i,j:word;
begin
if not mouseinstalled then begin writeln('Needs mouse!'); halt; end;
mousesensetivity(30,30);
asm mov ax,13h; int 10h; end;
getfont; {this has to go here, after setmode}
getmem(virscr,64000); Vaddr:=seg(virscr^);
newgame:
reset;
repeat
cls(Vaddr,9);
drawall;
moveplayer;
movetarget; {take this out, and see where i got the crappy math}
movebullets;
checkall;
if rightpressed then Goto newgame; {pure shit, huh?}
until port[$60]=1;
freemem(virscr,64000);
asm mov ax,3; int 10h; end;
end.