console.pas

一个不出名的GBA模拟器

procedure logAddInteger(name: string; var d: integer);
begin
  cvars.AddObject(Lowercase(name), TConsoleEntry.Create(ctInteger, @d));
end;

//////////////////////////////////////////////////////////////////////

procedure logAddInteger(name: string; var d: integer; help: string);
begin
  cvars.AddObject(Lowercase(name), TConsoleEntry.Create(ctInteger, @d, help));
end;

//////////////////////////////////////////////////////////////////////

procedure logAddInteger(name: string; var d: integer; value, help: string);
begin
  logSetValue(cvars.AddObject(Lowercase(name), TConsoleEntry.Create(ctInteger, @d, help)), value);
end;

//////////////////////////////////////////////////////////////////////

procedure logAddString(name: string; var d: string);
begin
  cvars.AddObject(Lowercase(name), TConsoleEntry.Create(ctString, @d));
end;

//////////////////////////////////////////////////////////////////////

procedure logAddString(name: string; var d: string; help: string);
begin
  cvars.AddObject(Lowercase(name), TConsoleEntry.Create(ctString, @d, help));
end;

//////////////////////////////////////////////////////////////////////

procedure logAddString(name: string; var d: string; value, help: string);
begin
  logSetValue(cvars.AddObject(Lowercase(name), TConsoleEntry.Create(ctString, @d, help)), value);
end;

//////////////////////////////////////////////////////////////////////

procedure logAddBoolean(name: string; var d: boolean);
begin
  cvars.AddObject(Lowercase(name), TConsoleEntry.Create(ctBoolean, @d));
end;

//////////////////////////////////////////////////////////////////////

procedure logAddBoolean(name: string; var d: boolean; help: string);
begin
  cvars.AddObject(Lowercase(name), TConsoleEntry.Create(ctBoolean, @d, help));
end;

//////////////////////////////////////////////////////////////////////

procedure logAddBoolean(name: string; var d: boolean; value, help: string);
begin
  logSetValue(cvars.AddObject(Lowercase(name), TConsoleEntry.Create(ctBoolean, @d, help)), value);
end;

//////////////////////////////////////////////////////////////////////

procedure logProcessCommand(st: string);
var
  cmd, s2: string;
  i, j: integer;
begin
  // Take the first word, lowercase it and try to match it to things
  st := TrimLeft(st);
  cmd := Lowercase(FirstToken(st));
  if cmd = '' then Exit;

  case cmd[1] of
    '=': begin
      // Do an expression evaluation
      i := Pos('=', st);
      st := Copy(st, i+1, Length(st)-i);
//            logWriteLn(IntToStr(EvaluateExpression(st)));
    end;
    ':': begin
      // Enter a program statement
    end;
  else
    // Do a normal command or lookup
    if cmd[1] = '/' then Delete(cmd, 1, 1);
    i := cvars.IndexOf(cmd);
    if i > -1 then begin
      j := Pos(' ', st);

      // If its a variable and we have something to assign to it, do so
      if j > 0 then
        logSetValue(i, Copy(st, j+1, Length(st)-j));

      // Get the value / execute the function
      if (TConsoleEntry(cvars.Objects[i]).myType <> ctFunc) or (j = 0) then
        s2 := logGetValue(i)
      else
        s2 := '';

      // Unless its a function that returned '' then print the value/result
      if (TConsoleEntry(cvars.Objects[i]).myType <> ctFunc) or (s2 <> '') then
        logWriteLn(cmd + ' is ' + s2);
    end else
      logWriteLn('"' + st + '"');
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure logProcessCommandSilent(st: string);
var
  cmd: string;
  i, j: integer;
begin
  // Take the first word, lowercase it and try to match it to things
  st := TrimLeft(st);
  cmd := Lowercase(FirstToken(st));
  if cmd = '' then Exit;
  if cmd[1] = '/' then Delete(cmd, 1, 1);
  i := cvars.IndexOf(cmd);
  if i > -1 then begin
    j := Pos(' ', st);
    if j > 0 then logSetValue(i, Copy(st, j+1, Length(st)-j));
    if (TConsoleEntry(cvars.Objects[i]).myType <> ctFunc) or (j = 0) then logGetValue(i)
  end;
