diff light.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/light.pas	Sun Dec 08 19:39:15 2013 +0100
@@ -0,0 +1,165 @@
+{ Field of vision counting routines. }
+
+UNIT Light;
+
+INTERFACE
+
+PROCEDURE MakeLut;
+PROCEDURE ApplyFov(cx,cy: INTEGER);
+
+IMPLEMENTATION
+
+USES Global;
+
+CONST	LOS_LINES=127;
+VAR	lut: 	ARRAY[0..MAPXSIZE,0..MAPYSIZE,0..1] OF BYTE;
+
+
+FUNCTION Min(a,b: INTEGER): INTEGER;
+BEGIN
+	IF a<b THEN Min:=a ELSE Min:=b;
+END;
+
+FUNCTION Max(a,b: INTEGER): INTEGER;
+BEGIN
+	IF a>b THEN Max:=a ELSE Max:=b;
+END;
+
+
+PROCEDURE MakeLut;
+VAR	a,d,x,y,lx,ly,dx,dy,ile: INTEGER;
+	s,c,an: REAL;
+BEGIN
+
+	FOR x:=0 TO MAPXSIZE DO
+		FOR y:=0 TO MAPYSIZE DO BEGIN
+			lut[x,y][0]:=255;
+			lut[x,y][1]:=0;
+		END;
+
+	FOR a:=0 TO LOS_LINES DO BEGIN
+		an:=(a*PI)/(los_lines*2);
+		s:=Sin(an)/4;
+		c:=Cos(an)/4;
+		lx:=0;
+		ly:=0;
+		d:=0;
+		REPEAT
+			x:=Trunc(s*d);
+			y:=Trunc(c*d);
+			
+			dx:=(x-lx);
+			dy:=(y-ly);
+			IF (x<=MAPXSIZE) AND (y<=MAPYSIZE) THEN BEGIN
+				lut[x,y][0]:=Min(lut[x,y][0],a);
+				lut[x,y][1]:=Max(lut[x,y][0],a);
+			END;
+			Inc(d);
+		UNTIL (x>MAPXSIZE) OR (y>MAPYSIZE);
+	END;
+END;
+
+
+PROCEDURE ApplyFov(cx,cy: INTEGER);
+VAR	rays: ARRAY[0..LOS_LINES] OF BOOLEAN;
+	x,y: INTEGER;
+	i,f,t: BYTE;
+	bl: BOOLEAN;
+	pow: BOOLEAN;
+	m: pMap;
+
+BEGIN
+	FOR i:=0 TO LOS_LINES DO rays[i]:=TRUE;
+	
+	FOR y:=cy TO MAPYSIZE DO
+		FOR x:=cx TO MAPXSIZE DO BEGIN
+			m:=GetMap(x,y);
+			pow:=FALSE;
+
+			bl:=(m^.ter^.vis<50);
+			
+			f:=lut[x-cx,y-cy][0];
+			t:=lut[x-cx,y-cy][1];
+			
+			FOR i:=f TO t DO IF rays[i] THEN BEGIN
+				pow:=TRUE;
+				IF NOT bl THEN rays[i]:=FALSE;
+			END;
+
+			IF pow  THEN BEGIN
+				m^.flg:=m^.flg+[MAP_VISIBLE];
+				m^.flg:=m^.flg+[MAP_EXPLORED];
+			END ELSE m^.flg:=m^.flg-[MAP_VISIBLE];
+		END;
+
+	FOR i:=0 TO LOS_LINES DO rays[i]:=TRUE;
+	
+	FOR y:=cy DOWNTO 0 DO
+		FOR x:=cx TO MAPXSIZE DO BEGIN
+			m:=GetMap(x,y);
+			pow:=FALSE;
+
+			bl:=(m^.ter^.vis<50);
+			
+			f:=lut[x-cx,cy-y][0];
+			t:=lut[x-cx,cy-y][1];
+			
+			FOR i:=f TO t DO IF rays[i] THEN BEGIN
+				pow:=TRUE;
+				IF NOT bl THEN rays[i]:=FALSE;
+			END;
+
+			IF pow  THEN BEGIN
+				m^.flg:=m^.flg+[MAP_VISIBLE];
+				m^.flg:=m^.flg+[MAP_EXPLORED];
+			END ELSE m^.flg:=m^.flg-[MAP_VISIBLE];
+		END;
+
+	FOR i:=0 TO LOS_LINES DO rays[i]:=TRUE;
+	
+	FOR y:=cy TO MAPYSIZE DO
+		FOR x:=cx DOWNTO 0 DO BEGIN
+			m:=GetMap(x,y);
+
+			pow:=FALSE;   
+			bl:=(m^.ter^.vis<50);
+			
+			f:=lut[cx-x,y-cy][0];
+			t:=lut[cx-x,y-cy][1];
+			
+			FOR i:=f TO t DO IF rays[i] THEN BEGIN
+				pow:=TRUE;
+				IF NOT bl THEN rays[i]:=FALSE;
+			END;
+
+			IF pow  THEN BEGIN
+				m^.flg:=m^.flg+[MAP_VISIBLE];
+				m^.flg:=m^.flg+[MAP_EXPLORED];
+			END ELSE m^.flg:=m^.flg-[MAP_VISIBLE];
+		END;
+
+	FOR i:=0 TO LOS_LINES DO rays[i]:=TRUE;
+	
+	FOR y:=cy DOWNTO 0 DO
+		FOR x:=cx DOWNTO 0 DO BEGIN
+			m:=GetMap(x,y);
+			pow:=FALSE;
+
+			bl:=(m^.ter^.vis<50);
+			
+			f:=lut[cx-x,cy-y][0];
+			t:=lut[cx-x,cy-y][1];
+			
+			FOR i:=f TO t DO IF rays[i] THEN BEGIN
+				pow:=TRUE;
+				IF NOT bl THEN rays[i]:=FALSE;
+			END;
+
+			IF pow  THEN BEGIN
+				m^.flg:=m^.flg+[MAP_VISIBLE];
+				m^.flg:=m^.flg+[MAP_EXPLORED];
+			END ELSE m^.flg:=m^.flg-[MAP_VISIBLE];
+		END;
+END;
+
+END.
\ No newline at end of file