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.