X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Futils.pas;h=4c4db7b0df59997698bca6e3d5861cb9ba9a01a0;hb=8e694e6ddeb42110a00233d7ff7345c57ee5d90d;hp=308293da64e3aed41b94449e6f71a2b3d69727ac;hpb=cd1ca85acc0740e0f307782e2af54e5ba0a59507;p=d2df-sdl.git

diff --git a/src/shared/utils.pas b/src/shared/utils.pas
index 308293d..4c4db7b 100644
--- a/src/shared/utils.pas
+++ b/src/shared/utils.pas
@@ -1,9 +1,8 @@
-(* Copyright (C)  DooM 2D:Forever Developers
+(* Copyright (C)  Doom 2D: Forever Developers
  *
  * This program is free software: you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or
- * (at your option) any later version.
+ * the Free Software Foundation, version 3 of the License ONLY.
  *
  * This program is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,7 +18,7 @@ unit utils;
 interface
 
 uses
-  SysUtils, Classes;
+  SysUtils, Classes, md5;
 
 
 // ////////////////////////////////////////////////////////////////////////// //
@@ -80,16 +79,20 @@ function isWadPath (const fn: AnsiString): Boolean;
 // adds ".wad" extension if filename doesn't have one of ".wad", ".pk3", ".zip"
 function addWadExtension (const fn: AnsiString): AnsiString;
 
+// check wad signature
+function isWadData (data: Pointer; len: LongWord): Boolean;
+
 // convert number to strig with nice commas
-function Int64ToStrComma (i: Int64): AnsiString;
+function int64ToStrComma (i: Int64): AnsiString;
 
-function UpCase1251 (ch: Char): Char;
-function LoCase1251 (ch: Char): Char;
+function upcase1251 (ch: AnsiChar): AnsiChar; inline;
+function locase1251 (ch: AnsiChar): AnsiChar; inline;
+function IsPrintable1251 (ch: AnsiChar): Boolean;
 
 function toLowerCase1251 (const s: AnsiString): AnsiString;
 
 // `true` if strings are equal; ignoring case for cp1251
-function StrEquCI1251 (const s0, s1: AnsiString): Boolean;
+function strEquCI1251 (const s0, s1: AnsiString): Boolean;
 
 function utf8Valid (const s: AnsiString): Boolean;
 
@@ -100,9 +103,16 @@ function utf8to1251 (s: AnsiString): AnsiString;
 // nobody cares about shitdoze, so i'll use the same code path for it
 function findFileCI (var pathname: AnsiString; lastIsDir: Boolean=false): Boolean;
 
+// return fixed AnsiString or empty AnsiString
+function findDiskWad (fname: AnsiString): AnsiString;
+// slashes must be normalized!
+function isWadNamesEqu (wna, wnb: AnsiString): Boolean;
+
 // they throws
 function openDiskFileRO (pathname: AnsiString): TStream;
 function createDiskFile (pathname: AnsiString): TStream;
+// creates file if necessary
+function openDiskFileRW (pathname: AnsiString): TStream;
 
 // little endian
 procedure writeSign (st: TStream; const sign: AnsiString);
@@ -162,7 +172,9 @@ function nmin (a, b: Int64): Int64; inline; overload;
 function nmin (a, b: UInt64): UInt64; inline; overload;
 function nmin (a, b: Single): Single; inline; overload;
 function nmin (a, b: Double): Double; inline; overload;
+{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
 function nmin (a, b: Extended): Extended; inline; overload;
+{$ENDIF}
 
 function nmax (a, b: Byte): Byte; inline; overload;
 function nmax (a, b: ShortInt): ShortInt; inline; overload;
@@ -174,8 +186,9 @@ function nmax (a, b: Int64): Int64; inline; overload;
 function nmax (a, b: UInt64): UInt64; inline; overload;
 function nmax (a, b: Single): Single; inline; overload;
 function nmax (a, b: Double): Double; inline; overload;
+{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
 function nmax (a, b: Extended): Extended; inline; overload;
-
+{$ENDIF}
 function nclamp (v, a, b: Byte): Byte; inline; overload;
 function nclamp (v, a, b: ShortInt): ShortInt; inline; overload;
 function nclamp (v, a, b: Word): Word; inline; overload;
@@ -186,8 +199,9 @@ function nclamp (v, a, b: Int64): Int64; inline; overload;
 function nclamp (v, a, b: UInt64): UInt64; inline; overload;
 function nclamp (v, a, b: Single): Single; inline; overload;
 function nclamp (v, a, b: Double): Double; inline; overload;
+{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
 function nclamp (v, a, b: Extended): Extended; inline; overload;
-
+{$ENDIF}
 
 type
   TFormatStrFCallback = procedure (constref buf; len: SizeUInt);
@@ -264,11 +278,36 @@ procedure CopyMemory (Dest: Pointer; Src: Pointer; Len: LongWord); inline;
 procedure ZeroMemory (Dest: Pointer; Len: LongWord); inline;
 
 
+type
+  TDiskFileInfo = record
+    diskName: AnsiString;
+    size: LongInt;
+    age: LongInt;
+    // not changed by info getter; used in other parts of the code
+    userName: AnsiString;
+    tag: Integer;
+    hash: TMD5Digest;
+    udata: Pointer;
+  end;
+
+function GetDiskFileInfo (fname: AnsiString; var info: TDiskFileInfo): Boolean;
+
+
 implementation
 
 uses
   xstreams;
 
+const wadExtensions: array [0..6] of AnsiString = (
+  '.dfz',
+  '.wad',
+  '.dfwad',
+  '.pk3',
+  '.pak',
+  '.zip',
+  '.dfzip'
+);
+
 
 // ////////////////////////////////////////////////////////////////////////// //
 procedure CopyMemory (Dest: Pointer; Src: Pointer; Len: LongWord); inline;
@@ -537,25 +576,25 @@ var
     if (code < 0) or (code > $10FFFF) then begin result := '?'; exit; end;
     if (code <= $7f) then
     begin
-      result := Char(code and $ff);
+      result := AnsiChar(code and $ff);
     end
     else if (code <= $7FF) then
     begin
-      result := Char($C0 or (code shr 6));
-      result += Char($80 or (code and $3F));
+      result := AnsiChar($C0 or (code shr 6));
+      result += AnsiChar($80 or (code and $3F));
     end
     else if (code <= $FFFF) then
     begin
-      result := Char($E0 or (code shr 12));
-      result += Char($80 or ((code shr 6) and $3F));
-      result += Char($80 or (code and $3F));
+      result := AnsiChar($E0 or (code shr 12));
+      result += AnsiChar($80 or ((code shr 6) and $3F));
+      result += AnsiChar($80 or (code and $3F));
     end
     else if (code <= $10FFFF) then
     begin
-      result := Char($F0 or (code shr 18));
-      result += Char($80 or ((code shr 12) and $3F));
-      result += Char($80 or ((code shr 6) and $3F));
-      result += Char($80 or (code and $3F));
+      result := AnsiChar($F0 or (code shr 18));
+      result += AnsiChar($80 or ((code shr 12) and $3F));
+      result += AnsiChar($80 or ((code shr 6) and $3F));
+      result += AnsiChar($80 or (code and $3F));
     end
     else
     begin
@@ -803,10 +842,13 @@ end;
 
 function hasWadExtension (const fn: AnsiString): Boolean;
 var
-  ext: AnsiString;
+  ext, newExt: AnsiString;
 begin
   ext := getFilenameExt(fn);
-  result := StrEquCI1251(ext, '.wad') or StrEquCI1251(ext, '.pk3') or StrEquCI1251(ext, '.zip');
+  result := true;
+  for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then exit;
+  result := false;
+  //result := StrEquCI1251(ext, '.wad') or StrEquCI1251(ext, '.pk3') or StrEquCI1251(ext, '.zip') or StrEquCI1251(ext, '.dfz');
 end;
 
 
@@ -817,6 +859,22 @@ begin
 end;
 
 
+function isWadData (data: Pointer; len: LongWord): Boolean;
+  var p: PChar;
+begin
+  p := PChar(data);
+  Result :=
+    (* ZIP *)
+    ((len > 3) and (p[0] = 'P') and (p[1] = 'K') and (p[2] = #03) and (p[3] = #04)) or
+    ((len > 3) and (p[0] = 'P') and (p[1] = 'K') and (p[2] = #05) and (p[3] = #06)) or
+    (* PACK *)
+    ((len > 3) and (p[0] = 'P') and (p[1] = 'A') and (p[2] = 'C') and (p[3] = 'K')) or
+    ((len > 3) and (p[0] = 'S') and (p[1] = 'P') and (p[2] = 'A') and (p[3] = 'K')) or
+    (* DFWAD *)
+    ((len > 5) and (p[0] = 'D') and (p[1] = 'F') and (p[2] = 'W') and (p[3] = 'A') and (p[4] = 'D') and (p[5] = #01))
+end;
+
+
 function isWadPath (const fn: AnsiString): Boolean;
 var
   pos: Integer;
@@ -832,7 +890,7 @@ begin
       if (pos-4 > 1) and (fn[pos-4] = '.') and ((fn[pos+1] = '\') or (fn[pos+1] = '/')) then
       begin
         s := Copy(fn, pos-4, 4);
-        if StrEquCI1251(s, '.wad') or StrEquCI1251(s, '.pk3') or StrEquCI1251(s, '.zip') then
+        if StrEquCI1251(s, '.wad') or StrEquCI1251(s, '.pk3') or StrEquCI1251(s, '.zip') or StrEquCI1251(s, '.dfz') then
         begin
           result := true;
           exit;
@@ -844,7 +902,7 @@ begin
 end;
 
 
-function Int64ToStrComma (i: Int64): AnsiString;
+function int64ToStrComma (i: Int64): AnsiString;
 var
   f: Integer;
 begin
@@ -857,7 +915,7 @@ begin
 end;
 
 
-function UpCase1251 (ch: Char): Char;
+function upcase1251 (ch: AnsiChar): AnsiChar; inline;
 begin
   if ch < #128 then
   begin
@@ -881,7 +939,7 @@ begin
 end;
 
 
-function LoCase1251 (ch: Char): Char;
+function locase1251 (ch: AnsiChar): AnsiChar; inline;
 begin
   if ch < #128 then
   begin
@@ -904,8 +962,13 @@ begin
   result := ch;
 end;
 
+function IsPrintable1251 (ch: AnsiChar): Boolean;
+begin
+  result := (ch >= #32) and (ch <> #127)
+end;
+
 
-function StrEquCI1251 (const s0, s1: AnsiString): Boolean;
+function strEquCI1251 (const s0, s1: AnsiString): Boolean;
 var
   i: Integer;
 begin
@@ -991,7 +1054,7 @@ const
   );
 
 
-function decodeUtf8Char (s: AnsiString; var pos: Integer): char;
+function decodeUtf8Char (s: AnsiString; var pos: Integer): AnsiChar;
 var
   b, c: Integer;
 begin
@@ -1009,7 +1072,7 @@ begin
 
   b := Byte(s[pos]);
   Inc(pos);
-  if b < $80 then begin result := char(b); exit; end;
+  if b < $80 then begin result := AnsiChar(b); exit; end;
 
   // mask out unused bits
        if (b and $FE) = $FC then b := b and $01
@@ -1030,7 +1093,7 @@ begin
   end;
 
   // done, try 1251
-  for c := 128 to 255 do if uni2wint[c] = b then begin result := char(c and $FF); exit; end;
+  for c := 128 to 255 do if uni2wint[c] = b then begin result := AnsiChar(c and $FF); exit; end;
   // alas
 end;
 
@@ -1122,9 +1185,57 @@ begin
 end;
 
 
+function isWadNamesEqu (wna, wnb: AnsiString): Boolean;
+var
+  ext, newExt: AnsiString;
+  found: Boolean;
+begin
+  result := StrEquCI1251(wna, wnb);
+  if result then exit;
+  // check first ext
+  ext := getFilenameExt(wna);
+  found := false;
+  for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
+  if not found then exit;
+  // check second ext
+  ext := getFilenameExt(wnb);
+  found := false;
+  for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
+  if not found then exit;
+  wna := forceFilenameExt(wna, '');
+  wnb := forceFilenameExt(wnb, '');
+  result := StrEquCI1251(wna, wnb);
+end;
+
+function findDiskWad (fname: AnsiString): AnsiString;
+var
+  origExt: AnsiString = '';
+  newExt: AnsiString = '';
+begin
+  result := '';
+  //writeln('findDiskWad00: fname=<', fname, '>');
+  if (findFileCI(fname)) then begin result := fname; exit; end;
+  origExt := getFilenameExt(fname);
+  fname := forceFilenameExt(fname, '');
+  //writeln(' findDiskWad01: fname=<', fname, '>; origExt=<', origExt, '>');
+  for newExt in wadExtensions do
+  begin
+    //writeln(' findDiskWad02: fname=<', fname, '>; origExt=<', origExt, '>; newExt=<', newExt, '>');
+    if (StrEquCI1251(newExt, origExt)) then
+    begin
+      //writeln('   SKIP');
+      continue;
+    end;
+    result := fname+newExt;
+    if (findFileCI(result)) then exit;
+  end;
+  result := '';
+end;
+
+
 function openDiskFileRO (pathname: AnsiString): TStream;
 begin
-  if not findFileCI(pathname) then raise Exception.Create('can''t open file "'+pathname+'"');
+  if not findFileCI(pathname) then raise EFileNotFoundException.Create('can''t open file "'+pathname+'"');
   result := TFileStream.Create(pathname, fmOpenRead or {fmShareDenyWrite}fmShareDenyNone);
 end;
 
@@ -1141,6 +1252,30 @@ begin
 end;
 
 
+function openDiskFileRW (pathname: AnsiString): TStream;
+var
+  path: AnsiString;
+  oldname: AnsiString;
+begin
+  //writeln('*** TRYING R/W FILE "', pathname, '"');
+  path := ExtractFilePath(pathname);
+  if length(path) > 0 then
+  begin
+    if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
+  end;
+  oldname := pathname;
+  if findFileCI(oldname) then
+  begin
+    //writeln('*** found old file "', oldname, '"');
+    result := TFileStream.Create(oldname, fmOpenReadWrite or fmShareDenyWrite);
+  end
+  else
+  begin
+    result := TFileStream.Create(path+ExtractFileName(pathname), fmCreate);
+  end;
+end;
+
+
 procedure writeIntegerLE (st: TStream; vp: Pointer; size: Integer);
 {$IFDEF ENDIAN_LITTLE}
 begin
@@ -1186,7 +1321,7 @@ end;
 
 function checkSign (st: TStream; const sign: AnsiString): Boolean;
 var
-  buf: packed array[0..7] of Char;
+  buf: packed array[0..7] of AnsiChar;
   f: Integer;
 begin
   result := false;
@@ -1321,7 +1456,9 @@ function nmin (a, b: Int64): Int64; inline; overload; begin if (a < b) then resu
 function nmin (a, b: UInt64): UInt64; inline; overload; begin if (a < b) then result := a else result := b; end;
 function nmin (a, b: Single): Single; inline; overload; begin if (a < b) then result := a else result := b; end;
 function nmin (a, b: Double): Double; inline; overload; begin if (a < b) then result := a else result := b; end;
+{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
 function nmin (a, b: Extended): Extended; inline; overload; begin if (a < b) then result := a else result := b; end;
+{$ENDIF}
 
 function nmax (a, b: Byte): Byte; inline; overload; begin if (a > b) then result := a else result := b; end;
 function nmax (a, b: ShortInt): ShortInt; inline; overload; begin if (a > b) then result := a else result := b; end;
@@ -1333,7 +1470,9 @@ function nmax (a, b: Int64): Int64; inline; overload; begin if (a > b) then resu
 function nmax (a, b: UInt64): UInt64; inline; overload; begin if (a > b) then result := a else result := b; end;
 function nmax (a, b: Single): Single; inline; overload; begin if (a > b) then result := a else result := b; end;
 function nmax (a, b: Double): Double; inline; overload; begin if (a > b) then result := a else result := b; end;
+{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
 function nmax (a, b: Extended): Extended; inline; overload; begin if (a > b) then result := a else result := b; end;
+{$ENDIF}
 
 function nclamp (v, a, b: Byte): Byte; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
 function nclamp (v, a, b: ShortInt): ShortInt; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
@@ -1345,8 +1484,9 @@ function nclamp (v, a, b: Int64): Int64; inline; overload; begin if (v < a) then
 function nclamp (v, a, b: UInt64): UInt64; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
 function nclamp (v, a, b: Single): Single; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
 function nclamp (v, a, b: Double): Double; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
+{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
 function nclamp (v, a, b: Extended): Extended; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
-
+{$ENDIF}
 
 // ////////////////////////////////////////////////////////////////////////// //
 {$IFDEF WINDOWS}
@@ -1878,6 +2018,32 @@ begin
 end;
 
 
+function GetDiskFileInfo (fname: AnsiString; var info: TDiskFileInfo): Boolean;
+var
+  age: LongInt;
+  size: LongInt;
+  handle: THandle;
+begin
+  result := false;
+  if (length(fname) = 0) then exit;
+  if not findFileCI(fname) then exit;
+  // get age
+  age := FileAge(fname);
+  if (age = -1) then exit;
+  // get size
+  handle := FileOpen(fname, fmOpenRead or fmShareDenyNone);
+  if (handle = THandle(-1)) then exit;
+  size := FileSeek(handle, 0, fsFromEnd);
+  FileClose(handle);
+  if (size = -1) then exit;
+  // fill info
+  info.diskName := fname;
+  info.size := size;
+  info.age := age;
+  result := true;
+end;
+
+
 (*
 var
   ss: ShortString;