observerioregs.pas

一个不出名的GBA模拟器

//////////////////////////////////////////////////////////////////////
//                                                                  //
// observerIORegs.pas: Memory mapped I/O observer                   //
//                                                                  //
// 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 observerIORegs; /////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

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

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, CheckLst, Contnrs, IniFiles,
  cpuObservers, console, nexus, AddressSpace;

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

type
  TjdevIORegs = class(TCpuObserver)
    registerSelect: TComboBox;
    curValue: TLabel;
    curRegister: TLabel;
    bitBreakdown: TCheckListBox;
    bShowSDK: TButton;
    rbNintendo: TRadioButton;
    rbMappy: TRadioButton;
    lNamingSystem: TLabel;
    procedure SelectNewRegister(Sender: TObject);

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);

    procedure ModifyRegister(Sender: TObject);
    procedure SelectMap(Sender: TObject);
    procedure ShowSDK(Sender: TObject);
  private
    useMappyNames: boolean;
    activeRegister: integer;
    regs: TObjectList;
    procedure LoadIOFile(filename: string);
  public
    procedure UpdateObserver; override;
    class function OCaption: string; override;
    procedure LoadSettings(ini: TIniFile); override;
    procedure SaveSettings(ini: TIniFile); override;
  end;

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

var
  jdevIORegs: TjdevIORegs;

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

{$R *.DFM}

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

type
  THalfwordIO = class
    address: integer;
    mnemonic: string;
    alternate: string;
    help: string;
    rwMode: string;
    name: string;
    bits: array[0..15] of string;
    readOnly: array[0..15] of boolean;
    constructor Create;
  end;

//////////////////////////////////////////////////////////////////////
// THalfwordIO ///////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

constructor THalfwordIO.Create;
var
  i: integer;
begin
  for i := 0 to 15 do readOnly[i] := false;
end;

//////////////////////////////////////////////////////////////////////
// TjdevIORegs ///////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

procedure TjdevIORegs.FormCreate(Sender: TObject);
begin
  HelpContext := LinkHelp('io_viewer.html');
  regs := TObjectList.Create;
  LoadIOFile(ExtractFilePath(ParamStr(0)) + 'mappy.io');
end;

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

procedure TjdevIORegs.FormDestroy(Sender: TObject);
begin
  regs.Free;
end;

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

procedure TjdevIORegs.FormShow(Sender: TObject);
begin
  // Pick the right names
  if useMappyNames then rbMappy.Checked := true else rbNintendo.Checked := true;
  SelectMap(Sender);

  // Update the display
  registerSelect.ItemIndex := 0;
  SelectNewRegister(nil);

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

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

class function TjdevIORegs.OCaption: string;
begin
  Result := 'IO Register Viewer';
end;

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

procedure TjdevIORegs.SelectNewRegister(Sender: TObject);
var
  item: THalfwordIO;
  index: integer;
begin
  // Look up the appropriate i/o entry
  index := registerSelect.ItemIndex;
  if index >= 0 then begin
    item := regs[index] as THalfwordIO;
    activeRegister := item.address;

    // Set the main caption
    curRegister.Caption := Format('%s (%s)', [item.name, item.rwMode]);

    // Set the bit captions and update the display
    for index := 0 to 15 do begin
      bitBreakdown.Items[index] := item.bits[index];
      bitBreakdown.ItemEnabled[index] := not item.readOnly[index];
    end;

    UpdateObserver;
  end else
    activeRegister := -1;
end;

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

procedure TjdevIORegs.UpdateObserver;
var
  hw: uint16;
  banks: TvmMemoryLock1;
  index: integer;
begin
  if activeRegister > -1 then begin
    vmLockMemory(banks);

    hw := Puint16(@(banks.iospace[activeRegister]))^;
    curValue.caption := IntToHex(hw, 4) + 'h';
    for index := 0 to 15 do
      bitBreakdown.Checked[index] := hw and (1 shl index) <> 0;

    vmUnlockMemory(banks);
  end;
end;

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

