nexus.pas

一个不出名的GBA模拟器

//////////////////////////////////////////////////////////////////////
//                                                                  //
// nexus.pas: Mappy VM core interface and common utility functions  //
//                                                                  //
// 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:                                                           //
//   None at present.                                               //
//                                                                  //
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
unit nexus; //////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

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

uses
  Windows, Classes, Menus, Graphics, SysUtils, ShellApi, TypInfo,
  AddressSpace;

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

type
  TvmPluginHeader = packed record
    // Filled in by the plugin writer
    author: PChar;
    name: PChar;
    version: integer;
    description: PChar;

    Init: procedure; cdecl;
    Destroy: procedure; cdecl;

    // The caption to display in the tools menu (return nil
    // if there is no OnUpdate), not implemented yet
    ObserverCaption: PChar;
    Update: procedure; cdecl;

    // the caption for ShowConfig (return nil if theres no config.)
    configCaption: PChar;
    ShowConfig: procedure; cdecl;

    // the caption for Trigger (return nil if there is no trigger)
    triggerCaption: PChar;
    Trigger: procedure; cdecl;

    // Filled in by Mappy VM
    mem: TvmMemoryLock1;
    OnStatus: function (progress: integer): boolean; cdecl;
//    OnClose: procedure; cdecl;
//    LogWrite(st: PChar);
  end;
  PvmPluginHeader = ^TvmPluginHeader;


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

var
  vmReset: procedure ;
  vmExecute: function (numCycles: integer): uint32;
  vmStep: procedure ;
  vmGetRegister: function (index: uint32): uint32;
  vmGetRegisters: procedure (var copy: TvmRegisterFile);
  vmSetRegister: procedure (index, value: uint32);
  vmSetRegisters: procedure (const copy: TvmRegisterFile);
  vmStartProfile: function : TvmProfileToken;
  vmStopProfile: function (const token: TvmProfileToken): int64;
  vmCurrentPC: function : uint32;
  vmHitBP: function : boolean;
  vmRenderFrame: procedure;

  vmGetLayerID: function (x: integer): byte;
  vmDrawScanline: function (y, width: integer): Puint16;
  vmRenderSprite: procedure (i: integer; y: integer; line: Puint16);

  vmReadByte: function (address: uint32): uint8;
  vmReadHalfword: function (address: uint32): uint16;
  vmReadWord: function (address: uint32): uint32;
  vmWriteByte: procedure (address: uint32; data: uint8);
  vmWriteHalfword: procedure (address: uint32; data: uint16);
  vmWriteWord: procedure (address: uint32; data: uint32);
  vmAddBreakpoint: procedure (address: uint32; soft: boolean);
  vmRemoveBreakpoint: procedure (address: uint32; mask: TBreakpointModes);
  vmSoftBreakpoints: procedure (active: boolean);
  vmIsBreakpoint: function (address: uint32): TBreakpointModes;
  vmInsertCartridge: procedure (data: pointer; size: integer);
  vmRemoveCartridge: procedure;
  vmLockMemory: procedure (var banks: TvmMemoryLock1);
  vmUnlockMemory: procedure (const banks: TvmMemoryLock1);

  vmKeyInput: procedure (mask: integer);

  vmSetOnSound: procedure (callback: TvmOnSoundReady);
  vmSetOnVideo: procedure (callback: TvmOnVideoReady);
  vmSetOnConsole: procedure (callback: TvmOnConsoleReady);

  vmSetAudioRate: procedure (cyclesPerSample: integer);
  vmGetAudioData: procedure (var data: pointer; var length: integer);

  vmGetCartInfo: function (info: PvmOpaqueChunk): integer;
  vmSetCartInfo: procedure (size: integer; info: PvmOpaqueChunk);
  vmSaveState: function (save: PvmSavestate): integer;
  vmLoadState: procedure (save: PvmSavestate);

  vmGetOption: function (st: PChar): boolean;
  vmSetOption: procedure (st: PChar; enabled: boolean);

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

var
  coreLoaded: boolean;
  cpuSourceDebug: boolean;
  helpFiles: TStringList;
  translation: TStringList;
  appIniFile: string;

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

procedure vmLoadCore(filename: PChar);
procedure vmUnloadCore;
function LinkHelp(url: string): integer;
procedure ShowWebPage(url: string);

procedure LoadTranslation(root: TComponent; list: TStringList);
procedure SaveTranslation(root: TComponent; list: TStringList);

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

var
  DLLHandle: uint32;

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

function LinkHelp(url: string): integer;
var
  i: integer;
begin
  url := 'file://' + ExtractFilePath(ParamStr(0)) + 'help/' + url;
  i := helpFiles.IndexOf(url);
  if i = -1 then i := helpFiles.Add(url);
  Result := i+1;
end;

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

procedure ShowWebPage(url: string);
begin
  ShellExecute(0, nil, PChar(url), nil, nil, SW_NORMAL);
end;

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

