Ask Question

Name:
Title:
Your Question:

Answer Question

Name:
Your Answer:
User Submitted Source Code!


Description:
  1012004
Language: PASCAL
Code:
{$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;

{ **** 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 ****',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 ****, huh?}
until port[$60]=1;
freemem(virscr,64000);
asm mov ax,3; int 10h; end;
end.
Comments: