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