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 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;
  19
  20   TDirection = (D_LEFT, D_RIGHT);
  21
  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;
  50
  51 implementation
  52
  53 uses
  54   Math, g_map, MAPDEF, SysUtils;
  55
  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;
  63
  64 function g_GetFileTime(fileName: String): Integer;
  65 var
  66   F: File;
  67
  68 begin
  69   if not FileExists(fileName) then
  70   begin
  71     Result := -1;
  72     Exit;
  73   end;
  74
  75   AssignFile(F, fileName);
  76   Reset(F);
  77   Result := FileGetDate(TFileRec(F).Handle);
  78   CloseFile(F);
  79 end;
  80
  81 function g_SetFileTime(fileName: String; time: Integer): Boolean;
  82 var
  83   F: File;
  84
  85 begin
  86   if (not FileExists(fileName)) or (time < 0) then
  87   begin
  88     Result := False;
  89     Exit;
  90   end;
  91
  92   AssignFile(F, fileName);
  93   Reset(F);
  94   Result := (FileSetDate(TFileRec(F).Handle, time) = 0);
  95   CloseFile(F);
  96 end;
  97
  98 function g_PatchLength(X1, Y1, X2, Y2: Integer): Word;
  99 begin
 100   Result := Trunc(Hypot(Abs(X2-X1), Abs(Y2-Y1)));
 101 end;
 102
 103 function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean;
 104 var
 105   a: Integer;
 106
 107 begin
 108  Result := False;
 109
 110  if gPanels = nil then Exit;
 111
 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;
 123
 124 {function g_CollideLevel2(X, Y, X2, Y2: Integer): Boolean;
 125 var
 126   a: Integer;
 127 begin
 128  Result := False;
 129
 130  if gWalls = nil then Exit;
 131
 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;}
 142
 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;
 148
 149  if gPanels = nil then Exit;
 150
 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;
 163
 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;
 172
 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;
 182
 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;
 187
 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;
 192
 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;
 197
 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;
 202
 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;
 207
 208 procedure IncMax(var A: Integer; Max: Integer);
 209 begin
 210  if A+1 > Max then A := Max else A := A+1;
 211 end;
 212
 213 procedure IncMax(var A: Single; Max: Single);
 214 begin
 215  if A+1 > Max then A := Max else A := A+1;
 216 end;
 217
 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;
 222
 223 procedure IncMax(var A: Word; Max: Word);
 224 begin
 225  if A+1 > Max then A := Max else A := A+1;
 226 end;
 227
 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;
 232
 233 procedure IncMax(var A: SmallInt; Max: SmallInt);
 234 begin
 235  if A+1 > Max then A := Max else A := A+1;
 236 end;
 237
 238 procedure DecMin(var A: Integer; Min: Integer);
 239 begin
 240  if A-1 < Min then A := Min else A := A-1;
 241 end;
 242
 243 procedure DecMin(var A: Single; Min: Single);
 244 begin
 245  if A-1 < Min then A := Min else A := A-1;
 246 end;
 247
 248 procedure DecMin(var A: Word; Min: Word);
 249 begin
 250  if A-1 < Min then A := Min else A := A-1;
 251 end;
 252
 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;
 257
 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;
 262
 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;
 269
 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;
 278
 279 function PointToRect(X, Y: Integer; X1, Y1, Width, Height: Integer): Integer;
 280 begin
 281  X := X-X1;
 282  Y := Y-Y1;
 283
 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;
 305
 306 end.