files.pas

delphi编的不错的贪吃蛇

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

function FS_LoadFile(path: PChar; buffer: PPointer): Integer;
var
  h: integer;
  buf: PByte;
  len: Integer;
begin
  //buf := nil;	// quiet compiler warning //Clootie: not needed in Delphi

// look for it in the filesystem or pack files
  len := FS_FOpenFile(path, h);
  if (len = -1) then                    // (!h)
  begin
    if (buffer <> nil) then
      buffer^ := nil;
    Result := -1;
    Exit;
  end;

  if (buffer = nil) then
  begin
    FileClose(h);
    Result := len;
    Exit;
  end;

  buf := Z_Malloc(len);
  buffer^ := buf;

  FS_Read(buf, len, h);

  FileClose(h);

  Result := len;
end;

(*
=============
FS_FreeFile
=============
*)

procedure FS_FreeFile(buffer: Pointer);
begin
  Z_Free(buffer);
end;

(*
=================
FS_LoadPackFile

Takes an explicit (not game tree related) path to a pak file.

Loads the header and directory, adding the files at the beginning
of the list so they override previous pack files.
=================
*)

function FS_LoadPackFile(packfile: PChar): pack_p;
var
  header: dpackheader_t;
  i: Integer;
  newfiles: PackFile_a;
  numpackfiles: Integer;
  pack: pack_p;
  packhandle: integer;                  //File
  info: array[0..MAX_FILES_IN_PACK - 1] of dpackfile_t;
{$IFDEF NO_ADDONS}
  checksum: Cardinal;
{$ENDIF}
begin
  packhandle := FileOpen(packfile, fmOpenRead or fmShareDenyNone);
  if (packhandle = -1) then
  begin
    Result := nil;
    Exit;
  end;

  FileRead(packhandle, header, sizeof(header)); // fread (&header, 1, sizeof(header), packhandle);
  if (LittleLong(header.ident) <> IDPAKHEADER) then
    Com_Error(ERR_FATAL, '%s is not a packfile', [packfile]);
  header.dirofs := LittleLong(header.dirofs);
  header.dirlen := LittleLong(header.dirlen);

  numpackfiles := header.dirlen div SizeOf(dpackfile_t);

  if (numpackfiles > MAX_FILES_IN_PACK) then
    Com_Error(ERR_FATAL, '%s has %d files', [packfile, numpackfiles]);

  newfiles := Z_Malloc(numpackfiles * SizeOf(packfile_t));

  FileSeek(packhandle, header.dirofs, 0); // fseek (packhandle, header.dirofs, SEEK_SET);
  FileRead(packhandle, info, header.dirlen); // fread (info, 1, header.dirlen, packhandle);

{$IFDEF NO_ADDONS}
  // crc the directory to check for modifications
  checksum := Com_BlockChecksum(@info, header.dirlen);

  if (checksum <> PAK0_CHECKSUM) then
  begin
    Result := nil;
    Exit;
  end;

