Mercurial > rg
diff 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 diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/level.pas Sun Dec 08 19:39:15 2013 +0100 @@ -0,0 +1,368 @@ +{ 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. \ No newline at end of file
