Umiestnenie súboru www.TrSek.com/cover/foxy/f-15.pas{ F-15.PAS }
{ }
{ Author: Robert Bobak }
{ Date : 15.02.1997 http://www.trsek.com }
program LeteckySimulatorF15;
uses crt,graph,DOS;
var gd,gm,x,y:integer;
ch:char;
P,M: pointer;
Size: Word;
xm,ym,but,XM1,YM1,BUT1:integer;
STRXM,STRYM,STRBUT:STRING;
konci:boolean;
PROCEDURE IKONA(X1,Y1,X2,Y2:INTEGER;TEXT:STRING);
BEGIN
SETLINESTYLE(0,0,3);SETFILLSTYLE(1,7);
BAR(X1,Y1,X2,Y2);SETCOLOR(15);
LINE(X1,Y1,X2,Y1);
LINE(X1,Y1,X1,Y2);
SETCOLOR(8);
LINE(X1,Y2,X2,Y2);LINE(X2,Y2,X2,Y1);
OUTTEXTXY(X1+8,(Y1+Y2) DIV 2 -4,TEXT);
SETLINESTYLE(0,0,1);
END;
function gminit:boolean;
var reg:registers;
begin
reg.ax:=$0000;
intr($33,reg);
if reg.ax=$0000 then gminit:=false
else gminit:=true;
but:=reg.bx;
end;
procedure zobraz_mys;
var reg:registers;
begin
reg.ax:=$0001;
intr($33,reg);
end;
procedure NEzobraz_mys;
var reg:registers;
begin
reg.ax:=$0002;
intr($33,reg);
end;
procedure test_mys(var x,y,but:integer);
var reg:registers;
begin
reg.ax:=$0003;
intr($33,reg);
x:=reg.cx;
y:=reg.dx;
but:=reg.bx;
end;
PROCEDURE IKONY;
BEGIN
ikona(10,10,100,30,'PLAY');IKONA(10,60,100,80,'HI-SCORE');
IKONA(10,110,100,130,'END');
END;
procedure f15(x,y,f:integer);
var a:integer;
begin
setcolor(f);
{-------------------zadna chvostova plocha---------------------------}
line(x+0,y+5,x+25,y+5);
line(x+10,y+5,x+52,y+32);
line(x+52,y+32,x+45,y+35);
moveto(x+45,y+35);lineto(x+5,y+35);
lineto(x+0,y+5);
line(x-2,y+6,x+2,y+6);
line(x-2,y+8,x+2,y+8);
{-----------------------stabilizatory--------------------------------}
for a:=40 to 41 do line(x+-5,y+a,x+30,y+a);
{-------------------------motor--------------------------------------}
moveto(x+7,y+40);lineto(x+7,y+47);
line(x+5,y+35,x+5,y+40);
lineto(x+17,y+50);lineto(x+17,y+40);
{--------------------------nasavaci otvor----------------------------}
line(x+17,y+50,x+150,y+45);
moveto(x+150,y+45);
lineto(x+172,y+27);
lineto(x+157,y+22);lineto(x+50,y+30);
{---------------------------predna cast+kabina-----------------------}
moveto(x+205,y+17);lineto(x+175,y+20);
line(x+152,y+42,x+204,y+40);
lineto(x+165,y+15);lineto(x+160,y+10);
lineto(x+150,y+15);line(x+160,y+10,x+182,y+5);
line(x+182,y+5,x+182,y+19);line(x+182,y+5,x+205,y+17);
line(x+197,y+13,x+197,y+18);
{-------------------kridlo+pripojka na kridlo-----------------------}
line(x+140,y+23,x+157,y+32);
moveto(x+157,y+32);
lineto(x+145,y+37);
lineto(x+80,y+40);
lineto(x+60,y+35);
lineto(x+80,y+28);
for a:=1 to 3 do line(x+56,y+33+a,x+125,y+29+a);
{--------------------------obluky-----------------------------------}
arc(x+200,y+155,69,90,138);
arc(x+190,y-98,270,296,138);
arc(x+109,y-61,270,300,87);
{-------------------------vyplnovanie-------------------------------}
setfillstyle(1,7);
floodfill(x+100,y+35,8);
floodfill(x+10,y+20,8);
floodfill(x+100,y+40,8);
floodfill(x+160,y+35,8);
setfillstyle(1,8);
floodfill(x+10,y+45,8);
setfillstyle(1,7);
floodfill(x+200,y+30,8);
setfillstyle(1,9);
floodfill(x+170,y+15,8);
floodfill(x+190,y+15,8);
floodfill(x+200,y+15,8);
{-------------------------znak--------------------------------}
setcolor(8);
line(x+180,y+30,x+195,y+30);
moveto(x+195,y+30);
lineto(x+195,y+35);
lineto(x+180,y+35);
lineto(x+180,y+30);
setcolor(lightred);
line(x+181,y+32,x+194,y+32);
setcolor(1);
for a:=1 to 4 do circle(x+187,y+32,a);
end;
procedure mrak(x,y:integer);
var a:integer;
begin
setcolor(15);
for a:=1 to 12 do circle(x+40,y+50,a);
for a:=1 to 12 do circle(x+34,y+54,a);
for a:=1 to 20 do circle(x+80,y+20,a);
for a:=1 to 20 do circle(x+100,y+20,a);
for a:=1 to 30 do circle(x+60,y+50,a);
for a:=1 to 30 do circle(x+50,y+54,a);
for a:=1 to 30 do circle(x+144,y+50,a);
for a:=1 to 32 do circle(x+110,y+50,a);
end;
outtextxy(x,y+200,'ÛÛÛÛÛ ÞÛÝ ÛÛÛÛÛ Û ÛÛÛÛÛ');
outtextxy(x,y+208,'Û Û Û Û Û Û Û');
outtextxy(x,y+216,'Û Û Û Û');
outtextxy(x,y+224,'Û Û Û Û');
outtextxy(x,y+232,'ÛÜÛ Û ÜÜ Û ÛÜÛ');
outtextxy(x,y+240,'ÛßÛ Û ßÛ Û ÛßÛ');
outtextxy(x,y+248,'Û Û Û Û Û');
outtextxy(x,y+256,'Û Û Û Û Û');
outtextxy(x,y+264,'Û Û Û Û Û Û Û');
outtextxy(x,y+272,'ÛÛÛÛÛ ÛÛ ÛÛ ÛÛÛÛÛ ÛÛÛÛÛ ÛÛÛÛÛ');
line(x+60,y+273,x+72,y+208);
line(x+80,y+208,x+92,y+273);
line(x+72,y+257,x+68,y+273);
line(x+72,y+257,x+80,y+257);
line(x+80,y+257,x+84,y+224+49);
line(x+72,y+249,x+80,y+249);
moveto(x+80,y+249);
lineto(x+76,180+49+y);
lineto(x+72,y+249);
setfillstyle(1,10);
floodfill(x+76,y+175+49,10);
end;
PROCEDURE MYS;
BEGIN
if not(gminit) then writeln('Nemas nainstalovany ovladac na mys.');
zobraz_mys;
konci:=false;
repeat
test_mys(xm,ym,but);
IF ((XM>9) AND (XM<101) AND (YM>10) AND (YM<30) AND (BUT=1)) THEN BEGIN
NEZOBRAZ_MYS;
DEMO(200,100);
IKONY;
ZOBRAZ_MYS;
konci:=true;
END;
IF ((XM>10) AND (XM<101) AND (YM>60) AND (YM<80) AND (BUT=1)) THEN BEGIN
CLEARDEVICE;
IKONY;
SETCOLOR(13);
OUTTEXTXY(500,100,'Hi-score:');
end;
IF ((XM>10) AND (XM<101) AND (YM>110) AND (YM<130) AND (BUT=1)) THEN konci:=true;
until (konci);
end;
procedure kresli(x,y:integer);
begin
GetImage(x,y,265+x,50+y,M^);
PutImage(x,y,P^,2);
delay(300);
PutImage(x,y,M^,NormalPut);
end;
procedure uvod_demo;
var i,a:integer;
begin
Size := ImageSize(0,0,270,50);
GetMem(P, Size);
f15(10,10,8);
GetImage(0,0,270,50,P^);
cleardevice;
for i:=1 to 50 do begin
putimage(i*5,100,P^,NormalPut);
sound(200);
delay(10);
end;
a:=500;
for i:=1 to 60 do begin
putimage(250+i*2,100+i*5,P^,NormalPut);
a:=a-5;
sound(a);
delay(10);
end;
nosound;
end;
{ zaciatok programu }
begin
gd:=detect;
initgraph(gd,gm,'');
if graphresult<>grok then halt(1);
setbkcolor(0);
cleardevice;
uvod_demo;