Mercurial > rg
view level.pas @ 0:62966dd383ed default tip
initial
| author | Radomir Dopieralski <sheep-devel@sheep.art.pl> |
|---|---|
| date | Sun, 08 Dec 2013 19:39:15 +0100 |
| parents | |
| children |
line wrap: on
line source
{ Level generating routines. } {$Q+R+} UNIT Level; INTERFACE USES Global; PROCEDURE GenerateLevel; IMPLEMENTATION USES Console, Items, Creature; CONST GEN_EMPTY=0; { level generator values } GEN_DOOR=1; GEN_OCCUPY=2; TYPE TmpMap=ARRAY[0..MAPXSIZE,0..MAPYSIZE] OF BYTE; VAR gen: TmpMap; m: TmpMap; PROCEDURE ClearMap; VAR x,y: INTEGER; m: pMap; nothing: TileDef; BEGIN nothing:=FindTile(0); GetMap(playchr^.x,playchr^.y)^.crt:=NIL; FOR y:=0 TO MAPYSIZE DO FOR x:=0 TO MAPXSIZE DO BEGIN m:=GetMap(x,y); IF m^.slt<>NIL THEN BEGIN Dispose(m^.slt); m^.slt:=NIL; END; IF m^.crt<>NIL THEN BEGIN Dispose(m^.crt); m^.crt:=NIL; END; m^.flg:=[]; m^.ter:=nothing; END; allmonsters:=NIL; END; PROCEDURE GenMap; VAR x,y: INTEGER; BEGIN FOR y:=0 TO MAPYSIZE DO FOR x:=0 TO MAPXSIZE DO BEGIN GetMap(x,y)^.ter:=FindTile(m[x,y]); END; END; PROCEDURE GenBack(lev: pLevel); VAR r,i,s,x,y,a,b: INTEGER; frak: TmpMap; BEGIN FOR y:=0 TO MAPYSIZE DO FOR x:=0 TO MAPXSIZE DO m[x,y]:=lev^.back[0]; END; PROCEDURE Erode(lev:pLevel); VAR x,y,r: INTEGER; BEGIN FOR y:=0 TO MAPYSIZE DO FOR x:=0 TO MAPXSIZE DO IF lev^.erosion>Random(100) THEN BEGIN r:=FindTile(m[x,y])^.dst; IF r>0 THEN m[x,y]:=r; END; END; PROCEDURE GenLevel(lev:pLevel); VAR r,i,j,p,x1,y1,x,y: INTEGER; door: BYTE; rom: pRoom; place: BYTE; pmap: tmpmap; tmpplaces: Places; FUNCTION TryRoom(x,y: INTEGER; rom: pRoom): BOOLEAN; VAR x1,y1: INTEGER; BEGIN IF rom=NIL THEN Exit; TryRoom:=FALSE; FOR y1:=0 TO 15 DO FOR x1:=0 TO 15 DO IF (rom^.map[x1,y1]<>GEN_EMPTY) THEN BEGIN IF (NOT InMap(x+x1,y+y1)) THEN Exit; IF (gen[x+x1,y+y1]=GEN_OCCUPY) THEN Exit; END; TryRoom:=TRUE; END; PROCEDURE RotateRoom(rom:pRoom); VAR x,y: INTEGER; tmp: ARRAY[0..15,0..15] OF BYTE; BEGIN FOR y:=0 TO 15 DO FOR x:=0 TO 15 DO tmp[x,y]:=rom^.map[y,15-x]; FOR y:=0 TO 15 DO FOR x:=0 TO 15 DO rom^.map[x,y]:=tmp[x,y]; END; PROCEDURE PutDoor(x,y:INTEGER); VAR p: INTEGER; BEGIN gen[x,y]:=GEN_OCCUPY; IF door=0 THEN Exit; m[x,y]:=door; END; PROCEDURE PutRoom(x,y: INTEGER; rom: pRoom); VAR x1,y1: INTEGER; BEGIN IF rom=NIL THEN Exit; IF tmpplaces[place].qnt>0 THEN Dec(tmpplaces[place].qnt); door:=tmpplaces[place].dor; FOR y1:=0 TO 15 DO FOR x1:=0 TO 15 DO IF InMap(x+x1,y+y1) AND (gen[x+x1,y+y1]<>GEN_OCCUPY) THEN BEGIN CASE rom^.map[x1,y1] OF GEN_EMPTY: {nothing}; GEN_OCCUPY: gen[x+x1,y+y1]:=GEN_EMPTY; GEN_DOOR: IF gen[x+x1,y+y1]=GEN_EMPTY THEN BEGIN gen[x+x1,y+y1]:=GEN_DOOR; pmap[x+x1,y+y1]:=place; END ELSE BEGIN IF (ROOM_EASYDOOR IN rom^.flg) AND (gen[x+x1,y+y1]=GEN_DOOR) THEN PutDoor(x+x1,y+y1) ELSE gen[x+x1,y+y1]:=GEN_OCCUPY; END; ELSE BEGIN gen[x+x1,y+y1]:=GEN_OCCUPY; m[x+x1,y+y1]:=rom^.map[x1,y1]; END; END; END; END; PROCEDURE NextRoom(x,y: INTEGER); VAR a: INTEGER; BEGIN a:=place; place:=pmap[x1,y1]; REPEAT Inc(a); IF a>MAXROOMS THEN a:=1; UNTIL (tmpplaces[place].con[a]<>0) AND (tmpplaces[tmpplaces[place].con[a]].qnt<>0); place:=tmpplaces[place].con[a]; rom:=FindRoom(tmpplaces[place].rom); a:=Random(100); IF (a<70) THEN RotateRoom(rom); END; PROCEDURE RandomRoom(x,y: INTEGER); VAR a: INTEGER; BEGIN place:=pmap[x1,y1]; a:=Random(MAXROOMS)+1; WHILE (tmpplaces[place].con[a]=0) OR (tmpplaces[tmpplaces[place].con[a]].qnt=0) DO BEGIN Inc(a); IF a>MAXROOMS THEN a:=1; END; place:=tmpplaces[place].con[a]; rom:=FindRoom(tmpplaces[place].rom); a:=Random(100); IF (a<70) THEN RotateRoom(rom); END; FUNCTION PickRoom: BOOLEAN; VAR i,j,k,l: INTEGER; BEGIN place:=pmap[x1,y1]; door:=tmpplaces[place].dor; PickRoom:=FALSE; IF tmpplaces[place].con[1]=0 THEN Exit; { IF (gen[x1+1,y1]<>GEN_EMPTY) AND (gen[x1-1,y1]<>GEN_EMPTY) AND (gen[x1,y1+1]<>GEN_EMPTY) AND (gen[x1,y1-1]<>GEN_EMPTY) THEN Exit;} PickRoom:=TRUE; RandomRoom(x1,y1); FOR k:=1 TO 4 DO BEGIN x:=Random(15); y:=Random(15); FOR j:=1 TO 2 DO BEGIN i:=0; REPEAT Inc(x); IF x>15 THEN BEGIN x:=0; Inc(y); IF y>15 THEN y:=0; END; Inc(i); IF (i>200) THEN BEGIN NextRoom(x1,y1); x:=Random(15); y:=Random(15); END; UNTIL (rom^.map[x,y]=GEN_DOOR); IF TryRoom(x1-x,y1-y,rom) THEN Exit; RotateRoom(rom); END; NextRoom(x1,y1); END; PickRoom:=FALSE; END; BEGIN tmpplaces:=lev^.rooms; FOR y:=0 TO MAPYSIZE DO FOR x:=0 TO MAPXSIZE DO BEGIN gen[x,y]:=GEN_EMPTY; pmap[x,y]:=0; END; place:=1; rom:=FindRoom(tmpplaces[place].rom); door:=rom^.dor; Msg('@cTrying first room...'); REPEAT x:=Random(MAPXSIZE); dec(x,8); y:=Random(MAPYSIZE); dec(y,8); Msg(Concat('@cx=',Num(x),';y=',Num(y))); UNTIL TryRoom(x,y,rom); Msg('@cPutting first room...'); PutRoom(x,y,rom); Msg('@cFirst room put...'); REPEAT x1:=Random(MAPXSIZE); y1:=Random(MAPYSIZE); i:=0; r:=Random(4); CASE r OF 0:WHILE gen[x1,y1]<>GEN_DOOR DO BEGIN Inc(x1); IF x1>MAPXSIZE-1 THEN BEGIN x1:=1; Inc(y1); IF y1>MAPYSIZE-1 THEN y1:=1; END; Inc(i); IF i>MAPXSIZE*MAPYSIZE THEN BEGIN Exit; END; END; 1:WHILE gen[x1,y1]<>GEN_DOOR DO BEGIN Dec(x1); IF x1<1 THEN BEGIN x1:=MAPXSIZE-1; Dec(y1); IF y1<1 THEN y1:=MAPYSIZE-1; END; Inc(i); IF i>MAPXSIZE*MAPYSIZE THEN BEGIN Exit; END; END; 2:WHILE gen[x1,y1]<>GEN_DOOR DO BEGIN Inc(y1); IF y1>MAPYSIZE-1 THEN BEGIN y1:=1; Inc(x1); IF x1>MAPXSIZE-1 THEN x1:=1; END; Inc(i); IF i>MAPXSIZE*MAPYSIZE THEN BEGIN Exit; END; END; 3: WHILE gen[x1,y1]<>GEN_DOOR DO BEGIN Dec(y1); IF y1<1 THEN BEGIN y1:=MAPYSIZE-1; Dec(x1); IF x1<1 THEN x1:=MAPXSIZE-1; END; Inc(i); IF i>MAPXSIZE*MAPYSIZE THEN BEGIN Exit; END; END; END; Msg('@cPicking room...'); IF PickRoom THEN BEGIN Msg('@cPutting room...'); PutDoor(x1,y1); PutRoom(x1-x,y1-y,rom); END ELSE BEGIN gen[x1,y1]:=GEN_EMPTY; END; UNTIL FALSE; END; PROCEDURE GenerateLevel; VAR x,y,i,a,b: INTEGER; l: pLevel; p: pCreat; BEGIN ClearMap; l:=FindLevel(pc.lev); Msg(Replace(msgs[12],'@v',l^.name)); GenBack(l); Msg('@cGenerated back...'); GenLevel(l); Msg('@cGenerated rooms...'); Erode(l); Msg('@cEroded...'); GenMap; FOR y:=0 TO MAPYSIZE DO FOR x:=0 TO MAPXSIZE DO BEGIN IF (TILE_ENTER IN GetMap(x,y)^.ter^.flg) THEN BEGIN p:=playchr; MoveMonster(x,y,p); END; END; Inc(pc.lev); END; END.
