1 (*
2 * Hedgewars, a free turn based strategy game
3 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
4 *
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; version 2 of the License
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
13 *
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
17 *)
18
19 {$INCLUDE "options.inc"}
20
21 unit uLandTexture;
22 interface
23 uses SDLh;
24
25 procedure initModule;
26 procedure freeModule;
27 procedure UpdateLandTexture(X, Width, Y, Height: LongInt; landAdded: boolean);
28 procedure DrawLand(dX, dY: LongInt);
29 procedure ResetLand;
30 procedure SetLandTexture;
31
32 implementation
33 uses uConsts, GLunit, uTypes, uVariables, uTextures, uDebug, uRender, uUtils;
34
35 const TEXSIZE = 128;
36 // in avoid tile borders stretch the blurry texture by 1 pixel more
37 BLURRYLANDOVERLAP: real = 1 / TEXSIZE / 2.0; // 1 pixel divided by texsize and blurry land scale factor
38
39 type TLandRecord = record
40 shouldUpdate, landAdded: boolean;
41 tex: PTexture;
42 end;
43
44 var LandTextures: array of array of TLandRecord;
45 tmpPixels: array [0..TEXSIZE - 1, 0..TEXSIZE - 1] of LongWord;
46 LANDTEXARW: LongWord;
47 LANDTEXARH: LongWord;
48
Pixelsnull49 function Pixels(x, y: Longword): Pointer;
50 var ty: Longword;
51 begin
52 for ty:= 0 to TEXSIZE - 1 do
53 Move(LandPixels[y * TEXSIZE + ty, x * TEXSIZE], tmpPixels[ty, 0], sizeof(Longword) * TEXSIZE);
54
55 Pixels:= @tmpPixels
56 end;
57
Pixels2null58 function Pixels2(x, y: Longword): Pointer;
59 var tx, ty: Longword;
60 begin
61 for ty:= 0 to TEXSIZE - 1 do
62 for tx:= 0 to TEXSIZE - 1 do
63 tmpPixels[ty, tx]:= Land[y * TEXSIZE + ty, x * TEXSIZE + tx] or AMask;
64
65 Pixels2:= @tmpPixels
66 end;
67
68 procedure UpdateLandTexture(X, Width, Y, Height: LongInt; landAdded: boolean);
69 var tx, ty: Longword;
70 tSize : LongInt;
71 begin
72 if cOnlyStats then exit;
73 if (Width <= 0) or (Height <= 0) then
74 exit;
75 checkFails((X >= 0) and (X < LAND_WIDTH), 'UpdateLandTexture: wrong X parameter', true);
76 checkFails(X + Width <= LAND_WIDTH, 'UpdateLandTexture: wrong Width parameter', true);
77 checkFails((Y >= 0) and (Y < LAND_HEIGHT), 'UpdateLandTexture: wrong Y parameter', true);
78 checkFails(Y + Height <= LAND_HEIGHT, 'UpdateLandTexture: wrong Height parameter', true);
79 if not allOK then exit;
80
81 tSize:= TEXSIZE;
82
83 // land textures have half the size/resolution in blurry mode
84 if (cReducedQuality and rqBlurryLand) <> 0 then
85 tSize:= tSize * 2;
86
87 for ty:= Y div tSize to (Y + Height - 1) div tSize do
88 for tx:= X div tSize to (X + Width - 1) div tSize do
89 begin
90 if not LandTextures[tx, ty].shouldUpdate then
91 begin
92 LandTextures[tx, ty].shouldUpdate:= true;
93 inc(dirtyLandTexCount);
94 end;
95 LandTextures[tx, ty].landAdded:= landAdded
96 end;
97 end;
98
99 procedure RealLandTexUpdate(x1, x2, y1, y2: LongInt);
100 var x, y, ty, tx, lx, ly : LongWord;
101 isEmpty: boolean;
102 begin
103 if cOnlyStats then exit;
104 (*
105 if LandTextures[0, 0].tex = nil then
106 for x:= 0 to LANDTEXARW -1 do
107 for y:= 0 to LANDTEXARH - 1 do
108 with LandTextures[x, y] do
109 begin
110 tex:= NewTexture(TEXSIZE, TEXSIZE, Pixels(x, y));
111 glBindTexture(GL_TEXTURE_2D, tex^.id);
112 glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_PRIORITY, tpHigh);
113 end
114 else
115 *)
116 for x:= x1 to x2 do
117 for y:= y1 to y2 do
118 with LandTextures[x, y] do
119 if shouldUpdate then
120 begin
121 shouldUpdate:= false;
122 dec(dirtyLandTexCount);
123 isEmpty:= not landAdded;
124 landAdded:= false;
125 ty:= 0;
126 tx:= 1;
127 ly:= y * TEXSIZE;
128 lx:= x * TEXSIZE;
129 // first check edges
130 while isEmpty and (ty < TEXSIZE) do
131 begin
132 isEmpty:= LandPixels[ly + ty, lx] and AMask = 0;
133 if isEmpty then isEmpty:= LandPixels[ly + ty, Pred(lx + TEXSIZE)] and AMask = 0;
134 inc(ty)
135 end;
136 while isEmpty and (tx < TEXSIZE-1) do
137 begin
138 isEmpty:= LandPixels[ly, lx + tx] and AMask = 0;
139 if isEmpty then isEmpty:= LandPixels[Pred(ly + TEXSIZE), lx + tx] and AMask = 0;
140 inc(tx)
141 end;
142 // then search every other remaining. does this sort of stuff defeat compiler opts?
143 ty:= 2;
144 while isEmpty and (ty < TEXSIZE-1) do
145 begin
146 tx:= 2;
147 while isEmpty and (tx < TEXSIZE-1) do
148 begin
149 isEmpty:= LandPixels[ly + ty, lx + tx] and AMask = 0;
150 inc(tx,2)
151 end;
152 inc(ty,2);
153 end;
154 // and repeat
155 ty:= 1;
156 while isEmpty and (ty < TEXSIZE-1) do
157 begin
158 tx:= 1;
159 while isEmpty and (tx < TEXSIZE-1) do
160 begin
161 isEmpty:= LandPixels[ly + ty, lx + tx] and AMask = 0;
162 inc(tx,2)
163 end;
164 inc(ty,2);
165 end;
166 if not isEmpty then
167 begin
168 if tex = nil then tex:= NewTexture(TEXSIZE, TEXSIZE, Pixels(x, y));
169 glBindTexture(GL_TEXTURE_2D, tex^.id);
170 glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, TEXSIZE, TEXSIZE, 0, GL_RGBA, GL_UNSIGNED_BYTE, Pixels(x,y));
171 end
172 else if tex <> nil then
173 FreeAndNilTexture(tex);
174
175 // nothing else to do
176 if dirtyLandTexCount < 1 then
177 exit;
178 end
179 end;
180
181 procedure DrawLand(dX, dY: LongInt);
182 var x, y, tX, ty, tSize, fx, lx, fy, ly: LongInt;
183 tScale: GLfloat;
184 overlap: boolean;
185 begin
186 // init values based on quality settings
187 if (cReducedQuality and rqBlurryLand) <> 0 then
188 begin
189 tSize:= TEXSIZE * 2;
190 tScale:= 2.0;
191 overlap:= (cReducedQuality and rqClampLess) <> 0;
192 end
193 else
194 begin
195 tSize:= TEXSIZE;
196 tScale:= 1.0;
197 overlap:= false;
198 end;
199
200 // figure out visible area
201 // first column
202 tx:= ViewLeftX - dx;
203 fx:= tx div tSize;
204 if tx < 0 then dec(fx);
205 fx:= max(0, fx);
206
207 // last column
208 tx:= ViewRightX - dx;
209 lx:= tx div tSize;
210 if tx < 0 then dec(lx);
211 lx:= min(LANDTEXARW -1, lx);
212
213 // all offscreen
214 if (fx > lx) then
215 exit;
216
217 // first row
218 ty:= ViewTopY - dy;
219 fy:= ty div tSize;
220 if ty < 0 then dec(fy);
221 fy:= max(0, fy);
222
223 // last row
224 ty:= ViewBottomY - dy;
225 ly:= ty div tSize;
226 if ty < 0 then dec(ly);
227 ly:= min(LANDTEXARH -1, ly);
228
229 // all offscreen
230 if (fy > ly) then
231 exit;
232
233 // update visible areas of landtex before drawing
234 if dirtyLandTexCount > 0 then
235 RealLandTexUpdate(fx, lx, fy, ly);
236
237 tX:= dX + tsize * fx;
238
239 // loop through columns
240 for x:= fx to lx do
241 begin
242 // loop through textures in this column
243 for y:= fy to ly do
244 with LandTextures[x, y] do
245 if tex <> nil then
246 begin
247 ty:= dY + y * tSize;
248 if overlap then
249 DrawTexture2(tX, ty, tex, tScale, BLURRYLANDOVERLAP)
250 else
251 DrawTexture(tX, ty, tex, tScale);
252 end;
253
254 // increment tX
255 inc(tX, tSize);
256 end;
257 end;
258
259 procedure SetLandTexture;
260 begin
261 if (cReducedQuality and rqBlurryLand) = 0 then
262 begin
263 LANDTEXARW:= LAND_WIDTH div TEXSIZE;
264 LANDTEXARH:= LAND_HEIGHT div TEXSIZE;
265 end
266 else
267 begin
268 LANDTEXARW:= (LAND_WIDTH div TEXSIZE) div 2;
269 LANDTEXARH:= (LAND_HEIGHT div TEXSIZE) div 2;
270 end;
271
272 SetLength(LandTextures, LANDTEXARW, LANDTEXARH);
273 end;
274
275 procedure initModule;
276 begin
277 end;
278
279 procedure ResetLand;
280 var x, y: LongInt;
281 begin
282 for x:= 0 to LANDTEXARW - 1 do
283 for y:= 0 to LANDTEXARH - 1 do
284 with LandTextures[x, y] do
285 FreeAndNilTexture(tex);
286 end;
287
288 procedure freeModule;
289 begin
290 ResetLand;
291 if LandBackSurface <> nil then
292 SDL_FreeSurface(LandBackSurface);
293 LandBackSurface:= nil;
294 SetLength(LandTextures, 0, 0);
295 end;
296 end.
297