37 procedure Smooth(X, Y: LongInt); |
37 procedure Smooth(X, Y: LongInt); |
38 function CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean; |
38 function CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean; |
39 function DrawExplosion(X, Y, Radius: LongInt): Longword; |
39 function DrawExplosion(X, Y, Radius: LongInt): Longword; |
40 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); |
40 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); |
41 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt); |
41 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt); |
42 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); |
42 function FillRoundInLand(X, Y, Radius: LongInt; Value: Longword): Longword; |
43 function FillRoundInLandFT(X, Y, Radius: LongInt; fill: fillType): Longword; |
43 function FillRoundInLandFT(X, Y, Radius: LongInt; fill: fillType): Longword; |
44 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
44 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
45 function LandBackPixel(x, y: LongInt): LongWord; |
45 function LandBackPixel(x, y: LongInt): LongWord; |
46 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword); |
46 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword); |
47 procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword); |
47 function DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword): Longword; |
48 procedure DumpLandToLog(x, y, r: LongInt); |
48 procedure DumpLandToLog(x, y, r: LongInt); |
49 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint); |
49 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint); |
50 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace, indestructible: boolean): boolean; inline; |
50 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace, indestructible: boolean): boolean; inline; |
51 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace, indestructible: boolean; LandFlags: Word): boolean; |
51 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace, indestructible: boolean; LandFlags: Word): boolean; |
52 |
52 |
295 nAlpha := min(255, oAlpha + nAlpha); |
295 nAlpha := min(255, oAlpha + nAlpha); |
296 |
296 |
297 addBgColor := (nAlpha shl AShift) or (nRed shl RShift) or (nGreen shl GShift) or (nBlue shl BShift); |
297 addBgColor := (nAlpha shl AShift) or (nRed shl RShift) or (nGreen shl GShift) or (nBlue shl BShift); |
298 end; |
298 end; |
299 |
299 |
300 procedure FillCircleLines(x, y, dx, dy: LongInt; Value: Longword); |
300 function FillCircleLines(x, y, dx, dy: LongInt; Value: Longword): Longword; |
301 var i: LongInt; |
301 var i: LongInt; |
302 begin |
302 begin |
303 if ((y + dy) and LAND_HEIGHT_MASK) = 0 then |
303 FillCircleLines:= 0; |
304 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
304 |
305 if (Land[y + dy, i] and lfIndestructible) = 0 then |
305 if ((y + dy) and LAND_HEIGHT_MASK) = 0 then |
306 Land[y + dy, i]:= Value; |
306 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
307 if ((y - dy) and LAND_HEIGHT_MASK) = 0 then |
307 if (Land[y + dy, i] and lfIndestructible) = 0 then |
308 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
308 begin |
309 if (Land[y - dy, i] and lfIndestructible) = 0 then |
309 if Land[y + dy, i] <> Value then inc(FillCircleLines); |
310 Land[y - dy, i]:= Value; |
310 Land[y + dy, i]:= Value; |
311 if ((y + dx) and LAND_HEIGHT_MASK) = 0 then |
311 end; |
312 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
312 if ((y - dy) and LAND_HEIGHT_MASK) = 0 then |
313 if (Land[y + dx, i] and lfIndestructible) = 0 then |
313 for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
314 Land[y + dx, i]:= Value; |
314 if (Land[y - dy, i] and lfIndestructible) = 0 then |
315 if ((y - dx) and LAND_HEIGHT_MASK) = 0 then |
315 begin |
316 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
316 if Land[y - dy, i] <> Value then inc(FillCircleLines); |
317 if (Land[y - dx, i] and lfIndestructible) = 0 then |
317 Land[y - dy, i]:= Value; |
318 Land[y - dx, i]:= Value; |
318 end; |
319 end; |
319 if ((y + dx) and LAND_HEIGHT_MASK) = 0 then |
320 |
320 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
321 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); |
321 if (Land[y + dx, i] and lfIndestructible) = 0 then |
|
322 begin |
|
323 if Land[y + dx, i] <> Value then inc(FillCircleLines); |
|
324 Land[y + dx, i]:= Value; |
|
325 end; |
|
326 if ((y - dx) and LAND_HEIGHT_MASK) = 0 then |
|
327 for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
|
328 if (Land[y - dx, i] and lfIndestructible) = 0 then |
|
329 begin |
|
330 if Land[y - dx, i] <> Value then inc(FillCircleLines); |
|
331 Land[y - dx, i]:= Value; |
|
332 end; |
|
333 end; |
|
334 |
|
335 function FillRoundInLand(X, Y, Radius: LongInt; Value: Longword): Longword; |
322 var dx, dy, d: LongInt; |
336 var dx, dy, d: LongInt; |
323 begin |
337 begin |
|
338 FillRoundInLand:= 0; |
324 dx:= 0; |
339 dx:= 0; |
325 dy:= Radius; |
340 dy:= Radius; |
326 d:= 3 - 2 * Radius; |
341 d:= 3 - 2 * Radius; |
327 while (dx < dy) do |
342 while (dx < dy) do |
328 begin |
343 begin |
329 FillCircleLines(x, y, dx, dy, Value); |
344 inc(FillRoundInLand, FillCircleLines(x, y, dx, dy, Value)); |
330 if (d < 0) then |
345 if (d < 0) then |
331 d:= d + 4 * dx + 6 |
346 d:= d + 4 * dx + 6 |
332 else |
347 else |
333 begin |
348 begin |
334 d:= d + 4 * (dx - dy) + 10; |
349 d:= d + 4 * (dx - dy) + 10; |
335 dec(dy) |
350 dec(dy) |
336 end; |
351 end; |
337 inc(dx) |
352 inc(dx) |
338 end; |
353 end; |
339 if (dx = dy) then |
354 if (dx = dy) then |
340 FillCircleLines(x, y, dx, dy, Value); |
355 inc(FillRoundInLand, FillCircleLines(x, y, dx, dy, Value)); |
341 end; |
356 end; |
342 |
357 |
343 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
358 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
344 begin |
359 begin |
345 if not doSet and isCurrent then |
360 if not doSet and isCurrent then |
982 if ((x and LAND_WIDTH_MASK) = 0) and ((y and LAND_HEIGHT_MASK) = 0) then |
997 if ((x and LAND_WIDTH_MASK) = 0) and ((y and LAND_HEIGHT_MASK) = 0) then |
983 Land[y, x]:= Color; |
998 Land[y, x]:= Color; |
984 end |
999 end |
985 end; |
1000 end; |
986 |
1001 |
987 procedure DrawDots(x, y, xx, yy: Longint; Color: Longword); inline; |
1002 function DrawDots(x, y, xx, yy: Longint; Color: Longword): Longword; inline; |
988 begin |
1003 begin |
989 if (((x + xx) and LAND_WIDTH_MASK) = 0) and (((y + yy) and LAND_HEIGHT_MASK) = 0) then Land[y + yy, x + xx]:= Color; |
1004 if (((x + xx) and LAND_WIDTH_MASK) = 0) and (((y + yy) and LAND_HEIGHT_MASK) = 0) and (Land[y + yy, x + xx] <> Color) then |
990 if (((x + xx) and LAND_WIDTH_MASK) = 0) and (((y - yy) and LAND_HEIGHT_MASK) = 0) then Land[y - yy, x + xx]:= Color; |
1005 begin inc(DrawDots); Land[y + yy, x + xx]:= Color; end; |
991 if (((x - xx) and LAND_WIDTH_MASK) = 0) and (((y + yy) and LAND_HEIGHT_MASK) = 0) then Land[y + yy, x - xx]:= Color; |
1006 if (((x + xx) and LAND_WIDTH_MASK) = 0) and (((y - yy) and LAND_HEIGHT_MASK) = 0) and (Land[y - yy, x + xx] <> Color) then |
992 if (((x - xx) and LAND_WIDTH_MASK) = 0) and (((y - yy) and LAND_HEIGHT_MASK) = 0) then Land[y - yy, x - xx]:= Color; |
1007 begin inc(DrawDots); Land[y - yy, x + xx]:= Color; end; |
993 if (((x + yy) and LAND_WIDTH_MASK) = 0) and (((y + xx) and LAND_HEIGHT_MASK) = 0) then Land[y + xx, x + yy]:= Color; |
1008 if (((x - xx) and LAND_WIDTH_MASK) = 0) and (((y + yy) and LAND_HEIGHT_MASK) = 0) and (Land[y + yy, x - xx] <> Color) then |
994 if (((x + yy) and LAND_WIDTH_MASK) = 0) and (((y - xx) and LAND_HEIGHT_MASK) = 0) then Land[y - xx, x + yy]:= Color; |
1009 begin inc(DrawDots); Land[y + yy, x - xx]:= Color; end; |
995 if (((x - yy) and LAND_WIDTH_MASK) = 0) and (((y + xx) and LAND_HEIGHT_MASK) = 0) then Land[y + xx, x - yy]:= Color; |
1010 if (((x - xx) and LAND_WIDTH_MASK) = 0) and (((y - yy) and LAND_HEIGHT_MASK) = 0) and (Land[y - yy, x - xx] <> Color) then |
996 if (((x - yy) and LAND_WIDTH_MASK) = 0) and (((y - xx) and LAND_HEIGHT_MASK) = 0) then Land[y - xx, x - yy]:= Color; |
1011 begin inc(DrawDots); Land[y - yy, x - xx]:= Color; end; |
997 end; |
1012 if (((x + yy) and LAND_WIDTH_MASK) = 0) and (((y + xx) and LAND_HEIGHT_MASK) = 0) and (Land[y + xx, x + yy] <> Color) then |
998 |
1013 begin inc(DrawDots); Land[y + xx, x + yy]:= Color; end; |
999 procedure DrawLines(X1, Y1, X2, Y2, XX, YY: LongInt; color: Longword); |
1014 if (((x + yy) and LAND_WIDTH_MASK) = 0) and (((y - xx) and LAND_HEIGHT_MASK) = 0) and (Land[y - xx, x + yy] <> Color) then |
|
1015 begin inc(DrawDots); Land[y - xx, x + yy]:= Color; end; |
|
1016 if (((x - yy) and LAND_WIDTH_MASK) = 0) and (((y + xx) and LAND_HEIGHT_MASK) = 0) and (Land[y + xx, x - yy] <> Color) then |
|
1017 begin inc(DrawDots); Land[y + xx, x - yy]:= Color; end; |
|
1018 if (((x - yy) and LAND_WIDTH_MASK) = 0) and (((y - xx) and LAND_HEIGHT_MASK) = 0) and (Land[y - xx, x - yy] <> Color) then |
|
1019 begin inc(DrawDots); Land[y - xx, x - yy]:= Color; end; |
|
1020 end; |
|
1021 |
|
1022 function DrawLines(X1, Y1, X2, Y2, XX, YY: LongInt; color: Longword): Longword; |
1000 var |
1023 var |
1001 eX, eY, dX, dY: LongInt; |
1024 eX, eY, dX, dY: LongInt; |
1002 i, sX, sY, x, y, d: LongInt; |
1025 i, sX, sY, x, y, d: LongInt; |
1003 f: boolean; |
1026 f: boolean; |
1004 begin |
1027 begin |
1005 eX:= 0; |
1028 eX:= 0; |
1006 eY:= 0; |
1029 eY:= 0; |
1007 dX:= X2 - X1; |
1030 dX:= X2 - X1; |
1008 dY:= Y2 - Y1; |
1031 dY:= Y2 - Y1; |
|
1032 DrawLines:= 0; |
1009 |
1033 |
1010 if (dX > 0) then |
1034 if (dX > 0) then |
1011 sX:= 1 |
1035 sX:= 1 |
1012 else |
1036 else |
1013 if (dX < 0) then |
1037 if (dX < 0) then |
1045 f:= eX > d; |
1069 f:= eX > d; |
1046 if f then |
1070 if f then |
1047 begin |
1071 begin |
1048 dec(eX, d); |
1072 dec(eX, d); |
1049 inc(x, sX); |
1073 inc(x, sX); |
1050 DrawDots(x, y, xx, yy, color) |
1074 inc(DrawLines, DrawDots(x, y, xx, yy, color)) |
1051 end; |
1075 end; |
1052 if (eY > d) then |
1076 if (eY > d) then |
1053 begin |
1077 begin |
1054 dec(eY, d); |
1078 dec(eY, d); |
1055 inc(y, sY); |
1079 inc(y, sY); |
1056 f:= true; |
1080 f:= true; |
1057 DrawDots(x, y, xx, yy, color) |
1081 inc(DrawLines, DrawDots(x, y, xx, yy, color)) |
1058 end; |
1082 end; |
1059 |
1083 |
1060 if not f then |
1084 if not f then |
1061 DrawDots(x, y, xx, yy, color) |
1085 inc(DrawLines, DrawDots(x, y, xx, yy, color)) |
1062 end |
1086 end |
1063 end; |
1087 end; |
1064 |
1088 |
1065 procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword); |
1089 function DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword): Longword; |
1066 var dx, dy, d: LongInt; |
1090 var dx, dy, d: LongInt; |
1067 begin |
1091 begin |
|
1092 DrawThickLine:= 0; |
|
1093 |
1068 dx:= 0; |
1094 dx:= 0; |
1069 dy:= Radius; |
1095 dy:= Radius; |
1070 d:= 3 - 2 * Radius; |
1096 d:= 3 - 2 * Radius; |
1071 while (dx < dy) do |
1097 while (dx < dy) do |
1072 begin |
1098 begin |
1073 DrawLines(x1, y1, x2, y2, dx, dy, color); |
1099 inc(DrawThickLine, DrawLines(x1, y1, x2, y2, dx, dy, color)); |
1074 if (d < 0) then |
1100 if (d < 0) then |
1075 d:= d + 4 * dx + 6 |
1101 d:= d + 4 * dx + 6 |
1076 else |
1102 else |
1077 begin |
1103 begin |
1078 d:= d + 4 * (dx - dy) + 10; |
1104 d:= d + 4 * (dx - dy) + 10; |
1079 dec(dy) |
1105 dec(dy) |
1080 end; |
1106 end; |
1081 inc(dx) |
1107 inc(dx) |
1082 end; |
1108 end; |
1083 if (dx = dy) then |
1109 if (dx = dy) then |
1084 DrawLines(x1, y1, x2, y2, dx, dy, color); |
1110 inc(DrawThickLine, DrawLines(x1, y1, x2, y2, dx, dy, color)); |
1085 end; |
1111 end; |
1086 |
1112 |
1087 |
1113 |
1088 procedure DumpLandToLog(x, y, r: LongInt); |
1114 procedure DumpLandToLog(x, y, r: LongInt); |
1089 var xx, yy, dx: LongInt; |
1115 var xx, yy, dx: LongInt; |