jdev_main.pas

一个不出名的GBA模拟器

//////////////////////////////////////////////////////////////////////
//                                                                  //
// jdev_main.pas: Main form of the Mappy VM user interface          //
//                                                                  //
// The contents of this file are subject to the Bottled Light       //
// Public License Version 1.0 (the "License"); you may not use this //
// file except in compliance with the License. You may obtain a     //
// copy of the License at http://www.bottledlight.com/BLPL/         //
//                                                                  //
// Software distributed under the License is distributed on an      //
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or   //
// implied. See the License for the specific language governing     //
// rights and limitations under the License.                        //
//                                                                  //
// The Original Code is the Mappy VM User Interface, released       //
// April 1st, 2003. The Initial Developer of the Original Code is   //
// Bottled Light, Inc. Portions created by Bottled Light, Inc. are  //
// Copyright (C) 2001-2003 Bottled Light, Inc. All Rights Reserved. //
//                                                                  //
// Author(s):                                                       //
//   Michael Noland (joat), [e-mail]                //
//                                                                  //
// Changelog:                                                       //
//   1.0: First public release (April 1st, 2003)                    //
//                                                                  //
// Notes:                                                           //
//   The menu items should be converted to actions so MVM can use   //
//   the configuration manager in delphi 6/7 if/when development    //
//   switches to a newer version.                                   //
//                                                                  //
//   This is also as good a place as any to describe the powerful   //
//   if quirky localization system Mappy VM uses.  It allows many   //
//   VCL controls to have their text localized to a particular      //
//   language, as well as making hotkeys configurable (you have to  //
//   edit a text file to do so sadly).                              //
//                                                                  //
//   The translation system currently goes for caption, color, and  //
//   shortcut properties of any component owned by the root passed  //
//   to it in a LoadTranslation call.  This uses the undocumented   //
//   Delphi reflection units, and is NOT portable across different  //
//   versions of delphi.  As far as I know, its just a matter of    //
//   changing the unit names when going from Delphi 5 to Delphi 7,  //
//   but YMMV.  Adding other properties to the localization         //
//   capabilities is pretty easy as well, see nexus.pas for more    //
//   information on the subject (such as LoadTranslation)           //
//                                                                  //
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
unit jdev_main; //////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
interface ////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls, IniFiles, Math, Contnrs,
  ComCtrls, MMSystem, ClipBrd, sysAviWriter, console, CpuObservers,
  platformSound, platformVideo, dwarfUtils, nexus, elfUtils,
  addressSpace, dbgBreakpoints, dbgWatches, romUtils, Tools,
  fisFileNotification, ShellApi;

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

