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