files.pas

delphi编的不错的贪吃蛇

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): qcommon.h (part), files.c                                         }
{ Content: Quake2\QCommon\ dynamic variable tracking                         }
{                                                                            }
{ Initial conversion by : Clootie (Alexey Barkovoy) - [e-mail]     }
{ Initial conversion on : 13-Jan-2002                                        }
{                                                                            }
{ This File contains part of convertion of Quake2 source to ObjectPascal.    }
{ More information about this project can be found at:                       }
{ http://www.sulaco.co.za/quake2/                                            }
{                                                                            }
{ Copyright (C) 1997-2001 Id Software, Inc.                                  }
{                                                                            }
{ 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 2             }
{ of the License, or (at your option) any later version.                     }
{                                                                            }
{ This program is distributed in the hope that it will be useful,            }
{ but WITHOUT ANY WARRANTY; without even the implied warranty of             }
{ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                       }
{                                                                            }
{ See the GNU General Public License for more details.                       }
{                                                                            }
{----------------------------------------------------------------------------}
{ * Updated:                                                                 }
{ 1) 19-Jan-2002 - Clootie ([e-mail])                              }
{    Updated, now unit uses existing code in QCommon dir instead of stubs.   }
{ 2) 25-Feb-2002 - Clootie ([e-mail])                              }
{    Resolved all dependency to Q_Shared.pas.                                }
{ 3) 06-Jun-2002 - Juha Hartikainen ([e-mail]                     }
{  - Changed file handling from pascal style to FileOpen/FileWrite.. style,  }
{    since pascal style handles can't be checked wether they are open or not }
{  - Removed NODEPEND hack                                                   }
{ 4) 19-Jul-2002 - Sly                                                       }
{  - Uses PPointer type declaration in ref.pas                               }
{ 4) 25-Jul-2002 - burnin ([e-mail])                            }
{  - Added routines needed by menu.pas to interface section                  }
{  - Only declaring PPCharArray when not Delphi6                             }
{----------------------------------------------------------------------------}
{ * Still dependent (to compile correctly) on:                               }
{ 1) q_shwin.pas  (unit exist but doesn't compile)                           }
{ 2) cd_win.pas                                                              }
{                                                                            }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{                                                                            }
{----------------------------------------------------------------------------}

// non-dependable compilation will use STUBS for some external symbols

{$IFDEF WIN32}
{$INCLUDE ..\Jedi.inc}
{$ELSE}
{$INCLUDE ../Jedi.inc}
{$ENDIF}

unit Files;

// define this to dissalow any data but the demo pak file
//{$DEFINE NO_ADDONS}

interface

uses
  {$IFDEF LINUX}
  Libc,
  {$ENDIF}
  CVar {, ref};

// From qcommon.h, line 687
(*
==============================================================

FILESYSTEM

==============================================================
*)

procedure FS_InitFilesystem; cdecl;
procedure FS_SetGamedir(dir: PChar); cdecl;
function FS_Gamedir: PChar; cdecl;
function FS_NextPath(prevpath: PChar): PChar; cdecl;
procedure FS_ExecAutoexec; cdecl;

function FS_FOpenFile(filename: PChar; var file_: integer): Integer; cdecl;
procedure FS_FCloseFile(var file_: integer); cdecl;
// note: this can't be called from another DLL, due to MS libc issues

function FS_LoadFile(path: PChar; buffer: PPointer): Integer; cdecl;
// a null buffer will just return the file length without loading
// a -1 length is not present

procedure FS_Read(buffer: Pointer; len: Integer; var file_: integer); cdecl;
// properly handles partial reads

procedure FS_FreeFile(buffer: Pointer); cdecl;

procedure FS_CreatePath(path: PChar); cdecl;

function Developer_searchpath(who: Integer): Integer; cdecl;

function FS_ListFiles(findname: PChar; var numfiles: Integer; musthave, canthave: Cardinal): PPCharArray;

var
  file_from_pak: Integer = 0;
  fs_basedir: cvar_p;
  fs_cddir: cvar_p;
  fs_gamedirvar: cvar_p;

implementation

uses
  CPas,
  SysUtils,
  q_Shared,
  qfiles,
  {$IFDEF WIN32}
  sys_win,
  cd_win,
  q_shwin,
  {$ELSE}
  sys_linux,
  cd_sdl,
  q_shlinux,
  //libc,
  {$ENDIF}
  CMD,
  Common;

// if a packfile directory differs from this, it is assumed to be hacked
const
  // Full version
  PAK0_CHECKSUM = $40E614E0;
  // Demo
  // PAK0_CHECKSUM        = $b2c6d7ea;
  // OEM
  // PAK0_CHECKSUM        = $78e135c;

  (*
  =============================================================================

  QUAKE FILESYSTEM

  =============================================================================
  *)

