jdev_main.pas

一个不出名的GBA模拟器

end;

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

procedure TjdevMain.LoadRecent(Sender: TObject);
var
  name: string;
  i: integer;
begin
  name := StripHotKey(TMenuItem(Sender).Caption);
  if not LoadInBinary(name) then begin
    i := mruList.IndexOf(name);
    mruList.Delete(i);
    RebuildMRUList;
  end;
end;

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

procedure TjdevMain.ExportDisassembly(Sender: TObject);
begin
  jdevDisasmDialog.Show;
end;

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

procedure TjdevMain.CopyScreenToClipboard(Sender: TObject);
var
  myFormat: word;
  data: THandle;
  pal: HPalette;
begin
  displayBMP.SaveToClipBoardFormat(myFormat, data, pal);
  clipboard.SetAsHandle(myFormat, data);
end;

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

procedure TjdevMain.SaveScreenshot(Sender: TObject);
begin
  saveDialog.Filter := 'Bitmap Images|*.bmp|All files|*.*';
  saveDialog.filename := lastScreenshotFilename;
  saveDialog.DefaultExt := 'bmp';
  if saveDialog.Execute then displayBMP.SaveToFile(saveDialog.FileName);
  lastScreenshotFilename := saveDialog.filename;
end;

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

procedure TjdevMain.ExitApplication(Sender: TObject);
begin
  Close;
end;

//////////////////////////////////////////////////////////////////////
// Options Menu Actions //////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

procedure TjdevMain.ToggleSoundEnabled(Sender: TObject);
begin
  mToggleSoundEnabled.Checked := not mToggleSoundEnabled.Checked;
  sysSound.enabled := mToggleSoundEnabled.Checked;
end;

//////////////////////////////////////////////////////////////////////
// View Menu Actions /////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

procedure TjdevMain.ClearConsole(Sender: TObject);
begin
  logProcessCommand('clear');
end;

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

procedure TjdevMain.OnViewerClick(Sender: TObject);
var
  ref: TCpuObserver;
  item: TMenuItem;
begin
  item := Sender as TMenuItem;
  if item.checked then begin
    ref := FindObserver(StripHotKey(item.Caption));
    if ref <> nil then
      if ref.CloseQuery then begin
        ref.Close;
        item.checked := false;
      end;
  end else begin
    CreateObserver(StripHotKey(item.Caption), item);
  end;
end;

//////////////////////////////////////////////////////////////////////
// Run Menu Actions //////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

procedure TjdevMain.RunCPU(Sender: TObject);
begin
  ClearTempBreakpoint;
  isActive := true;
end;

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

procedure TjdevMain.StepOver(Sender: TObject);
var
  address: uint32;
begin
  ClearTempBreakpoint;

  // Figure out where to set a temporary breakpoint
  // (2 for thumb, 4 for arm or thumb BL)
  address := vmCurrentPC + 2;
  if (vmGetRegister(CPSR) and SR_T = 0) then
    Inc(address, 2)
  else if (vmReadHalfword(vmCurrentPC) and $F800 = $F000) then
    Inc(address, 2);

  // Add a breakpoint and make a note to remove it if needed
  SetTempBreakpoint(address);
  isActive := true;
end;

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

procedure TjdevMain.TraceInto(Sender: TObject);
begin
  ClearTempBreakpoint;

  vmStep;
  ExecuteCleanup;

  isActive := false;
  UpdateObservers;
end;

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

procedure TjdevMain.TraceToSourceLine(Sender: TObject);
begin
  cpuSourceDebug := true;
  vmSoftBreakpoints(cpuSourceDebug);
  isActive := true;
end;

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

procedure TjdevMain.StepOneFrame(Sender: TObject);
begin
  // Run one frame
  ClearTempBreakpoint;
  vmRenderFrame;
  ExecuteCleanup;
  isActive := false;

  // Update the observers
  UpdateObservers;
end;

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

