src/editor/g_basic.pas

   1 unit g_basic;
   2
   3 {$INCLUDE ../shared/a_modes.inc}
   4
   5 interface
   6
   7 uses
   8   LCLIntf, LCLType, LMessages;
   9
  10 const
  11   EDITOR_VERSION = '0.667';
  12   EDITOR_BUILDDATE = {$I %DATE%};
  13   EDITOR_BUILDTIME = {$I %TIME%};
  14
  15 Type
  16   String16   = String[16];
  17   Char16     = packed array[0..15] of Char;
  18   Char32     = packed array[0..31] of Char;
  19   Char64     = packed array[0..63] of Char;
  20   Char256    = packed array[0..255] of Char;
  21   ArrayStr16 = Array of String16;
  22   SArray     = Array of String;
  23   DWArray    = Array of DWORD;
  24
  25   TDirection = (D_LEFT, D_RIGHT);
  26
  27 function g_GetBuilderName (): AnsiString;
  28 function g_GetBuildHash (full: Boolean = True): AnsiString;
  29
  30 function  g_Collide(X1, Y1: Integer; Width1, Height1: Word;
  31                     X2, Y2: Integer; Width2, Height2: Word): Boolean;
  32 function  g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean;
  33 function  g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean;
  34 function  g_CollideLevel2(X, Y: Integer; Width, Height: Word; _ID: DWORD; var PanelID: DWORD): Boolean;
  35 function  g_PatchLength(X1, Y1, X2, Y2: Integer): Word;
  36 procedure IncMax(var A: Integer; B, Max: Integer); overload;
  37 procedure IncMax(var A: Single; B, Max: Single); overload;
  38 procedure IncMax(var A: Integer; Max: Integer); overload;
  39 procedure IncMax(var A: Single; Max: Single); overload;
  40 procedure IncMax(var A: Word; B, Max: Word); overload;
  41 procedure IncMax(var A: Word; Max: Word); overload;
  42 procedure IncMax(var A: SmallInt; B, Max: SmallInt); overload;
  43 procedure IncMax(var A: SmallInt; Max: SmallInt); overload;
  44 procedure DecMin(var A: Integer; B, Min: Integer); overload;
  45 procedure DecMin(var A: Single; B, Min: Single); overload;
  46 procedure DecMin(var A: Integer; Min: Integer); overload;
  47 procedure DecMin(var A: Single; Min: Single); overload;
  48 procedure DecMin(var A: Word; B, Min: Word); overload;
  49 procedure DecMin(var A: Word; Min: Word); overload;
  50 procedure DecMin(var A: Byte; B, Min: Byte); overload;
  51 procedure DecMin(var A: Byte; Min: Byte); overload;
  52 function  Sign(A: Integer): ShortInt; overload;
  53 function  Sign(A: Single): ShortInt; overload;
  54 function  PointToRect(X, Y: Integer; X1, Y1, Width, Height: Integer): Integer;
  55 procedure g_ChangeDir(var dir: TDirection);
  56 function  g_GetFileTime(fileName: String): Integer;
  57 function  g_SetFileTime(fileName: String; time: Integer): Boolean;
  58
  59 implementation
  60
  61 uses
  62   Math, g_map, MAPDEF, SysUtils;
  63
  64 {$PUSH}
  65 {$WARN 2054 OFF} // unknwon env var
  66 {$WARN 6018 OFF} // unreachable code
  67 function g_GetBuilderName (): AnsiString;
  68 begin
  69   if {$I %D2DF_BUILD_USER%} <> '' then
  70     result := {$I %D2DF_BUILD_USER%} // custom
  71   else if {$I %USER%} <> '' then
  72     result := {$I %USER%} // unix username
  73   else if {$I %USERNAME%} <> '' then
  74     result := {$I %USERNAME%} // windows username
  75   else
  76     result := 'unknown'
  77 end;
  78
  79 function g_GetBuildHash (full: Boolean = True): AnsiString;
  80 begin
  81   if {$I %D2DF_BUILD_HASH%} <> '' then
  82     if full then
  83       result := {$I %D2DF_BUILD_HASH%}
  84     else
  85       result := Copy({$I %D2DF_BUILD_HASH%}, 1, 7)
  86   else
  87     result := 'custom build'
  88 end;
  89 {$POP}
  90
  91 procedure g_ChangeDir(var dir: TDirection);
  92 begin
  93   if dir = D_LEFT then
  94     dir := D_RIGHT
  95   else
  96     dir := D_LEFT;
  97 end;
  98
  99 function g_GetFileTime(fileName: String): Integer;
 100 var
 101   F: File;
 102
 103 begin
 104   if not FileExists(fileName) then
 105   begin
 106     Result := -1;
 107     Exit;
 108   end;
 109
 110   AssignFile(F, fileName);
 111   Reset(F);
 112   Result := FileGetDate(TFileRec(F).Handle);
 113   CloseFile(F);
 114 end;
 115
 116 function g_SetFileTime(fileName: String; time: Integer): Boolean;
 117 var
 118   F: File;
 119
 120 begin
 121   if (not FileExists(fileName)) or (time < 0) then
 122   begin
 123     Result := False;
 124     Exit;
 125   end;
 126
 127   AssignFile(F, fileName);
 128   Reset(F);
 129   Result := (FileSetDate(TFileRec(F).Handle, time) = 0);
 130   CloseFile(F);
 131 end;
 132
 133 function g_PatchLength(X1, Y1, X2, Y2: Integer): Word;
 134 begin
 135   Result := Trunc(Hypot(Abs(X2-X1), Abs(Y2-Y1)));
 136 end;
 137
 138 function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean;
 139 var
 140   a: Integer;
 141
 142 begin
 143  Result := False;
 144
 145  if gPanels = nil then Exit;
 146
 147  for a := 0 to High(gPanels) do
 148   if gPanels[a].PanelType = PANEL_WALL then
 149    if not (((Y + Height <= gPanels[a].Y) or
 150             (Y          >= gPanels[a].Y + gPanels[a].Height)) or
 151            ((X + Width  <= gPanels[a].X) or
 152             (X          >= gPanels[a].X + gPanels[a].Width))) then
 153    begin
 154     Result := True;
 155     Exit;
 156    end;
 157 end;
 158
 159 {function g_CollideLevel2(X, Y, X2, Y2: Integer): Boolean;
 160 var
 161   a: Integer;
 162 begin
 163  Result := False;
 164
 165  if gWalls = nil then Exit;
 166
 167  for a := 0 to High(gWalls) do
 168   if not (((Y2 <= gWalls[a].Y) or
 169            (Y  >= gWalls[a].Y + gWalls[a].Height)) or
 170           ((X2 <= gWalls[a].X) or
 171            (X  >= gWalls[a].X + gWalls[a].Width))) then
 172   begin
 173    Result := True;
 174    Exit;
 175   end;
 176 end;}
 177
 178 function g_CollideLevel2(X, Y: Integer; Width, Height: Word; _ID: DWORD; var PanelID: DWORD): Boolean;
 179 var
 180   a: DWORD;
 181 begin
 182  Result := False;
 183
 184  if gPanels = nil then Exit;
 185
 186  for a := 0 to High(gPanels) do
 187   if (gPanels[a].PanelType = PANEL_WALL) and (_ID <> a) then
 188    if not (((Y + Height <= gPanels[a].Y) or
 189             (Y          >= gPanels[a].Y + gPanels[a].Height)) or
 190            ((X + Width  <= gPanels[a].X) or
 191             (X          >= gPanels[a].X + gPanels[a].Width))) then
 192    begin
 193     Result := True;
 194     PanelID := a;
 195     Exit;
 196    end;
 197 end;
 198
 199 function g_Collide(X1, Y1: Integer; Width1, Height1: Word;
 200                    X2, Y2: Integer; Width2, Height2: Word): Boolean;
 201 begin
 202  Result := not (((Y1 + Height1 <= Y2) or
 203                 (Y1           >= Y2 + Height2)) or
 204                 ((X1 + Width1 <= X2) or
 205                 (X1           >= X2 + Width2)));
 206 end;
 207
 208 function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean;
 209 begin
 210  {X := X-X2;
 211  Y := Y-Y2;
 212  Result := (x >= 0) and (x <= Width) and
 213            (y >= 0) and (y <= Height);}
 214  Result := (X >= X2) and (X <= (X2+Width)) and
 215            (Y >= Y2) and (Y <= (Y2+Height));
 216 end;
 217
 218 procedure IncMax(var A: Integer; B, Max: Integer);
 219 begin
 220  if A+B > Max then A := Max else A := A+B;
 221 end;
 222
 223 procedure IncMax(var A: Single; B, Max: Single);
 224 begin
 225  if A+B > Max then A := Max else A := A+B;
 226 end;
 227
 228 procedure DecMin(var A: Integer; B, Min: Integer);
 229 begin
 230  if A-B < Min then A := Min else A := A-B;
 231 end;
 232
 233 procedure DecMin(var A: Word; B, Min: Word);
 234 begin
 235  if A-B < Min then A := Min else A := A-B;
 236 end;
 237
 238 procedure DecMin(var A: Single; B, Min: Single);
 239 begin
 240  if A-B < Min then A := Min else A := A-B;
 241 end;
 242
 243 procedure IncMax(var A: Integer; Max: Integer);
 244 begin
 245  if A+1 > Max then A := Max else A := A+1;
 246 end;
 247
 248 procedure IncMax(var A: Single; Max: Single);
 249 begin
 250  if A+1 > Max then A := Max else A := A+1;
 251 end;
 252
 253 procedure IncMax(var A: Word; B, Max: Word);
 254 begin
 255  if A+B > Max then A := Max else A := A+B;
 256 end;
 257
 258 procedure IncMax(var A: Word; Max: Word);
 259 begin
 260  if A+1 > Max then A := Max else A := A+1;
 261 end;
 262
 263 procedure IncMax(var A: SmallInt; B, Max: SmallInt);
 264 begin
 265  if A+B > Max then A := Max else A := A+B;
 266 end;
 267
 268 procedure IncMax(var A: SmallInt; Max: SmallInt);
 269 begin
 270  if A+1 > Max then A := Max else A := A+1;
 271 end;
 272
 273 procedure DecMin(var A: Integer; Min: Integer);
 274 begin
 275  if A-1 < Min then A := Min else A := A-1;
 276 end;
 277
 278 procedure DecMin(var A: Single; Min: Single);
 279 begin
 280  if A-1 < Min then A := Min else A := A-1;
 281 end;
 282
 283 procedure DecMin(var A: Word; Min: Word);
 284 begin
 285  if A-1 < Min then A := Min else A := A-1;
 286 end;
 287
 288 procedure DecMin(var A: Byte; B, Min: Byte);
 289 begin
 290  if A-B < Min then A := Min else A := A-B;
 291 end;
 292
 293 procedure DecMin(var A: Byte; Min: Byte); overload;
 294 begin
 295  if A-1 < Min then A := Min else A := A-1;
 296 end;
 297
 298 function Sign(A: Integer): ShortInt;
 299 begin
 300  if A < 0 then Result := -1
 301   else if A > 0 then Result := 1
 302    else Result := 0;
 303 end;
 304
 305 function Sign(A: Single): ShortInt;
 306 const
 307    Eps = 1.0E-5;
 308 begin
 309  if Abs(A) < Eps then Result := 0
 310   else if A < 0 then Result := -1
 311    else Result := 1;
 312 end;
 313
 314 function PointToRect(X, Y: Integer; X1, Y1, Width, Height: Integer): Integer;
 315 begin
 316  X := X-X1;
 317  Y := Y-Y1;
 318
 319  if X < 0 then
 320  begin
 321   if Y < 0 then Result := Round(Sqrt(Sqr(X)+Sqr(Y)))
 322    else if Y > Height then Result := Round(Sqrt(Sqr(X)+Sqr(Y-Height)))
 323     else Result := -X;
 324  end
 325   else
 326  if X > Width then
 327  begin
 328   X := X-width;
 329   if y < 0 then Result := Round(Sqrt(Sqr(X)+Sqr(Y)))
 330    else if Y > Height then Result := Round(Sqrt(Sqr(X)+Sqr(Y-Height)))
 331     else Result := X;
 332  end
 333   else
 334  begin
 335   if Y < 0 then Result := -Y
 336    else if Y > Height then Result := Y-Height
 337     else Result:=0;
 338  end;
 339 end;
 340
 341 end.