X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Futils.pas;h=308293da64e3aed41b94449e6f71a2b3d69727ac;hb=ae58c60b09a12df74e69717546235c3e5bf3c992;hp=49f7ef1e4f1a9b2ec39be9cdd79760cb929ba538;hpb=c7ee5fde8d382144cfd01bf9432031a827490e1b;p=d2df-sdl.git

diff --git a/src/shared/utils.pas b/src/shared/utils.pas
index 49f7ef1..308293d 100644
--- a/src/shared/utils.pas
+++ b/src/shared/utils.pas
@@ -22,6 +22,11 @@ uses
   SysUtils, Classes;
 
 
+// ////////////////////////////////////////////////////////////////////////// //
+type
+  SSArray = array of ShortString;
+
+
 // ////////////////////////////////////////////////////////////////////////// //
 type
   TUtf8DecoderFast = packed record
@@ -52,14 +57,28 @@ type
 
 
 // ////////////////////////////////////////////////////////////////////////// //
+function getFilenameExt (const fn: AnsiString): AnsiString;
+function setFilenameExt (const fn, ext: AnsiString): AnsiString;
+function forceFilenameExt (const fn, ext: AnsiString): AnsiString;
+
+// strips out name from `fn`, leaving trailing slash
+function getFilenamePath (const fn: AnsiString): AnsiString;
+
+// ends with '/' or '\'?
+function isFilenamePath (const fn: AnsiString): Boolean;
+
+// strips extra trailing slashes in `path, and extra leading slashes in `fn`
+// will add slash to `path`, even if `fn` is empty!
+function filenameConcat (const path, fn: AnsiString): AnsiString;
+
 // does filename have one of ".wad", ".pk3", ".zip" extensions?
-function hasWadExtension (fn: AnsiString): Boolean;
+function hasWadExtension (const fn: AnsiString): Boolean;
 
 // does filepath have ".XXX:\" in it?
-function isWadPath (fn: AnsiString): Boolean;
+function isWadPath (const fn: AnsiString): Boolean;
 
 // adds ".wad" extension if filename doesn't have one of ".wad", ".pk3", ".zip"
-function addWadExtension (fn: AnsiString): AnsiString;
+function addWadExtension (const fn: AnsiString): AnsiString;
 
 // convert number to strig with nice commas
 function Int64ToStrComma (i: Int64): AnsiString;
@@ -67,6 +86,8 @@ function Int64ToStrComma (i: Int64): AnsiString;
 function UpCase1251 (ch: Char): Char;
 function LoCase1251 (ch: Char): Char;
 
+function toLowerCase1251 (const s: AnsiString): AnsiString;
+
 // `true` if strings are equal; ignoring case for cp1251
 function StrEquCI1251 (const s0, s1: AnsiString): Boolean;
 
@@ -84,6 +105,15 @@ function openDiskFileRO (pathname: AnsiString): TStream;
 function createDiskFile (pathname: AnsiString): TStream;
 
 // little endian
+procedure writeSign (st: TStream; const sign: AnsiString);
+function checkSign (st: TStream; const sign: AnsiString): Boolean;
+
+procedure writeBool (st: TStream; b: Boolean);
+function readBool (st: TStream): Boolean;
+
+procedure writeStr (st: TStream; const str: AnsiString; maxlen: LongWord=65535);
+function readStr (st: TStream; maxlen: LongWord=65535): AnsiString;
+
 procedure writeInt (st: TStream; v: Byte); overload;
 procedure writeInt (st: TStream; v: ShortInt); overload;
 procedure writeInt (st: TStream; v: Word); overload;
@@ -163,7 +193,7 @@ type
   TFormatStrFCallback = procedure (constref buf; len: SizeUInt);
 
 // returns formatted string if `writerCB` is `nil`, empty string otherwise
-function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
+function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
 
 function wchar2win (wc: WideChar): AnsiChar; inline;
 function utf2win (const s: AnsiString): AnsiString;
@@ -219,6 +249,8 @@ type
     procedure clear (); inline;
 
     procedure append (constref it: ItemT); inline;
+    procedure delete (idx: Integer); inline;
+    function remove (idx: Integer): ItemT; inline;
 
   public
     property count: Integer read mCount;
@@ -227,8 +259,33 @@ type
   end;
 
 
+procedure FillMemory (Dest: Pointer; Len: LongWord; Ch: Byte); inline;
+procedure CopyMemory (Dest: Pointer; Src: Pointer; Len: LongWord); inline;
+procedure ZeroMemory (Dest: Pointer; Len: LongWord); inline;
+
+
 implementation
 