procedure TjdevMain.PauseCPU(Sender: TObject);
begin
  isActive := false;
end;

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

procedure TjdevMain.ResetCPU(Sender: TObject);
begin
  vmReset;
  isActive := false;
  UpdateObservers;
end;

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

procedure TjdevMain.EvaluateModify(Sender: TObject);
begin
  jdevModify.Show;
end;

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

procedure TjdevMain.AddAWatch(Sender: TObject);
var
  watchProperties: TdbgWatchProperties;
begin
  Application.CreateForm(TdbgWatchProperties, watchProperties);
  watchProperties.watch := TWatch.Create;
  AddWatch(watchProperties.watch);
  watchProperties.Show;
  UpdateObservers;
end;

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

procedure TjdevMain.AddABreakpoint(Sender: TObject);
var
  bpProperties: TdbgBreakpointProperties;
begin
  Application.CreateForm(TdbgBreakpointProperties, bpProperties);
  bpProperties.bp := TBreakpoint.Create;
  AddBreakpoint(bpProperties.bp);
  bpProperties.Show;
  UpdateObservers;
end;

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

procedure TjdevMain.RunNCycles(Sender: TObject);
var
  st: string;
  cycs: integer;
begin
  try
    // Offer an input box for the user to enter a cycle count
    st := InputBox('Mappy', 'Enter the number of cycles to process:', '10');
    cycs := StrToIntDef(st, 1);

    // Run 'n' cycles
    if cycs < 0 then cycs := 1;
    isActive := true;
    vmExecute(cycs);
    ExecuteCleanup;
    isActive := false;

    // Update the observers
    UpdateObservers;
  except
    on e: EConvertError do ShowMessage('The number of cycles must be a positive integer.');
  end;
end;

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

procedure TjdevMain.RunNFrames(Sender: TObject);
var
  st: string;
  frames: integer;
begin
  // Offer an input box for the user to enter a frame count
  st := InputBox('Mappy', 'Enter the number of frames to process:', '10');
  frames := StrToIntDef(st, 1);

  // Process 'n' frames, allowing windows to get a word in edgewise
  // every so often.
  isActive := true;
  while isActive and (frames > 0) do begin
    vmRenderFrame;
    ExecuteCleanup;

    Dec(frames);
    if frames and 7 = 0 then begin
      Application.ProcessMessages;
      UpdateObservers;
    end;
  end;
  isActive := false;
end;

//////////////////////////////////////////////////////////////////////
// Tools Menu Actions ////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
// Help Menu Actions /////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

procedure TjdevMain.ShowHelp(Sender: TObject);
begin
  ShowWebPage(helpFiles.strings[HelpContext-1]);
end;

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

procedure TjdevMain.ShowSDK(Sender: TObject);
begin
  ShowWebPage('file://' + ExtractFilePath(ParamStr(0)) + 'sdk/index.html');
end;

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

procedure TjdevMain.ShowCompanyPage(Sender: TObject);
begin
  ShowWebPage('http://www.bottledlight.com/index.html');
end;

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

procedure TjdevMain.ShowMappyPage(Sender: TObject);
begin
  ShowWebPage('http://www.bottledlight.com/mappy/index.html');
end;

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

procedure TjdevMain.ShowCommunityNews(Sender: TObject);
begin
  ShowWebPage('http://www.gbadev.org/');
end;

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

procedure TjdevMain.showAboutBox(Sender: TObject);
begin
  jdevAbout.ShowModal;
end;

//////////////////////////////////////////////////////////////////////
// Misc. events //////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

procedure TjdevMain.FileDropHandler(var msg: TMessage);
var
  number: integer;
  filename: string;
begin
  SetLength(filename, 256);
  number := DragQueryFile(msg.wparam, $FFFFFFFF, PChar(filename), 255);
  if number > 0 then begin
    DragQueryFile(msg.wparam, 0, PChar(filename), 255);
    LoadInBinary(filename);
  end;
end;

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