end;

//////////////////////////////////////////////////////////////////////

function logGetValue(name: string): string;
var
  index: integer;
begin
  index := cvars.IndexOf(name);
  if index > -1 then
    Result := TConsoleEntry(cvars.Objects[index]).GetValue
  else
    Result := '';
end;

//////////////////////////////////////////////////////////////////////

function logGetValue(index: integer): string;
begin
  Result := TConsoleEntry(cvars.Objects[index]).GetValue;
end;

//////////////////////////////////////////////////////////////////////

procedure logSetValue(name, value: string);
var
  index: integer;
begin
  index := cvars.IndexOf(name);
  if index > -1 then
    TConsoleEntry(cvars.Objects[index]).SetValue(value);
end;

//////////////////////////////////////////////////////////////////////

procedure logSetValue(index: integer; value: string);
begin
  TConsoleEntry(cvars.Objects[index]).SetValue(value);
end;

//////////////////////////////////////////////////////////////////////
// TConsoleEntry /////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

constructor TConsoleEntry.Create(typ: TConsoleType; data: pointer);
begin
  myType := typ;
  myData := data;
  help := '';
end;

//////////////////////////////////////////////////////////////////////

constructor TConsoleEntry.Create(typ: TConsoleType; data: pointer; helpInfo: string);
begin
  myType := typ;
  myData := data;
  help := helpInfo;
end;

//////////////////////////////////////////////////////////////////////

function TConsoleEntry.GetHelp: string;
begin
  Result := help;
end;

//////////////////////////////////////////////////////////////////////

function TConsoleEntry.GetValue: string;
const
  bools: array[false..true] of string = ('false', 'true');
begin
  case myType of
    ctFunc: Result := TConsoleCallback(myData)('');
    ctInteger: Result := IntToStr(integer(myData^));
    ctString: Result := string(myData^);
    ctBoolean: Result := bools[boolean(myData^)];
  else
    Result := 'error: invalid type';
  end;
end;

//////////////////////////////////////////////////////////////////////

function ExpandLine(st: string): string;
var
  i, j: integer;
  left, right: string;
begin
  i := Pos('%', st);
  while i > 0 do begin
    // l33t string magik :P
    left := Copy(st, 1, i-1);
    Delete(st, 1, i);
    j := Pos('%', st);
    if j = 0 then j := Length(st)+1;
    right := Copy(st, 1, j-1);
    Delete(st, 1, j);

    // Substitution
    i := Pos('$', st);
    st := left + logGetValue(Lowercase(right)) + right;
  end;
  Result := st;
end;

//////////////////////////////////////////////////////////////////////

procedure TConsoleEntry.SetValue(st: string);
begin
  case myType of
    ctFunc: begin
      // Call a function
      TConsoleCallback(myData)(st);
    end;
    ctInteger: begin
      // Process a command line to set the value of an integer variable
      st := Uppercase(ExpandLine(FirstToken(st)));
      if (st = 'TRUE') or (st = 'ON') or (st = 'YES') then
        integer(myData^) := 1
      else if (st = 'FALSE') or (st = 'OFF') or (st = 'NO') then
        integer(myData^) := 0
      else
        integer(myData^) := StrToIntDef(st, integer(myData^));
    end;
    ctString: begin
      // Process the command line to set a string variable
      string(myData^) := st;
    end;
    ctBoolean: begin
      // Process the command line to set a boolean variable
      st := Uppercase(ExpandLine(FirstToken(st)));
      if (st = 'TRUE') or (st = 'ON') or (st = 'YES') then
        boolean(myData^) := true
      else if (st = 'FALSE') or (st = 'OFF') or (st = 'NO') then
        boolean(myData^) := false
      else
        boolean(myData^) := StrToIntDef(st, Ord(boolean(myData^))) <> 0;
    end;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure logSetCallback(callback: TLogCallback);