{$ENDIF}
  // parse the directory
  for i := 0 to numpackfiles - 1 do
  begin
    StrCopy(newfiles[i].name, info[i].name);
    newfiles[i].filepos := LittleLong(info[i].filepos);
    newfiles[i].filelen := LittleLong(info[i].filelen);
  end;

  pack := Z_Malloc(SizeOf(pack_t));
  StrCopy(pack.filename, packfile);
  pack.handle := packhandle;
  pack.numfiles := numpackfiles;
  pack.files := newfiles;

  Com_Printf('Added packfile %s (%d files)'#10, [packfile, numpackfiles]);
  Result := pack;
end;

(*
================
FS_AddGameDirectory

Sets fs_gamedir_, adds the directory to the head of the path,
then loads and adds pak1.pak pak2.pak ...
================
*)

procedure FS_AddGameDirectory(dir: PChar);
var
  i: Integer;
  search: searchpath_p;
  pak: pack_p;
  pakfile: array[0..MAX_OSPATH - 1] of Char;
begin
  StrCopy(fs_gamedir_, dir);

  //
  // add the directory to the search path
  //
  search := Z_Malloc(SizeOf(searchpath_t));
  StrCopy(search.filename, dir);
  search.next := fs_searchpaths;
  fs_searchpaths := search;

  //
  // add any pak files in the format pak0.pak pak1.pak, ...
  //
  for i := 0 to 9 do
  begin
    Com_sprintf(pakfile, SizeOf(pakfile), '%s/pak%d.pak', [dir, i]);
    pak := FS_LoadPackFile(pakfile);
    if (pak = nil) then
      Continue;
    search := Z_Malloc(SizeOf(searchpath_t));
    search.pack := pak;
    search.next := fs_searchpaths;
    fs_searchpaths := search;
  end;
end;

(*
============
FS_Gamedir

Called to find where to write a file (demos, savegames, etc)
============
*)

function FS_Gamedir: PChar;
begin
  if (fs_gamedir_ <> nil) then
    Result := fs_gamedir_
  else
    Result := BASEDIRNAME;
end;

(*
=============
FS_ExecAutoexec
=============
*)

procedure FS_ExecAutoexec;
var
  dir: PChar;
  name: array[0..MAX_QPATH - 1] of Char;
begin
  dir := Cvar_VariableString('gamedir');
  if (dir <> nil) then
    Com_sprintf(name, sizeof(name), '%s/%s/autoexec.cfg', [fs_basedir.string_, dir])
  else
    Com_sprintf(name, sizeof(name), '%s/%s/autoexec.cfg', [fs_basedir.string_, BASEDIRNAME]);
  if (Sys_FindFirst(name, 0, SFF_SUBDIR or SFF_HIDDEN or SFF_SYSTEM) <> nil) then
    Cbuf_AddText('exec autoexec.cfg'#10);
  Sys_FindClose;
end;

(*
================
FS_SetGamedir

Sets the gamedir and path to a different directory.
================
*)

procedure FS_SetGamedir(dir: PChar);
var
  next: searchpath_p;
begin
  if (strstr(dir, '..') <> nil) or (strstr(dir, '/') <> nil) or
    (strstr(dir, '\') <> nil) or (strstr(dir, ':') <> nil) then
  begin
    Com_Printf('Gamedir should be a single filename, not a path'#10);
    Exit;
  end;

  //
  // free up any current game dir info
  //
  while (fs_searchpaths <> fs_base_searchpaths) do
  begin
    if (fs_searchpaths.pack <> nil) then
    begin
      FileClose(fs_searchpaths.pack.handle);
      Z_Free(fs_searchpaths.pack.files);
      Z_Free(fs_searchpaths.pack);
    end;
    next := fs_searchpaths.next;
    Z_Free(fs_searchpaths);
    fs_searchpaths := next;
  end;

  //
  // flush all data, so it will be forced to reload
  //
  if (dedicated <> nil) and (dedicated.value = 0) then
    Cbuf_AddText('vid_restart'#10'snd_restart'#10);

  Com_sprintf(fs_gamedir_, SizeOf(fs_gamedir_), '%s/%s', [fs_basedir.string_, dir]);

  if (strcmp(dir, BASEDIRNAME) = 0) or (dir^ = #0) then
  begin
    Cvar_FullSet('gamedir', '', CVAR_SERVERINFO or CVAR_NOSET);
    Cvar_FullSet('game', '', CVAR_LATCH or CVAR_SERVERINFO);
  end
  else
  begin
    Cvar_FullSet('gamedir', dir, CVAR_SERVERINFO or CVAR_NOSET);
    if (fs_cddir.string_[0] <> #0) then
      FS_AddGameDirectory(va('%s/%s', [fs_cddir.string_, dir]));
    FS_AddGameDirectory(va('%s/%s', [fs_basedir.string_, dir]));
  end;
end;

(*
================
FS_Link_f

Creates a filelink_t
================
*)

procedure FS_Link_f; cdecl;
var
  l: filelink_p;
  prev: ^filelink_p;
begin
  if (Cmd_Argc <> 3) then
  begin
    Com_Printf('USAGE: link <from> <to>'#10);
    Exit;
  end;

  // see if the link already exists
  prev := @fs_links;
  // for (l=fs_links ; l ; l=l->next)
  l := fs_links;
  while (l <> nil) do
  begin
    if (strcmp(l.from, Cmd_Argv(1)) = 0) then
    begin
      Z_Free(l.to_);
      if (StrLen(Cmd_Argv(2)) = 0) then
      begin                             // delete it
        prev^ := l.next;
        Z_Free(l.from);
        Z_Free(l);
        Exit;
      end;
      l.to_ := CopyString(Cmd_Argv(2));
      Exit;
    end;
    prev := @l.next;

    l := l.next;
  end;

  // create a new link
  l := Z_Malloc(SizeOf(l^));
  l.next := fs_links;
  fs_links := l;
  l.from := CopyString(Cmd_Argv(1));
  l.fromlength := StrLen(l.from);
  l.to_ := CopyString(Cmd_Argv(2));
end;

(*
** FS_ListFiles
*)

function FS_ListFiles(findname: PChar; var numfiles: Integer; musthave, canthave: Cardinal): PPCharArray;
var
  s: PChar;
  nfiles: Integer;
  list: PPCharArray;
begin
  nfiles := 0;
  //list := nil; //Clootie: not needed in Delphi

  s := Sys_FindFirst(findname, musthave, canthave);
  while (s <> nil) do
  begin
    if (s[strlen(s) - 1] <> '.') then
      Inc(nfiles);
    s := Sys_FindNext(musthave, canthave);
  end;
  Sys_FindClose;

  if (nfiles = 0) then
  begin
    Result := nil;
    Exit;
  end;

  Inc(nfiles);                          // add space for a guard
  numfiles := nfiles;

  GetMem(list, SizeOf(PChar) * nfiles);
  FillChar(list^, SizeOf(PChar) * nfiles, 0);

  s := Sys_FindFirst(findname, musthave, canthave);
  nfiles := 0;
  while (s <> nil) do
  begin
    if (s[strlen(s) - 1] <> '.') then
    begin
      list[nfiles] := StrNew(s);        // strdup(s)
{$IFDEF WIN32}
      StrLower(list[nfiles]);           // strlwr(list[nfiles]);
{$ENDIF}
      Inc(nfiles);
    end;
    s := Sys_FindNext(musthave, canthave);
  end;
  Sys_FindClose;

  Result := list;
end;

(*
** FS_Dir_f
*)

procedure FS_Dir_f; cdecl;
var
  path: PChar;
  findname: array[0..1023] of Char;
  wildcard: array[0..1023] of Char;
  dirnames: PPCharArray;
  ndirs: Integer;
  tmp: PChar;
  i: Integer;
begin
  path := nil;
  wildcard := '*.*';

  if (Cmd_Argc <> 1) then
  begin
    StrCopy(wildcard, Cmd_Argv(1));
  end;

  path := FS_NextPath(path);
  while (path <> nil) do
  begin
    tmp := findname;

    Com_sprintf(findname, SizeOf(findname), '%s/%s', [path, wildcard]);

    while (tmp^ <> #0) do
    begin
      if (tmp^ = '\') then
        tmp^ := '/';
      Inc(tmp);
    end;
    Com_Printf('Directory of %s'#10, [findname]);
    Com_Printf('----'#10, []);

    dirnames := FS_ListFiles(findname, ndirs, 0, 0);
    if (dirnames <> nil) then
    begin
      for i := 0 to ndirs - 2 do
      begin
        if (StrRScan(dirnames[i], '/') <> nil) then // strrchr( dirnames[i], '/' )
          Com_Printf('%s'#10, [PChar(StrRScan(dirnames[i], '/') + 1)])
        else
          Com_Printf('%s'#10, [dirnames[i]]);

        StrDispose(dirnames[i]);        // free(dirnames[i]);
      end;
      FreeMem(dirnames);                // free(dirnames);
    end;
    Com_Printf(#10, []);
    path := FS_NextPath(path)
  end;
end;

(*
============
FS_Path_f

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

procedure FS_Path_f; cdecl;
var
  s: searchpath_p;
  l: filelink_p;
begin
  Com_Printf('Current search path:'#10, []);
  // for (s=fs_searchpaths ; s ; s=s->next)
  s := fs_searchpaths;
  while (s <> nil) do
  begin
    if (s = fs_base_searchpaths) then
      Com_Printf('----------'#10, []);
    if (s.pack <> nil) then
      Com_Printf('%s (%d files)'#10, [s.pack.filename, s.pack.numfiles])
    else
      Com_Printf('%s'#10, [s.filename]);
    s := s.next;
  end;

  Com_Printf(#10'Links:'#10, []);
  // for (l=fs_links ; l ; l=l->next)
  l := fs_links;
  while (l <> nil) do
  begin
    Com_Printf('%s : %s'#10, [l.from, l.to_]);
    l := l.next;
  end;
end;

(*
================
FS_NextPath

Allows enumerating all of the directories in the search path
================
*)

function FS_NextPath(prevpath: PChar): PChar;
var
  s: searchpath_p;
  prev: PChar;
begin
  if (prevpath = nil) then
  begin
    Result := fs_gamedir_;
    Exit;
  end;

  prev := fs_gamedir_;
  // for (s=fs_searchpaths ; s ; s=s->next)
  s := fs_searchpaths;
  while (s <> nil) do
  begin
    if (s.pack <> nil) then
    begin
      s := s.next;
      Continue;
    end;
    if (prevpath = prev) then
    begin
      Result := s.filename;
      Exit;
    end;
    prev := s.filename;
    s := s.next;
  end;

  Result := nil;
end;

(*
================
FS_InitFilesystem
================
*)

procedure FS_InitFilesystem;
begin
  Cmd_AddCommand('path', @FS_Path_f);
  Cmd_AddCommand('link', @FS_Link_f);
  Cmd_AddCommand('dir', @FS_Dir_f);

  //
  // basedir <path>
  // allows the game to run from outside the data tree
  //
  fs_basedir := Cvar_Get('basedir', '.', CVAR_NOSET);

  //
  // cddir <path>
  // Logically concatenates the cddir after the basedir for
  // allows the game to run from outside the data tree
  //
  fs_cddir := Cvar_Get('cddir', '', CVAR_NOSET);
  if (fs_cddir.string_[0] <> #0) then
    FS_AddGameDirectory(va('%s/' + BASEDIRNAME, [fs_cddir.string_]));

  //
  // start up with baseq2 by default
  //
  FS_AddGameDirectory(va('%s/' + BASEDIRNAME, [fs_basedir.string_]));

  // any set gamedirs will be freed up to here
  fs_base_searchpaths := fs_searchpaths;

  // check for game override
  fs_gamedirvar := Cvar_Get('game', '', CVAR_LATCH or CVAR_SERVERINFO);
  if (fs_gamedirvar.string_[0] <> #0) then
    FS_SetGamedir(fs_gamedirvar.string_);
end;

end.