procedure vmLoadCore(filename: PChar);
begin
  if coreLoaded then vmUnloadCore;

  DLLHandle := LoadLibrary(filename);
  if DLLHandle >= 32 then begin
    vmReset := GetProcAddress(DLLHandle,            'vmReset');
    vmExecute := GetProcAddress(DLLHandle,          'vmExecute');
    vmStep := GetProcAddress(DLLHandle,             'vmStep');
    vmGetRegister := GetProcAddress(DLLHandle,      'vmGetRegister');
    vmGetRegisters := GetProcAddress(DLLHandle,     'vmGetRegisters');
    vmSetRegister := GetProcAddress(DLLHandle,      'vmSetRegister');
    vmSetRegisters := GetProcAddress(DLLHandle,     'vmSetRegisters');
    vmStartProfile := GetProcAddress(DLLHandle,     'vmStartProfile');
    vmStopProfile := GetProcAddress(DLLHandle,      'vmStopProfile');
    vmCurrentPC := GetProcAddress(DLLHandle,        'vmCurrentPC');
    vmHitBP := GetProcAddress(DLLHandle,            'vmHitBP');
    vmRenderFrame := GetProcAddress(DLLHandle,      'vmRenderFrame');

    vmGetLayerID := GetProcAddress(DLLHandle,       'vmGetLayerID');
    vmDrawScanline := GetProcAddress(DLLHandle,     'vmDrawScanline');
    vmRenderSprite := GetProcAddress(DLLHandle,     'vmRenderSprite');

    vmReadByte := GetProcAddress(DLLHandle,         'vmReadByte');
    vmReadHalfword := GetProcAddress(DLLHandle,     'vmReadHalfword');
    vmReadWord := GetProcAddress(DLLHandle,         'vmReadWord');
    vmWriteByte := GetProcAddress(DLLHandle,        'vmWriteByte');
    vmWriteHalfword := GetProcAddress(DLLHandle,    'vmWriteHalfword');
    vmWriteWord := GetProcAddress(DLLHandle,        'vmWriteWord');
    vmAddBreakpoint := GetProcAddress(DLLHandle,    'vmAddBreakpoint');
    vmRemoveBreakpoint := GetProcAddress(DLLHandle, 'vmRemoveBreakpoint');
    vmSoftBreakpoints := GetProcAddress(DLLHandle,  'vmSoftBreakpoints');
    vmIsBreakpoint := GetProcAddress(DLLHandle,     'vmIsBreakpoint');
    vmInsertCartridge := GetProcAddress(DLLHandle,  'vmInsertCartridge');
    vmRemoveCartridge := GetProcAddress(DLLHandle,  'vmRemoveCartridge');
    vmLockMemory := GetProcAddress(DLLHandle,       'vmLockMemory');
    vmUnlockMemory := GetProcAddress(DLLHandle,     'vmUnlockMemory');

    vmKeyInput := GetProcAddress(DLLHandle,         'vmKeyInput');

    vmSetOnSound := GetProcAddress(DLLHandle,       'vmSetOnSound');
    vmSetOnVideo := GetProcAddress(DLLHandle,       'vmSetOnVideo');
    vmSetOnConsole := GetProcAddress(DLLHandle,     'vmSetOnConsole');

    vmSetAudioRate := GetProcAddress(DLLHandle,     'vmSetAudioRate');
    vmGetAudioData := GetProcAddress(DLLHandle,     'vmGetAudioData');

    vmGetCartInfo := GetProcAddress(DLLHandle,      'vmGetCartInfo');
    vmSetCartInfo := GetProcAddress(DLLHandle,      'vmSetCartInfo');
    vmSaveState := GetProcAddress(DLLHandle,        'vmSaveState');
    vmLoadState := GetProcAddress(DLLHandle,        'vmLoadState');

    vmGetOption := GetProcAddress(DLLHandle,        'vmGetOption');
    vmSetOption := GetProcAddress(DLLHandle,        'vmSetOption');

    coreLoaded := true;
  end else
    coreLoaded := false;
end;

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

procedure vmUnloadCore;
begin
  FreeLibrary(DLLHandle);
  coreLoaded := false;
end;

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

function SplitString(var st: string): string;
var
  i: integer;
begin
  i := Pos('.', st);
  Result := Copy(st, 1, i-1);
  Delete(st, 1, i);
end;

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

procedure LoadTranslation(root: TComponent; list: TStringList);
var
  i: integer;
  c: TComponent;
  prop: string;
begin
  for i := 0 to list.Count - 1 do begin
    prop := list.Names[i];
    if SplitString(prop) = root.Name then begin
      c := root.FindComponent(SplitString(prop));
      if assigned(c) then begin
        if prop = 'caption' then
          SetStrProp(c, prop, list.values[list.Names[i]])
        else if prop = 'shortcut' then
          SetOrdProp(c, prop, TextToShortCut(list.values[list.names[i]]))
        else if prop = 'color' then
          SetOrdProp(c, prop, StringToColor(list.values[list.names[i]]));
      end;
    end;
  end;
end;

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

procedure SaveTranslation(root: TComponent; list: TStringList);
var
  i: integer;
  c: TComponent;
  st: string;
begin
  for i := 0 to root.ComponentCount - 1 do begin
    c := root.Components[i];
    if c.Name <> '' then begin
      if IsPublishedProp(c, 'caption') then begin
        st := GetStrProp(c, 'caption');
        if (st <> '') and (st <> '-') then list.add(root.Name + '.' + c.Name + '.caption=' + st);
      end else st := '';
      if st <> '-' then begin
        if IsPublishedProp(c, 'shortcut') then list.add(root.Name + '.' + c.Name + '.shortcut=' + ShortCutToText(GetOrdProp(c, 'shortcut')));
        if IsPublishedProp(c, 'color') then list.add(root.Name + '.' + c.Name + '.color=' + ColorToString(GetOrdProp(c, 'color')));
      end;
    end;
  end;
end;

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

initialization
  helpFiles := TStringList.Create;
  translation := TStringList.Create;
  if FileExists(ExtractFilePath(ParamStr(0)) + 'baseline.trs') then
    translation.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'baseline.trs');
  appIniFile := ExtractFilePath(ParamStr(0)) + 'settings.ini';
finalization
  translation.Free;
  helpFiles.Free;
  if coreLoaded then vmUnloadCore;
end.

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