From 844441154d1220d6c83f75043300c2851ec87109 Mon Sep 17 00:00:00 2001 From: Ketmar Dark Date: Mon, 18 Apr 2016 08:43:22 +0300 Subject: [PATCH] sfs and wad code refactoring: part 1 --- src/game/Doom2DF.dpr | 3 +- src/game/g_basic.pas | 2 +- src/game/g_console.pas | 2 +- src/game/g_game.pas | 44 +++- src/game/g_gui.pas | 6 +- src/game/g_main.pas | 6 +- src/game/g_map.pas | 26 +- src/game/g_menu.pas | 10 +- src/game/g_monsters.pas | 2 +- src/game/g_netmaster.pas | 2 +- src/game/g_netmsg.pas | 2 +- src/game/g_player.pas | 2 +- src/game/g_playermodel.pas | 7 +- src/game/g_res_downloader.pas | 4 +- src/game/g_saveload.pas | 2 +- src/game/g_sound.pas | 10 +- src/game/g_textures.pas | 14 +- src/game/g_triggers.pas | 2 +- src/game/g_window.pas | 6 +- src/sfs/sfs.pas | 216 +--------------- src/sfs/sfsMemFS.pas | 6 +- src/sfs/sfsPlainFS.pas | 32 +-- src/sfs/sfsZipFS.pas | 16 +- src/sfs/wadcvt.dpr | 3 +- src/shared/utils.pas | 271 +++++++++++++++++++- src/shared/{WADEDITOR.pas => wadreader.pas} | 82 +++--- src/{shared => unused}/WADEDITOR_full.pas | 36 ++- src/{shared => unused}/WADSTRUCT.pas | 0 28 files changed, 443 insertions(+), 371 deletions(-) rename src/shared/{WADEDITOR.pas => wadreader.pas} (74%) rename src/{shared => unused}/WADEDITOR_full.pas (96%) rename src/{shared => unused}/WADSTRUCT.pas (100%) diff --git a/src/game/Doom2DF.dpr b/src/game/Doom2DF.dpr index 6796156..d885e2b 100644 --- a/src/game/Doom2DF.dpr +++ b/src/game/Doom2DF.dpr @@ -48,8 +48,7 @@ uses sfsMemFS in '../sfs/sfsMemFS.pas', xstreams in '../sfs/xstreams.pas', utils in '../shared/utils.pas', - WADEDITOR in '../shared/WADEDITOR.pas', - WADSTRUCT in '../shared/WADSTRUCT.pas', + wadreader in '../shared/wadreader.pas', MAPSTRUCT in '../shared/MAPSTRUCT.pas', MAPREADER in '../shared/MAPREADER.pas', MAPDEF in '../shared/MAPDEF.pas', diff --git a/src/game/g_basic.pas b/src/game/g_basic.pas index 3807b54..69d8aa7 100644 --- a/src/game/g_basic.pas +++ b/src/game/g_basic.pas @@ -3,7 +3,7 @@ unit g_basic; interface uses - WADEDITOR, g_phys; + wadreader, g_phys; const GAME_VERSION = '0.667'; diff --git a/src/game/g_console.pas b/src/game/g_console.pas index 5f26b86..31bce9a 100644 --- a/src/game/g_console.pas +++ b/src/game/g_console.pas @@ -27,7 +27,7 @@ implementation uses g_textures, g_main, e_graphics, e_input, g_game, - SysUtils, g_basic, g_options, WADEDITOR, Math, + SysUtils, g_basic, g_options, wadreader, Math, g_menu, g_language, g_net, g_netmsg, e_log; type diff --git a/src/game/g_game.pas b/src/game/g_game.pas index e65dc76..4a8afe8 100644 --- a/src/game/g_game.pas +++ b/src/game/g_game.pas @@ -4,7 +4,7 @@ interface uses g_basic, g_player, e_graphics, Classes, g_res_downloader, - SysUtils, g_sound, g_gui, MAPSTRUCT, WADEDITOR, md5; + SysUtils, g_sound, g_gui, MAPSTRUCT, wadreader, md5; type TGameSettings = record @@ -470,7 +470,7 @@ end; function g_Game_GetMegaWADInfo(WAD: String): TMegaWADInfo; var - w: TWADEditor_1; + w: TWADFile; cfg: TConfig; p: Pointer; len: Integer; @@ -479,7 +479,7 @@ begin Result.description := ''; Result.author := ''; - w := TWADEditor_1.Create(); + w := TWADFile.Create(); w.ReadFile(WAD); if not w.GetResource('', 'INTERSCRIPT', p, len) then @@ -525,7 +525,7 @@ end; procedure g_Game_LoadWAD(WAD: string); var - w: TWADEditor_1; + w: TWADFile; cfg: TConfig; p: Pointer; {b, }len: Integer; @@ -538,7 +538,7 @@ begin MegaWAD.info := g_Game_GetMegaWADInfo(MapsDir + WAD); - w := TWADEditor_1.Create(); + w := TWADFile.Create(); w.ReadFile(MapsDir + WAD); if not w.GetResource('', 'INTERSCRIPT', p, len) then @@ -4070,7 +4070,7 @@ var MapName: Char16; WadName: string; { - WAD: TWADEditor_1; + WAD: TWADFile; MapList: SArray; time: Integer; } @@ -4094,7 +4094,7 @@ begin if not gTempDelete then begin time := g_GetFileTime(WadName); - WAD := TWADEditor_1.Create(); + WAD := TWADFile.Create(); // ×èòàåì Wad-ôàéë: if not WAD.ReadFile(WadName) then @@ -5851,17 +5851,33 @@ end; procedure g_TakeScreenShot(); var a: Word; - FileName: String; + FileName: string; + ssdir, t: string; begin - for a := 1 to High(Word) do + ssdir := GameDir+'/screenshots'; + if not findFileCI(ssdir, true) then begin - FileName := Format(GameDir+'/screenshots/screenshot%.3d.bmp', [a]); - if not FileExists(FileName) then + // try to create dir + try + CreateDir(ssdir); + except + end; + if not findFileCI(ssdir, true) then exit; // alas + end; + try + for a := 1 to High(Word) do begin - e_MakeScreenshot(FileName, gScreenWidth, gScreenHeight); - g_Console_Add(Format(_lc[I_CONSOLE_SCREENSHOT], [ExtractFileName(FileName)])); - Break; + FileName := Format(ssdir+'screenshot%.3d.bmp', [a]); + t := FileName; + if findFileCI(t, true) then continue; + if not findFileCI(FileName) then + begin + e_MakeScreenshot(FileName, gScreenWidth, gScreenHeight); + g_Console_Add(Format(_lc[I_CONSOLE_SCREENSHOT], [ExtractFileName(FileName)])); + Break; + end; end; + except end; end; diff --git a/src/game/g_gui.pas b/src/game/g_gui.pas index 0100e36..e26ad7c 100644 --- a/src/game/g_gui.pas +++ b/src/game/g_gui.pas @@ -3,7 +3,7 @@ unit g_gui; interface uses - e_graphics, e_input, g_playermodel, g_basic, MAPSTRUCT, WADEDITOR; + e_graphics, e_input, g_playermodel, g_basic, MAPSTRUCT, wadreader; const MAINMENU_HEADER_COLOR: TRGB = (R:255; G:255; B:255); @@ -2463,7 +2463,7 @@ end; procedure TGUIMapPreview.SetMap(Res: string); var - WAD: TWADEditor_1; + WAD: TWADFile; MapReader: TMapReader_1; panels: TPanelsRec1Array; header: TMapHeaderRec_1; @@ -2475,7 +2475,7 @@ var begin g_ProcessResourceStr(Res, FileName, SectionName, ResName); - WAD := TWADEditor_1.Create(); + WAD := TWADFile.Create(); if not WAD.ReadFile(FileName) then begin WAD.Free(); diff --git a/src/game/g_main.pas b/src/game/g_main.pas index d78c84e..48f0bb5 100644 --- a/src/game/g_main.pas +++ b/src/game/g_main.pas @@ -20,11 +20,11 @@ var implementation uses - SDL2, GL, GLExt, WADEDITOR, e_log, g_window, + SDL2, GL, GLExt, wadreader, e_log, g_window, e_graphics, e_input, g_game, g_console, g_gui, e_sound, g_options, g_sound, g_player, g_weapons, SysUtils, g_triggers, MAPDEF, g_map, - MAPSTRUCT, g_menu, g_language, g_net, sfs; + MAPSTRUCT, g_menu, g_language, g_net, utils; var charbuff: Array [0..15] of Char; @@ -494,7 +494,7 @@ begin else begin for a := 0 to 14 do charbuff[a] := charbuff[a+1]; - charbuff[15] := SFSUpCase(C); + charbuff[15] := UpCase1251(C); Cheat(); end; end; diff --git a/src/game/g_map.pas b/src/game/g_map.pas index de8bc5b..7b1b1d7 100644 --- a/src/game/g_map.pas +++ b/src/game/g_map.pas @@ -4,7 +4,7 @@ interface uses e_graphics, g_basic, MAPSTRUCT, g_textures, Classes, - g_phys, WADEDITOR, BinEditor, g_panel, md5; + g_phys, wadreader, BinEditor, g_panel, md5; type TMapInfo = record @@ -363,7 +363,7 @@ end; function CreateTexture(RecName: String; Map: string; log: Boolean): Integer; var - WAD: TWADEditor_1; + WAD: TWADFile; TextureData: Pointer; WADName: String; SectionName: String; @@ -410,7 +410,7 @@ begin // Çàãðóæàåì ðåñóðñ òåêñòóðû â ïàìÿòü èç WAD'à: g_ProcessResourceStr(RecName, WADName, SectionName, TextureName); - WAD := TWADEditor_1.Create(); + WAD := TWADFile.Create(); if WADName <> '' then WADName := GameDir+'/wads/'+WADName @@ -445,7 +445,7 @@ end; function CreateAnimTexture(RecName: String; Map: string; log: Boolean): Integer; var - WAD: TWADEditor_1; + WAD: TWADFile; TextureWAD: Pointer; TextData: Pointer; TextureData: Pointer; @@ -463,7 +463,7 @@ begin // ×èòàåì WAD-ðåñóðñ àíèì.òåêñòóðû èç WAD'à â ïàìÿòü: g_ProcessResourceStr(RecName, WADName, SectionName, TextureName); - WAD := TWADEditor_1.Create(); + WAD := TWADFile.Create(); if WADName <> '' then WADName := GameDir+'/wads/'+WADName @@ -755,7 +755,7 @@ const DefaultMusRes = 'Standart.wad:STDMUS\MUS1'; DefaultSkyRes = 'Standart.wad:STDSKY\SKY0'; var - WAD: TWADEditor_1; + WAD: TWADFile; MapReader: TMapReader_1; Header: TMapHeaderRec_1; _textures: TTexturesRec1Array; @@ -794,7 +794,7 @@ begin e_WriteLog('Loading map WAD: ' + FileName, MSG_NOTIFY); g_Game_SetLoadingText(_lc[I_LOAD_WAD_FILE], 0, False); - WAD := TWADEditor_1.Create(); + WAD := TWADFile.Create(); if not WAD.ReadFile(FileName) then begin g_FatalError(Format(_lc[I_GAME_ERROR_MAP_WAD], [FileName])); @@ -1253,7 +1253,7 @@ end; function g_Map_GetMapInfo(Res: String): TMapInfo; var - WAD: TWADEditor_1; + WAD: TWADFile; MapReader: TMapReader_1; Header: TMapHeaderRec_1; FileName, SectionName, ResName: String; @@ -1263,7 +1263,7 @@ begin FillChar(Result, SizeOf(Result), 0); g_ProcessResourceStr(Res, FileName, SectionName, ResName); - WAD := TWADEditor_1.Create(); + WAD := TWADFile.Create(); if not WAD.ReadFile(FileName) then begin WAD.Free(); @@ -1305,7 +1305,7 @@ end; function g_Map_GetMapsList(WADName: string): SArray; var - WAD: TWADEditor_1; + WAD: TWADFile; a: Integer; ResList: SArray; Data: Pointer; @@ -1314,7 +1314,7 @@ var begin Result := nil; - WAD := TWADEditor_1.Create(); + WAD := TWADFile.Create(); if not WAD.ReadFile(WADName) then begin WAD.Free(); @@ -1344,7 +1344,7 @@ end; function g_Map_Exist(Res: string): Boolean; var - WAD: TWADEditor_1; + WAD: TWADFile; FileName, SectionName, ResName: string; ResList: SArray; a: Integer; @@ -1355,7 +1355,7 @@ begin FileName := addWadExtension(FileName); - WAD := TWADEditor_1.Create; + WAD := TWADFile.Create; if not WAD.ReadFile(FileName) then begin WAD.Free(); diff --git a/src/game/g_menu.pas b/src/game/g_menu.pas index 46d6dad..be5f432 100644 --- a/src/game/g_menu.pas +++ b/src/game/g_menu.pas @@ -29,7 +29,7 @@ uses g_gui, g_textures, e_graphics, g_main, g_window, g_game, g_map, g_basic, g_console, g_sound, g_gfx, g_player, g_options, e_log, SysUtils, CONFIG, g_playermodel, DateUtils, - MAPSTRUCT, WADEDITOR, Math, WADSTRUCT, g_saveload, + MAPSTRUCT, wadreader, Math, g_saveload, e_textures, GL, GLExt, g_language, g_net, g_netmsg, g_netmaster, g_items, e_input; @@ -774,14 +774,14 @@ var cwdt, chgt: Byte; spc: ShortInt; ID: DWORD; - wad: TWADEditor_1; + wad: TWADFile; cfgdata: Pointer; cfglen: Integer; config: TConfig; begin cfglen := 0; - wad := TWADEditor_1.Create; + wad := TWADFile.Create; if wad.ReadFile(GameWAD) then wad.GetResource('FONTS', cfgres, cfgdata, cfglen); wad.Free(); @@ -809,7 +809,7 @@ var cwdt, chgt: Byte; spc: ShortInt; CharID: DWORD; - wad: TWADEditor_1; + wad: TWADFile; cfgdata, fntdata: Pointer; cfglen, fntlen: Integer; config: TConfig; @@ -819,7 +819,7 @@ begin cfglen := 0; fntlen := 0; - wad := TWADEditor_1.Create; + wad := TWADFile.Create; if wad.ReadFile(GameWAD) then begin wad.GetResource('FONTS', txtres, cfgdata, cfglen); diff --git a/src/game/g_monsters.pas b/src/game/g_monsters.pas index 1c9040a..e47c0ff 100644 --- a/src/game/g_monsters.pas +++ b/src/game/g_monsters.pas @@ -158,7 +158,7 @@ implementation uses e_log, g_main, g_sound, g_gfx, g_player, g_game, g_weapons, g_triggers, MAPDEF, g_items, g_options, - g_console, g_map, Math, SysUtils, g_menu, WADEDITOR, + g_console, g_map, Math, SysUtils, g_menu, wadreader, g_language, g_netmsg; const diff --git a/src/game/g_netmaster.pas b/src/game/g_netmaster.pas index b05c6d4..c5e792b 100644 --- a/src/game/g_netmaster.pas +++ b/src/game/g_netmaster.pas @@ -57,7 +57,7 @@ implementation uses SysUtils, e_fixedbuffer, e_input, e_graphics, e_log, g_window, g_net, g_console, - g_map, g_game, g_sound, g_textures, g_gui, g_menu, g_options, g_language, WADEDITOR, + g_map, g_game, g_sound, g_textures, g_gui, g_menu, g_options, g_language, wadreader, ENetPlatform; var diff --git a/src/game/g_netmsg.pas b/src/game/g_netmsg.pas index ad92f47..44135d7 100644 --- a/src/game/g_netmsg.pas +++ b/src/game/g_netmsg.pas @@ -257,7 +257,7 @@ uses g_textures, g_gfx, g_sound, g_console, g_basic, g_options, g_main, g_game, g_player, g_map, g_panel, g_items, g_weapons, g_phys, g_gui, g_language, g_monsters, g_netmaster, sfs, - WADEDITOR, MAPDEF; + wadreader, MAPDEF; const NET_KEY_LEFT = 1; diff --git a/src/game/g_player.pas b/src/game/g_player.pas index 9d79504..28c28b1 100644 --- a/src/game/g_player.pas +++ b/src/game/g_player.pas @@ -471,7 +471,7 @@ implementation uses e_log, g_map, g_items, g_console, SysUtils, g_gfx, Math, g_options, g_triggers, g_menu, MAPDEF, g_game, - WADEDITOR, g_main, g_monsters, CONFIG, g_language, g_net, g_netmsg; + wadreader, g_main, g_monsters, CONFIG, g_language, g_net, g_netmsg; type TBotProfile = record diff --git a/src/game/g_playermodel.pas b/src/game/g_playermodel.pas index 6174d87..dd66ccd 100644 --- a/src/game/g_playermodel.pas +++ b/src/game/g_playermodel.pas @@ -3,8 +3,7 @@ unit g_playermodel; interface uses - g_textures, g_basic, e_graphics, WADEDITOR, - WADSTRUCT, g_weapons; + g_textures, g_basic, g_weapons, e_graphics, wadreader; const A_STAND = 0; @@ -235,7 +234,7 @@ var cc: TDirection; config: TConfig; pData, pData2: Pointer; - WAD: TWADEditor_1; + WAD: TWADFile; s: string; prefix: string; ok: Boolean; @@ -244,7 +243,7 @@ begin Result := False; - WAD := TWADEditor_1.Create; + WAD := TWADFile.Create; WAD.ReadFile(FileName); if {WAD.GetLastError <> DFWAD_NOERROR} not WAD.isOpen then diff --git a/src/game/g_res_downloader.pas b/src/game/g_res_downloader.pas index fc815da..cd0a360 100644 --- a/src/game/g_res_downloader.pas +++ b/src/game/g_res_downloader.pas @@ -9,7 +9,7 @@ function g_Res_DownloadWAD(const FileName: string): string; implementation -uses g_language, sfs, WADEDITOR; +uses g_language, sfs, utils, wadreader; const DOWNLOAD_DIR = 'downloads'; @@ -23,7 +23,7 @@ begin repeat if (searchResult.Attr and faDirectory) = 0 then begin - if SFSStrEqu(searchResult.Name, filename) then + if StrEquCI1251(searchResult.Name, filename) then begin files.Add(dirName+'/'+filename); Exit; diff --git a/src/game/g_saveload.pas b/src/game/g_saveload.pas index 36cf729..980cef8 100644 --- a/src/game/g_saveload.pas +++ b/src/game/g_saveload.pas @@ -15,7 +15,7 @@ implementation uses g_game, g_items, g_map, g_monsters, g_triggers, - g_basic, g_main, SysUtils, Math, WADEDITOR, + g_basic, g_main, SysUtils, Math, wadreader, MAPSTRUCT, MAPDEF, g_weapons, g_player, g_console, e_log, g_language; diff --git a/src/game/g_sound.pas b/src/game/g_sound.pas index b37cd1f..48c5167 100644 --- a/src/game/g_sound.pas +++ b/src/game/g_sound.pas @@ -68,7 +68,7 @@ procedure g_Sound_SetupAllVolumes(SoundVol, MusicVol: Byte); implementation uses - e_log, SysUtils, g_console, g_options, WADEDITOR, + e_log, SysUtils, g_console, g_options, wadreader, g_game, g_basic, g_items, g_map, Math, g_language; @@ -279,7 +279,7 @@ end; function g_Sound_CreateWAD(var ID: DWORD; Resource: string; isMusic: Boolean = False): Boolean; var - WAD: TWADEditor_1; + WAD: TWADFile; FileName, SectionName, ResourceName: string; @@ -293,7 +293,7 @@ begin // e_WriteLog('Loading sound: ' + Resource, MSG_NOTIFY); g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName); - WAD := TWADEditor_1.Create(); + WAD := TWADFile.Create(); WAD.ReadFile(FileName); if WAD.GetResource(SectionName, ResourceName, SoundData, ResLength) then @@ -324,7 +324,7 @@ end; function g_Sound_CreateWADEx(SoundName: ShortString; Resource: string; isMusic: Boolean = False): Boolean; var - WAD: TWADEditor_1; + WAD: TWADFile; FileName, SectionName, ResourceName: string; SoundData: Pointer; ResLength: Integer; @@ -339,7 +339,7 @@ begin find_id := FindSound(); - WAD := TWADEditor_1.Create(); + WAD := TWADFile.Create(); WAD.ReadFile(FileName); if WAD.GetResource(SectionName, ResourceName, SoundData, ResLength) then diff --git a/src/game/g_textures.pas b/src/game/g_textures.pas index c96d4c6..a6ea764 100644 --- a/src/game/g_textures.pas +++ b/src/game/g_textures.pas @@ -93,7 +93,7 @@ procedure DumpTextureNames(); implementation uses - g_game, e_log, g_basic, SysUtils, g_console, WADEDITOR, + g_game, e_log, g_basic, SysUtils, g_console, wadreader, g_language; type @@ -143,7 +143,7 @@ end; function g_Texture_CreateWAD(var ID: DWORD; Resource: String): Boolean; var - WAD: TWADEditor_1; + WAD: TWADFile; FileName, SectionName, ResourceName: String; @@ -153,7 +153,7 @@ begin Result := False; g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName); - WAD := TWADEditor_1.Create; + WAD := TWADFile.Create; WAD.ReadFile(FileName); if WAD.GetResource(SectionName, ResourceName, TextureData, ResourceLength) then @@ -183,7 +183,7 @@ end; function g_Texture_CreateWADEx(TextureName: ShortString; Resource: String): Boolean; var - WAD: TWADEditor_1; + WAD: TWADFile; FileName, SectionName, ResourceName: String; @@ -195,7 +195,7 @@ begin find_id := FindTexture(); - WAD := TWADEditor_1.Create; + WAD := TWADFile.Create; WAD.ReadFile(FileName); if WAD.GetResource(SectionName, ResourceName, TextureData, ResourceLength) then @@ -391,7 +391,7 @@ end; function g_Frames_CreateWAD(ID: PDWORD; Name: ShortString; Resource: string; FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean; var - WAD: TWADEditor_1; + WAD: TWADFile; FileName, SectionName, ResourceName: string; @@ -402,7 +402,7 @@ begin g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName); - WAD := TWADEditor_1.Create(); + WAD := TWADFile.Create(); WAD.ReadFile(FileName); if not WAD.GetResource(SectionName, ResourceName, TextureData, ResourceLength) then diff --git a/src/game/g_triggers.pas b/src/game/g_triggers.pas index 1bfd188..8e8cf44 100644 --- a/src/game/g_triggers.pas +++ b/src/game/g_triggers.pas @@ -71,7 +71,7 @@ implementation uses g_player, g_map, Math, g_gfx, g_game, g_textures, g_console, g_monsters, g_items, g_phys, g_weapons, - WADEDITOR, g_main, SysUtils, e_log, g_language, + wadreader, g_main, SysUtils, e_log, g_language, g_options, g_net, g_netmsg; const diff --git a/src/game/g_window.pas b/src/game/g_window.pas index 0429b77..cbc1028 100644 --- a/src/game/g_window.pas +++ b/src/game/g_window.pas @@ -3,7 +3,7 @@ unit g_window; interface uses - WADEDITOR; + wadreader; function SDLMain(): Integer; function GetTimer(): Int64; @@ -23,7 +23,7 @@ function g_Window_SetSize(W, H: Word; FScreen: Boolean): Boolean; implementation uses -{$IFDEF WIN32}Windows,{$ENDIF} +{$IFDEF WINDOWS}Windows,{$ENDIF} SDL2, GL, GLExt, e_graphics, e_log, g_main, g_console, SysUtils, e_input, g_options, g_game, g_basic, g_textures, e_sound, g_sound, g_menu, ENet, g_net; @@ -435,7 +435,7 @@ begin Result := True; end; -{$IFDEF WIN32} +{$IFDEF WINDOWS} // windoze sux; in headless mode `GetTickCount()` (and SDL) returns shit function GetTimer(): Int64; var diff --git a/src/sfs/sfs.pas b/src/sfs/sfs.pas index 69e4368..157fbac 100644 --- a/src/sfs/sfs.pas +++ b/src/sfs/sfs.pas @@ -208,22 +208,12 @@ procedure sfsGCEnable (); // for completeness sake procedure sfsGCCollect (); - function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString; -// èãíîðèðóåò ðåãèñòð ñèìâîëîâ -function SFSStrEqu (const s0, s1: TSFSString): Boolean; // ðàçîáðàòü òîëñòîå èìÿ ôàéëà, âåðíóòü âèðòóàëüíîå èìÿ ïîñëåäíåãî ñïèñêà // èëè ïóñòóþ ñòîðîêó, åñëè ñïèñêîâ íå áûëî. function SFSGetLastVirtualName (const fn: TSFSString): string; -// ïðåîáðàçîâàòü ÷èñëî â ñòðîêó, êðàñèâî ðàçáàâëÿÿ çàïÿòûìè -function Int64ToStrComma (i: Int64): string; - -// `name` will be modified -// return `true` if file was found -function sfsFindFileCI (path: string; var name: string): Boolean; - // Wildcard matching // this code is meant to allow wildcard pattern matches. tt is VERY useful // for matching filename wildcard patterns. tt allows unix grep-like pattern @@ -244,10 +234,6 @@ function WildMatch (pattern, text: TSFSString): Boolean; function WildListMatch (wildList, text: TSFSString; delimChar: AnsiChar=':'): Integer; function HasWildcards (const pattern: TSFSString): Boolean; -function SFSUpCase (ch: Char): Char; - -function utf8to1251 (s: TSFSString): TSFSString; - var // ïðàâäà: ðàçðåøåíî èñêàòü ôàéëî íå òîëüêî â ôàéëàõ äàííûõ, íî è íà äèñêå. @@ -268,47 +254,7 @@ var implementation uses - xstreams; - - -function Int64ToStrComma (i: Int64): string; -var - f: Integer; -begin - Str(i, result); - f := Length(result)+1; - while f > 4 do - begin - Dec(f, 3); Insert(',', result, f); - end; -end; - - -// `name` will be modified -function sfsFindFileCI (path: string; var name: string): Boolean; -var - sr: TSearchRec; - bestname: string = ''; -begin - if length(path) = 0 then path := '.'; - while (length(path) > 0) and (path[length(path)] = '/') do Delete(path, length(path), 1); - if (length(path) = 0) or (path[length(path)] <> '/') then path := path+'/'; - if FileExists(path+name) then begin result := true; exit; end; - if FindFirst(path+'*', faAnyFile, sr) = 0 then - repeat - if (sr.name = '.') or (sr.name = '..') then continue; - if (sr.attr and faDirectory) <> 0 then continue; - if sr.name = name then - begin - FindClose(sr); - result := true; - exit; - end; - if (length(bestname) = 0) and SFSStrEqu(sr.name, name) then bestname := sr.name; - until FindNext(sr) <> 0; - FindClose(sr); - if length(bestname) > 0 then begin result := true; name := bestname; end else result := false; -end; + xstreams, utils; const @@ -624,7 +570,7 @@ begin vi := TVolumeInfo(volumes[f]); if not onlyPerm or vi.fPermanent then begin - if SFSStrEqu(vi.fPackName, dataFileName) then + if StrEquCI1251(vi.fPackName, dataFileName) then begin result := f; exit; @@ -651,42 +597,6 @@ begin end; end; -function SFSUpCase (ch: Char): Char; -begin - if ch < #128 then - begin - if (ch >= 'a') and (ch <= 'z') then Dec(ch, 32); - end - else - begin - if (ch >= #224) and (ch <= #255) then - begin - Dec(ch, 32); - end - else - begin - case ch of - #184, #186, #191: Dec(ch, 16); - #162, #179: Dec(ch); - end; - end; - end; - result := ch; -end; - -function SFSStrEqu (const s0, s1: TSFSString): Boolean; -var - i: Integer; -begin - //result := (AnsiCompareText(s0, s1) == 0); - result := false; - if length(s0) <> length(s1) then exit; - for i := 1 to length(s0) do - begin - if SFSUpCase(s0[i]) <> SFSUpCase(s1[i]) then exit; - end; - result := true; -end; // adds '/' too function normalizePath (fn: string): string; @@ -901,8 +811,8 @@ begin Dec(result); if fFiles[result] <> nil then begin - if SFSStrEqu(fPath, TSFSFileInfo(fFiles[result]).fPath) and - SFSStrEqu(fName, TSFSFileInfo(fFiles[result]).fName) then exit; + if StrEquCI1251(fPath, TSFSFileInfo(fFiles[result]).fPath) and + StrEquCI1251(fName, TSFSFileInfo(fFiles[result]).fName) then exit; end; end; result := -1; @@ -1353,124 +1263,6 @@ begin end; -// ////////////////////////////////////////////////////////////////////////// // -// utils -// `ch`: utf8 start -// -1: invalid utf8 -function utf8CodeLen (ch: Word): Integer; -begin - if ch < $80 then begin result := 1; exit; end; - if (ch and $FE) = $FC then begin result := 6; exit; end; - if (ch and $FC) = $F8 then begin result := 5; exit; end; - if (ch and $F8) = $F0 then begin result := 4; exit; end; - if (ch and $F0) = $E0 then begin result := 3; exit; end; - if (ch and $E0) = $C0 then begin result := 2; exit; end; - result := -1; // invalid -end; - - -function utf8Valid (s: string): Boolean; -var - pos, len: Integer; -begin - result := false; - pos := 1; - while pos <= length(s) do - begin - len := utf8CodeLen(Byte(s[pos])); - if len < 1 then exit; // invalid sequence start - if pos+len-1 > length(s) then exit; // out of chars in string - Dec(len); - Inc(pos); - // check other sequence bytes - while len > 0 do - begin - if (Byte(s[pos]) and $C0) <> $80 then exit; - Dec(len); - Inc(pos); - end; - end; - result := true; -end; - - -// ////////////////////////////////////////////////////////////////////////// // -const - // TODO: move this to a separate file - uni2wint: array [128..255] of Word = ( - $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F, - $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F, - $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407, - $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457, - $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F, - $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F, - $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F, - $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F - ); - - -function decodeUtf8Char (s: TSFSString; var pos: Integer): char; -var - b, c: Integer; -begin - (* The following encodings are valid, except for the 5 and 6 byte - * combinations: - * 0xxxxxxx - * 110xxxxx 10xxxxxx - * 1110xxxx 10xxxxxx 10xxxxxx - * 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx - * 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx - * 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx - *) - result := '?'; - if pos > length(s) then exit; - - b := Byte(s[pos]); - Inc(pos); - if b < $80 then begin result := char(b); exit; end; - - // mask out unused bits - if (b and $FE) = $FC then b := b and $01 - else if (b and $FC) = $F8 then b := b and $03 - else if (b and $F8) = $F0 then b := b and $07 - else if (b and $F0) = $E0 then b := b and $0F - else if (b and $E0) = $C0 then b := b and $1F - else exit; // invalid utf8 - - // now continue - while pos <= length(s) do - begin - c := Byte(s[pos]); - if (c and $C0) <> $80 then break; // no more - b := b shl 6; - b := b or (c and $3F); - Inc(pos); - end; - - // done, try 1251 - for c := 128 to 255 do if uni2wint[c] = b then begin result := char(c and $FF); exit; end; - // alas -end; - - -function utf8to1251 (s: TSFSString): TSFSString; -var - pos: Integer; -begin - if not utf8Valid(s) then begin result := s; exit; end; - pos := 1; - while pos <= length(s) do - begin - if Byte(s[pos]) >= $80 then break; - Inc(pos); - end; - if pos > length(s) then begin result := s; exit; end; // nothing to do here - result := ''; - pos := 1; - while pos <= length(s) do result := result+decodeUtf8Char(s, pos); -end; - - initialization factories := TObjectList.Create(true); volumes := TObjectList.Create(true); diff --git a/src/sfs/sfsMemFS.pas b/src/sfs/sfsMemFS.pas index 748dbc3..627ca78 100644 --- a/src/sfs/sfsMemFS.pas +++ b/src/sfs/sfsMemFS.pas @@ -53,7 +53,7 @@ implementation {$IFDEF SFS_MSMFS} uses - xstreams; + xstreams, utils; function SLHCheckMagic (st: TStream): Boolean; @@ -208,8 +208,8 @@ end; function TSFSMemoryVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean; begin result := - SFSStrEqu(prefix, 'mem') or - SFSStrEqu(prefix, 'slh!'); + StrEquCI1251(prefix, 'mem') or + StrEquCI1251(prefix, 'slh!'); end; procedure TSFSMemoryVolumeFactory.Recycle (vol: TSFSVolume); diff --git a/src/sfs/sfsPlainFS.pas b/src/sfs/sfsPlainFS.pas index c46d83f..b658388 100644 --- a/src/sfs/sfsPlainFS.pas +++ b/src/sfs/sfsPlainFS.pas @@ -79,7 +79,7 @@ type implementation uses - xstreams; + xstreams, utils; type @@ -408,7 +408,7 @@ begin if c <> f then begin // link can't be linked to itself - if SFSStrEqu(TSFSExtFileInfo(fFiles[c]).fName, fi.fLink) then break; + if StrEquCI1251(TSFSExtFileInfo(fFiles[c]).fName, fi.fLink) then break; end; Inc(c); end; @@ -691,22 +691,22 @@ end; function TSFSPlainVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean; begin result := - SFSStrEqu(prefix, 'pak') or - SFSStrEqu(prefix, 'sin') or - SFSStrEqu(prefix, 'quake') + StrEquCI1251(prefix, 'pak') or + StrEquCI1251(prefix, 'sin') or + StrEquCI1251(prefix, 'quake') {$IFDEF SFS_PLAINFS_FULL} or - SFSStrEqu(prefix, 'wad') or // sorry - SFSStrEqu(prefix, 'wad2') or - SFSStrEqu(prefix, 'grp') or - SFSStrEqu(prefix, 'spe') or - SFSStrEqu(prefix, 'spec') or - SFSStrEqu(prefix, 'doom') or - SFSStrEqu(prefix, 'duke3d') or - SFSStrEqu(prefix, 'abuse') or - SFSStrEqu(prefix, 'allegro') or - SFSStrEqu(prefix, 'dune2') or - SFSStrEqu(prefix, 'max') + StrEquCI1251(prefix, 'wad') or // sorry + StrEquCI1251(prefix, 'wad2') or + StrEquCI1251(prefix, 'grp') or + StrEquCI1251(prefix, 'spe') or + StrEquCI1251(prefix, 'spec') or + StrEquCI1251(prefix, 'doom') or + StrEquCI1251(prefix, 'duke3d') or + StrEquCI1251(prefix, 'abuse') or + StrEquCI1251(prefix, 'allegro') or + StrEquCI1251(prefix, 'dune2') or + StrEquCI1251(prefix, 'max') {$ENDIF} ; end; diff --git a/src/sfs/sfsZipFS.pas b/src/sfs/sfsZipFS.pas index 4abd880..7a1852a 100644 --- a/src/sfs/sfsZipFS.pas +++ b/src/sfs/sfsZipFS.pas @@ -61,7 +61,7 @@ type implementation uses - zstream, xstreams; + zstream, xstreams, utils; type @@ -153,7 +153,7 @@ begin for f := 1 to length(s0) do begin if f > length(s1) then begin result := f; exit; end; - if SFSUpCase(s0[f]) <> SFSUpCase(s1[f]) then begin result := f; exit; end; + if UpCase1251(s0[f]) <> UpCase1251(s1[f]) then begin result := f; exit; end; end; result := length(s0); end; @@ -607,13 +607,13 @@ end; function TSFSZipVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean; begin result := - SFSStrEqu(prefix, 'zip') or - SFSStrEqu(prefix, 'dfwad') + StrEquCI1251(prefix, 'zip') or + StrEquCI1251(prefix, 'dfwad') {$IFDEF SFS_ZIPFS_FULL} - or SFSStrEqu(prefix, 'jar') or - SFSStrEqu(prefix, 'fout2') or - SFSStrEqu(prefix, 'vtdb') or - SFSStrEqu(prefix, 'wad') + or StrEquCI1251(prefix, 'jar') or + StrEquCI1251(prefix, 'fout2') or + StrEquCI1251(prefix, 'vtdb') or + StrEquCI1251(prefix, 'wad') {$ENDIF} ; end; diff --git a/src/sfs/wadcvt.dpr b/src/sfs/wadcvt.dpr index bd5933e..1fa828a 100644 --- a/src/sfs/wadcvt.dpr +++ b/src/sfs/wadcvt.dpr @@ -8,6 +8,7 @@ uses SysUtils, Classes, SDL2 in '../lib/sdl2/sdl2.pas', + utils in '../shared/utils.pas', sfs, sfsPlainFS, sfsZipFS, @@ -173,7 +174,7 @@ begin end; infname := ParamStr(1); - if not SFSStrEqu(ExtractFileExt(infname), '.wad') and not SFSStrEqu(ExtractFileExt(infname), '.dfwad') then + if not StrEquCI1251(ExtractFileExt(infname), '.wad') and not StrEquCI1251(ExtractFileExt(infname), '.dfwad') then begin writeln('wtf?!'); Halt(1); diff --git a/src/shared/utils.pas b/src/shared/utils.pas index 76edd1f..712923e 100644 --- a/src/shared/utils.pas +++ b/src/shared/utils.pas @@ -4,39 +4,56 @@ unit utils; interface // does filename have one of ".wad", ".pk3", ".zip" extensions? -function hasWadExtension (fn: string): Boolean; +function hasWadExtension (fn: AnsiString): Boolean; // does filepath have ".XXX:\" in it? -function isWadPath (fn: string): Boolean; +function isWadPath (fn: AnsiString): Boolean; // adds ".wad" extension if filename doesn't have one of ".wad", ".pk3", ".zip" -function addWadExtension (fn: string): string; +function addWadExtension (fn: AnsiString): AnsiString; + +// convert number to strig with nice commas +function Int64ToStrComma (i: Int64): AnsiString; + +function UpCase1251 (ch: Char): Char; + +// `true` if strings are equal; ignoring case for cp1251 +function StrEquCI1251 (const s0, s1: AnsiString): Boolean; + +function utf8Valid (const s: AnsiString): Boolean; + +function utf8to1251 (s: AnsiString): AnsiString; + +// `pathname` will be modified if path is valid +// `lastIsDir` should be `true` if we are searching for directory +// nobody cares about shitdoze, so i'll use the same code path for it +function findFileCI (var pathname: AnsiString; lastIsDir: Boolean=false): Boolean; implementation uses - SysUtils, sfs; + SysUtils; -function hasWadExtension (fn: string): Boolean; +function hasWadExtension (fn: AnsiString): Boolean; begin fn := ExtractFileExt(fn); - result := SFSStrEqu(fn, '.wad') or SFSStrEqu(fn, '.pk3') or SFSStrEqu(fn, '.zip'); + result := StrEquCI1251(fn, '.wad') or StrEquCI1251(fn, '.pk3') or StrEquCI1251(fn, '.zip'); end; -function addWadExtension (fn: string): string; +function addWadExtension (fn: AnsiString): AnsiString; begin result := fn; if not hasWadExtension(result) then result := result+'.wad'; end; -function isWadPath (fn: string): Boolean; +function isWadPath (fn: AnsiString): Boolean; var p: Integer; - s: string; + s: AnsiString; begin result := false; while true do @@ -46,7 +63,7 @@ begin if (p-4 > 1) and (fn[p-4] = '.') and ((fn[p+1] = '\') or (fn[p+1] = '/')) then begin s := Copy(fn, p-4, 4); - if SFSStrEqu(s, '.wad') or SFSStrEqu(s, '.pk3') or SFSStrEqu(s, '.zip') then + if StrEquCI1251(s, '.wad') or StrEquCI1251(s, '.pk3') or StrEquCI1251(s, '.zip') then begin result := true; exit; @@ -57,4 +74,238 @@ begin end; +function Int64ToStrComma (i: Int64): AnsiString; +var + f: Integer; +begin + Str(i, result); + f := Length(result)+1; + while f > 4 do + begin + Dec(f, 3); Insert(',', result, f); + end; +end; + + +function UpCase1251 (ch: Char): Char; +begin + if ch < #128 then + begin + if (ch >= 'a') and (ch <= 'z') then Dec(ch, 32); + end + else + begin + if (ch >= #224) and (ch <= #255) then + begin + Dec(ch, 32); + end + else + begin + case ch of + #184, #186, #191: Dec(ch, 16); + #162, #179: Dec(ch); + end; + end; + end; + result := ch; +end; + + +function StrEquCI1251 (const s0, s1: AnsiString): Boolean; +var + i: Integer; +begin + result := false; + if length(s0) <> length(s1) then exit; + for i := 1 to length(s0) do if UpCase1251(s0[i]) <> UpCase1251(s1[i]) then exit; + result := true; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +// utils +// `ch`: utf8 start +// -1: invalid utf8 +function utf8CodeLen (ch: Word): Integer; +begin + if ch < $80 then begin result := 1; exit; end; + if (ch and $FE) = $FC then begin result := 6; exit; end; + if (ch and $FC) = $F8 then begin result := 5; exit; end; + if (ch and $F8) = $F0 then begin result := 4; exit; end; + if (ch and $F0) = $E0 then begin result := 3; exit; end; + if (ch and $E0) = $C0 then begin result := 2; exit; end; + result := -1; // invalid +end; + + +function utf8Valid (const s: AnsiString): Boolean; +var + pos, len: Integer; +begin + result := false; + pos := 1; + while pos <= length(s) do + begin + len := utf8CodeLen(Byte(s[pos])); + if len < 1 then exit; // invalid sequence start + if pos+len-1 > length(s) then exit; // out of chars in string + Dec(len); + Inc(pos); + // check other sequence bytes + while len > 0 do + begin + if (Byte(s[pos]) and $C0) <> $80 then exit; + Dec(len); + Inc(pos); + end; + end; + result := true; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +const + uni2wint: array [128..255] of Word = ( + $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F, + $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F, + $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407, + $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457, + $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F, + $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F, + $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F, + $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F + ); + + +function decodeUtf8Char (s: AnsiString; var pos: Integer): char; +var + b, c: Integer; +begin + (* The following encodings are valid, except for the 5 and 6 byte + * combinations: + * 0xxxxxxx + * 110xxxxx 10xxxxxx + * 1110xxxx 10xxxxxx 10xxxxxx + * 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx + * 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx + * 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx + *) + result := '?'; + if pos > length(s) then exit; + + b := Byte(s[pos]); + Inc(pos); + if b < $80 then begin result := char(b); exit; end; + + // mask out unused bits + if (b and $FE) = $FC then b := b and $01 + else if (b and $FC) = $F8 then b := b and $03 + else if (b and $F8) = $F0 then b := b and $07 + else if (b and $F0) = $E0 then b := b and $0F + else if (b and $E0) = $C0 then b := b and $1F + else exit; // invalid utf8 + + // now continue + while pos <= length(s) do + begin + c := Byte(s[pos]); + if (c and $C0) <> $80 then break; // no more + b := b shl 6; + b := b or (c and $3F); + Inc(pos); + end; + + // done, try 1251 + for c := 128 to 255 do if uni2wint[c] = b then begin result := char(c and $FF); exit; end; + // alas +end; + + +function utf8to1251 (s: AnsiString): AnsiString; +var + pos: Integer; +begin + if not utf8Valid(s) then begin result := s; exit; end; + pos := 1; + while pos <= length(s) do + begin + if Byte(s[pos]) >= $80 then break; + Inc(pos); + end; + if pos > length(s) then begin result := s; exit; end; // nothing to do here + result := ''; + pos := 1; + while pos <= length(s) do result := result+decodeUtf8Char(s, pos); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +// `pathname` will be modified if path is valid +// `lastIsDir` should be `true` if we are searching for directory +// nobody cares about shitdoze, so i'll use the same code path for it +function findFileCI (var pathname: AnsiString; lastIsDir: Boolean=false): Boolean; +var + sr: TSearchRec; + npt: AnsiString; + newname: AnsiString = ''; + curname: AnsiString; + wantdir: Boolean; + attr: LongInt; + foundher: Boolean; +begin + npt := pathname; + result := (length(npt) > 0); + if (length(npt) > 0) and ((npt[1] = '/') or (npt[1] = '\')) then newname := '/'; + while length(npt) > 0 do + begin + // remove trailing slashes + while (length(npt) > 0) and ((npt[1] = '/') or (npt[1] = '\')) do Delete(npt, 1, 1); + if length(npt) = 0 then break; + // extract name + curname := ''; + while (length(npt) > 0) and (npt[1] <> '/') and (npt[1] <> '\') do + begin + curname := curname+npt[1]; + Delete(npt, 1, 1); + end; + // remove trailing slashes again + while (length(npt) > 0) and ((npt[1] = '/') or (npt[1] = '\')) do Delete(npt, 1, 1); + wantdir := lastIsDir or (length(npt) > 0); // do we want directory here? + //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)])); + // try the easiest case first + attr := FileGetAttr(newname+curname); + if attr <> -1 then + begin + if wantdir = ((attr and faDirectory) <> 0) then + begin + // i found her! + newname := newname+curname; + if wantdir then newname := newname+'/'; + continue; + end; + end; + //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)])); + // alas, either not found, or invalid attributes + foundher := false; + try + if FindFirst(newname+'*', faAnyFile, sr) = 0 then + repeat + if (wantdir = ((sr.attr and faDirectory) <> 0)) and StrEquCI1251(sr.name, curname) then + begin + // i found her! + newname := newname+sr.name; + if wantdir then newname := newname+'/'; + foundher := true; + break; + end; + until FindNext(sr) <> 0; + finally + FindClose(sr); + end; + if not foundher then begin newname := ''; result := false; break; end; + end; + if result then pathname := newname; +end; + + end. diff --git a/src/shared/WADEDITOR.pas b/src/shared/wadreader.pas similarity index 74% rename from src/shared/WADEDITOR.pas rename to src/shared/wadreader.pas index d41acfa..3cce5df 100644 --- a/src/shared/WADEDITOR.pas +++ b/src/shared/wadreader.pas @@ -1,4 +1,4 @@ -unit WADEDITOR; +unit wadreader; {$DEFINE SFS_DWFAD_DEBUG} @@ -11,7 +11,7 @@ uses type SArray = array of ShortString; - TWADEditor_1 = class(TObject) + TWADFile = class(TObject) private fFileName: string; // empty: not opened fIter: TSFSFileList; @@ -32,19 +32,6 @@ type property isOpen: Boolean read getIsOpen; end; -{ -const - DFWAD_NOERROR = 0; - DFWAD_ERROR_WADNOTFOUND = -1; - DFWAD_ERROR_CANTOPENWAD = -2; - DFWAD_ERROR_RESOURCENOTFOUND = -3; - DFWAD_ERROR_FILENOTWAD = -4; - DFWAD_ERROR_WADNOTLOADED = -5; - DFWAD_ERROR_READRESOURCE = -6; - DFWAD_ERROR_READWAD = -7; - DFWAD_ERROR_WRONGVERSION = -8; -} - procedure g_ProcessResourceStr (ResourceStr: String; var FileName, SectionName, ResourceName: String); overload; procedure g_ProcessResourceStr (ResourceStr: String; FileName, SectionName, ResourceName: PString); overload; @@ -56,48 +43,43 @@ function findDiskWad (fname: string): string; implementation uses - SysUtils, Classes, BinEditor, e_log, g_options; + SysUtils, Classes, BinEditor, e_log, g_options, utils; function findDiskWad (fname: string): string; -var - path, rfn: string; begin result := ''; - path := ExtractFilePath(fname); - rfn := ExtractFileName(fname); - if not sfsFindFileCI(path, rfn) then + if not findFileCI(fname) then begin - //e_WriteLog(Format('TWADEditor_1.ReadFile: error looking for [%s] [%s]', [path, ExtractFileName(fname)]), MSG_NOTIFY); - if SFSStrEqu(ExtractFileExt(fname), '.wad') then + //e_WriteLog(Format('TWADFile.ReadFile: error looking for [%s] [%s]', [path, ExtractFileName(fname)]), MSG_NOTIFY); + if StrEquCI1251(ExtractFileExt(fname), '.wad') then begin - rfn := ChangeFileExt(ExtractFileName(fname), '.pk3'); + fname := ChangeFileExt(ExtractFileName(fname), '.pk3'); //e_WriteLog(Format(' looking for [%s] [%s]', [path, rfn]), MSG_NOTIFY); - if not sfsFindFileCI(path, rfn) then + if not findFileCI(fname) then begin //e_WriteLog(Format(' looking for [%s] [%s]', [path, rfn]), MSG_NOTIFY); - rfn := ChangeFileExt(ExtractFileName(fname), '.zip'); - if not sfsFindFileCI(path, rfn) then exit; + fname := ChangeFileExt(ExtractFileName(fname), '.zip'); + if not findFileCI(fname) then exit; end; end else begin exit; end; - //e_WriteLog(Format('TWADEditor_1.ReadFile: FOUND [%s]', [rfn]), MSG_NOTIFY); + //e_WriteLog(Format('TWADFile.ReadFile: FOUND [%s]', [rfn]), MSG_NOTIFY); end else begin - //if rfn <> ExtractFileName(FileName) then e_WriteLog(Format('TWADEditor_1.ReadFile: FOUND [%s]', [rfn]), MSG_NOTIFY); + //if rfn <> ExtractFileName(FileName) then e_WriteLog(Format('TWADFile.ReadFile: FOUND [%s]', [rfn]), MSG_NOTIFY); end; - result := path+rfn; + result := fname; end; procedure g_ProcessResourceStr (ResourceStr: String; var FileName, SectionName, ResourceName: String); var a, i: Integer; - begin //e_WriteLog(Format('g_ProcessResourceStr0: [%s]', [ResourceStr]), MSG_NOTIFY); for i := Length(ResourceStr) downto 1 do @@ -148,30 +130,30 @@ begin end; -{ TWADEditor_1 } -constructor TWADEditor_1.Create(); +{ TWADFile } +constructor TWADFile.Create(); begin fFileName := ''; end; -destructor TWADEditor_1.Destroy(); +destructor TWADFile.Destroy(); begin FreeWAD(); inherited; end; -function TWADEditor_1.getIsOpen (): Boolean; +function TWADFile.getIsOpen (): Boolean; begin result := (fFileName <> ''); end; -procedure TWADEditor_1.FreeWAD(); +procedure TWADFile.FreeWAD(); begin if fIter <> nil then FreeAndNil(fIter); - //if fFileName <> '' then e_WriteLog(Format('TWADEditor_1.ReadFile: [%s] closed', [fFileName]), MSG_NOTIFY); + //if fFileName <> '' then e_WriteLog(Format('TWADFile.ReadFile: [%s] closed', [fFileName]), MSG_NOTIFY); fFileName := ''; end; @@ -190,7 +172,7 @@ begin result := s; end; -function TWADEditor_1.GetResource (Section, Resource: string; var pData: Pointer; var Len: Integer): Boolean; +function TWADFile.GetResource (Section, Resource: string; var pData: Pointer; var Len: Integer): Boolean; var f: Integer; fi: TSFSFileInfo; @@ -208,7 +190,7 @@ begin fi := fIter.Files[f]; if fi = nil then continue; //e_WriteLog(Format('DFWAD: searching for [%s : %s] in [%s]; current is [%s : %s]', [Section, Resource, fFileName, fi.path, fi.name]), MSG_NOTIFY); - if SFSStrEqu(fi.path, Section) and SFSStrEqu(removeExt(fi.name), Resource) then + if StrEquCI1251(fi.path, Section) and StrEquCI1251(removeExt(fi.name), Resource) then begin // i found her! //fn := fFileName+'::'+fi.path+fi.name; @@ -250,7 +232,7 @@ begin end; -function TWADEditor_1.GetResourcesList (Section: string): SArray; +function TWADFile.GetResourcesList (Section: string): SArray; var f: Integer; fi: TSFSFileInfo; @@ -263,7 +245,7 @@ begin fi := fIter.Files[f]; if fi = nil then continue; if length(fi.name) = 0 then continue; - if SFSStrEqu(fi.path, Section) then + if StrEquCI1251(fi.path, Section) then begin SetLength(result, Length(result)+1); result[high(result)] := removeExt(fi.name); @@ -272,23 +254,23 @@ begin end; -function TWADEditor_1.ReadFile (FileName: string): Boolean; +function TWADFile.ReadFile (FileName: string): Boolean; var rfn: string; //f: Integer; //fi: TSFSFileInfo; begin Result := False; - //e_WriteLog(Format('TWADEditor_1.ReadFile: [%s]', [FileName]), MSG_NOTIFY); + //e_WriteLog(Format('TWADFile.ReadFile: [%s]', [FileName]), MSG_NOTIFY); FreeWAD(); rfn := findDiskWad(FileName); if length(rfn) = 0 then begin - e_WriteLog(Format('TWADEditor_1.ReadFile: error looking for [%s]', [FileName]), MSG_NOTIFY); + e_WriteLog(Format('TWADFile.ReadFile: error looking for [%s]', [FileName]), MSG_NOTIFY); exit; end; {$IFDEF SFS_DWFAD_DEBUG} - if gSFSDebug then e_WriteLog(Format('TWADEditor_1.ReadFile: FOUND [%s]', [rfn]), MSG_NOTIFY); + if gSFSDebug then e_WriteLog(Format('TWADFile.ReadFile: FOUND [%s]', [rfn]), MSG_NOTIFY); {$ENDIF} // cache this wad try @@ -307,7 +289,7 @@ begin if fIter = nil then Exit; fFileName := rfn; {$IFDEF SFS_DWFAD_DEBUG} - if gSFSDebug then e_WriteLog(Format('TWADEditor_1.ReadFile: [%s] opened', [fFileName]), MSG_NOTIFY); + if gSFSDebug then e_WriteLog(Format('TWADFile.ReadFile: [%s] opened', [fFileName]), MSG_NOTIFY); {$ENDIF} Result := True; end; @@ -316,7 +298,7 @@ end; var uniqueCounter: Integer = 0; -function TWADEditor_1.ReadMemory (Data: Pointer; Len: LongWord): Boolean; +function TWADFile.ReadMemory (Data: Pointer; Len: LongWord): Boolean; var fn: string; st: TStream = nil; @@ -327,14 +309,14 @@ begin FreeWAD(); if (Data = nil) or (Len = 0) then begin - e_WriteLog('TWADEditor_1.ReadMemory: EMPTY SUBWAD!', MSG_WARNING); + e_WriteLog('TWADFile.ReadMemory: EMPTY SUBWAD!', MSG_WARNING); Exit; end; fn := Format(' -- memwad %d -- ', [uniqueCounter]); Inc(uniqueCounter); {$IFDEF SFS_DWFAD_DEBUG} - e_WriteLog(Format('TWADEditor_1.ReadMemory: [%s]', [fn]), MSG_NOTIFY); + e_WriteLog(Format('TWADFile.ReadMemory: [%s]', [fn]), MSG_NOTIFY); {$ENDIF} try @@ -354,7 +336,7 @@ begin fFileName := fn; {$IFDEF SFS_DWFAD_DEBUG} - e_WriteLog(Format('TWADEditor_1.ReadMemory: [%s] opened', [fFileName]), MSG_NOTIFY); + e_WriteLog(Format('TWADFile.ReadMemory: [%s] opened', [fFileName]), MSG_NOTIFY); {$ENDIF} { diff --git a/src/shared/WADEDITOR_full.pas b/src/unused/WADEDITOR_full.pas similarity index 96% rename from src/shared/WADEDITOR_full.pas rename to src/unused/WADEDITOR_full.pas index 8212992..cec3571 100644 --- a/src/shared/WADEDITOR_full.pas +++ b/src/unused/WADEDITOR_full.pas @@ -8,12 +8,40 @@ WADEDITOR.PAS ----------------------------------- } -interface +{ +----------------------------------- +WADSTRUCT.PAS ÂÅÐÑÈß ÎÒ 24.09.06 + +Ïîääåðæêà âàäîâ âåðñèè 1 +----------------------------------- -uses WADSTRUCT; +Ñòðóêòóðà DFWAD-ôàéëà âåðñèè 1: + ------------------------------------------ + SIGNATURE | Byte[5] | 'DFWAD' + VERSION | Byte | $01 + HEADER | TWADHeaderRec_1 | + RESRECORD1 | TResourceTableRec_1 | + ... | ................... | + RESRECORDN | TResourceTableRec_1 | + DATA | RAW | + ------------------------------------------ +} + +interface type SArray = array of ShortString; + Char16 = packed array[0..15] of Char; + + TWADHeaderRec_1 = packed record + RecordsCount: Word; + end; + + TResourceTableRec_1 = packed record + ResourceName: Char16; + Address: LongWord; + Length: LongWord; + end; TWADEditor_1 = class(TObject) private @@ -55,6 +83,10 @@ type property GetVersion: Byte read FVersion; end; +const + DFWAD_SIGNATURE = 'DFWAD'; + DFWAD_VERSION = $01; + const DFWAD_NOERROR = 0; DFWAD_ERROR_WADNOTFOUND = -1; diff --git a/src/shared/WADSTRUCT.pas b/src/unused/WADSTRUCT.pas similarity index 100% rename from src/shared/WADSTRUCT.pas rename to src/unused/WADSTRUCT.pas -- 2.29.2