+uses
+  xstreams;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+procedure CopyMemory (Dest: Pointer; Src: Pointer; Len: LongWord); inline;
+begin
+  Move(Src^, Dest^, Len);
+end;
+
+procedure FillMemory (Dest: Pointer; Len: LongWord; Ch: Byte); inline;
+begin
+  FillChar(Dest^, Len, Ch);
+end;
+
+procedure ZeroMemory (Dest: Pointer; Len: LongWord); inline;
+begin
+  FillChar(Dest^, Len, 0);
+end;
+
 
 // ////////////////////////////////////////////////////////////////////////// //
 constructor TSimpleList.TEnumerator.Create (const aitems: TItemArr; acount: Integer);
@@ -312,16 +369,46 @@ end;
 
 
 procedure TSimpleList.append (constref it: ItemT); inline;
+var
+  newsz: Integer;
 begin
-  if (mCount = Length(mItems)) then
+  if (mCount >= Length(mItems)) then
   begin
-    if (mCount = 0) then SetLength(mItems, 128) else SetLength(mItems, mCount*2);
+    newsz := mCount+(mCount div 3)+128;
+    SetLength(mItems, newsz);
   end;
   mItems[mCount] := it;
   Inc(mCount);
 end;
 
 
+procedure TSimpleList.delete (idx: Integer); inline;
+var
+  f: Integer;
+begin
+  if (idx >= 0) and (idx < mCount) then
+  begin
+    for f := idx+1 to mCount-1 do mItems[f-1] := mItems[f];
+  end;
+end;
+
+
+function TSimpleList.remove (idx: Integer): ItemT; inline;
+var
+  f: Integer;
+begin
+  if (idx >= 0) and (idx < mCount) then
+  begin
+    result := mItems[idx];
+    for f := idx+1 to mCount-1 do mItems[f-1] := mItems[f];
+  end
+  else
+  begin
+    result := Default(ItemT);
+  end;
+end;
+
+
 // ////////////////////////////////////////////////////////////////////////// //
 var
   wc2shitmap: array[0..65535] of AnsiChar;
@@ -583,40 +670,176 @@ end;
 
 
 // ////////////////////////////////////////////////////////////////////////// //