procedure TjdevMain.OnDirectoryChange(Sender: TObject);
begin
  Beep;
  if lastFileAge <> FileAge(lastRomFilename) then begin
    caption := inttostr(lastFileAge);
    if MessageDlg('Image ' + lastRomFilename + '''s time/date changed.  Reload?', mtInformation, [mbYes, mbNo], 0) = mrYes then begin
      ReloadFile(Sender);
      lastFileAge := FileAge(lastRomFilename);
    end;
  end;
end;

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

procedure TjdevMain.OnActivateApp(sender: TObject);
begin
  sysSound.enabled := mToggleSoundEnabled.Checked;
  appFocused := true;
end;

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

procedure TjdevMain.OnDeactivateApp(sender: TObject);
begin
  sysSound.enabled := false;
  appFocused := false;
end;

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

function TjdevMain.OnShowHelp(Command: word; Data: longint; var CallHelp: boolean): boolean;
begin
  CallHelp := false;
  if (data <= helpFiles.Count) and (data > 0) then ShowWebPage(helpFiles.strings[data-1]);
  Result := true;
end;

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

procedure TjdevMain.ExecuteCleanup;
var
  bp: TBreakpoint;
begin
  if vmHitBP then begin
    if IsTempBreakpoint then
      isActive := false
    else begin
      bp := FindBreakpoint(vmCurrentPC);
      if bp <> nil then
        if bp.TriggerBP then begin
          ShowMessage('Breakpoint at ' + IntToHex(vmCurrentPC, 8) + ' encountered');
          isActive := false;
        end;
    end;
  end;
  cpuSourceDebug := cpuSourceDebug and isActive;
  if dwarf <> nil then cpuSourceDebug := isActive;
  vmSoftBreakpoints(cpuSourceDebug);
end;

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

// Translates a file name into a file type based solely on the extension
// Further refinement is neccecary for them anyways, but this is a start
function SimpleFileType(filename: string): TSFileType;
const
  exts: array[0..5] of string = ('.BIN', '.GBA', '.AGB', '.MB', '.ELF', '.JST');
  typs: array[0..5] of TSFileType = (ftROM, ftROM, ftROM, ftMultiboot, ftELF, ftSaveState);
var
  i: integer;
begin
  i := 0;
  filename := Uppercase(ExtractFileExt(filename));
  while i <= 5 do begin
    if filename = exts[i] then Break;
    Inc(i);
  end;
  if i > 5 then i := 0;
  Result := typs[i];
end;

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

procedure TjdevMain.LoadSavestate(filename: string; stream: TStream);
var
  save: PvmSavestate;
  data: Puint8array;
  size: integer;
  st: string;
begin
  size := stream.Size;
  GetMem(save, size);
  stream.Read(save^, stream.size);
  stream.Free;

  if save^.cartLoaded then begin
    st := ExtractFilePath(filename) + save^.filename;
    if FileExists(st) then begin
      stream := TFileStream.Create(st, fmOpenRead or fmShareDenyNone);
      GetMem(data, stream.size);
      stream.Read(data^, stream.size);
      vmInsertCartridge(data, stream.size);
      FreeMem(data, stream.size);
      stream.Free;

      if autopatchLogo then PatchHeader;

      if save^.crc <> CrcROM then
        logWriteLn('LoadSavestate: Error, image CRC does not match stored value');
    end else
      logWriteLn('LoadSavestate: Error, could not load image "' + st + '"');
  end;

  vmLoadState(save);
  FreeMem(save);
end;

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

function TjdevMain.LoadInBinary(filename: string): boolean;
var
  stream: TFileStream;
  data: Puint8array;
  banks: TvmMemoryLock1;
  size: integer;
  typ: TSFileType;
begin
  Result := false;
  if not FileExists(filename) then begin
    logWriteLn('Error: File "' + filename + '" not found!');
    Exit;
  end;
  RemoveCart(nil);

  typ := SimpleFileType(filename);

  fileWatcher.Stop;
  isActive := false;