procedure TjdevIORegs.ModifyRegister(Sender: TObject);
var
  hw: uint16;
  banks: TvmMemoryLock1;
  index: integer;
begin
  if activeRegister >= 0 then begin
    hw := 0;
    for index := 0 to 15 do
      if bitBreakdown.Checked[index] then hw := hw or (1 shl index);

    vmLockMemory(banks);
    Puint16(@(banks.iospace[activeRegister]))^ := hw;
    vmUnlockMemory(banks);

    UpdateObserver;
  end;
end;

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

procedure TjdevIORegs.LoadIOFile(filename: string);
var
  item: THalfwordIO;
  i, j, k: integer;
  cmd, line, arg: string;
  map: TStringList;
  captured: boolean;
begin
  if FileExists(filename) then begin
    activeRegister := 0;
    regs.Clear;

    map := TStringList.Create;
    try
      // Load the i/o map
      map.LoadFromFile(filename);

      // Read the i/o map
      i := 0;
      item := nil;

      while i < map.count do begin
        captured := false;
        line := map.Strings[i];
        arg := ThwackString('=', line);
        cmd := Uppercase(Trim(line));
        if arg <> '' then begin
          if cmd = 'ADDR' then begin
            if item <> nil then item.address := StrToIntDef(arg, 0);
            captured := true;
          end else if cmd = 'NAME' then begin
            if item <> nil then item.name := arg;
            captured := true;
          end else if cmd = 'HELP' then begin
            if item <> nil then item.help := arg;
            captured := true;
          end else if cmd = 'REG' then begin
            item := THalfwordIO.Create;
            regs.Add(item);
            item.mnemonic := arg;
            item.alternate := arg;
            captured := true;
          end else if cmd = 'ALT' then begin
            if item <> nil then item.alternate := arg;
            captured := true;
          end else if cmd = 'MODE' then begin
            if item <> nil then item.rwMode := arg;
            captured := true;
          end;
        end;

        if (item <> nil) and (line <> '') and not captured then begin
          if arg <> '' then line := line + '=' + arg;
          arg := Trim(ThwackString(':', line));

          j := StrToIntDef(line, 0);
          if (j >= 0) and (j < 16) then begin
            // Look for the read-only flag
            k := Pos('%', arg);
            if k > 0 then begin
              Delete(arg, k, 1);
              item.readOnly[j] := true;
            end;

            // Set the caption
            item.bits[j] := arg;
          end;
        end;
        Inc(i);
      end;
    except
      on e: exception do e.Free;
    end;
    map.Free;
  end;
end;

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

procedure TjdevIORegs.SelectMap(Sender: TObject);
var
  i, lastIndex: integer;
  item: THalfwordIO;
begin
  // Add the register names to the combo box
  lastIndex := registerSelect.ItemIndex;
  registerSelect.Clear;
  for i := 0 to regs.Count - 1 do begin
    item := regs.Items[i] as THalfwordIO;
    if rbMappy.Checked then
      registerSelect.Items.Add(Format('%s [$%3.3x]', [item.mnemonic, item.address]))
    else
      registerSelect.Items.Add(Format('%s [$%3.3x]', [item.alternate, item.address]));
  end;
  useMappyNames := rbMappy.Checked;
  registerSelect.ItemIndex := lastIndex;
end;

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

procedure TjdevIORegs.LoadSettings(ini: TIniFile);
begin
  inherited;
  useMappyNames := ini.ReadBool(OCaption, 'MappyScheme', true);
end;

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

procedure TjdevIORegs.SaveSettings(ini: TIniFile);
begin
  inherited;
  ini.WriteBool(OCaption, 'MappyScheme', useMappyNames);
end;

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

procedure TjdevIORegs.ShowSDK(Sender: TObject);
var
  item: THalfwordIO;
begin
  if registerSelect.ItemIndex >= 0 then begin
    item := regs[registerSelect.ItemIndex] as THalfwordIO;
    if item.help <> '' then
      ShowWebPage('file://' + ExtractFilePath(ParamStr(0)) + item.help);
  end;
end;

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

initialization
  RegisterViewer(TjdevIORegs);
end.

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