-function hasWadExtension (fn: AnsiString): Boolean;
+function getFilenameExt (const fn: AnsiString): AnsiString;
+var
+  pos: Integer;
+  ch: AnsiChar;
+begin
+  pos := Length(fn);
+  while (pos > 0) do
+  begin
+    ch := fn[pos];
+    if (ch = '.') then
+    begin
+      if (pos = Length(fn)) then result := '' else result := Copy(fn, pos, Length(fn)-pos+1);
+      exit;
+    end;
+    if (ch = '/') or (ch = '\') then break;
+    Dec(pos);
+  end;
+  result := ''; // no extension
+end;
+
+
+function setFilenameExt (const fn, ext: AnsiString): AnsiString;
+var
+  pos: Integer;
+  ch: AnsiChar;
+begin
+  result := fn;
+  if (Length(ext) = 0) or (ext = '.') then exit;
+  pos := Length(fn);
+  while (pos > 0) do
+  begin
+    ch := fn[pos];
+    if (ch = '.') then exit;
+    if (ch = '/') or (ch = '\') then break;
+    Dec(pos);
+  end;
+  if (ext[1] <> '.') then result += '.';
+  result += ext;
+end;
+
+
+function forceFilenameExt (const fn, ext: AnsiString): AnsiString;
+var
+  pos: Integer;
+  ch: AnsiChar;
+begin
+  result := fn;
+  pos := Length(fn);
+  while (pos > 0) do
+  begin
+    ch := fn[pos];
+    if (ch = '.') then
+    begin
+      if (Length(ext) = 0) or (ext = '.') then
+      begin
+        result := Copy(fn, 1, pos-1);
+      end
+      else
+      begin
+        if (ext[1] = '.') then result := Copy(fn, 1, pos-1) else result := Copy(fn, 1, pos);
+        result += ext;
+        exit;
+      end;
+    end;
+    if (ch = '/') or (ch = '\') then break;
+    Dec(pos);
+  end;
+  if (Length(ext) > 0) then
+  begin
+    if (ext[1] <> '.') then result += '.';
+    result += ext;
+  end;
+end;
+
+
+// strips out name from `fn`, leaving trailing slash
+function getFilenamePath (const fn: AnsiString): AnsiString;
+var
+  pos: Integer;
+  ch: AnsiChar;
+begin
+  if (Length(fn) = 0) then begin result := './'; exit; end;
+  if (fn[Length(fn)] = '/') or (fn[Length(fn)] = '\') then begin result := fn; exit; end;
+  pos := Length(fn);
+  while (pos > 0) do
+  begin
+    ch := fn[pos];
+    if (ch = '/') or (ch = '\') then begin result := Copy(fn, 1, pos); exit; end;
+    Dec(pos);
+  end;
+  result := './'; // no path -> current dir
+end;
+
+
+// ends with '/' or '\'?
+function isFilenamePath (const fn: AnsiString): Boolean;
 begin
-  fn := ExtractFileExt(fn);
-  result := StrEquCI1251(fn, '.wad') or StrEquCI1251(fn, '.pk3') or StrEquCI1251(fn, '.zip');
+  if (Length(fn) = 0) then
+  begin
+    result := false;
+  end
+  else
+  begin
+    result := (fn[Length(fn)] = '/') or (fn[Length(fn)] = '\');
+  end;
 end;
 
 
-function addWadExtension (fn: AnsiString): AnsiString;
+// strips extra trailing slashes in `path, and extra leading slashes in `fn`
+// will add slash to `path`, even if `fn` is empty!
+function filenameConcat (const path, fn: AnsiString): AnsiString;
+var
+  pos: Integer;
+begin
+  pos := 1;
+  while (pos <= Length(fn)) and ((fn[pos] = '/') or (fn[pos] = '\')) do Inc(pos);
+  result := path;
+  if (Length(result) > 0) and ((result[Length(result)] <> '/') and (result[Length(result)] <> '\')) then result += '/';
+  if (pos <= Length(fn)) then
+  begin
+    result += Copy(fn, pos, Length(fn)-pos+1);
+    //FIXME: make this faster!
+    while (Length(result) > 0) and ((result[Length(result)] = '/') or (result[Length(result)] = '\')) do
+    begin
+      Delete(result, Length(result), 1);
+    end;
+    if (fn[Length(fn)] = '/') or (fn[Length(fn)] = '\') then result += '/';
+  end;
+end;
+
+
+function hasWadExtension (const fn: AnsiString): Boolean;
+var
+  ext: AnsiString;
+begin
+  ext := getFilenameExt(fn);
+  result := StrEquCI1251(ext, '.wad') or StrEquCI1251(ext, '.pk3') or StrEquCI1251(ext, '.zip');
+end;
+
+
+function addWadExtension (const fn: AnsiString): AnsiString;
 begin
   result := fn;
   if not hasWadExtension(result) then result := result+'.wad';
 end;
 
 
-function isWadPath (fn: AnsiString): Boolean;
+function isWadPath (const fn: AnsiString): Boolean;
 var
-  p: Integer;
+  pos: Integer;
   s: AnsiString;
 begin
   result := false;
-  while true do
+  pos := 1;
+  while (pos <= Length(fn)) do
   begin
-    p := Pos(':', fn);
-    if (p = 0) or (length(fn)-p < 1) then break;
-    if (p-4 > 1) and (fn[p-4] = '.') and ((fn[p+1] = '\') or (fn[p+1] = '/')) then
+    if (fn[pos] = ':') then
     begin
-      s := Copy(fn, p-4, 4);
-      if StrEquCI1251(s, '.wad') or StrEquCI1251(s, '.pk3') or StrEquCI1251(s, '.zip') then
+      if (Length(fn)-pos < 1) then break;
+      if (pos-4 > 1) and (fn[pos-4] = '.') and ((fn[pos+1] = '\') or (fn[pos+1] = '/')) then
       begin
-        result := true;
-        exit;
+        s := Copy(fn, pos-4, 4);
+        if StrEquCI1251(s, '.wad') or StrEquCI1251(s, '.pk3') or StrEquCI1251(s, '.zip') then
+        begin
+          result := true;
+          exit;
+        end;
       end;
     end;
-    Delete(fn, 1, p);
+    Inc(pos);
   end;
 end;
 
@@ -693,6 +916,26 @@ begin
 end;
 
 
+function toLowerCase1251 (const s: AnsiString): AnsiString;
+var
+  f: Integer;
+  ch: AnsiChar;
+begin
+  for ch in s do
+  begin
+    if (ch <> LoCase1251(ch)) then
+    begin
+      result := '';
+      SetLength(result, Length(s));
+      for f := 1 to Length(s) do result[f] := LoCase1251(s[f]);
+      exit;
+    end;
+  end;
+  // nothing to do
+  result := s;
+end;
+
+
 // ////////////////////////////////////////////////////////////////////////// //
 // utils
 // `ch`: utf8 start
@@ -936,6 +1179,36 @@ begin
 end;
 {$ENDIF}
 
+procedure writeSign (st: TStream; const sign: AnsiString);
+begin
+  if (Length(sign) > 0) then st.WriteBuffer(sign[1], Length(sign));
+end;
+
+function checkSign (st: TStream; const sign: AnsiString): Boolean;
+var
+  buf: packed array[0..7] of Char;
+  f: Integer;
+begin
+  result := false;
+  if (Length(sign) > 0) then
+  begin
+    if (Length(sign) <= 8) then
+    begin
+      st.ReadBuffer(buf[0], Length(sign));
+      for f := 1 to Length(sign) do if (buf[f-1] <> sign[f]) then exit;
+    end
+    else
+    begin
+      for f := 1 to Length(sign) do
+      begin
+        st.ReadBuffer(buf[0], 1);
+        if (buf[0] <> sign[f]) then exit;
+      end;
+    end;
+  end;
+  result := true;
+end;
+
 procedure writeInt (st: TStream; v: Byte); overload; begin writeIntegerLE(st, @v, 1); end;
 procedure writeInt (st: TStream; v: ShortInt); overload; begin writeIntegerLE(st, @v, 1); end;
 procedure writeInt (st: TStream; v: Word); overload; begin writeIntegerLE(st, @v, 2); end;
@@ -954,6 +1227,31 @@ procedure writeIntBE (st: TStream; v: LongInt); overload; begin writeIntegerBE(s
 procedure writeIntBE (st: TStream; v: Int64); overload; begin writeIntegerBE(st, @v, 8); end;
 procedure writeIntBE (st: TStream; v: UInt64); overload; begin writeIntegerBE(st, @v, 8); end;
 
+procedure writeBool (st: TStream; b: Boolean); begin writeInt(st, Byte(b)); end;
+function readBool (st: TStream): Boolean; begin result := (readByte(st) <> 0); end;
+
+
+procedure writeStr (st: TStream; const str: AnsiString; maxlen: LongWord=65535);
+begin
+  if (Length(str) > maxlen) then raise XStreamError.Create('string too long');
+  if (maxlen <= 65535) then writeInt(st, Word(Length(str))) else writeInt(st, LongWord(Length(str)));
+  if (Length(str) > 0) then st.WriteBuffer(str[1], Length(str));
+end;
+
+function readStr (st: TStream; maxlen: LongWord=65535): AnsiString;
+var
+  len: Integer;
+begin
+  result := '';
+  if (maxlen <= 65535) then len := readWord(st) else len := Integer(readLongWord(st));
+  if (len < 0) or (len > maxlen) then raise XStreamError.Create('string too long');
+  if (len > 0) then
+  begin
+    SetLength(result, len);
+    st.ReadBuffer(result[1], len);
+  end;
+end;
+
 
 procedure readIntegerLE (st: TStream; vp: Pointer; size: Integer);
 {$IFDEF ENDIAN_LITTLE}
@@ -1080,7 +1378,7 @@ end;
 *)
 
 
-function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
+function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
 const
   PadSpaces: AnsiString = '                                                                       ';
   PadZeroes: AnsiString = '00000000000000000000000000000000000000000000000000000000000000000000000';
@@ -1097,6 +1395,7 @@ var
   fmtblen: Integer;
   pclen: Integer;
   pc: PAnsiChar;
+  ccname: ShortString;
 
   procedure writer (constref buf; len: SizeUInt);
   var
@@ -1188,7 +1487,7 @@ var
       xpos := High(strbuf);
       strbuf[xpos] := #0; Dec(xpos);
       repeat
-        if hex then
+        if not hex then
         begin
           strbuf[xpos] := AnsiChar((n mod 10)+48);
           Dec(xpos);
@@ -1218,7 +1517,7 @@ var
     xpos := High(strbuf);
     strbuf[xpos] := #0; Dec(xpos);
     repeat
-      if hex then
+      if not hex then
       begin
         strbuf[xpos] := AnsiChar((n mod 10)+48);
         Dec(xpos);
@@ -1496,15 +1795,17 @@ begin
         end;
       vtObject: // args[curarg].VObject.Classname (TObject)
         begin
-          if (sign <> '-') then indent(width-Length(args[curarg].VObject.Classname));
-          xwrite(args[curarg].VObject.Classname);
-          if (sign = '-') then indent(width-Length(args[curarg].VObject.Classname));
+          if (args[curarg].VObject <> nil) then ccname := args[curarg].VObject.Classname else ccname := '<nil>';
+          if (sign <> '-') then indent(width-Length(ccname));
+          xwrite(ccname);
+          if (sign = '-') then indent(width-Length(ccname));
         end;
       vtClass: // args[curarg].VClass.Classname (TClass)
         begin
-          if (sign <> '-') then indent(width-Length(args[curarg].VClass.Classname));
-          xwrite(args[curarg].VClass.Classname);
-          if (sign = '-') then indent(width-Length(args[curarg].VClass.Classname));
+          if (args[curarg].VClass <> nil) then ccname := args[curarg].VClass.Classname else ccname := '<nil>';
+          if (sign <> '-') then indent(width-Length(ccname));
+          xwrite(ccname);
+          if (sign = '-') then indent(width-Length(ccname));
         end;
       //vtPWideChar: begin end; // args[curarg].VPWideChar (PWideChar)
       vtAnsiString: // AnsiString(args[curarg].VAnsiString) (Pointer)