program gen;
uses graphabc;
var x,y,d,k,k1,ch:integer;
camX,camY,koef:integer;
dx:array[1..100,1..100] of string;
pX,pY:integer;
R,G,B,rad:integer;
dk:real;
procedure MouseDown(x,y,mb: integer);begin;
if mb=1 then begin
// camX:=round(camX/2);camY:=round(camY/2);
koef:=round(koef/2);
dk:=dk*2;
end;
if mb=2 then begin
// camX:=camX*2;camY:=camY*2;
koef:=koef*2;
dk:=dk/2;
end;
end;
procedure gener;begin;
ch:=0;
x:=50;
y:=50;
while ch<500 do begin
k:=1+random(4);
if k1=k then k:=1+random(4);
if k1=3 then k:=2;
if k1=4 then k:=1;
d:=1+random(7);
for var i:=0 to d-1 do begin
if k=1 then x:=x+1;
if k=2 then y:=y-1;
if k=3 then x:=x-1;
if k=4 then y:=y+1;
if x>1 then begin
if x<100 then begin
if y>1 then begin
if y<100 then begin
dx[x,y]:='floor';
end;end;end;end;
end;
if ch=0 then begin
pX:=x;pY:=y;
end;
ch:=ch+1;k1:=k;
end;
writeln('info:gen is ok');
end;
procedure init;begin;
Window.Title:='amazing rougelike';
Window.Height:=800;
Window.Width:=800;
Window.IsFixedSize:=true;
Window.CenterOnScreen;
for var i:=1 to 100 do begin
for var j:=1 to 100 do begin
dx[i,j]:='wall';
end;
end;
koef:=32;dk:=12.5;
writeln('info:init is ok');
end;
procedure keydown(key:integer);begin;
case key of
VK_Left: begin;
if dx[Px-1,Py]<>'wall' then pX:=pX-1;
end;
VK_Right: begin;
if dx[Px+1,Py]<>'wall' then pX:=pX+1;
end;
VK_Up: begin;
if dx[Px,Py-1]<>'wall' then pY:=pY-1;
end;
VK_Down: begin;
if dx[Px,Py+1]<>'wall' then pY:=pY+1;
end;
VK_Enter: begin; init; gener; end;
end;
end;
procedure mapping;begin;
camX:=round((pX-dk)*koef);camY:=round((pY-dk)*koef);
Window.Clear(clBlack);
var dr:boolean;
var ss:integer;
ss:=0;
var a:real;
var gx,gy,n:integer;
var dnd:boolean;
dnd:=false;n:=6;
r:=0;g:=0;b:=0;
//rad:=round(sqrt(((i-px)*(i-px))+((j-py)*(j-py))));
//if rad<6 then begin
for var l:=1 to 359 do begin
for var rg:=1 to n do begin
a:=l*(pi/180);
gx:=round((cos(a)*rg)+px);gy:=round((sin(a)*rg)+py);
if dx[gx,gy]='wall' then begin dnd:=true;n:=rg;end;
if dx[gx,gy]='floor' then begin
if dnd=false then begin
r:=254-rg*35;
g:=254-rg*35;
b:=254-rg*35;
setbrushcolor(rgb(r,g,b));setpencolor(rgb(r-20,g-20,b-20));
rectangle(((gx-1)*koef)-camX,((gy-1)*koef)-camY,((gx)*koef)-camX,((gy)*koef)-camY);
ss:=ss+1;
end;
end;
end;
dnd:=false;n:=6;
end;
setbrushcolor(clRandom);setpencolor(clRandom);
rectangle(((pX-1)*koef)-camX,((pY-1)*koef)-camY,((pX)*koef)-camX,((pY)*koef)-camY);
Window.Title:=inttostr(ss);
end;
begin
init;
gener;
writeln('info:wait for...');
for var i:=5 downto 1 do begin
writeln(' for ',i); sleep(999);
end;
writeln('info:drawing');writeln('info:simulating');sleep(150);
while 0=0 do begin
OnKeyDown := KeyDown;
OnMouseDown := MouseDown;
LockDrawing;
mapping;
Redraw;sleep(1);
end;
end.
//1-right/2-up/3-left/4-down