1 unit uLandUtils; |
1 unit uLandUtils; |
2 interface |
2 interface |
3 |
3 |
4 procedure ResizeLand(width, height: LongWord); |
4 procedure ResizeLand(width, height: LongWord); |
|
5 procedure DisposeLand(); |
5 procedure InitWorldEdges(); |
6 procedure InitWorldEdges(); |
|
7 |
|
8 function LandGet(y, x: LongInt): Word; |
|
9 procedure LandSet(y, x: LongInt; value: Word); |
|
10 |
|
11 procedure FillLand(x, y: LongInt; border, value: Word); |
6 |
12 |
7 implementation |
13 implementation |
8 uses uUtils, uConsts, uVariables, uTypes; |
14 uses uUtils, uConsts, uVariables, uTypes; |
|
15 |
|
16 const LibFutureName = 'hwengine_future'; |
|
17 function create_game_field(width, height: Longword): pointer; cdecl; external LibFutureName; |
|
18 procedure dispose_game_field(game_field: pointer); cdecl; external LibFutureName; |
|
19 function land_get(game_field: pointer; x, y: LongInt): Word; cdecl; external LibFutureName; |
|
20 procedure land_set(game_field: pointer; x, y: LongInt; value: Word); cdecl; external LibFutureName; |
|
21 procedure land_fill(game_field: pointer; x, y: LongInt; border, fill: Word); cdecl; external LibFutureName; |
|
22 |
|
23 var gameField: pointer; |
|
24 |
|
25 function LandGet(y, x: LongInt): Word; |
|
26 begin |
|
27 LandGet:= land_get(gameField, x, y) |
|
28 end; |
|
29 |
|
30 procedure LandSet(y, x: LongInt; value: Word); |
|
31 begin |
|
32 land_set(gameField, x, y, value) |
|
33 end; |
|
34 |
|
35 procedure FillLand(x, y: LongInt; border, value: Word); |
|
36 begin |
|
37 land_fill(gameField, x, y, border, value) |
|
38 end; |
9 |
39 |
10 procedure ResizeLand(width, height: LongWord); |
40 procedure ResizeLand(width, height: LongWord); |
11 var potW, potH: LongInt; |
41 var potW, potH: LongInt; |
12 begin |
42 begin |
13 potW:= toPowerOf2(width); |
43 potW:= toPowerOf2(width); |
22 if (cReducedQuality and rqBlurryLand) = 0 then |
52 if (cReducedQuality and rqBlurryLand) = 0 then |
23 SetLength(LandPixels, LAND_HEIGHT, LAND_WIDTH) |
53 SetLength(LandPixels, LAND_HEIGHT, LAND_WIDTH) |
24 else |
54 else |
25 SetLength(LandPixels, LAND_HEIGHT div 2, LAND_WIDTH div 2); |
55 SetLength(LandPixels, LAND_HEIGHT div 2, LAND_WIDTH div 2); |
26 |
56 |
27 SetLength(Land, LAND_HEIGHT, LAND_WIDTH); |
57 gameField:= create_game_field(LAND_WIDTH, LAND_HEIGHT); |
28 SetLength(LandDirty, (LAND_HEIGHT div 32), (LAND_WIDTH div 32)); |
58 SetLength(LandDirty, (LAND_HEIGHT div 32), (LAND_WIDTH div 32)); |
29 // 0.5 is already approaching on unplayable |
59 // 0.5 is already approaching on unplayable |
30 if (width div 4096 >= 2) or (height div 2048 >= 2) then cMaxZoomLevel:= cMaxZoomLevel/2; |
60 if (width div 4096 >= 2) or (height div 2048 >= 2) then cMaxZoomLevel:= cMaxZoomLevel/2; |
31 cMinMaxZoomLevelDelta:= cMaxZoomLevel - cMinZoomLevel |
61 cMinMaxZoomLevelDelta:= cMaxZoomLevel - cMinZoomLevel |
32 end; |
62 end; |
33 initScreenSpaceVars(); |
63 initScreenSpaceVars(); |
|
64 end; |
|
65 |
|
66 procedure DisposeLand(); |
|
67 begin |
|
68 dispose_game_field(gameField) |
34 end; |
69 end; |
35 |
70 |
36 procedure InitWorldEdges(); |
71 procedure InitWorldEdges(); |
37 var cy, cx, lx, ly: LongInt; |
72 var cy, cx, lx, ly: LongInt; |
38 found: boolean; |
73 found: boolean; |
68 // find most left land pixels and set leftX accordingly |
103 // find most left land pixels and set leftX accordingly |
69 found:= false; |
104 found:= false; |
70 for cx:= 0 to lx do |
105 for cx:= 0 to lx do |
71 begin |
106 begin |
72 for cy:= ly downto 0 do |
107 for cy:= ly downto 0 do |
73 if Land[cy, cx] <> 0 then |
108 if LandGet(cy, cx) <> 0 then |
74 begin |
109 begin |
75 leftX:= max(0, cx - cWorldEdgeDist); |
110 leftX:= max(0, cx - cWorldEdgeDist); |
76 // break out of both loops |
111 // break out of both loops |
77 found:= true; |
112 found:= true; |
78 break; |
113 break; |
83 // find most right land pixels and set rightX accordingly |
118 // find most right land pixels and set rightX accordingly |
84 found:= false; |
119 found:= false; |
85 for cx:= lx downto 0 do |
120 for cx:= lx downto 0 do |
86 begin |
121 begin |
87 for cy:= ly downto 0 do |
122 for cy:= ly downto 0 do |
88 if Land[cy, cx] <> 0 then |
123 if LandGet(cy, cx) <> 0 then |
89 begin |
124 begin |
90 rightX:= min(lx, cx + cWorldEdgeDist); |
125 rightX:= min(lx, cx + cWorldEdgeDist); |
91 // break out of both loops |
126 // break out of both loops |
92 found:= true; |
127 found:= true; |
93 break; |
128 break; |