begin
  logViewer := callback;
end;

//////////////////////////////////////////////////////////////////////

procedure logGetEntries(last, count: integer; list: TStrings);
var
  i: integer;
begin
  if count = 0 then Exit;
  for i := Max(last-count, 1) to Min(last, log.Count) do
    list.Add(log.Strings[i-1]);
  if currentString <> '' then list.Add(currentString);
  beenUpdated := false;
end;

//////////////////////////////////////////////////////////////////////

function logNumEntries: integer;
begin
  Result := log.Count;
  if currentString <> '' then Inc(Result);
end;

//////////////////////////////////////////////////////////////////////

function logBeenUpdated: boolean;
begin
  Result := beenUpdated;
end;

//////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

procedure InitConsole;
begin
  if not Assigned(log) then begin
    // Create the log file and associated stuff
    log := TStringList.Create;
    log.Add('Mappy VM: Logging started on ' + DateTimeToStr(Now));
    maxLogSize := 1 shl 18;
    log.Capacity := maxLogSize shr 1;
    currentString := '';

    // Create the console and associated stuff
    cvars := TStringList.Create;
    logViewer := nil;
    beenUpdated := false;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure DestroyConsole;
var
  i: integer;
begin
  log.Free;
  for i := 0 to cvars.Count-1 do
    TConsoleEntry(cvars.Objects[i]).Free;
  cvars.Free;
end;

//////////////////////////////////////////////////////////////////////

procedure logExecuteScript(filename: string);
var
  list: TStringList;
begin
  if FileExists(filename) then begin
    // Load the file into a string list and use the other function
    list := TStringList.Create;
    list.LoadFromFile(filename);
    logExecuteScript(list);
    list.Free;
  end else
    logWriteLn('ERROR: Script ' + filename + ' could not be found');
end;

//////////////////////////////////////////////////////////////////////

procedure logExecuteScript(script: TStringList);
var
  index: integer;
begin
  // Load the script and execute it
  for index := 0 to script.Count-1 do
    logProcessCommand(script.Strings[index]);
end;

//////////////////////////////////////////////////////////////////////

procedure logSaveSettings(filename: string);
var
  list: TStringList;
begin
  // Create a string list, fill it, and save it
  list := TStringList.Create;
  logSaveSettings(list);
  list.SaveToFile(filename);
  list.Free;
end;

//////////////////////////////////////////////////////////////////////

procedure logSaveSettings(script: TStringList);
var
  index: integer;
  name: string;
begin
  // Save any variables with a '$' prefix to a config file
  for index := 0 to cvars.Count-1 do begin
    name := cvars.Strings[index];
    if (name <> '') and (name[1] = '$') then begin
      if TConsoleEntry(cvars.Objects[index]).myType = ctFunc then
        script.Add(name + ' ' + logGetValue(index))
      else
        script.Add('/set ' + name + ' ' + logGetValue(index));
    end;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure logSaveLog(filename: string);
begin
  log.Add(currentString);
  log.SaveToFile(filename);
  if log.Count > 0 then log.Delete(log.Count-1);
end;

//////////////////////////////////////////////////////////////////////

procedure logClear;
begin
  log.Clear;
end;

//////////////////////////////////////////////////////////////////////

initialization
  InitConsole;
  logAddCommand('set', CFuncSetValue, 'Sets a console object to a specified value');
  logAddCommand('list', CFuncList, 'Lists all console objects in the current namespace');
  logAddCommand('help', CFuncHelp, 'Displays help for a console object if available');
  logAddCommand('clear', CFuncClear, 'Clears the console');
finalization
//  logSaveSettings(ExtractFilePath(ParamStr(0)) + 'setup.cfg');
  DestroyConsole;
end.

//////////////////////////////////////////////////////////////////////