type
  //
  // in memory
  //

  PackFile_p = ^PackFile_t;
  PackFile_t = record
    name: array[0..MAX_QPATH - 1] of Char;
    filepos: Integer;
    filelen: Integer;
  end;
  PackFile_a = ^PackFile_at;
  PackFile_at = array[0..MaxInt div SizeOf(PackFile_t) - 1] of PackFile_t;

  //Pfile = ^file;

  pack_p = ^pack_t;
  pack_t = record
    filename: array[0..MAX_OSPATH - 1] of Char;
    handle: Integer;
    numfiles: Integer;
    files: PackFile_a;
  end;
  //pack_t = pack_s;

type
  filelink_p = ^filelink_t;
  filelink_t = record
    next: filelink_p;
    from: PChar;
    fromlength: Integer;
    to_: PChar;
  end;
  //filelink_t = filelink_s;

var
  fs_links: filelink_p;
  fs_gamedir_: array[0..MAX_OSPATH - 1] of Char;

type
  searchpath_p = ^searchpath_t;
  searchpath_t = record
    filename: array[0..MAX_OSPATH - 1] of Char;
    pack: pack_p;                       // only one of filename / pack will be used
    next: searchpath_p;
  end;
  //searchpath_t = searchpath_s;

var
  fs_searchpaths: searchpath_p;
  fs_base_searchpaths: searchpath_p;    // without gamedirs

  (*

  All of Quake's data access is through a hierchal file system, but the contents of the file system can be transparently merged from several sources.

  The "base directory" is the path to the directory holding the quake.exe and all game directories.  The sys_* files pass this to host_init in quakeparms_t->basedir.  This can be overridden with the "-basedir" command line parm to allow code debugging in a different directory.  The base directory is
  only used during filesystem initialization.

  The "game directory" is the first tree on the search path and directory that all generated files (savegames, screenshots, demos, config files) will be saved to.  This can be overridden with the "-game" command line parameter.  The game directory can never be changed while quake is executing.  This is a precacution against having a malicious server instruct clients to write files over areas they shouldn't.

  *)

  (*
  ================
  FS_filelength
  ================
  *)

function FS_filelength(file_: Integer): Integer;
var
  CurPos: Integer;
begin
  { Get current position }
  CurPos := FileSeek(file_, 0, 1);
  { Seek to end }
  Result := FileSeek(file_, 0, 2);
  { And restore original position }
  FileSeek(file_, CurPos, 0);
end;

(*
============
FS_CreatePath

Creates any directories needed to store the given filename
============
*)

procedure FS_CreatePath(path: PChar);
var
  ofs: PChar;
