author | RodolfoRG |
Mon, 22 Jul 2013 18:16:01 +0200 | |
changeset 9366 | 4d0128c9cb35 |
parent 9080 | 9b42757d7e71 |
child 9127 | e350500c4edb |
child 9144 | 1e0ba74930d0 |
permissions | -rw-r--r-- |
393 | 1 |
(* |
1066 | 2 |
* Hedgewars, a free turn based strategy game |
9080 | 3 |
* Copyright (c) 2004-2013 Andrey Korotaev <unC0Rr@gmail.com> |
393 | 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA |
|
17 |
*) |
|
18 |
||
2630 | 19 |
{$INCLUDE "options.inc"} |
20 |
||
184 | 21 |
unit uLandGraphics; |
22 |
interface |
|
4357
a1fcfc341a52
Introduce unit uTypes in order to remove some cyclic unit dependencies
unC0Rr
parents:
3749
diff
changeset
|
23 |
uses uFloat, uConsts, uTypes; |
184 | 24 |
|
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
25 |
type |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
26 |
fillType = (nullPixel, backgroundPixel, ebcPixel, icePixel, setNotCurrentMask, changePixelSetNotCurrent, setCurrentHog, changePixelNotSetNotCurrent); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
27 |
|
7035 | 28 |
type TRangeArray = array[0..31] of record |
371 | 29 |
Left, Right: LongInt; |
184 | 30 |
end; |
7035 | 31 |
PRangeArray = ^TRangeArray; |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
32 |
TLandCircleProcedure = procedure (landX, landY, pixelX, pixelY: Longint); |
184 | 33 |
|
4791 | 34 |
function addBgColor(OldColor, NewColor: LongWord): LongWord; |
2716
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2695
diff
changeset
|
35 |
function SweepDirty: boolean; |
5885
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
36 |
function Despeckle(X, Y: LongInt): Boolean; |
5267
e9ae019e9bb4
move smoothing into separate function, adjust call order
nemo
parents:
5266
diff
changeset
|
37 |
procedure Smooth(X, Y: LongInt); |
3509
d72c2219595d
Make land types flagged (to allow stacking future attributes such as indestructible ice, but also for a damaged flag)
nemo
parents:
3236
diff
changeset
|
38 |
function CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean; |
4377 | 39 |
function DrawExplosion(X, Y, Radius: LongInt): Longword; |
371 | 40 |
procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); |
41 |
procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt); |
|
42 |
procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); |
|
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
43 |
function FillRoundInLand(X, Y, Radius: LongInt; fill: fillType): LongWord; |
7270
93e92e82d5c8
Step 1. Add current hedgehog as top bit of bottom byte.
nemo
parents:
7268
diff
changeset
|
44 |
procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
4367 | 45 |
function LandBackPixel(x, y: LongInt): LongWord; |
6490 | 46 |
procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword); |
7147 | 47 |
procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword); |
7268 | 48 |
procedure DumpLandToLog(x, y, r: LongInt); |
8602 | 49 |
procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint); |
4886 | 50 |
function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean; indestructible: boolean): boolean; |
409 | 51 |
|
184 | 52 |
implementation |
4403 | 53 |
uses SDLh, uLandTexture, uVariables, uUtils, uDebug; |
184 | 54 |
|
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
55 |
|
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
56 |
procedure calculatePixelsCoordinates(landX, landY: Longint; var pixelX, pixelY: Longint); inline; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
57 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
58 |
if (cReducedQuality and rqBlurryLand) = 0 then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
59 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
60 |
pixelX := landX; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
61 |
pixelY := landY; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
62 |
end |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
63 |
else |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
64 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
65 |
pixelX := LandX div 2; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
66 |
pixelY := LandY div 2; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
67 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
68 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
69 |
|
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
70 |
function drawPixelBG(landX, landY, pixelX, pixelY: Longint): Longword; inline; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
71 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
72 |
drawPixelBG := 0; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
73 |
if (Land[LandY, landX] and lfIndestructible) = 0 then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
74 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
75 |
if ((Land[landY, landX] and lfBasic) <> 0) and (((LandPixels[pixelY, pixelX] and AMask) shr AShift) = 255) and (not disableLandBack) then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
76 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
77 |
LandPixels[pixelY, pixelX]:= LandBackPixel(landX, landY); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
78 |
inc(drawPixelBG); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
79 |
end |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
80 |
else if ((Land[landY, landX] and lfObject) <> 0) or (((LandPixels[pixelY, pixelX] and AMask) shr AShift) < 255) then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
81 |
LandPixels[pixelY, pixelX]:= 0 |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
82 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
83 |
end; |
8795 | 84 |
|
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
85 |
procedure drawPixelEBC(landX, landY, pixelX, pixelY: Longint); inline; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
86 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
87 |
if ((Land[landY, landX] and lfBasic) <> 0) or ((Land[landY, landX] and lfObject) <> 0) then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
88 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
89 |
LandPixels[pixelY, pixelX]:= ExplosionBorderColor; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
90 |
Land[landY, landX]:= (Land[landY, landX] or lfDamaged) and not lfIce; |
8795 | 91 |
LandDirty[landY div 32, landX div 32]:= 1; |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
92 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
93 |
end; |
8795 | 94 |
|
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
95 |
function isLandscapeEdge(weight:Longint):boolean; inline; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
96 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
97 |
result := (weight < 8) and (weight >= 2); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
98 |
end; |
8795 | 99 |
|
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
100 |
function getPixelWeight(x, y:Longint): Longint; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
101 |
var |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
102 |
i, j:Longint; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
103 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
104 |
result := 0; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
105 |
for i := x - 1 to x + 1 do |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
106 |
for j := y - 1 to y + 1 do |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
107 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
108 |
if (i < 0) or |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
109 |
(i > LAND_WIDTH - 1) or |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
110 |
(j < 0) or |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
111 |
(j > LAND_HEIGHT -1) then |
8795 | 112 |
begin |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
113 |
result := 9; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
114 |
exit; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
115 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
116 |
if Land[j, i] and lfLandMask and not lfIce = 0 then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
117 |
result := result + 1; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
118 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
119 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
120 |
|
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
121 |
|
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
122 |
procedure fillPixelFromIceSprite(pixelX, pixelY:Longint); inline; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
123 |
var |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
124 |
iceSurface: PSDL_Surface; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
125 |
icePixels: PLongwordArray; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
126 |
w: LongWord; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
127 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
128 |
// So. 3 parameters here. Ice colour, Ice opacity, and a bias on the greyscaled pixel towards lightness |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
129 |
iceSurface:= SpritesData[sprIceTexture].Surface; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
130 |
icePixels := iceSurface^.pixels; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
131 |
w:= LandPixels[pixelY, pixelX]; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
132 |
if w > 0 then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
133 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
134 |
w:= round(((w shr RShift and $FF) * RGB_LUMINANCE_RED + |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
135 |
(w shr BShift and $FF) * RGB_LUMINANCE_GREEN + |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
136 |
(w shr GShift and $FF) * RGB_LUMINANCE_BLUE)); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
137 |
if w < 128 then w:= w+128; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
138 |
if w > 255 then w:= 255; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
139 |
w:= (w shl RShift) or (w shl BShift) or (w shl GShift) or (LandPixels[pixelY, pixelX] and AMask); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
140 |
LandPixels[pixelY, pixelX]:= addBgColor(w, IceColor); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
141 |
LandPixels[pixelY, pixelX]:= addBgColor(LandPixels[pixelY, pixelX], icePixels^[iceSurface^.w * (pixelY mod iceSurface^.h) + (pixelX mod iceSurface^.w)]) |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
142 |
end |
8795 | 143 |
else |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
144 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
145 |
LandPixels[pixelY, pixelX]:= IceColor and not AMask or $E8 shl AShift; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
146 |
LandPixels[pixelY, pixelX]:= addBgColor(LandPixels[pixelY, pixelX], icePixels^[iceSurface^.w * (pixelY mod iceSurface^.h) + (pixelX mod iceSurface^.w)]); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
147 |
// silly workaround to avoid having to make background erasure a tadb it smarter about sea ice |
8795 | 148 |
if LandPixels[pixelY, pixelX] and AMask shr AShift = 255 then |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
149 |
LandPixels[pixelY, pixelX]:= LandPixels[pixelY, pixelX] and not AMask or 254 shl AShift; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
150 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
151 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
152 |
|
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
153 |
|
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
154 |
procedure DrawPixelIce(landX, landY, pixelX, pixelY: Longint); inline; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
155 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
156 |
if ((Land[landY, landX] and lfIce) <> 0) then exit; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
157 |
if isLandscapeEdge(getPixelWeight(landX, landY)) then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
158 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
159 |
if (LandPixels[pixelY, pixelX] and AMask < 255) and (LandPixels[pixelY, pixelX] and AMask > 0) then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
160 |
LandPixels[pixelY, pixelX] := (IceEdgeColor and not AMask) or (LandPixels[pixelY, pixelX] and AMask) |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
161 |
else if (LandPixels[pixelY, pixelX] and AMask < 255) or (Land[landY, landX] > 255) then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
162 |
LandPixels[pixelY, pixelX] := IceEdgeColor |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
163 |
end |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
164 |
else if Land[landY, landX] > 255 then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
165 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
166 |
fillPixelFromIceSprite(pixelX, pixelY); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
167 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
168 |
if Land[landY, landX] > 255 then Land[landY, landX] := Land[landY, landX] or lfIce and not lfDamaged; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
169 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
170 |
|
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
171 |
|
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
172 |
function FillLandCircleLine(y, fromPix, toPix: LongInt; fill : fillType): Longword; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
173 |
var px, py, i: LongInt; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
174 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
175 |
//get rid of compiler warning |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
176 |
px := 0; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
177 |
py := 0; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
178 |
FillLandCircleLine := 0; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
179 |
case fill of |
8795 | 180 |
backgroundPixel: |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
181 |
for i:= fromPix to toPix do |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
182 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
183 |
calculatePixelsCoordinates(i, y, px, py); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
184 |
inc(FillLandCircleLine, drawPixelBG(i, y, px, py)); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
185 |
end; |
8795 | 186 |
ebcPixel: |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
187 |
for i:= fromPix to toPix do |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
188 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
189 |
calculatePixelsCoordinates(i, y, px, py); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
190 |
drawPixelEBC(i, y, px, py); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
191 |
end; |
8795 | 192 |
nullPixel: |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
193 |
for i:= fromPix to toPix do |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
194 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
195 |
calculatePixelsCoordinates(i, y, px, py); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
196 |
if ((Land[y, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[y, i] > 255)) then |
8795 | 197 |
LandPixels[py, px]:= 0 |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
198 |
end; |
8795 | 199 |
icePixel: |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
200 |
for i:= fromPix to toPix do |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
201 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
202 |
calculatePixelsCoordinates(i, y, px, py); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
203 |
DrawPixelIce(i, y, px, py); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
204 |
end; |
8795 | 205 |
setNotCurrentMask: |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
206 |
for i:= fromPix to toPix do |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
207 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
208 |
Land[y, i]:= Land[y, i] and lfNotCurrentMask; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
209 |
end; |
8795 | 210 |
changePixelSetNotCurrent: |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
211 |
for i:= fromPix to toPix do |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
212 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
213 |
if Land[y, i] and lfObjMask > 0 then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
214 |
Land[y, i]:= (Land[y, i] and lfNotObjMask) or ((Land[y, i] and lfObjMask) - 1); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
215 |
end; |
8795 | 216 |
setCurrentHog: |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
217 |
for i:= fromPix to toPix do |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
218 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
219 |
Land[y, i]:= Land[y, i] or lfCurrentHog |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
220 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
221 |
changePixelNotSetNotCurrent: |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
222 |
for i:= fromPix to toPix do |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
223 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
224 |
if Land[y, i] and lfObjMask < lfObjMask then |
8795 | 225 |
Land[y, i]:= (Land[y, i] and lfNotObjMask) or ((Land[y, i] and lfObjMask) + 1) |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
226 |
end; |
8795 | 227 |
end; |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
228 |
end; |
8795 | 229 |
|
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
230 |
function FillLandCircleSegment(x, y, dx, dy: LongInt; fill : fillType): Longword; inline; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
231 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
232 |
FillLandCircleSegment := 0; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
233 |
if ((y + dy) and LAND_HEIGHT_MASK) = 0 then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
234 |
inc(FillLandCircleSegment, FillLandCircleLine(y + dy, Max(x - dx, 0), Min(x + dx, LAND_WIDTH - 1), fill)); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
235 |
if ((y - dy) and LAND_HEIGHT_MASK) = 0 then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
236 |
inc(FillLandCircleSegment, FillLandCircleLine(y - dy, Max(x - dx, 0), Min(x + dx, LAND_WIDTH - 1), fill)); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
237 |
if ((y + dx) and LAND_HEIGHT_MASK) = 0 then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
238 |
inc(FillLandCircleSegment, FillLandCircleLine(y + dx, Max(x - dy, 0), Min(x + dy, LAND_WIDTH - 1), fill)); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
239 |
if ((y - dx) and LAND_HEIGHT_MASK) = 0 then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
240 |
inc(FillLandCircleSegment, FillLandCircleLine(y - dx, Max(x - dy, 0), Min(x + dy, LAND_WIDTH - 1), fill)); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
241 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
242 |
|
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
243 |
function FillRoundInLand(X, Y, Radius: LongInt; fill: fillType): Longword; inline; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
244 |
var dx, dy, d: LongInt; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
245 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
246 |
dx:= 0; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
247 |
dy:= Radius; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
248 |
d:= 3 - 2 * Radius; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
249 |
FillRoundInLand := 0; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
250 |
while (dx < dy) do |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
251 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
252 |
inc(FillRoundInLand, FillLandCircleSegment(x, y, dx, dy, fill)); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
253 |
if (d < 0) then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
254 |
d:= d + 4 * dx + 6 |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
255 |
else |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
256 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
257 |
d:= d + 4 * (dx - dy) + 10; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
258 |
dec(dy) |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
259 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
260 |
inc(dx) |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
261 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
262 |
if (dx = dy) then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
263 |
inc (FillRoundInLand, FillLandCircleSegment(x, y, dx, dy, fill)); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
264 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
265 |
|
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
266 |
|
4791 | 267 |
function addBgColor(OldColor, NewColor: LongWord): LongWord; |
268 |
// Factor ranges from 0 to 100% NewColor |
|
269 |
var |
|
6011
519f8a58c021
Fix a bunch of warnings (also improves speed a bit in 32 bit code)
unC0Rr
parents:
5895
diff
changeset
|
270 |
oRed, oBlue, oGreen, oAlpha, nRed, nBlue, nGreen, nAlpha: byte; |
4791 | 271 |
begin |
6011
519f8a58c021
Fix a bunch of warnings (also improves speed a bit in 32 bit code)
unC0Rr
parents:
5895
diff
changeset
|
272 |
oAlpha := (OldColor shr AShift); |
519f8a58c021
Fix a bunch of warnings (also improves speed a bit in 32 bit code)
unC0Rr
parents:
5895
diff
changeset
|
273 |
nAlpha := (NewColor shr AShift); |
5692 | 274 |
// shortcircuit |
275 |
if (oAlpha = 0) or (nAlpha = $FF) then |
|
276 |
begin |
|
277 |
addBgColor:= NewColor; |
|
278 |
exit |
|
7492
3188794b9d87
Perf opt for the c conversion. Use downto instead to avoid repeated function calls in the loop
nemo
parents:
7270
diff
changeset
|
279 |
end; |
4791 | 280 |
// Get colors |
6011
519f8a58c021
Fix a bunch of warnings (also improves speed a bit in 32 bit code)
unC0Rr
parents:
5895
diff
changeset
|
281 |
oRed := (OldColor shr RShift); |
519f8a58c021
Fix a bunch of warnings (also improves speed a bit in 32 bit code)
unC0Rr
parents:
5895
diff
changeset
|
282 |
oGreen := (OldColor shr GShift); |
519f8a58c021
Fix a bunch of warnings (also improves speed a bit in 32 bit code)
unC0Rr
parents:
5895
diff
changeset
|
283 |
oBlue := (OldColor shr BShift); |
4791 | 284 |
|
6011
519f8a58c021
Fix a bunch of warnings (also improves speed a bit in 32 bit code)
unC0Rr
parents:
5895
diff
changeset
|
285 |
nRed := (NewColor shr RShift); |
519f8a58c021
Fix a bunch of warnings (also improves speed a bit in 32 bit code)
unC0Rr
parents:
5895
diff
changeset
|
286 |
nGreen := (NewColor shr GShift); |
519f8a58c021
Fix a bunch of warnings (also improves speed a bit in 32 bit code)
unC0Rr
parents:
5895
diff
changeset
|
287 |
nBlue := (NewColor shr BShift); |
4791 | 288 |
|
289 |
// Mix colors |
|
6011
519f8a58c021
Fix a bunch of warnings (also improves speed a bit in 32 bit code)
unC0Rr
parents:
5895
diff
changeset
|
290 |
nRed := min(255,((nRed*nAlpha) div 255) + ((oRed*oAlpha*byte(255-nAlpha)) div 65025)); |
519f8a58c021
Fix a bunch of warnings (also improves speed a bit in 32 bit code)
unC0Rr
parents:
5895
diff
changeset
|
291 |
nGreen := min(255,((nGreen*nAlpha) div 255) + ((oGreen*oAlpha*byte(255-nAlpha)) div 65025)); |
7492
3188794b9d87
Perf opt for the c conversion. Use downto instead to avoid repeated function calls in the loop
nemo
parents:
7270
diff
changeset
|
292 |
nBlue := min(255,((nBlue*nAlpha) div 255) + ((oBlue*oAlpha*byte(255-nAlpha)) div 65025)); |
4791 | 293 |
nAlpha := min(255, oAlpha + nAlpha); |
294 |
||
5041 | 295 |
addBgColor := (nAlpha shl AShift) or (nRed shl RShift) or (nGreen shl GShift) or (nBlue shl BShift); |
4791 | 296 |
end; |
297 |
||
371 | 298 |
procedure FillCircleLines(x, y, dx, dy: LongInt; Value: Longword); |
299 |
var i: LongInt; |
|
184 | 300 |
begin |
1753 | 301 |
if ((y + dy) and LAND_HEIGHT_MASK) = 0 then |
7509 | 302 |
for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
3519 | 303 |
if (Land[y + dy, i] and lfIndestructible) = 0 then |
1753 | 304 |
Land[y + dy, i]:= Value; |
305 |
if ((y - dy) and LAND_HEIGHT_MASK) = 0 then |
|
7509 | 306 |
for i:= Max(x - dx, 0) to Min(x + dx, LAND_WIDTH - 1) do |
3519 | 307 |
if (Land[y - dy, i] and lfIndestructible) = 0 then |
1753 | 308 |
Land[y - dy, i]:= Value; |
309 |
if ((y + dx) and LAND_HEIGHT_MASK) = 0 then |
|
7509 | 310 |
for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
3519 | 311 |
if (Land[y + dx, i] and lfIndestructible) = 0 then |
1753 | 312 |
Land[y + dx, i]:= Value; |
313 |
if ((y - dx) and LAND_HEIGHT_MASK) = 0 then |
|
7509 | 314 |
for i:= Max(x - dy, 0) to Min(x + dy, LAND_WIDTH - 1) do |
3519 | 315 |
if (Land[y - dx, i] and lfIndestructible) = 0 then |
1753 | 316 |
Land[y - dx, i]:= Value; |
184 | 317 |
end; |
318 |
||
371 | 319 |
procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword); |
320 |
var dx, dy, d: LongInt; |
|
184 | 321 |
begin |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
322 |
dx:= 0; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
323 |
dy:= Radius; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
324 |
d:= 3 - 2 * Radius; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
325 |
while (dx < dy) do |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
326 |
begin |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
327 |
FillCircleLines(x, y, dx, dy, Value); |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
328 |
if (d < 0) then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
329 |
d:= d + 4 * dx + 6 |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
330 |
else |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
331 |
begin |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
332 |
d:= d + 4 * (dx - dy) + 10; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
333 |
dec(dy) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
334 |
end; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
335 |
inc(dx) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
336 |
end; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
337 |
if (dx = dy) then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
338 |
FillCircleLines(x, y, dx, dy, Value); |
184 | 339 |
end; |
340 |
||
7270
93e92e82d5c8
Step 1. Add current hedgehog as top bit of bottom byte.
nemo
parents:
7268
diff
changeset
|
341 |
procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean); |
504
13b6ebc53627
Fix collision info artifacts in Land array when two objects intersect
unc0rr
parents:
495
diff
changeset
|
342 |
begin |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
343 |
if not doSet and isCurrent then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
344 |
FillRoundInLand(X, Y, Radius, setNotCurrentMask) |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
345 |
else if not doSet and not IsCurrent then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
346 |
FillRoundInLand(X, Y, Radius, changePixelSetNotCurrent) |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
347 |
else if doSet and IsCurrent then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
348 |
FillRoundInLand(X, Y, Radius, setCurrentHog) |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
349 |
else if doSet and not IsCurrent then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
350 |
FillRoundInLand(X, Y, Radius, changePixelNotSetNotCurrent); |
8583 | 351 |
end; |
352 |
||
8602 | 353 |
procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint); |
354 |
var |
|
355 |
i, j: integer; |
|
356 |
landRect: TSDL_Rect; |
|
357 |
begin |
|
358 |
for i := min(max(x - iceRadius, 0), LAND_WIDTH - 1) to min(max(x + iceRadius, 0), LAND_WIDTH - 1) do |
|
359 |
begin |
|
360 |
for j := min(max(y, 0), LAND_HEIGHT - 1) to min(max(y + iceHeight, 0), LAND_HEIGHT - 1) do |
|
361 |
begin |
|
8624 | 362 |
if Land[j, i] = 0 then |
8602 | 363 |
begin |
8795 | 364 |
Land[j, i] := lfIce; |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
365 |
fillPixelFromIceSprite(i, j); |
8602 | 366 |
end; |
8795 | 367 |
end; |
8602 | 368 |
end; |
369 |
landRect.x := min(max(x - iceRadius, 0), LAND_WIDTH - 1); |
|
370 |
landRect.y := min(max(y, 0), LAND_HEIGHT - 1); |
|
371 |
landRect.w := min(2*iceRadius, LAND_WIDTH - landRect.x - 1); |
|
372 |
landRect.h := min(iceHeight, LAND_HEIGHT - landRect.y - 1); |
|
8795 | 373 |
UpdateLandTexture(landRect.x, landRect.w, landRect.y, landRect.h, true); |
8602 | 374 |
end; |
375 |
||
3689 | 376 |
function DrawExplosion(X, Y, Radius: LongInt): Longword; |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
377 |
var |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
378 |
tx, ty, dx, dy: Longint; |
184 | 379 |
begin |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
380 |
DrawExplosion := FillRoundInLand(x, y, Radius, backgroundPixel); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
381 |
if Radius > 20 then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
382 |
FillRoundInLand(x, y, Radius - 15, nullPixel); |
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
383 |
FillRoundInLand(X, Y, Radius, 0); |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
384 |
FillRoundInLand(x, y, Radius + 4, ebcPixel); |
8828 | 385 |
tx:= Max(X - Radius - 5, 0); |
386 |
dx:= Min(X + Radius + 5, LAND_WIDTH) - tx; |
|
387 |
ty:= Max(Y - Radius - 5, 0); |
|
388 |
dy:= Min(Y + Radius + 5, LAND_HEIGHT) - ty; |
|
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
389 |
UpdateLandTexture(tx, dx, ty, dy, false); |
184 | 390 |
end; |
391 |
||
371 | 392 |
procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte); |
5480 | 393 |
var tx, ty, by, bx, i: LongInt; |
184 | 394 |
begin |
395 |
for i:= 0 to Pred(Count) do |
|
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
396 |
begin |
7509 | 397 |
for ty:= Max(y - Radius, 0) to Min(y + Radius, LAND_HEIGHT) do |
398 |
for tx:= Max(0, ar^[i].Left - Radius) to Min(LAND_WIDTH, ar^[i].Right + Radius) do |
|
5480 | 399 |
begin |
6096
a00dbbf49d6c
Add landbacktex to a few maps, just to see how it looks.
nemo
parents:
6081
diff
changeset
|
400 |
if (Land[ty, tx] and lfIndestructible) = 0 then |
5480 | 401 |
begin |
6096
a00dbbf49d6c
Add landbacktex to a few maps, just to see how it looks.
nemo
parents:
6081
diff
changeset
|
402 |
if (cReducedQuality and rqBlurryLand) = 0 then |
a00dbbf49d6c
Add landbacktex to a few maps, just to see how it looks.
nemo
parents:
6081
diff
changeset
|
403 |
begin |
a00dbbf49d6c
Add landbacktex to a few maps, just to see how it looks.
nemo
parents:
6081
diff
changeset
|
404 |
by:= ty; bx:= tx; |
a00dbbf49d6c
Add landbacktex to a few maps, just to see how it looks.
nemo
parents:
6081
diff
changeset
|
405 |
end |
a00dbbf49d6c
Add landbacktex to a few maps, just to see how it looks.
nemo
parents:
6081
diff
changeset
|
406 |
else |
a00dbbf49d6c
Add landbacktex to a few maps, just to see how it looks.
nemo
parents:
6081
diff
changeset
|
407 |
begin |
a00dbbf49d6c
Add landbacktex to a few maps, just to see how it looks.
nemo
parents:
6081
diff
changeset
|
408 |
by:= ty div 2; bx:= tx div 2; |
a00dbbf49d6c
Add landbacktex to a few maps, just to see how it looks.
nemo
parents:
6081
diff
changeset
|
409 |
end; |
6355 | 410 |
if ((Land[ty, tx] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then |
6096
a00dbbf49d6c
Add landbacktex to a few maps, just to see how it looks.
nemo
parents:
6081
diff
changeset
|
411 |
LandPixels[by, bx]:= LandBackPixel(tx, ty) |
7492
3188794b9d87
Perf opt for the c conversion. Use downto instead to avoid repeated function calls in the loop
nemo
parents:
7270
diff
changeset
|
412 |
else if ((Land[ty, tx] and lfObject) <> 0) or (((LandPixels[by,bx] and AMask) shr AShift) < 255) then |
6096
a00dbbf49d6c
Add landbacktex to a few maps, just to see how it looks.
nemo
parents:
6081
diff
changeset
|
413 |
LandPixels[by, bx]:= 0 |
a00dbbf49d6c
Add landbacktex to a few maps, just to see how it looks.
nemo
parents:
6081
diff
changeset
|
414 |
end |
5480 | 415 |
end; |
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
416 |
inc(y, dY) |
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
417 |
end; |
184 | 418 |
|
419 |
inc(Radius, 4); |
|
351 | 420 |
dec(y, Count * dY); |
184 | 421 |
|
422 |
for i:= 0 to Pred(Count) do |
|
423 |
begin |
|
7509 | 424 |
for ty:= Max(y - Radius, 0) to Min(y + Radius, LAND_HEIGHT) do |
425 |
for tx:= Max(0, ar^[i].Left - Radius) to Min(LAND_WIDTH, ar^[i].Right + Radius) do |
|
4690
490cf71b436a
revert last change. ordinary fire is fine, but HHG screws up.
nemo
parents:
4688
diff
changeset
|
426 |
if ((Land[ty, tx] and lfBasic) <> 0) or ((Land[ty, tx] and lfObject) <> 0) then |
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset
|
427 |
begin |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
428 |
if (cReducedQuality and rqBlurryLand) = 0 then |
6982 | 429 |
LandPixels[ty, tx]:= ExplosionBorderColor |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
430 |
else |
6982 | 431 |
LandPixels[ty div 2, tx div 2]:= ExplosionBorderColor; |
3595
341e407e3754
partially removing DOWNSCALE ifdef -- only two remain and their removal requires dynamic allocation (btw this breaks low quality mode)
koda
parents:
3554
diff
changeset
|
432 |
|
8579
d18bc19d780a
graphics tweak. flag a couple more overeager setall HH
nemo
parents:
7509
diff
changeset
|
433 |
Land[ty, tx]:= (Land[ty, tx] or lfDamaged) and not lfIce; |
3596 | 434 |
LandDirty[ty div 32, tx div 32]:= 1; |
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset
|
435 |
end; |
184 | 436 |
inc(y, dY) |
437 |
end; |
|
438 |
||
818 | 439 |
|
7170
84ac6c6d2d8e
Only create textures for non-empty LandPixel chunks. This should save a fair amount of memory, especially on smaller maps, and eliminate a number of draws
nemo
parents:
7150
diff
changeset
|
440 |
UpdateLandTexture(0, LAND_WIDTH, 0, LAND_HEIGHT, false) |
184 | 441 |
end; |
442 |
||
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
443 |
|
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
444 |
|
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
445 |
procedure DrawExplosionBorder(X, Y, dx, dy:hwFloat; despeckle : Boolean); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
446 |
var |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
447 |
t, tx, ty :Longint; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
448 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
449 |
for t:= 0 to 7 do |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
450 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
451 |
X:= X + dX; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
452 |
Y:= Y + dY; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
453 |
tx:= hwRound(X); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
454 |
ty:= hwRound(Y); |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
455 |
if ((ty and LAND_HEIGHT_MASK) = 0) and ((tx and LAND_WIDTH_MASK) = 0) and (((Land[ty, tx] and lfBasic) <> 0) |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
456 |
or ((Land[ty, tx] and lfObject) <> 0)) then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
457 |
begin |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
458 |
Land[ty, tx]:= (Land[ty, tx] or lfDamaged) and not lfIce; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
459 |
if despeckle then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
460 |
LandDirty[ty div 32, tx div 32]:= 1; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
461 |
if (cReducedQuality and rqBlurryLand) = 0 then |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
462 |
LandPixels[ty, tx]:= ExplosionBorderColor |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
463 |
else |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
464 |
LandPixels[ty div 2, tx div 2]:= ExplosionBorderColor |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
465 |
end |
8795 | 466 |
end; |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
467 |
end; |
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
468 |
|
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
469 |
|
184 | 470 |
// |
471 |
// - (dX, dY) - direction, vector of length = 0.5 |
|
472 |
// |
|
371 | 473 |
procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt); |
358 | 474 |
var nx, ny, dX8, dY8: hwFloat; |
5480 | 475 |
i, t, tx, ty, by, bx, stX, stY, ddy, ddx: Longint; |
5332 | 476 |
despeckle : Boolean; |
184 | 477 |
begin // (-dY, dX) is (dX, dY) rotated by PI/2 |
772
e8d530ca77be
Don't update all land texture when drawing tunnel (saves video throughput)
unc0rr
parents:
769
diff
changeset
|
478 |
stY:= hwRound(Y); |
1809 | 479 |
stX:= hwRound(X); |
772
e8d530ca77be
Don't update all land texture when drawing tunnel (saves video throughput)
unc0rr
parents:
769
diff
changeset
|
480 |
|
5332 | 481 |
despeckle:= HalfWidth > 1; |
482 |
||
184 | 483 |
nx:= X + dY * (HalfWidth + 8); |
484 |
ny:= Y - dX * (HalfWidth + 8); |
|
485 |
||
358 | 486 |
dX8:= dX * 8; |
487 |
dY8:= dY * 8; |
|
184 | 488 |
for i:= 0 to 7 do |
489 |
begin |
|
358 | 490 |
X:= nx - dX8; |
491 |
Y:= ny - dY8; |
|
184 | 492 |
for t:= -8 to ticks + 8 do |
2666 | 493 |
begin |
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
494 |
X:= X + dX; |
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
495 |
Y:= Y + dY; |
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
496 |
tx:= hwRound(X); |
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
497 |
ty:= hwRound(Y); |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
498 |
if ((ty and LAND_HEIGHT_MASK) = 0) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
499 |
and ((tx and LAND_WIDTH_MASK) = 0) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
500 |
and (((Land[ty, tx] and lfBasic) <> 0) or ((Land[ty, tx] and lfObject) <> 0)) then |
3509
d72c2219595d
Make land types flagged (to allow stacking future attributes such as indestructible ice, but also for a damaged flag)
nemo
parents:
3236
diff
changeset
|
501 |
begin |
8579
d18bc19d780a
graphics tweak. flag a couple more overeager setall HH
nemo
parents:
7509
diff
changeset
|
502 |
Land[ty, tx]:= Land[ty, tx] and not lfIce; |
7492
3188794b9d87
Perf opt for the c conversion. Use downto instead to avoid repeated function calls in the loop
nemo
parents:
7270
diff
changeset
|
503 |
if despeckle then |
5887 | 504 |
begin |
505 |
Land[ty, tx]:= Land[ty, tx] or lfDamaged; |
|
506 |
LandDirty[ty div 32, tx div 32]:= 1 |
|
507 |
end; |
|
5332 | 508 |
if (cReducedQuality and rqBlurryLand) = 0 then |
6982 | 509 |
LandPixels[ty, tx]:= ExplosionBorderColor |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
510 |
else |
6982 | 511 |
LandPixels[ty div 2, tx div 2]:= ExplosionBorderColor |
3509
d72c2219595d
Make land types flagged (to allow stacking future attributes such as indestructible ice, but also for a damaged flag)
nemo
parents:
3236
diff
changeset
|
512 |
end |
2666 | 513 |
end; |
184 | 514 |
nx:= nx - dY; |
515 |
ny:= ny + dX; |
|
516 |
end; |
|
517 |
||
518 |
for i:= -HalfWidth to HalfWidth do |
|
519 |
begin |
|
358 | 520 |
X:= nx - dX8; |
521 |
Y:= ny - dY8; |
|
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
522 |
DrawExplosionBorder(X, Y, dx, dy, despeckle); |
184 | 523 |
X:= nx; |
524 |
Y:= ny; |
|
525 |
for t:= 0 to ticks do |
|
526 |
begin |
|
527 |
X:= X + dX; |
|
528 |
Y:= Y + dY; |
|
351 | 529 |
tx:= hwRound(X); |
530 |
ty:= hwRound(Y); |
|
3519 | 531 |
if ((ty and LAND_HEIGHT_MASK) = 0) and ((tx and LAND_WIDTH_MASK) = 0) and ((Land[ty, tx] and lfIndestructible) = 0) then |
2647 | 532 |
begin |
5480 | 533 |
if (cReducedQuality and rqBlurryLand) = 0 then |
534 |
begin |
|
535 |
by:= ty; bx:= tx; |
|
536 |
end |
|
4690
490cf71b436a
revert last change. ordinary fire is fine, but HHG screws up.
nemo
parents:
4688
diff
changeset
|
537 |
else |
5480 | 538 |
begin |
539 |
by:= ty div 2; bx:= tx div 2; |
|
540 |
end; |
|
6355 | 541 |
if ((Land[ty, tx] and lfBasic) <> 0) and (((LandPixels[by,bx] and AMask) shr AShift) = 255) and (not disableLandBack) then |
6096
a00dbbf49d6c
Add landbacktex to a few maps, just to see how it looks.
nemo
parents:
6081
diff
changeset
|
542 |
LandPixels[by, bx]:= LandBackPixel(tx, ty) |
a00dbbf49d6c
Add landbacktex to a few maps, just to see how it looks.
nemo
parents:
6081
diff
changeset
|
543 |
else if ((Land[ty, tx] and lfObject) <> 0) or (((LandPixels[by,bx] and AMask) shr AShift) < 255) then |
6097 | 544 |
LandPixels[by, bx]:= 0; |
545 |
Land[ty, tx]:= 0; |
|
2647 | 546 |
end |
184 | 547 |
end; |
8783
f1231a48fc48
Remove some duplicating code from uLandGraphics.pas
Urbertar
parents:
8773
diff
changeset
|
548 |
DrawExplosionBorder(X, Y, dx, dy, despeckle); |
184 | 549 |
nx:= nx - dY; |
550 |
ny:= ny + dX; |
|
551 |
end; |
|
552 |
||
553 |
for i:= 0 to 7 do |
|
554 |
begin |
|
358 | 555 |
X:= nx - dX8; |
556 |
Y:= ny - dY8; |
|
184 | 557 |
for t:= -8 to ticks + 8 do |
2666 | 558 |
begin |
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
559 |
X:= X + dX; |
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
560 |
Y:= Y + dY; |
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
561 |
tx:= hwRound(X); |
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
562 |
ty:= hwRound(Y); |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
563 |
if ((ty and LAND_HEIGHT_MASK) = 0) and ((tx and LAND_WIDTH_MASK) = 0) and (((Land[ty, tx] and lfBasic) <> 0) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
564 |
or ((Land[ty, tx] and lfObject) <> 0)) then |
3509
d72c2219595d
Make land types flagged (to allow stacking future attributes such as indestructible ice, but also for a damaged flag)
nemo
parents:
3236
diff
changeset
|
565 |
begin |
8579
d18bc19d780a
graphics tweak. flag a couple more overeager setall HH
nemo
parents:
7509
diff
changeset
|
566 |
Land[ty, tx]:= (Land[ty, tx] or lfDamaged) and not lfIce; |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
567 |
if despeckle then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
568 |
LandDirty[ty div 32, tx div 32]:= 1; |
3595
341e407e3754
partially removing DOWNSCALE ifdef -- only two remain and their removal requires dynamic allocation (btw this breaks low quality mode)
koda
parents:
3554
diff
changeset
|
569 |
if (cReducedQuality and rqBlurryLand) = 0 then |
6982 | 570 |
LandPixels[ty, tx]:= ExplosionBorderColor |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
571 |
else |
6982 | 572 |
LandPixels[ty div 2, tx div 2]:= ExplosionBorderColor |
3509
d72c2219595d
Make land types flagged (to allow stacking future attributes such as indestructible ice, but also for a damaged flag)
nemo
parents:
3236
diff
changeset
|
573 |
end |
2666 | 574 |
end; |
184 | 575 |
nx:= nx - dY; |
576 |
ny:= ny + dX; |
|
577 |
end; |
|
578 |
||
4374 | 579 |
tx:= Max(stX - HalfWidth * 2 - 4 - abs(hwRound(dX * ticks)), 0); |
580 |
ty:= Max(stY - HalfWidth * 2 - 4 - abs(hwRound(dY * ticks)), 0); |
|
581 |
ddx:= Min(stX + HalfWidth * 2 + 4 + abs(hwRound(dX * ticks)), LAND_WIDTH) - tx; |
|
582 |
ddy:= Min(stY + HalfWidth * 2 + 4 + abs(hwRound(dY * ticks)), LAND_HEIGHT) - ty; |
|
1809 | 583 |
|
7170
84ac6c6d2d8e
Only create textures for non-empty LandPixel chunks. This should save a fair amount of memory, especially on smaller maps, and eliminate a number of draws
nemo
parents:
7150
diff
changeset
|
584 |
UpdateLandTexture(tx, ddx, ty, ddy, false) |
184 | 585 |
end; |
586 |
||
4886 | 587 |
function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean; indestructible: boolean): boolean; |
6077
d8fa5a85d24f
This prevents girders from erasing landbacktex (square windows in tunnels and such), at the cost of requiring lfBasic and lfObject to be treated the same apart from graphically
nemo
parents:
6011
diff
changeset
|
588 |
var X, Y, bpp, h, w, row, col, gx, gy, numFramesFirstCol: LongInt; |
409 | 589 |
p: PByteArray; |
769
788efc1d649f
- Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset
|
590 |
Image: PSDL_Surface; |
409 | 591 |
begin |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
592 |
TryPlaceOnLand:= false; |
2235 | 593 |
numFramesFirstCol:= SpritesData[Obj].imageHeight div SpritesData[Obj].Height; |
594 |
||
769
788efc1d649f
- Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset
|
595 |
TryDo(SpritesData[Obj].Surface <> nil, 'Assert SpritesData[Obj].Surface failed', true); |
788efc1d649f
- Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset
|
596 |
Image:= SpritesData[Obj].Surface; |
409 | 597 |
w:= SpritesData[Obj].Width; |
769
788efc1d649f
- Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset
|
598 |
h:= SpritesData[Obj].Height; |
2235 | 599 |
row:= Frame mod numFramesFirstCol; |
600 |
col:= Frame div numFramesFirstCol; |
|
409 | 601 |
|
602 |
if SDL_MustLock(Image) then |
|
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
603 |
SDLTry(SDL_LockSurface(Image) >= 0, true); |
409 | 604 |
|
605 |
bpp:= Image^.format^.BytesPerPixel; |
|
769
788efc1d649f
- Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset
|
606 |
TryDo(bpp = 4, 'It should be 32 bpp sprite', true); |
788efc1d649f
- Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset
|
607 |
// Check that sprite fits free space |
2236 | 608 |
p:= @(PByteArray(Image^.pixels)^[ Image^.pitch * row * h + col * w * 4 ]); |
409 | 609 |
case bpp of |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
610 |
4: for y:= 0 to Pred(h) do |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
611 |
begin |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
612 |
for x:= 0 to Pred(w) do |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
613 |
if (PLongword(@(p^[x * 4]))^) <> 0 then |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
614 |
if ((cpY + y) <= Longint(topY)) or ((cpY + y) >= LAND_HEIGHT) or |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
615 |
((cpX + x) <= Longint(leftX)) or ((cpX + x) >= Longint(rightX)) or (Land[cpY + y, cpX + x] <> 0) then |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
616 |
begin |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
617 |
if SDL_MustLock(Image) then |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
618 |
SDL_UnlockSurface(Image); |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
619 |
exit; |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
620 |
end; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
621 |
p:= @(p^[Image^.pitch]); |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
622 |
end; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
623 |
end; |
409 | 624 |
|
520 | 625 |
TryPlaceOnLand:= true; |
769
788efc1d649f
- Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset
|
626 |
if not doPlace then |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
627 |
begin |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
628 |
if SDL_MustLock(Image) then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
629 |
SDL_UnlockSurface(Image); |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
630 |
exit |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
631 |
end; |
520 | 632 |
|
409 | 633 |
// Checked, now place |
2236 | 634 |
p:= @(PByteArray(Image^.pixels)^[ Image^.pitch * row * h + col * w * 4 ]); |
409 | 635 |
case bpp of |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
636 |
4: for y:= 0 to Pred(h) do |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
637 |
begin |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
638 |
for x:= 0 to Pred(w) do |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
639 |
if (PLongword(@(p^[x * 4]))^) <> 0 then |
769
788efc1d649f
- Save 8 MB of memory by freeing LandSurface and not using it anymore after game initialization
unc0rr
parents:
768
diff
changeset
|
640 |
begin |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
641 |
if (cReducedQuality and rqBlurryLand) = 0 then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
642 |
begin |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
643 |
gX:= cpX + x; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
644 |
gY:= cpY + y; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
645 |
end |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
646 |
else |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
647 |
begin |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
648 |
gX:= (cpX + x) div 2; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
649 |
gY:= (cpY + y) div 2; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
650 |
end; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
651 |
if indestructible then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
652 |
Land[cpY + y, cpX + x]:= lfIndestructible |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
653 |
else if (LandPixels[gY, gX] and AMask) shr AShift = 255 then // This test assumes lfBasic and lfObject differ only graphically |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
654 |
Land[cpY + y, cpX + x]:= lfBasic |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
655 |
else |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
656 |
Land[cpY + y, cpX + x]:= lfObject; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
657 |
// For testing only. Intent is to flag this on objects with masks, or use it for an ice ray gun |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
658 |
if (Theme = 'Snow') or (Theme = 'Christmas') then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
659 |
Land[cpY + y, cpX + x]:= Land[cpY + y, cpX + x] or lfIce; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
660 |
LandPixels[gY, gX]:= PLongword(@(p^[x * 4]))^ |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
661 |
end; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
662 |
p:= @(p^[Image^.pitch]); |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
663 |
end; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
664 |
end; |
409 | 665 |
if SDL_MustLock(Image) then |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
666 |
SDL_UnlockSurface(Image); |
409 | 667 |
|
4374 | 668 |
x:= Max(cpX, leftX); |
669 |
w:= Min(cpX + Image^.w, LAND_WIDTH) - x; |
|
670 |
y:= Max(cpY, topY); |
|
671 |
h:= Min(cpY + Image^.h, LAND_HEIGHT) - y; |
|
7170
84ac6c6d2d8e
Only create textures for non-empty LandPixel chunks. This should save a fair amount of memory, especially on smaller maps, and eliminate a number of draws
nemo
parents:
7150
diff
changeset
|
672 |
UpdateLandTexture(x, w, y, h, true) |
409 | 673 |
end; |
674 |
||
5885
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
675 |
function Despeckle(X, Y: LongInt): boolean; |
4695
ac2cb3b99d70
add a disabling for landback, set it if flakes are enabled
nemo
parents:
4690
diff
changeset
|
676 |
var nx, ny, i, j, c, xx, yy: LongInt; |
ac2cb3b99d70
add a disabling for landback, set it if flakes are enabled
nemo
parents:
4690
diff
changeset
|
677 |
pixelsweep: boolean; |
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset
|
678 |
begin |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
679 |
Despeckle:= true; |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
680 |
|
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
681 |
if (cReducedQuality and rqBlurryLand) = 0 then |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
682 |
begin |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
683 |
xx:= X; |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
684 |
yy:= Y; |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
685 |
end |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
686 |
else |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
687 |
begin |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
688 |
xx:= X div 2; |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
689 |
yy:= Y div 2; |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
690 |
end; |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
691 |
|
8751
4609823efc94
More flagging of Land values. Also use less than for tests of non-terrain, instead of "and $FF00 = 0". Saves a couple of ops, which actually matters a small amount in a few places.
nemo
parents:
8744
diff
changeset
|
692 |
pixelsweep:= (Land[Y, X] <= lfAllObjMask) and (LandPixels[yy, xx] <> 0); |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
693 |
if (((Land[Y, X] and lfDamaged) <> 0) and ((Land[Y, X] and lfIndestructible) = 0)) or pixelsweep then |
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
694 |
begin |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
695 |
c:= 0; |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
696 |
for i:= -1 to 1 do |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
697 |
for j:= -1 to 1 do |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
698 |
if (i <> 0) or (j <> 0) then |
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
699 |
begin |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
700 |
ny:= Y + i; |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
701 |
nx:= X + j; |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
702 |
if ((ny and LAND_HEIGHT_MASK) = 0) and ((nx and LAND_WIDTH_MASK) = 0) then |
4695
ac2cb3b99d70
add a disabling for landback, set it if flakes are enabled
nemo
parents:
4690
diff
changeset
|
703 |
begin |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
704 |
if pixelsweep then |
4695
ac2cb3b99d70
add a disabling for landback, set it if flakes are enabled
nemo
parents:
4690
diff
changeset
|
705 |
begin |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
706 |
if ((cReducedQuality and rqBlurryLand) <> 0) then |
4695
ac2cb3b99d70
add a disabling for landback, set it if flakes are enabled
nemo
parents:
4690
diff
changeset
|
707 |
begin |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
708 |
nx:= nx div 2; |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
709 |
ny:= ny div 2 |
4695
ac2cb3b99d70
add a disabling for landback, set it if flakes are enabled
nemo
parents:
4690
diff
changeset
|
710 |
end; |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
711 |
if LandPixels[ny, nx] <> 0 then |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
712 |
inc(c); |
4695
ac2cb3b99d70
add a disabling for landback, set it if flakes are enabled
nemo
parents:
4690
diff
changeset
|
713 |
end |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
714 |
else if Land[ny, nx] > 255 then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
715 |
inc(c); |
4695
ac2cb3b99d70
add a disabling for landback, set it if flakes are enabled
nemo
parents:
4690
diff
changeset
|
716 |
end |
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
717 |
end; |
5885
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
718 |
|
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
719 |
if c < 4 then // 0-3 neighbours |
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
720 |
begin |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
721 |
if ((Land[Y, X] and lfBasic) <> 0) and (not disableLandBack) then |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
722 |
LandPixels[yy, xx]:= LandBackPixel(X, Y) |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
723 |
else |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
724 |
LandPixels[yy, xx]:= 0; |
3595
341e407e3754
partially removing DOWNSCALE ifdef -- only two remain and their removal requires dynamic allocation (btw this breaks low quality mode)
koda
parents:
3554
diff
changeset
|
725 |
|
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
726 |
if not pixelsweep then |
6681 | 727 |
begin |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
728 |
Land[Y, X]:= 0; |
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
729 |
exit |
6681 | 730 |
end |
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
731 |
end; |
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
732 |
end; |
6990
40e5af28d026
change every return value into a more pascal-ish form, using the name of the fucntion (helps the parser and macpas compaitilibity)
koda
parents:
6982
diff
changeset
|
733 |
Despeckle:= false |
5267
e9ae019e9bb4
move smoothing into separate function, adjust call order
nemo
parents:
5266
diff
changeset
|
734 |
end; |
e9ae019e9bb4
move smoothing into separate function, adjust call order
nemo
parents:
5266
diff
changeset
|
735 |
|
e9ae019e9bb4
move smoothing into separate function, adjust call order
nemo
parents:
5266
diff
changeset
|
736 |
procedure Smooth(X, Y: LongInt); |
e9ae019e9bb4
move smoothing into separate function, adjust call order
nemo
parents:
5266
diff
changeset
|
737 |
begin |
5261 | 738 |
// a bit of AA for explosions |
7492
3188794b9d87
Perf opt for the c conversion. Use downto instead to avoid repeated function calls in the loop
nemo
parents:
7270
diff
changeset
|
739 |
if (Land[Y, X] = 0) and (Y > LongInt(topY) + 1) and |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
740 |
(Y < LAND_HEIGHT-2) and (X > LongInt(leftX) + 1) and (X < LongInt(rightX) - 1) then |
5261 | 741 |
begin |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
742 |
if ((((Land[y, x-1] and lfDamaged) <> 0) and (((Land[y+1,x] and lfDamaged) <> 0)) or ((Land[y-1,x] and lfDamaged) <> 0)) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
743 |
or (((Land[y, x+1] and lfDamaged) <> 0) and (((Land[y-1,x] and lfDamaged) <> 0) or ((Land[y+1,x] and lfDamaged) <> 0)))) then |
5261 | 744 |
begin |
5274 | 745 |
if (cReducedQuality and rqBlurryLand) = 0 then |
746 |
begin |
|
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
747 |
if ((LandPixels[y,x] and AMask) shr AShift) < 10 then |
6982 | 748 |
LandPixels[y,x]:= (ExplosionBorderColor and (not AMask)) or (128 shl AShift) |
5274 | 749 |
else |
750 |
LandPixels[y,x]:= |
|
6982 | 751 |
(((((LandPixels[y,x] and RMask shr RShift) div 2)+((ExplosionBorderColor and RMask) shr RShift) div 2) and $FF) shl RShift) or |
752 |
(((((LandPixels[y,x] and GMask shr GShift) div 2)+((ExplosionBorderColor and GMask) shr GShift) div 2) and $FF) shl GShift) or |
|
753 |
(((((LandPixels[y,x] and BMask shr BShift) div 2)+((ExplosionBorderColor and BMask) shr BShift) div 2) and $FF) shl BShift) or ($FF shl AShift) |
|
5274 | 754 |
end; |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
755 |
if (Land[y, x-1] = lfObject) then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
756 |
Land[y,x]:= lfObject |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
757 |
else if (Land[y, x+1] = lfObject) then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
758 |
Land[y,x]:= lfObject |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
759 |
else |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
760 |
Land[y,x]:= lfBasic; |
5261 | 761 |
end |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
762 |
else if ((((Land[y, x-1] and lfDamaged) <> 0) and ((Land[y+1,x-1] and lfDamaged) <> 0) and ((Land[y+2,x] and lfDamaged) <> 0)) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
763 |
or (((Land[y, x-1] and lfDamaged) <> 0) and ((Land[y-1,x-1] and lfDamaged) <> 0) and ((Land[y-2,x] and lfDamaged) <> 0)) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
764 |
or (((Land[y, x+1] and lfDamaged) <> 0) and ((Land[y+1,x+1] and lfDamaged) <> 0) and ((Land[y+2,x] and lfDamaged) <> 0)) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
765 |
or (((Land[y, x+1] and lfDamaged) <> 0) and ((Land[y-1,x+1] and lfDamaged) <> 0) and ((Land[y-2,x] and lfDamaged) <> 0)) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
766 |
or (((Land[y+1, x] and lfDamaged) <> 0) and ((Land[y+1,x+1] and lfDamaged) <> 0) and ((Land[y,x+2] and lfDamaged) <> 0)) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
767 |
or (((Land[y-1, x] and lfDamaged) <> 0) and ((Land[y-1,x+1] and lfDamaged) <> 0) and ((Land[y,x+2] and lfDamaged) <> 0)) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
768 |
or (((Land[y+1, x] and lfDamaged) <> 0) and ((Land[y+1,x-1] and lfDamaged) <> 0) and ((Land[y,x-2] and lfDamaged) <> 0)) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
769 |
or (((Land[y-1, x] and lfDamaged) <> 0) and ((Land[y-1,x-1] and lfDamaged) <> 0) and ((Land[y,x-2] and lfDamaged) <> 0))) then |
5261 | 770 |
begin |
5274 | 771 |
if (cReducedQuality and rqBlurryLand) = 0 then |
772 |
begin |
|
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
773 |
if ((LandPixels[y,x] and AMask) shr AShift) < 10 then |
6982 | 774 |
LandPixels[y,x]:= (ExplosionBorderColor and (not AMask)) or (64 shl AShift) |
5274 | 775 |
else |
776 |
LandPixels[y,x]:= |
|
6982 | 777 |
(((((LandPixels[y,x] and RMask shr RShift) * 3 div 4)+((ExplosionBorderColor and RMask) shr RShift) div 4) and $FF) shl RShift) or |
778 |
(((((LandPixels[y,x] and GMask shr GShift) * 3 div 4)+((ExplosionBorderColor and GMask) shr GShift) div 4) and $FF) shl GShift) or |
|
779 |
(((((LandPixels[y,x] and BMask shr BShift) * 3 div 4)+((ExplosionBorderColor and BMask) shr BShift) div 4) and $FF) shl BShift) or ($FF shl AShift) |
|
5274 | 780 |
end; |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
781 |
if (Land[y, x-1] = lfObject) then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
782 |
Land[y, x]:= lfObject |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
783 |
else if (Land[y, x+1] = lfObject) then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
784 |
Land[y, x]:= lfObject |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
785 |
else if (Land[y+1, x] = lfObject) then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
786 |
Land[y, x]:= lfObject |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
787 |
else if (Land[y-1, x] = lfObject) then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
788 |
Land[y, x]:= lfObject |
5687
fac606654317
Die speckles, round N. Check that alpha is not basically empty while blending, try to match the damaged land type.
nemo
parents:
5480
diff
changeset
|
789 |
else Land[y,x]:= lfBasic |
5261 | 790 |
end |
5267
e9ae019e9bb4
move smoothing into separate function, adjust call order
nemo
parents:
5266
diff
changeset
|
791 |
end |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
792 |
else if ((cReducedQuality and rqBlurryLand) = 0) and (LandPixels[Y, X] and AMask = 255) |
8598
9d21bab30893
Apologies if jaree had done something similar, but didn't see anything in repo pull. This removes Land[] mixed w/ LandPixels[] and streamlines things a little
nemo
parents:
8596
diff
changeset
|
793 |
and (Land[Y, X] and (lfDamaged or lfBasic) = lfBasic) |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
794 |
and (Y > LongInt(topY) + 1) and (Y < LAND_HEIGHT-2) and (X > LongInt(leftX) + 1) and (X < LongInt(rightX) - 1) then |
6130 | 795 |
begin |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
796 |
if ((((Land[y, x-1] and lfDamaged) <> 0) and (((Land[y+1,x] and lfDamaged) <> 0)) or ((Land[y-1,x] and lfDamaged) <> 0)) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
797 |
or (((Land[y, x+1] and lfDamaged) <> 0) and (((Land[y-1,x] and lfDamaged) <> 0) or ((Land[y+1,x] and lfDamaged) <> 0)))) then |
6130 | 798 |
begin |
799 |
LandPixels[y,x]:= |
|
6982 | 800 |
(((((LandPixels[y,x] and RMask shr RShift) div 2)+((ExplosionBorderColor and RMask) shr RShift) div 2) and $FF) shl RShift) or |
801 |
(((((LandPixels[y,x] and GMask shr GShift) div 2)+((ExplosionBorderColor and GMask) shr GShift) div 2) and $FF) shl GShift) or |
|
802 |
(((((LandPixels[y,x] and BMask shr BShift) div 2)+((ExplosionBorderColor and BMask) shr BShift) div 2) and $FF) shl BShift) or ($FF shl AShift) |
|
6130 | 803 |
end |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
804 |
else if ((((Land[y, x-1] and lfDamaged) <> 0) and ((Land[y+1,x-1] and lfDamaged) <> 0) and ((Land[y+2,x] and lfDamaged) <> 0)) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
805 |
or (((Land[y, x-1] and lfDamaged) <> 0) and ((Land[y-1,x-1] and lfDamaged) <> 0) and ((Land[y-2,x] and lfDamaged) <> 0)) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
806 |
or (((Land[y, x+1] and lfDamaged) <> 0) and ((Land[y+1,x+1] and lfDamaged) <> 0) and ((Land[y+2,x] and lfDamaged) <> 0)) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
807 |
or (((Land[y, x+1] and lfDamaged) <> 0) and ((Land[y-1,x+1] and lfDamaged) <> 0) and ((Land[y-2,x] and lfDamaged) <> 0)) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
808 |
or (((Land[y+1, x] and lfDamaged) <> 0) and ((Land[y+1,x+1] and lfDamaged) <> 0) and ((Land[y,x+2] and lfDamaged) <> 0)) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
809 |
or (((Land[y-1, x] and lfDamaged) <> 0) and ((Land[y-1,x+1] and lfDamaged) <> 0) and ((Land[y,x+2] and lfDamaged) <> 0)) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
810 |
or (((Land[y+1, x] and lfDamaged) <> 0) and ((Land[y+1,x-1] and lfDamaged) <> 0) and ((Land[y,x-2] and lfDamaged) <> 0)) |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
811 |
or (((Land[y-1, x] and lfDamaged) <> 0) and ((Land[y-1,x-1] and lfDamaged) <> 0) and ((Land[y,x-2] and lfDamaged) <> 0))) then |
6130 | 812 |
begin |
813 |
LandPixels[y,x]:= |
|
6982 | 814 |
(((((LandPixels[y,x] and RMask shr RShift) * 3 div 4)+((ExplosionBorderColor and RMask) shr RShift) div 4) and $FF) shl RShift) or |
815 |
(((((LandPixels[y,x] and GMask shr GShift) * 3 div 4)+((ExplosionBorderColor and GMask) shr GShift) div 4) and $FF) shl GShift) or |
|
816 |
(((((LandPixels[y,x] and BMask shr BShift) * 3 div 4)+((ExplosionBorderColor and BMask) shr BShift) div 4) and $FF) shl BShift) or ($FF shl AShift) |
|
6130 | 817 |
end |
818 |
end |
|
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset
|
819 |
end; |
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset
|
820 |
|
1792 | 821 |
function SweepDirty: boolean; |
5885
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
822 |
var x, y, xx, yy, ty, tx: LongInt; |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
823 |
bRes, updateBlock, resweep, recheck: boolean; |
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset
|
824 |
begin |
2695 | 825 |
bRes:= false; |
3554
066faceb977d
Extend pixel sweep to recheck neighbours if erasing on edges
nemo
parents:
3521
diff
changeset
|
826 |
reCheck:= true; |
1792 | 827 |
|
3554
066faceb977d
Extend pixel sweep to recheck neighbours if erasing on edges
nemo
parents:
3521
diff
changeset
|
828 |
while recheck do |
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
829 |
begin |
3554
066faceb977d
Extend pixel sweep to recheck neighbours if erasing on edges
nemo
parents:
3521
diff
changeset
|
830 |
recheck:= false; |
066faceb977d
Extend pixel sweep to recheck neighbours if erasing on edges
nemo
parents:
3521
diff
changeset
|
831 |
for y:= 0 to LAND_HEIGHT div 32 - 1 do |
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
832 |
begin |
3554
066faceb977d
Extend pixel sweep to recheck neighbours if erasing on edges
nemo
parents:
3521
diff
changeset
|
833 |
for x:= 0 to LAND_WIDTH div 32 - 1 do |
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
834 |
begin |
5895 | 835 |
if LandDirty[y, x] = 1 then |
2167
4e9ad395c1d1
Loop sweeping to avoid stray pixels. Avoided at first hoping there was a cleverer approach. Fortunately sweep is infrequent.
nemo
parents:
1892
diff
changeset
|
836 |
begin |
3554
066faceb977d
Extend pixel sweep to recheck neighbours if erasing on edges
nemo
parents:
3521
diff
changeset
|
837 |
updateBlock:= false; |
5885
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
838 |
resweep:= true; |
3602
99c93fa258d6
Restore prior optimisation with the wildly out-of-bounds tx in LandDirty removed
nemo
parents:
3601
diff
changeset
|
839 |
ty:= y * 32; |
99c93fa258d6
Restore prior optimisation with the wildly out-of-bounds tx in LandDirty removed
nemo
parents:
3601
diff
changeset
|
840 |
tx:= x * 32; |
5885
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
841 |
while(resweep) do |
3554
066faceb977d
Extend pixel sweep to recheck neighbours if erasing on edges
nemo
parents:
3521
diff
changeset
|
842 |
begin |
5885
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
843 |
resweep:= false; |
3602
99c93fa258d6
Restore prior optimisation with the wildly out-of-bounds tx in LandDirty removed
nemo
parents:
3601
diff
changeset
|
844 |
for yy:= ty to ty + 31 do |
99c93fa258d6
Restore prior optimisation with the wildly out-of-bounds tx in LandDirty removed
nemo
parents:
3601
diff
changeset
|
845 |
for xx:= tx to tx + 31 do |
5885
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
846 |
if Despeckle(xx, yy) then |
3554
066faceb977d
Extend pixel sweep to recheck neighbours if erasing on edges
nemo
parents:
3521
diff
changeset
|
847 |
begin |
066faceb977d
Extend pixel sweep to recheck neighbours if erasing on edges
nemo
parents:
3521
diff
changeset
|
848 |
bRes:= true; |
066faceb977d
Extend pixel sweep to recheck neighbours if erasing on edges
nemo
parents:
3521
diff
changeset
|
849 |
updateBlock:= true; |
5885
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
850 |
resweep:= true; |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
851 |
if (yy = ty) and (y > 0) then |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
852 |
begin |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
853 |
LandDirty[y-1, x]:= 1; |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
854 |
recheck:= true; |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
855 |
end |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
856 |
else if (yy = ty+31) and (y < LAND_HEIGHT div 32 - 1) then |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
857 |
begin |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
858 |
LandDirty[y+1, x]:= 1; |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
859 |
recheck:= true; |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
860 |
end; |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
861 |
if (xx = tx) and (x > 0) then |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
862 |
begin |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
863 |
LandDirty[y, x-1]:= 1; |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
864 |
recheck:= true; |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
865 |
end |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
866 |
else if (xx = tx+31) and (x < LAND_WIDTH div 32 - 1) then |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
867 |
begin |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
868 |
LandDirty[y, x+1]:= 1; |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
869 |
recheck:= true; |
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
870 |
end |
3554
066faceb977d
Extend pixel sweep to recheck neighbours if erasing on edges
nemo
parents:
3521
diff
changeset
|
871 |
end; |
066faceb977d
Extend pixel sweep to recheck neighbours if erasing on edges
nemo
parents:
3521
diff
changeset
|
872 |
end; |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
873 |
if updateBlock then |
7170
84ac6c6d2d8e
Only create textures for non-empty LandPixel chunks. This should save a fair amount of memory, especially on smaller maps, and eliminate a number of draws
nemo
parents:
7150
diff
changeset
|
874 |
UpdateLandTexture(tx, 32, ty, 32, false); |
5895 | 875 |
LandDirty[y, x]:= 2; |
2167
4e9ad395c1d1
Loop sweeping to avoid stray pixels. Avoided at first hoping there was a cleverer approach. Fortunately sweep is infrequent.
nemo
parents:
1892
diff
changeset
|
876 |
end; |
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
877 |
end; |
3f21a9dc93d0
Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents:
2741
diff
changeset
|
878 |
end; |
3554
066faceb977d
Extend pixel sweep to recheck neighbours if erasing on edges
nemo
parents:
3521
diff
changeset
|
879 |
end; |
1792 | 880 |
|
5895 | 881 |
for y:= 0 to LAND_HEIGHT div 32 - 1 do |
882 |
for x:= 0 to LAND_WIDTH div 32 - 1 do |
|
883 |
if LandDirty[y, x] <> 0 then |
|
884 |
begin |
|
885 |
LandDirty[y, x]:= 0; |
|
886 |
ty:= y * 32; |
|
887 |
tx:= x * 32; |
|
888 |
for yy:= ty to ty + 31 do |
|
889 |
for xx:= tx to tx + 31 do |
|
890 |
Smooth(xx,yy) |
|
891 |
end; |
|
892 |
||
2695 | 893 |
SweepDirty:= bRes; |
1738
00e8dadce69a
Add nemo's depixeling patch. Still needs some polishing for the case when we delete pixel on which hedgehog stays
unc0rr
parents:
1066
diff
changeset
|
894 |
end; |
184 | 895 |
|
5885
ae257409bcff
Remove extra graphical resweeps, and smooth prior to despeckling. Was getting odd desync here without Land[] seemingly incorrect at end of passes. Just removing seems to fix, and code wasn't that good an idea in its prior state anyway.
nemo
parents:
5832
diff
changeset
|
896 |
|
2331
e4941a7986d6
Another try at keeping blowtorch/firepunch/jackhammer from going through indestructible stuff. Shame these routines don't use hedgehog movement
nemo
parents:
2236
diff
changeset
|
897 |
// Return true if outside of land or not the value tested, used right now for some X/Y movement that does not use normal hedgehog movement in GSHandlers.inc |
6096
a00dbbf49d6c
Add landbacktex to a few maps, just to see how it looks.
nemo
parents:
6081
diff
changeset
|
898 |
function CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean; inline; |
2331
e4941a7986d6
Another try at keeping blowtorch/firepunch/jackhammer from going through indestructible stuff. Shame these routines don't use hedgehog movement
nemo
parents:
2236
diff
changeset
|
899 |
begin |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
900 |
CheckLandValue:= ((X and LAND_WIDTH_MASK <> 0) or (Y and LAND_HEIGHT_MASK <> 0)) or ((Land[Y, X] and LandFlag) = 0) |
2331
e4941a7986d6
Another try at keeping blowtorch/firepunch/jackhammer from going through indestructible stuff. Shame these routines don't use hedgehog movement
nemo
parents:
2236
diff
changeset
|
901 |
end; |
4367 | 902 |
|
6096
a00dbbf49d6c
Add landbacktex to a few maps, just to see how it looks.
nemo
parents:
6081
diff
changeset
|
903 |
function LandBackPixel(x, y: LongInt): LongWord; inline; |
4367 | 904 |
var p: PLongWordArray; |
905 |
begin |
|
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
906 |
if LandBackSurface = nil then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
907 |
LandBackPixel:= 0 |
4367 | 908 |
else |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
909 |
begin |
4367 | 910 |
p:= LandBackSurface^.pixels; |
911 |
LandBackPixel:= p^[LandBackSurface^.w * (y mod LandBackSurface^.h) + (x mod LandBackSurface^.w)];// or $FF000000; |
|
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
912 |
end |
4367 | 913 |
end; |
914 |
||
915 |
||
6490 | 916 |
procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword); |
917 |
var |
|
918 |
eX, eY, dX, dY: LongInt; |
|
919 |
i, sX, sY, x, y, d: LongInt; |
|
920 |
begin |
|
921 |
eX:= 0; |
|
922 |
eY:= 0; |
|
923 |
dX:= X2 - X1; |
|
924 |
dY:= Y2 - Y1; |
|
925 |
||
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
926 |
if (dX > 0) then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
927 |
sX:= 1 |
6490 | 928 |
else |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
929 |
if (dX < 0) then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
930 |
begin |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
931 |
sX:= -1; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
932 |
dX:= -dX |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
933 |
end |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
934 |
else |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
935 |
sX:= dX; |
6490 | 936 |
|
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
937 |
if (dY > 0) then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
938 |
sY:= 1 |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
939 |
else |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
940 |
if (dY < 0) then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
941 |
begin |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
942 |
sY:= -1; |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
943 |
dY:= -dY |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
944 |
end |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
945 |
else |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
946 |
sY:= dY; |
6490 | 947 |
|
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
948 |
if (dX > dY) then |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
949 |
d:= dX |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
950 |
else |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
951 |
d:= dY; |
6490 | 952 |
|
953 |
x:= X1; |
|
954 |
y:= Y1; |
|
955 |
||
956 |
for i:= 0 to d do |
|
957 |
begin |
|
958 |
inc(eX, dX); |
|
959 |
inc(eY, dY); |
|
960 |
if (eX > d) then |
|
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
961 |
begin |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
962 |
dec(eX, d); |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
963 |
inc(x, sX); |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
964 |
end; |
6490 | 965 |
if (eY > d) then |
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
966 |
begin |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
967 |
dec(eY, d); |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
968 |
inc(y, sY); |
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
969 |
end; |
6490 | 970 |
|
971 |
if ((x and LAND_WIDTH_MASK) = 0) and ((y and LAND_HEIGHT_MASK) = 0) then |
|
6580
6155187bf599
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent.
lovelacer
parents:
6490
diff
changeset
|
972 |
Land[y, x]:= Color; |
6490 | 973 |
end |
974 |
end; |
|
975 |
||
7150
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
976 |
procedure DrawDots(x, y, xx, yy: Longint; Color: Longword); inline; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
977 |
begin |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
978 |
if (((x + xx) and LAND_WIDTH_MASK) = 0) and (((y + yy) and LAND_HEIGHT_MASK) = 0) then Land[y + yy, x + xx]:= Color; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
979 |
if (((x + xx) and LAND_WIDTH_MASK) = 0) and (((y - yy) and LAND_HEIGHT_MASK) = 0) then Land[y - yy, x + xx]:= Color; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
980 |
if (((x - xx) and LAND_WIDTH_MASK) = 0) and (((y + yy) and LAND_HEIGHT_MASK) = 0) then Land[y + yy, x - xx]:= Color; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
981 |
if (((x - xx) and LAND_WIDTH_MASK) = 0) and (((y - yy) and LAND_HEIGHT_MASK) = 0) then Land[y - yy, x - xx]:= Color; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
982 |
if (((x + yy) and LAND_WIDTH_MASK) = 0) and (((y + xx) and LAND_HEIGHT_MASK) = 0) then Land[y + xx, x + yy]:= Color; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
983 |
if (((x + yy) and LAND_WIDTH_MASK) = 0) and (((y - xx) and LAND_HEIGHT_MASK) = 0) then Land[y - xx, x + yy]:= Color; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
984 |
if (((x - yy) and LAND_WIDTH_MASK) = 0) and (((y + xx) and LAND_HEIGHT_MASK) = 0) then Land[y + xx, x - yy]:= Color; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
985 |
if (((x - yy) and LAND_WIDTH_MASK) = 0) and (((y - xx) and LAND_HEIGHT_MASK) = 0) then Land[y - xx, x - yy]:= Color; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
986 |
end; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
987 |
|
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
988 |
procedure DrawLines(X1, Y1, X2, Y2, XX, YY: LongInt; color: Longword); |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
989 |
var |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
990 |
eX, eY, dX, dY: LongInt; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
991 |
i, sX, sY, x, y, d: LongInt; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
992 |
f: boolean; |
7147 | 993 |
begin |
7150
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
994 |
eX:= 0; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
995 |
eY:= 0; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
996 |
dX:= X2 - X1; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
997 |
dY:= Y2 - Y1; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
998 |
|
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
999 |
if (dX > 0) then |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1000 |
sX:= 1 |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1001 |
else |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1002 |
if (dX < 0) then |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1003 |
begin |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1004 |
sX:= -1; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1005 |
dX:= -dX |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1006 |
end |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1007 |
else |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1008 |
sX:= dX; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1009 |
|
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1010 |
if (dY > 0) then |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1011 |
sY:= 1 |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1012 |
else |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1013 |
if (dY < 0) then |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1014 |
begin |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1015 |
sY:= -1; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1016 |
dY:= -dY |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1017 |
end |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1018 |
else |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1019 |
sY:= dY; |
7147 | 1020 |
|
7150
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1021 |
if (dX > dY) then |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1022 |
d:= dX |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1023 |
else |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1024 |
d:= dY; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1025 |
|
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1026 |
x:= X1; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1027 |
y:= Y1; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1028 |
|
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1029 |
for i:= 0 to d do |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1030 |
begin |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1031 |
inc(eX, dX); |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1032 |
inc(eY, dY); |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1033 |
|
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1034 |
f:= eX > d; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1035 |
if f then |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1036 |
begin |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1037 |
dec(eX, d); |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1038 |
inc(x, sX); |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1039 |
DrawDots(x, y, xx, yy, color) |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1040 |
end; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1041 |
if (eY > d) then |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1042 |
begin |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1043 |
dec(eY, d); |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1044 |
inc(y, sY); |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1045 |
f:= true; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1046 |
DrawDots(x, y, xx, yy, color) |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1047 |
end; |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1048 |
|
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1049 |
if not f then |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1050 |
DrawDots(x, y, xx, yy, color) |
fba3b14ff746
This should make drawn maps rendering even more faster
unc0rr
parents:
7147
diff
changeset
|
1051 |
end |
7147 | 1052 |
end; |
1053 |
||
1054 |
procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword); |
|
1055 |
var dx, dy, d: LongInt; |
|
1056 |
begin |
|
1057 |
dx:= 0; |
|
1058 |
dy:= Radius; |
|
1059 |
d:= 3 - 2 * Radius; |
|
1060 |
while (dx < dy) do |
|
1061 |
begin |
|
1062 |
DrawLines(x1, y1, x2, y2, dx, dy, color); |
|
1063 |
if (d < 0) then |
|
1064 |
d:= d + 4 * dx + 6 |
|
1065 |
else |
|
1066 |
begin |
|
1067 |
d:= d + 4 * (dx - dy) + 10; |
|
1068 |
dec(dy) |
|
1069 |
end; |
|
1070 |
inc(dx) |
|
1071 |
end; |
|
1072 |
if (dx = dy) then |
|
1073 |
DrawLines(x1, y1, x2, y2, dx, dy, color); |
|
1074 |
end; |
|
1075 |
||
7268 | 1076 |
|
1077 |
procedure DumpLandToLog(x, y, r: LongInt); |
|
1078 |
var xx, yy, dx: LongInt; |
|
1079 |
s: shortstring; |
|
1080 |
begin |
|
1081 |
s[0]:= char(r * 2 + 1); |
|
1082 |
for yy:= y - r to y + r do |
|
1083 |
begin |
|
1084 |
for dx:= 0 to r*2 do |
|
1085 |
begin |
|
1086 |
xx:= dx - r + x; |
|
1087 |
if (xx = x) and (yy = y) then |
|
1088 |
s[dx + 1]:= 'X' |
|
1089 |
else if Land[yy, xx] > 255 then |
|
1090 |
s[dx + 1]:= 'O' |
|
1091 |
else if Land[yy, xx] > 0 then |
|
1092 |
s[dx + 1]:= '*' |
|
1093 |
else |
|
1094 |
s[dx + 1]:= '.' |
|
1095 |
end; |
|
1096 |
AddFileLog('Land dump: ' + s); |
|
1097 |
end; |
|
1098 |
end; |
|
1099 |
||
184 | 1100 |
end. |