type
  // File type codes
  TSFileType = (ftROM, ftMultiboot, ftELF, ftSaveState);

  TjdevMain = class(TForm)
    mainMenu: TMainMenu;

    mFile: TMenuItem;
    mLoadFile: TMenuItem;
    mReopenFile: TMenuItem;
    mReloadFile: TMenuItem;
    mRemoveCart: TMenuItem;
    mExportDisassembly: TMenuItem;
    mCopyScreenToClipboard: TMenuItem;
    mSaveScreenshot: TMenuItem;
    mExitMappy: TMenuItem;

    mOptions: TMenuItem;
    mToggleSoundEnabled: TMenuItem;

    mView: TMenuItem;
    mClearLog: TMenuItem;

    mRun: TMenuItem;
    mRunCPU: TMenuItem;
    mStepOver: TMenuItem;
    mTraceInto: TMenuItem;
    mStepFrame: TMenuItem;
    mPauseCPU: TMenuItem;
    mResetCPU: TMenuItem;
    mEvaluateModify: TMenuItem;
    mAddBreakpoint: TMenuItem;
    mRunNFrames: TMenuItem;
    mRunNCycles: TMenuItem;
    mTraceSourceLine: TMenuItem;
    mAddWatch: TMenuItem;
    mAdvancedStuff: TMenuItem;

    mTools: TMenuItem;
    mNothingness: TMenuItem;

    mHelp: TMenuItem;
    mShowHelp: TMenuItem;
    mShowSDK: TMenuItem;
    mShowMappyPage: TMenuItem;
    mShowCommunityNews: TMenuItem;
    mShowAboutBox: TMenuItem;
    mShowCompanyPage: TMenuItem;

    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N1: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N5: TMenuItem;

    openDialog: TOpenDialog;
    saveDialog: TSaveDialog;
    status: TStatusBar;
    fileWatcher: TfisFileNotification;
    N8: TMenuItem;
    mLoadCore: TMenuItem;
    mWriteSavestate: TMenuItem;
    DwarfDebugger1: TMenuItem;

    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormPaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);

    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);

    procedure clockTimer(Sender: TObject);

    // File Menu
    procedure LoadFile(Sender: TObject);
    procedure RemoveCart(Sender: TObject);
    procedure ReloadFile(Sender: TObject);
    procedure LoadRecent(Sender: TObject);

    procedure SaveSavestate(Sender: TObject);
    procedure ExportDisassembly(Sender: TObject);

    procedure CopyScreenToClipboard(Sender: TObject);
    procedure SaveScreenshot(Sender: TObject);

    procedure ExitApplication(Sender: TObject);

    // Options Menu
    procedure ToggleSoundEnabled(Sender: TObject);

    // View Menu
    procedure ClearConsole(Sender: TObject);

    // Run Menu
    procedure RunCPU(Sender: TObject);
    procedure StepOver(Sender: TObject);
    procedure TraceInto(Sender: TObject);
    procedure TraceToSourceLine(Sender: TObject);
    procedure StepOneFrame(Sender: TObject);
    procedure PauseCPU(Sender: TObject);
    procedure ResetCPU(Sender: TObject);
    procedure EvaluateModify(Sender: TObject);
    procedure AddAWatch(Sender: TObject);
    procedure AddABreakpoint(Sender: TObject);
    procedure RunNCycles(Sender: TObject);
    procedure RunNFrames(Sender: TObject);

    // Tools Menu

    // Help Menu
    procedure ShowHelp(Sender: TObject);
    procedure ShowSDK(Sender: TObject);
    procedure ShowCompanyPage(Sender: TObject);
    procedure ShowMappyPage(Sender: TObject);
    procedure ShowCommunityNews(Sender: TObject);
    procedure ShowAboutBox(Sender: TObject);

    // Directory watching
    procedure OnDirectoryChange(Sender: TObject);

    procedure mNothingnessClick(Sender: TObject);
    procedure LoadNewCore(Sender: TObject);
    procedure DwarfDebugger1Click(Sender: TObject);
  private
    function LoadInBinary(filename: string): boolean;
    procedure LoadSavestate(filename: string; stream: TStream);
    procedure ExecuteCleanup;
  public
    lastFileAge: integer;
    cartLoaded: boolean;
    appFocused: boolean;

    mruList: TStringList;

    keyMask: uint16;
    downkeys: uint16;
    isActive: boolean;

    // Graphics related stuff
    dontResize: boolean;

    // Contains the dynamic menu items, since they must be freed
    menuViewers: TObjectList;
    procedure OnViewerClick(Sender: TObject);

    // Drag-drop handler
    procedure FileDropHandler(var msg: TMessage); message WM_DROPFILES;

    // Most recently used file list
    procedure RebuildMRUList;

    // Plugin list
    procedure RebuildPluginList;
    procedure OnTriggerPluginClick(Sender: TObject);

    procedure OnIdle(Sender: TObject; var Done: Boolean);
    procedure OnActivateApp(sender: TObject);
    procedure OnDeactivateApp(sender: TObject);
    function OnShowHelp(Command: word; Data: longint; var CallHelp: boolean): boolean;

    procedure LoadCore(filename: string);
    procedure UnloadCore;
    procedure SaveCartInfo;
    procedure LoadCartInfo;
  end;

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

var
  jdevMain: TjdevMain;
  clockMutex: boolean = true;
  fps: double;

  // File locations
  lastRomFilename: string;
  lastScreenshotFilename: string;

//////////////////////////////////////////////////////////////////////
implementation ///////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

uses
  jdevAboutBox, jdevDwarfDebugger, debugBreakpointProperties,
  debugWatchProperties, observerCSource, jdevSplashScreen,
  jdevCapture, jdevEvalModify, VideoOptions, AudioOptions,
  DebugOptions, JoypadOptions, observerBreakpointList,
  observerWatchList, jdevDisassemblyDialog, GeneralOptions,
  debugFindPattern;

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

{$R *.DFM}
{$R jdev2.res}

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

procedure OnConsoleReady(line: PChar);
begin
  logWrite(line);
end;

//////////////////////////////////////////////////////////////////////
// Form Events ///////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

procedure TjdevMain.FormCreate(Sender: TObject);
var
  i: integer;
  item: TMenuItem;
