DEADSOFTWARE

more zip related fixes for packmap
[d2df-editor.git] / src / editor / g_basic.pas
1 unit g_basic;
3 {$INCLUDE ../shared/a_modes.inc}
5 interface
7 uses
8 LCLIntf, LCLType, LMessages;
10 Type
11 String16 = String[16];
12 Char16 = packed array[0..15] of Char;
13 Char32 = packed array[0..31] of Char;
14 Char64 = packed array[0..63] of Char;
15 Char256 = packed array[0..255] of Char;
16 ArrayStr16 = Array of String16;
17 SArray = Array of String;
18 DWArray = Array of DWORD;
20 TDirection = (D_LEFT, D_RIGHT);
22 function g_Collide(X1, Y1: Integer; Width1, Height1: Word;
23 X2, Y2: Integer; Width2, Height2: Word): Boolean;
24 function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean;
25 function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean;
26 function g_CollideLevel2(X, Y: Integer; Width, Height: Word; _ID: DWORD; var PanelID: DWORD): Boolean;
27 function g_PatchLength(X1, Y1, X2, Y2: Integer): Word;
28 procedure IncMax(var A: Integer; B, Max: Integer); overload;
29 procedure IncMax(var A: Single; B, Max: Single); overload;
30 procedure IncMax(var A: Integer; Max: Integer); overload;
31 procedure IncMax(var A: Single; Max: Single); overload;
32 procedure IncMax(var A: Word; B, Max: Word); overload;
33 procedure IncMax(var A: Word; Max: Word); overload;
34 procedure IncMax(var A: SmallInt; B, Max: SmallInt); overload;
35 procedure IncMax(var A: SmallInt; Max: SmallInt); overload;
36 procedure DecMin(var A: Integer; B, Min: Integer); overload;
37 procedure DecMin(var A: Single; B, Min: Single); overload;
38 procedure DecMin(var A: Integer; Min: Integer); overload;
39 procedure DecMin(var A: Single; Min: Single); overload;
40 procedure DecMin(var A: Word; B, Min: Word); overload;
41 procedure DecMin(var A: Word; Min: Word); overload;
42 procedure DecMin(var A: Byte; B, Min: Byte); overload;
43 procedure DecMin(var A: Byte; Min: Byte); overload;
44 function Sign(A: Integer): ShortInt; overload;
45 function Sign(A: Single): ShortInt; overload;
46 function PointToRect(X, Y: Integer; X1, Y1, Width, Height: Integer): Integer;
47 procedure g_ChangeDir(var dir: TDirection);
48 function g_GetFileTime(fileName: String): Integer;
49 function g_SetFileTime(fileName: String; time: Integer): Boolean;
51 implementation
53 uses
54 Math, g_map, MAPDEF, SysUtils;
56 procedure g_ChangeDir(var dir: TDirection);
57 begin
58 if dir = D_LEFT then
59 dir := D_RIGHT
60 else
61 dir := D_LEFT;
62 end;
64 function g_GetFileTime(fileName: String): Integer;
65 var
66 F: File;
68 begin
69 if not FileExists(fileName) then
70 begin
71 Result := -1;
72 Exit;
73 end;
75 AssignFile(F, fileName);
76 Reset(F);
77 Result := FileGetDate(TFileRec(F).Handle);
78 CloseFile(F);
79 end;
81 function g_SetFileTime(fileName: String; time: Integer): Boolean;
82 var
83 F: File;
85 begin
86 if (not FileExists(fileName)) or (time < 0) then
87 begin
88 Result := False;
89 Exit;
90 end;
92 AssignFile(F, fileName);
93 Reset(F);
94 Result := (FileSetDate(TFileRec(F).Handle, time) = 0);
95 CloseFile(F);
96 end;
98 function g_PatchLength(X1, Y1, X2, Y2: Integer): Word;
99 begin
100 Result := Trunc(Hypot(Abs(X2-X1), Abs(Y2-Y1)));
101 end;
103 function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean;
104 var
105 a: Integer;
107 begin
108 Result := False;
110 if gPanels = nil then Exit;
112 for a := 0 to High(gPanels) do
113 if gPanels[a].PanelType = PANEL_WALL then
114 if not (((Y + Height <= gPanels[a].Y) or
115 (Y >= gPanels[a].Y + gPanels[a].Height)) or
116 ((X + Width <= gPanels[a].X) or
117 (X >= gPanels[a].X + gPanels[a].Width))) then
118 begin
119 Result := True;
120 Exit;
121 end;
122 end;
124 {function g_CollideLevel2(X, Y, X2, Y2: Integer): Boolean;
125 var
126 a: Integer;
127 begin
128 Result := False;
130 if gWalls = nil then Exit;
132 for a := 0 to High(gWalls) do
133 if not (((Y2 <= gWalls[a].Y) or
134 (Y >= gWalls[a].Y + gWalls[a].Height)) or
135 ((X2 <= gWalls[a].X) or
136 (X >= gWalls[a].X + gWalls[a].Width))) then
137 begin
138 Result := True;
139 Exit;
140 end;
141 end;}
143 function g_CollideLevel2(X, Y: Integer; Width, Height: Word; _ID: DWORD; var PanelID: DWORD): Boolean;
144 var
145 a: DWORD;
146 begin
147 Result := False;
149 if gPanels = nil then Exit;
151 for a := 0 to High(gPanels) do
152 if (gPanels[a].PanelType = PANEL_WALL) and (_ID <> a) then
153 if not (((Y + Height <= gPanels[a].Y) or
154 (Y >= gPanels[a].Y + gPanels[a].Height)) or
155 ((X + Width <= gPanels[a].X) or
156 (X >= gPanels[a].X + gPanels[a].Width))) then
157 begin
158 Result := True;
159 PanelID := a;
160 Exit;
161 end;
162 end;
164 function g_Collide(X1, Y1: Integer; Width1, Height1: Word;
165 X2, Y2: Integer; Width2, Height2: Word): Boolean;
166 begin
167 Result := not (((Y1 + Height1 <= Y2) or
168 (Y1 >= Y2 + Height2)) or
169 ((X1 + Width1 <= X2) or
170 (X1 >= X2 + Width2)));
171 end;
173 function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean;
174 begin
175 {X := X-X2;
176 Y := Y-Y2;
177 Result := (x >= 0) and (x <= Width) and
178 (y >= 0) and (y <= Height);}
179 Result := (X >= X2) and (X <= (X2+Width)) and
180 (Y >= Y2) and (Y <= (Y2+Height));
181 end;
183 procedure IncMax(var A: Integer; B, Max: Integer);
184 begin
185 if A+B > Max then A := Max else A := A+B;
186 end;
188 procedure IncMax(var A: Single; B, Max: Single);
189 begin
190 if A+B > Max then A := Max else A := A+B;
191 end;
193 procedure DecMin(var A: Integer; B, Min: Integer);
194 begin
195 if A-B < Min then A := Min else A := A-B;
196 end;
198 procedure DecMin(var A: Word; B, Min: Word);
199 begin
200 if A-B < Min then A := Min else A := A-B;
201 end;
203 procedure DecMin(var A: Single; B, Min: Single);
204 begin
205 if A-B < Min then A := Min else A := A-B;
206 end;
208 procedure IncMax(var A: Integer; Max: Integer);
209 begin
210 if A+1 > Max then A := Max else A := A+1;
211 end;
213 procedure IncMax(var A: Single; Max: Single);
214 begin
215 if A+1 > Max then A := Max else A := A+1;
216 end;
218 procedure IncMax(var A: Word; B, Max: Word);
219 begin
220 if A+B > Max then A := Max else A := A+B;
221 end;
223 procedure IncMax(var A: Word; Max: Word);
224 begin
225 if A+1 > Max then A := Max else A := A+1;
226 end;
228 procedure IncMax(var A: SmallInt; B, Max: SmallInt);
229 begin
230 if A+B > Max then A := Max else A := A+B;
231 end;
233 procedure IncMax(var A: SmallInt; Max: SmallInt);
234 begin
235 if A+1 > Max then A := Max else A := A+1;
236 end;
238 procedure DecMin(var A: Integer; Min: Integer);
239 begin
240 if A-1 < Min then A := Min else A := A-1;
241 end;
243 procedure DecMin(var A: Single; Min: Single);
244 begin
245 if A-1 < Min then A := Min else A := A-1;
246 end;
248 procedure DecMin(var A: Word; Min: Word);
249 begin
250 if A-1 < Min then A := Min else A := A-1;
251 end;
253 procedure DecMin(var A: Byte; B, Min: Byte);
254 begin
255 if A-B < Min then A := Min else A := A-B;
256 end;
258 procedure DecMin(var A: Byte; Min: Byte); overload;
259 begin
260 if A-1 < Min then A := Min else A := A-1;
261 end;
263 function Sign(A: Integer): ShortInt;
264 begin
265 if A < 0 then Result := -1
266 else if A > 0 then Result := 1
267 else Result := 0;
268 end;
270 function Sign(A: Single): ShortInt;
271 const
272 Eps = 1.0E-5;
273 begin
274 if Abs(A) < Eps then Result := 0
275 else if A < 0 then Result := -1
276 else Result := 1;
277 end;
279 function PointToRect(X, Y: Integer; X1, Y1, Width, Height: Integer): Integer;
280 begin
281 X := X-X1;
282 Y := Y-Y1;
284 if X < 0 then
285 begin
286 if Y < 0 then Result := Round(Sqrt(Sqr(X)+Sqr(Y)))
287 else if Y > Height then Result := Round(Sqrt(Sqr(X)+Sqr(Y-Height)))
288 else Result := -X;
289 end
290 else
291 if X > Width then
292 begin
293 X := X-width;
294 if y < 0 then Result := Round(Sqrt(Sqr(X)+Sqr(Y)))
295 else if Y > Height then Result := Round(Sqrt(Sqr(X)+Sqr(Y-Height)))
296 else Result := X;
297 end
298 else
299 begin
300 if Y < 0 then Result := -Y
301 else if Y > Height then Result := Y-Height
302 else Result:=0;
303 end;
304 end;
306 end.