27 procedure FreeLand; |
27 procedure FreeLand; |
28 |
28 |
29 implementation |
29 implementation |
30 uses uMisc, uLand, uStore, uConsts, |
30 uses uMisc, uLand, uStore, uConsts, |
31 {$IFDEF GLES11} |
31 {$IFDEF GLES11} |
32 gles11; |
32 gles11; |
33 {$ELSE} |
33 {$ELSE} |
34 GL; |
34 GL; |
35 {$ENDIF} |
35 {$ENDIF} |
36 |
36 |
37 |
37 |
38 const TEXSIZE = 256; |
38 const TEXSIZE = 256; |
39 LANDTEXARW = LAND_WIDTH div TEXSIZE; |
39 LANDTEXARW = LAND_WIDTH div TEXSIZE; |
40 LANDTEXARH = LAND_HEIGHT div TEXSIZE; |
40 LANDTEXARH = LAND_HEIGHT div TEXSIZE; |
41 |
41 |
42 var |
42 var |
43 LandTextures: array[0..LANDTEXARW - 1, 0..LANDTEXARH - 1] of |
43 LandTextures: array[0..LANDTEXARW - 1, 0..LANDTEXARH - 1] of |
44 record |
44 record |
45 shouldUpdate: boolean; |
45 shouldUpdate: boolean; |
46 tex: PTexture; |
46 tex: PTexture; |
47 end; |
47 end; |
48 |
48 |
49 tmpPixels: array [0..TEXSIZE - 1, 0..TEXSIZE - 1] of LongWord; |
49 tmpPixels: array [0..TEXSIZE - 1, 0..TEXSIZE - 1] of LongWord; |
50 |
50 |
51 function Pixels(x, y: Longword): Pointer; |
51 function Pixels(x, y: Longword): Pointer; |
52 var ty: Longword; |
52 var ty: Longword; |
53 begin |
53 begin |
54 for ty:= 0 to TEXSIZE - 1 do |
54 for ty:= 0 to TEXSIZE - 1 do |
55 Move(LandPixels[y * TEXSIZE + ty, x * TEXSIZE], tmpPixels[ty, 0], sizeof(Longword) * TEXSIZE); |
55 Move(LandPixels[y * TEXSIZE + ty, x * TEXSIZE], tmpPixels[ty, 0], sizeof(Longword) * TEXSIZE); |
56 |
56 |
57 Pixels:= @tmpPixels |
57 Pixels:= @tmpPixels |
58 end; |
58 end; |
59 |
59 |
60 function Pixels2(x, y: Longword): Pointer; |
60 function Pixels2(x, y: Longword): Pointer; |
61 var tx, ty: Longword; |
61 var tx, ty: Longword; |
62 begin |
62 begin |
63 for ty:= 0 to TEXSIZE - 1 do |
63 for ty:= 0 to TEXSIZE - 1 do |
64 for tx:= 0 to TEXSIZE - 1 do |
64 for tx:= 0 to TEXSIZE - 1 do |
65 tmpPixels[ty, tx]:= Land[y * TEXSIZE + ty, x * TEXSIZE + tx] or AMask; |
65 tmpPixels[ty, tx]:= Land[y * TEXSIZE + ty, x * TEXSIZE + tx] or AMask; |
66 |
66 |
67 Pixels2:= @tmpPixels |
67 Pixels2:= @tmpPixels |
68 end; |
68 end; |
69 |
69 |
70 procedure UpdateLandTexture(X, Width, Y, Height: LongInt); |
70 procedure UpdateLandTexture(X, Width, Y, Height: LongInt); |
75 TryDo(X + Width <= LAND_WIDTH, 'UpdateLandTexture: wrong Width parameter', true); |
75 TryDo(X + Width <= LAND_WIDTH, 'UpdateLandTexture: wrong Width parameter', true); |
76 TryDo((Y >= 0) and (Y < LAND_HEIGHT), 'UpdateLandTexture: wrong Y parameter', true); |
76 TryDo((Y >= 0) and (Y < LAND_HEIGHT), 'UpdateLandTexture: wrong Y parameter', true); |
77 TryDo(Y + Height <= LAND_HEIGHT, 'UpdateLandTexture: wrong Height parameter', true); |
77 TryDo(Y + Height <= LAND_HEIGHT, 'UpdateLandTexture: wrong Height parameter', true); |
78 |
78 |
79 for ty:= Y div TEXSIZE to (Y + Height - 1) div TEXSIZE do |
79 for ty:= Y div TEXSIZE to (Y + Height - 1) div TEXSIZE do |
80 for tx:= X div TEXSIZE to (X + Width - 1) div TEXSIZE do |
80 for tx:= X div TEXSIZE to (X + Width - 1) div TEXSIZE do |
81 LandTextures[tx, ty].shouldUpdate:= true |
81 LandTextures[tx, ty].shouldUpdate:= true |
82 end; |
82 end; |
83 |
83 |
84 procedure RealLandTexUpdate; |
84 procedure RealLandTexUpdate; |
85 var x, y: LongWord; |
85 var x, y: LongWord; |
86 begin |
86 begin |
87 if LandTextures[0, 0].tex = nil then |
87 if LandTextures[0, 0].tex = nil then |
88 for x:= 0 to LANDTEXARW -1 do |
88 for x:= 0 to LANDTEXARW -1 do |
89 for y:= 0 to LANDTEXARH - 1 do |
89 for y:= 0 to LANDTEXARH - 1 do |
90 with LandTextures[x, y] do |
90 with LandTextures[x, y] do |
91 tex:= NewTexture(TEXSIZE, TEXSIZE, Pixels(x, y)) |
91 tex:= NewTexture(TEXSIZE, TEXSIZE, Pixels(x, y)) |
92 else |
92 else |
93 for x:= 0 to LANDTEXARW -1 do |
93 for x:= 0 to LANDTEXARW -1 do |
94 for y:= 0 to LANDTEXARH - 1 do |
94 for y:= 0 to LANDTEXARH - 1 do |
95 with LandTextures[x, y] do |
95 with LandTextures[x, y] do |
96 if shouldUpdate then |
96 if shouldUpdate then |
97 begin |
97 begin |
98 shouldUpdate:= false; |
98 shouldUpdate:= false; |
99 glBindTexture(GL_TEXTURE_2D, tex^.id); |
99 glBindTexture(GL_TEXTURE_2D, tex^.id); |
100 glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, TEXSIZE, TEXSIZE, GL_RGBA, GL_UNSIGNED_BYTE, Pixels(x, y)); |
100 glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, TEXSIZE, TEXSIZE, GL_RGBA, GL_UNSIGNED_BYTE, Pixels(x, y)); |
101 end |
101 end |
102 end; |
102 end; |
103 |
103 |
104 procedure DrawLand(dX, dY: LongInt); |
104 procedure DrawLand(dX, dY: LongInt); |
105 var x, y: LongInt; |
105 var x, y: LongInt; |
106 begin |
106 begin |
107 RealLandTexUpdate; |
107 RealLandTexUpdate; |
108 |
108 |
109 for x:= 0 to LANDTEXARW -1 do |
109 for x:= 0 to LANDTEXARW -1 do |
110 for y:= 0 to LANDTEXARH - 1 do |
110 for y:= 0 to LANDTEXARH - 1 do |
111 with LandTextures[x, y] do |
111 with LandTextures[x, y] do |
112 DrawTexture(dX + x * TEXSIZE, dY + y * TEXSIZE, tex) |
112 DrawTexture(dX + x * TEXSIZE, dY + y * TEXSIZE, tex) |
113 end; |
113 end; |
114 |
114 |
115 procedure FreeLand; |
115 procedure FreeLand; |
116 var x, y: LongInt; |
116 var x, y: LongInt; |
117 begin |
117 begin |
118 for x:= 0 to LANDTEXARW -1 do |
118 for x:= 0 to LANDTEXARW -1 do |
119 for y:= 0 to LANDTEXARH - 1 do |
119 for y:= 0 to LANDTEXARH - 1 do |
120 with LandTextures[x, y] do |
120 with LandTextures[x, y] do |
121 begin |
121 begin |
122 FreeTexture(tex); |
122 FreeTexture(tex); |
123 tex:= nil; |
123 tex:= nil; |
124 end; |
124 end; |
125 end; |
125 end; |
126 |
126 |
127 end. |
127 end. |