basic rougelike

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
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