cvar.pas

雷神之锤2(Quake2)Delphi源码

      Exit;
    end;
  end;

  if (not force) then
  begin
    if ((var_.flags and CVAR_NOSET) <> 0) then
    begin
      Com_Printf('%s is write protected.'#10, [var_name]);
      Result:= var_;
      Exit;
    end;

    if (var_.flags and CVAR_LATCH) <> 0 then
    begin
      if (var_.latched_string <> nil) then
      begin
        if (StrComp(value, var_.latched_string) = 0) then
        begin
          Result:= var_;
          Exit;
        end;
        Z_Free(var_.latched_string);
      end else
      begin
        if (StrComp(value, var_.string_) = 0) then
        begin
          Result:= var_;
          Exit;
        end;
      end;

      if (Com_ServerState <> 0) then
      begin
        Com_Printf('%s will be changed for next game.'#10, [var_name]);
        var_.latched_string := CopyString(value);
      end else
      begin
        var_.string_ := CopyString(value);
        var_.value := atof(var_.string_);
        if (StrComp(var_.name, 'game') = 0) then
        begin
          FS_SetGamedir(var_.string_);
          FS_ExecAutoexec ;
        end;
      end;
      Result:= var_;
      Exit;
    end;
  end else
  begin
    if (var_.latched_string <> nil) then
    begin
      Z_Free(var_.latched_string);
      var_.latched_string := nil;
    end;
  end;

  if (StrComp(value, var_.string_) = 0) then
  begin
    Result:= var_;		// not changed
    Exit;
  end;

  var_.modified := True;

  if (var_.flags and CVAR_USERINFO) <> 0 then
    userinfo_modified := True;	// transmit at next oportunity

  Z_Free(var_.string_);	// free the old value string

  var_.string_ := CopyString(value);
  var_.value := atof(var_.string_);
  Result:= var_;
end;

(*
============
Cvar_ForceSet
============
*)
function Cvar_ForceSet(var_name, value: PChar): cvar_p;
begin
  Result:= Cvar_Set2(var_name, value, true);
end;

(*
============
Cvar_Set
============
*)
function Cvar_Set(var_name, value: PChar): cvar_p;
begin
  Result:= Cvar_Set2(var_name, value, false);
end;

(*
============
Cvar_FullSet
============
*)
function Cvar_FullSet(var_name, value: PChar; flags: Integer): cvar_p;
var
  var_: cvar_p;
begin
  var_ := Cvar_FindVar(var_name);
  if (var_ = nil) then
  begin	// create it
    Result:= Cvar_Get(var_name, value, flags);
    Exit;
  end;

  var_.modified := true;

  if (var_.flags and CVAR_USERINFO) <> 0 then
    userinfo_modified := True;	// transmit at next oportunity

  Z_Free(var_.string_);	// free the old value string

  var_.string_ := CopyString(value);
  var_.value := atof(var_.string_);
  var_.flags := flags;

  Result:= var_;
end;

(*
============
Cvar_SetValue
============
*)
procedure Cvar_SetValue(var_name: PChar; value: Single);
var
  val: array[0..31] of Char;
begin
  if (value = Round(value)) then
    Com_sprintf(val, sizeof(val), '%d', [Round(value)])
  else
    Com_sprintf(val, sizeof(val), '%f', [value]);
  Cvar_Set(var_name, val);
end;


(*
============
Cvar_GetLatchedVars

Any variables with latched values will now be updated
============
*)
procedure Cvar_GetLatchedVars;
var
  var_: cvar_p;
begin
  // for (var = cvar_vars ; var ; var = var->next)
  var_ := cvar_vars;
  while (var_ <> nil) do
  begin
    if (var_.latched_string = nil) then
    begin
      var_ := var_.next;
      Continue;
    end;
    Z_Free(var_.string_);
    var_.string_ := var_.latched_string;
    var_.latched_string := nil;
    var_.value := atof(var_.string_);
    if (StrComp(var_.name, 'game') = 0) then
    begin
      FS_SetGamedir(var_.string_);
      FS_ExecAutoexec ;
    end;
    var_ := var_.next;
  end;
end;

(*
============
Cvar_Command

Handles variable inspection and changing from the console
============
*)
function Cvar_Command: qboolean;
var
  v: cvar_p;
begin
// check variables
  v := Cvar_FindVar(Cmd_Argv(0));
  if (v = nil) then
  begin
    Result:= False;
    Exit;
  end;

// perform a variable print or set
  if (Cmd_Argc = 1) then
  begin
    Com_Printf('"%s" is "%s"'#10, [v.name, v.string_]);
    Result:= True;
    Exit;
  end;

  Cvar_Set(v.name, Cmd_Argv(1));
  Result:= true;
end;


(*
============
Cvar_Set_f

Allows setting and defining of arbitrary cvars from console
============
*)
procedure Cvar_Set_f; cdecl;
var
  c: Integer;
  flags: Integer;
begin
  c := Cmd_Argc;
  if (c <> 3) and (c <> 4) then
  begin
    Com_Printf('usage: set <variable> <value> [u / s]'#10, []);
    Exit;
  end;

  if (c = 4) then
  begin
    if (StrComp(Cmd_Argv(3), 'u') = 0) then
      flags := CVAR_USERINFO
    else if (StrComp(Cmd_Argv(3), 's') = 0) then
      flags := CVAR_SERVERINFO
    else
    begin
      Com_Printf('flags can only be ''u'' or ''s'''#10, []);
      Exit;
    end;
    Cvar_FullSet(Cmd_Argv(1), Cmd_Argv(2), flags);
  end
  else
    Cvar_Set(Cmd_Argv(1), Cmd_Argv(2));
end;


(*
============
Cvar_WriteVariables

Appends lines containing "set variable value" for all variables
with the archive flag set to true.
============
*)
procedure Cvar_WriteVariables(path: PChar);
var
  var_: cvar_p;
  buffer: array[0..1024-1] of Char;
  f: Integer;
begin
  f := FileOpen(path, fmOpenWrite);
  if f = -1 then begin
    f := FileCreate(path);
  end else
    FileSeek(f, 0, 2);
  var_ := cvar_vars;
  while (var_ <> nil) do
  begin
    if ((var_.flags and CVAR_ARCHIVE) <> 0) then
    begin
      Com_sprintf(buffer, SizeOf(buffer), 'set %s "%s"'#13#10, [var_.name, var_.string_]);
      FileWrite(f, buffer, strlen(buffer));
    end;
    var_ := var_.next;
  end;
  FileClose(f);
end;

(*
============
Cvar_List_f

============
*)
procedure Cvar_List_f; cdecl;
var
  var_: cvar_p;
  i: Integer;
begin
  i := 0;
  // for (var = cvar_vars ; var ; var = var->next, i++)
  var_ := cvar_vars;
  while (var_ <> nil) do
  begin
    if (var_.flags and CVAR_ARCHIVE) <> 0
      then Com_Printf ('*', [])
      else Com_Printf (' ', []);
    if (var_.flags and CVAR_USERINFO) <> 0
      then Com_Printf('U', [])
      else Com_Printf(' ', []);
    if (var_.flags and CVAR_SERVERINFO) <> 0
      then Com_Printf('S', [])
      else Com_Printf(' ', []);
    if (var_.flags and CVAR_NOSET) <> 0
    then Com_Printf('-', [])
    else
      if (var_.flags and CVAR_LATCH) <> 0
      then Com_Printf('L', [])
      else Com_Printf(' ', []);
    Com_Printf(' %s "%s"'#10, [var_.name, var_.string_]);

    var_ := var_.next;
    Inc(i);
  end;
  Com_Printf('%d cvars'#10, [i]);
end;

function Cvar_BitInfo(bit: Integer): PChar;
{$WRITEABLECONST ON}
const
  info: array[0..MAX_INFO_STRING-1] of Char = '';
{$WRITEABLECONST OFF}
var
  var_: cvar_p;
begin
  info[0] := #0;

  // for (var = cvar_vars ; var ; var = var->next)
  var_ := cvar_vars;
  while (var_ <> nil) do
  begin
    if (var_.flags and bit) <> 0 then
      Info_SetValueForKey(info, var_.name, var_.string_);
    var_ := var_.next;
  end;
  Result:= info;
end;

// returns an info string containing all the CVAR_USERINFO cvars
function Cvar_Userinfo_: PChar;
begin
  Result:= Cvar_BitInfo(CVAR_USERINFO);
end;

// returns an info string containing all the CVAR_SERVERINFO cvars
function Cvar_Serverinfo_: PChar;
begin
  Result:= Cvar_BitInfo(CVAR_SERVERINFO);
end;

(*
============
Cvar_Init

Reads in all archived cvars
============
*)
procedure Cvar_Init;
begin
  Cmd_AddCommand('set', Cvar_Set_f);
  Cmd_AddCommand('cvarlist', Cvar_List_f);
end;

end.