begin
  HelpContext := LinkHelp('index.html');
  cartLoaded := false;

  // Platform graphics code
  dontResize := false;

  // Application events
  appFocused := true;
  Application.OnHelp := OnShowHelp;

  // Drag-drop support
  DragAcceptFiles(Handle, true);

  // Key input
  keyMask := $03FF;

  // MRU file list
  mruList := TStringList.Create;

  // Create the viewer menu
  menuViewers := TObjectList.Create;
  observers.Sort;
  for i := 0 to observers.Count-1 do begin
    item := NewItem(observers.Strings[i], 0, false, true, OnViewerClick, i, 'oviewer'+IntToStr(i));
    menuViewers.Add(item);
    mView.Add(item);
  end;

  // Create the options menu
  guiObservers.Sort;
  for i := 0 to guiObservers.Count-1 do begin
    item := NewItem(guiObservers.Strings[i], 0, false, true, OnViewerClick, i, 'odialog'+IntToStr(i));
    menuViewers.Add(item);
    mOptions.Add(item);
  end;

  // Populate the tools menu
  EnumeratePlugins;
  RebuildPluginList;
end;

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

procedure TjdevMain.FormShow(Sender: TObject);
var
  i: integer;
  st: string;
begin
  // Find a suitable MVM core
  st := ExtractFilePath(ParamStr(0)) + 'core/standard.cor';
  if not FileExists(st) then st := st + 'e';
  if not FileExists(st) then st := ExtractFilePath(ParamStr(0)) + 'core/vmcore.dll';
  if not FileExists(st) then begin
    ShowMessage('Could not find a suitable core file, terminating!');
    Halt;
  end;
//  st := ExtractFilePath(ParamStr(0)) + 'core/vmcore.dll';
  LoadCore(st);

  // Load the translation
  LoadTranslation(self, translation);

//fixme, get a new license here: if showSplashScreen then jdevSplash.ShowModal;
  if not runOnce then begin
    // show several options that can be changed fixme findme todo
  end;

  // Handle command line parameters
  for i := 1 to ParamCount do begin
    st := ParamStr(i);
    if st[1] = '-' then begin
       Delete(st, 1, 1);
      logProcessCommand(st);
    end else if FileExists(st) then
      LoadInBinary(st);
  end;

  clockMutex := false;
end;

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

procedure TjdevMain.FormResize(Sender: TObject);
begin
  if not dontResize then begin
    screenWidth := ClientWidth;
    screenHeight := ClientHeight - status.Height;
    status.Panels[1].Text := Format(' Screen: %d x %d', [screenWidth, screenHeight]);
    Repaint;
  end;
end;

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

procedure TjdevMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  clockMutex := true;
  isActive := false;

  RemoveCart(Sender);

  UnloadCore;
end;

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

procedure TjdevMain.FormPaint(Sender: TObject);
begin
  platformRenderScreen;
end;

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

procedure TjdevMain.FormDestroy(Sender: TObject);
begin
  menuViewers.Free;
  mruList.Free;
end;

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

procedure TjdevMain.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  i: integer;
begin
  for i := 0 to 9 do
    if Key = keyCodes[i] then keyMask := keyMask and not (1 shl i);

  if downkeys <> keyMask then begin
    downkeys := keyMask;
    vmKeyInput(keyMask);
  end;
end;

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

procedure TjdevMain.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  i: integer;
begin
  for i := 0 to 9 do
    if Key = keyCodes[i] then keyMask := keyMask or (1 shl i);

//  if Key = captureToggleKey then ToggleMovieCapture(nil);

  if downkeys <> keyMask then begin
    downkeys := keyMask;
    vmKeyInput(keyMask);
  end;
end;

//////////////////////////////////////////////////////////////////////
// File Menu Actions /////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

procedure TjdevMain.LoadFile(Sender: TObject);
begin
  openDialog.Filter := 'Binaries|*.bin;*.gba;*.agb;*.mb;*.elf;*.jst|All files|*.*';
  openDialog.DefaultExt := 'bin';
  openDialog.FileName := lastRomFilename;
  if openDialog.Execute then LoadInBinary(openDialog.FileName);
end;

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

procedure TjdevMain.RemoveCart(Sender: TObject);
begin
  if cartLoaded then begin
    cartLoaded := false;
    SaveCartInfo;
    vmRemoveCartridge;

    if Assigned(dwarf) then dwarf.Free;  dwarf := nil;
    if Assigned(elf) then elf.Free;      elf := nil;

    Caption := 'Mappy VM';
    UpdateObservers;
  end;
end;

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

procedure TjdevMain.ReloadFile(Sender: TObject);
begin
  LoadInBinary(lastRomFilename);