begin
  // for (ofs = path+1 ; *ofs ; ofs++)
  ofs := path + 1;
  while (ofs^ <> #0) do
  begin
    if (ofs^ = '/') then
    begin                               // create the directory
      ofs^ := #0;
      Sys_Mkdir(path);
      ofs^ := '/';
    end;
    Inc(ofs)
  end;
end;

(*
==============
FS_FCloseFile

For some reason, other dll's can't just cal fclose()
on files returned by FS_FOpenFile...
==============
*)

procedure FS_FCloseFile(var file_: integer);
begin
  FileClose(file_);
  file_ := 0;
end;

// RAFAEL
(*
 Developer_searchpath
*)

function Developer_searchpath(who: Integer): Integer;
var
  //  ch: Integer;
    // PMM - warning removal
  //	char	*start;
  search: searchpath_p;
begin
  {//Clootie: code below was not used anyway
    if (who = 1) then // xatrix
      ch := 'x'
    else if (who = 2)
      ch := 'r';
  }

    // for (search = fs_searchpaths ; search ; search = search->next)
  search := fs_searchpaths;
  while (search <> nil) do
  begin
    if (StrPos(search.filename, 'xatrix') <> nil) then
    begin
      Result := 1;
      Exit;
    end;

    if (StrPos(search.filename, 'rogue') <> nil) then
    begin
      Result := 2;
      Exit;
    end;
    //Clootie: Code below was originally commented
    (*
        start = strchr (search->filename, ch);

        if (start == NULL)
                continue;

        if (strcmp (start ,"xatrix") == 0)
                return (1);
    *)
    search := search.next;
  end;
  Result := 0;
end;

(*
===========
FS_FOpenFile

Finds the file in the search path.
returns filesize and an open FILE *
Used for streaming data out of either a pak file or
a seperate file.
===========
*)

{$IFNDEF NO_ADDONS}

function FS_FOpenFile(filename: PChar; var file_: integer): Integer;
var
  search: searchpath_p;
  netpath: array[0..MAX_OSPATH - 1] of Char;
  pak: pack_p;
  i: Integer;
  link: filelink_p;
begin
  file_from_pak := 0;

  // check for links first
  // for (link = fs_links ; link ; link=link->next)
  link := fs_links;

  while (link <> nil) do
  begin
    if (strncmp(filename, link.from, link.fromlength) = 0) then // strncmp
    begin
      Com_sprintf(netpath, SizeOf(netpath), '%s%s', [link.to_, filename + link.fromlength]);
      file_ := FileOpen(netpath, fmOpenRead);
      if (file_ <> -1) then
      begin
        Com_DPrintf('link file: %s'#10, [netpath]);
        Result := FS_filelength(file_);
        Exit;
      end;
      file_ := 0;
      Result := -1;
      Exit;
    end;
    link := link.next;
  end;

  //
  // search through the path, one element at a time
  //
    // for (search = fs_searchpaths ; search ; search = search->next)
  search := fs_searchpaths;
  while (search <> nil) do
  begin
    // is the element a pak file?
    if (search.pack <> nil) then
    begin
      // look through all the pak file elements
      pak := search.pack;
      for i := 0 to pak.numfiles - 1 do
      begin
        if (Q_strcasecmp(pak.files[i].name, filename) = 0) then
        begin                           // found it!
          file_from_pak := 1;
          Com_DPrintf('PackFile: %s : %s'#10, [pak.filename, filename]);
          // open a new file on the pakfile
          file_ := FileOpen(pak.filename, fmOpenRead or fmShareDenyNone);
          if (file_ = -1) then
            Com_Error(ERR_FATAL, 'Couldn''t reopen %s', [pak.filename]);
          FileSeek(file_, pak.files[i].filepos, 0);
          Result := pak.files[i].filelen;
          Exit;
        end;
      end;
    end
    else
    begin
      // check a file in the directory tree

      Com_sprintf(netpath, SizeOf(netpath), '%s/%s', [search.filename, filename]);

      file_ := FileOpen(netpath, fmOpenRead);
      if (file_ <> -1) then
      begin
        Com_DPrintf('FindFile: %s'#10, [netpath]);

        Result := FS_filelength(file_);
        Exit;
      end;
    end;

    search := search.next;
  end;

  Com_DPrintf('FindFile: can''t find %s'#10, [filename]);
  file_ := 0;
  Result := -1;
end;

{$ELSE}

// this is just for demos to prevent add on hacking

function FS_FOpenFile(filename: PChar; var file_: integer): Integer;
var
  search: searchpath_p;
  netpath: array[0..MAX_OSPATH - 1] of Char;
  pak: pack_p;
  i: Integer;
begin
  file_from_pak := 0;

  // get config from directory, everything else from pak
  if (StrComp(filename, 'config.cfg') = 0) or (StrLComp(filename, 'players/', 8) = 0) then
  begin
    Com_sprintf(netpath, SizeOf(netpath), '%s/%s', [FS_Gamedir(), filename]);
    file_ := FileOpen(netpath, fmOpenRead);
    if (file_ = -1) then
    begin
      Result := -1;
      Exit;
    end;

    Com_DPrintf('FindFile: %s'#10, [netpath]);

    Result := FS_filelength(file_);
    Exit;
  end;

  // for (search = fs_searchpaths ; search ; search = search->next)
  search := fs_searchpaths;
  while (search <> nil) do
  begin
    if (search.pack <> nil) then
      Break;
    search := search.next;
  end;

  if (search = nil) then
  begin
    Result := -1;
    Exit;
  end;

  pak := search.pack;
  for i := 0 to pak.numfiles - 1 do
  begin
    if (Q_strcasecmp(pak.files[i].name, filename) = 0) then
    begin                               // found it!
      file_from_pak := 1;
      Com_DPrintf('PackFile: %s : %s'#10, [pak.filename, filename]);
      // open a new file on the pakfile
      file_ := FileOpen(pak.filename, fmOpenRead);
      if (file_ = -1) then
        Com_Error(ERR_FATAL, 'Couldn''t reopen %s', [pak.filename]);
      FileSeek(file_, pak.files[i].filepos, 0);
      Result := pak.files[i].filelen;
      Exit;
    end;
  end;

  Com_DPrintf('FindFile: can''t find %s'#10, [filename]);

  Result := -1;
end;

{$ENDIF}

(*
=================
FS_ReadFile

Properly handles partial reads
=================
*)
const
  MAX_READ = $10000;                    // read in blocks of 64k

procedure FS_Read(buffer: Pointer; len: Integer; var file_: integer);
var
  block, remaining: Integer;
  read: Integer;
  buf: PByte;
  tries: Integer;
begin
  buf := PByte(buffer);

  // read in chunks for progress bar
  remaining := len;
  tries := 0;
  while (remaining <> 0) do
  begin
    block := remaining;
    if (block > MAX_READ) then
      block := MAX_READ;
    read := FileRead(file_, buf^, block);
    if (read = 0) then
    begin
      // we might have been trying to read from a CD
      if (tries = 0) then
      begin
        tries := 1;
        CDAudio_Stop;
      end
      else
        Com_Error(ERR_FATAL, 'FS_Read: 0 bytes read', []);
    end;

    if (read = -1) then
      Com_Error(ERR_FATAL, 'FS_Read: -1 bytes read', []);
    if (read <> block) then
      Com_Error(ERR_FATAL, 'FS_Read: read less when requested', []);

    // do some progress bar thing here...

    remaining := remaining - read;
    Inc(buf, read);
  end;
end;

(*
============
FS_LoadFile

Filename are reletive to the quake search path
a null buffer will just return the file length without loading