16 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA |
16 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA |
17 *) |
17 *) |
18 |
18 |
19 unit uLandTexture; |
19 unit uLandTexture; |
20 interface |
20 interface |
21 uses SDLh, uLandTemplates, uFloat, GL, uConsts; |
21 uses SDLh; |
22 |
22 |
23 procedure UpdateLandTexture(Y, Height: LongInt); |
23 procedure UpdateLandTexture(X, Width, Y, Height: LongInt); |
24 procedure DrawLand (X, Y: LongInt); |
24 procedure DrawLand(dX, dY: LongInt); |
|
25 procedure FreeLand; |
25 |
26 |
26 implementation |
27 implementation |
27 uses uMisc, uLand, uStore; |
28 uses uMisc, uLand, uStore, GL, uConsts; |
28 |
29 |
29 var LandTexture: PTexture = nil; |
30 const TEXSIZE = 256; |
30 updTopY: LongInt = LAND_HEIGHT; |
31 LANDTEXARW = LAND_WIDTH div TEXSIZE; |
31 updBottomY: LongInt = 0; |
32 LANDTEXARH = LAND_HEIGHT div TEXSIZE; |
32 |
33 |
|
34 var |
|
35 LandTextures: array[0..LANDTEXARW - 1, 0..LANDTEXARH - 1] of |
|
36 record |
|
37 shouldUpdate: boolean; |
|
38 tex: PTexture; |
|
39 end; |
33 |
40 |
34 procedure UpdateLandTexture(Y, Height: LongInt); |
41 tmpPixels: array [0..TEXSIZE - 1, 0..TEXSIZE - 1] of LongWord; |
|
42 |
|
43 function Pixels(x, y: Longword): Pointer; |
|
44 var ty: Longword; |
35 begin |
45 begin |
36 if (Height <= 0) then exit; |
46 for ty:= 0 to TEXSIZE - 1 do |
|
47 Move(LandPixels[y * TEXSIZE + ty, x * TEXSIZE], tmpPixels[ty, 0], sizeof(Longword) * TEXSIZE); |
|
48 |
|
49 Pixels:= @tmpPixels |
|
50 end; |
37 |
51 |
|
52 procedure UpdateLandTexture(X, Width, Y, Height: LongInt); |
|
53 var tx, ty: Longword; |
|
54 begin |
|
55 TryDo((X >= 0) and (X < LAND_WIDTH), 'UpdateLandTexture: wrong X parameter', true); |
|
56 TryDo(X + Width <= LAND_WIDTH, 'UpdateLandTexture: wrong Width parameter', true); |
38 TryDo((Y >= 0) and (Y < LAND_HEIGHT), 'UpdateLandTexture: wrong Y parameter', true); |
57 TryDo((Y >= 0) and (Y < LAND_HEIGHT), 'UpdateLandTexture: wrong Y parameter', true); |
39 TryDo(Y + Height <= LAND_HEIGHT, 'UpdateLandTexture: wrong Height parameter', true); |
58 TryDo(Y + Height <= LAND_HEIGHT, 'UpdateLandTexture: wrong Height parameter', true); |
40 |
59 |
41 if Y < updTopY then updTopY:= Y; |
60 for ty:= Y div TEXSIZE to (Y + Height - 1) div TEXSIZE do |
42 if Y + Height > updBottomY then updBottomY:= Y + Height |
61 for tx:= X div TEXSIZE to (X + Width - 1) div TEXSIZE do |
|
62 LandTextures[tx, ty].shouldUpdate:= true |
43 end; |
63 end; |
44 |
64 |
45 procedure RealLandTexUpdate; |
65 procedure RealLandTexUpdate; |
|
66 var x, y: LongWord; |
46 begin |
67 begin |
47 if updBottomY = 0 then exit; |
68 if LandTextures[0, 0].tex = nil then |
48 |
69 for x:= 0 to LANDTEXARW -1 do |
49 if LandTexture = nil then |
70 for y:= 0 to LANDTEXARH - 1 do |
50 LandTexture:= NewTexture(LAND_WIDTH, LAND_HEIGHT, @LandPixels) |
71 with LandTextures[x, y] do |
|
72 tex:= NewTexture(TEXSIZE, TEXSIZE, Pixels(x, y)) |
51 else |
73 else |
52 begin |
74 for x:= 0 to LANDTEXARW -1 do |
53 glBindTexture(GL_TEXTURE_2D, LandTexture^.id); |
75 for y:= 0 to LANDTEXARH - 1 do |
54 glTexSubImage2D(GL_TEXTURE_2D, 0, 0, updTopY, LAND_WIDTH, updBottomY - updTopY, GL_RGBA, GL_UNSIGNED_BYTE, @LandPixels[updTopY, 0]); |
76 with LandTextures[x, y] do |
55 end; |
77 if shouldUpdate then |
56 |
78 begin |
57 updTopY:= LAND_HEIGHT + 1; |
79 glBindTexture(GL_TEXTURE_2D, tex^.id); |
58 updBottomY:= 0 |
80 glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, TEXSIZE, TEXSIZE, GL_RGBA, GL_UNSIGNED_BYTE, Pixels(x, y)); |
|
81 end |
59 end; |
82 end; |
60 |
83 |
61 procedure DrawLand(X, Y: LongInt); |
84 procedure DrawLand(dX, dY: LongInt); |
|
85 var x, y: LongInt; |
62 begin |
86 begin |
63 RealLandTexUpdate; |
87 RealLandTexUpdate; |
64 DrawTexture(X, Y, LandTexture) |
88 |
|
89 for x:= 0 to LANDTEXARW -1 do |
|
90 for y:= 0 to LANDTEXARH - 1 do |
|
91 with LandTextures[x, y] do |
|
92 DrawTexture(dX + x * TEXSIZE, dY + y * TEXSIZE, tex) |
|
93 end; |
|
94 |
|
95 procedure FreeLand; |
|
96 var x, y: LongInt; |
|
97 begin |
|
98 for x:= 0 to LANDTEXARW -1 do |
|
99 for y:= 0 to LANDTEXARH - 1 do |
|
100 with LandTextures[x, y] do |
|
101 FreeTexture(tex) |
65 end; |
102 end; |
66 |
103 |
67 end. |
104 end. |