observervram.pas

来自「一个不出名的GBA模拟器」· PAS 代码 · 共 892 行 · 第 1/2 页

//////////////////////////////////////////////////////////////////////
//                                                                  //
// observerVRAM.pas: VRAM observer (all video modes)                //
//                                                                  //
// 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:                                                           //
//   When this observer is active, it slows everything down         //
//   considerably, its probably a good candidate for optimization.  //
//                                                                  //
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
unit observerVRAM; ///////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

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

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, IniFiles, CheckLst, StdCtrls, ComCtrls, Menus, ExtCtrls,
  Math, ClipBrd, CpuObservers, console, nexus, AddressSpace;

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

type
  TjdevVRAMViewer = class(TCpuObserver)
    pages: TPageControl;
    pTileMap: TTabSheet;
    pTiles: TTabSheet;
    pSprites: TTabSheet;
    pFramebuffer: TTabSheet;
    rMode3: TRadioButton;
    rMode4fb0: TRadioButton;
    rMode5fb0: TRadioButton;
    Label1: TLabel;
    rMode5fb1: TRadioButton;
    rMode4fb1: TRadioButton;
    cbScreenSize: TComboBox;
    cbTileMap: TComboBox;
    cbTileSet: TComboBox;
    cbBackgrounds: TComboBox;
    loadBGButton: TButton;
    r16Colors: TRadioButton;
    r256Colors: TRadioButton;
    lMapLocation: TLabel;
    lTilesetLocation: TLabel;
    lScreenSize: TLabel;
    lGeneral: TLabel;
    rWraparound: TCheckBox;
    lColorMode: TLabel;
    rRotScale: TCheckBox;
    lxferSettings: TLabel;
    bevel: TBevel;
    image: TPaintBox;
    horizScroll: TScrollBar;
    vertScroll: TScrollBar;
    cbTilesetTiles: TComboBox;
    lTilesetLocationTiles: TLabel;
    r256ColorTiles: TRadioButton;
    r16ColorTiles: TRadioButton;
    lColorModeTiles: TLabel;
    lColorModeSprites: TLabel;
    r16ColorSprites: TRadioButton;
    r256ColorSprites: TRadioButton;
    saveBGButton: TButton;
    lPosition: TLabel;
    lPosX: TLabel;
    paletteBase: TScrollBar;
    lPaletteBase: TLabel;
    lPaletteBaseDisp: TLabel;
    lPaletteBase2: TLabel;
    lPaletteBaseDisp2: TLabel;
    paletteBase2: TScrollBar;
    pLayerSheet: TTabSheet;
    activeLayers: TCheckListBox;
    Label2: TLabel;
    bResetLayers: TButton;
    Label3: TLabel;
    lLayerPos: TLabel;
    lLayerColor: TLabel;
    lLayerLayer: TLabel;
    bSaveToFile: TButton;
    bCopyToClipboard: TButton;
    saveDialog: TSaveDialog;
    magnifier: TTrackBar;
    lMagnifier: TLabel;
    bSaveLayers: TButton;
    lTileMapCR: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure toggleRotScaleMode(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure UpdateObserverX(Sender: TObject);
    procedure paletteBaseChange(Sender: TObject);
    procedure loadBGSettings(Sender: TObject);
    procedure SaveBGSettings(Sender: TObject);
    procedure paletteBase2Change(Sender: TObject);
    procedure UpdateScrollDisp(Sender: TObject);
    procedure reloadLayersFromDispCR(Sender: TObject);
    procedure imageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure SaveToFile(Sender: TObject);
    procedure CopyToClipboard(Sender: TObject);
    procedure SaveLayersToDispCR(Sender: TObject);
    procedure imagePaint(Sender: TObject);
  private
    // banks is only valid in the functions below
    banks: TvmMemoryLock1;
    backups: array[0..REGISTERS_MASK] of byte;
    myScreen: TBitmap;
    active: boolean;
    mult: integer;
    layerWatchX, layerWatchY: integer;
    tileWidth, tileHeight: integer;
    lastFx, lastFy: integer;

    zoom: integer;
    pageIndex: integer;

    procedure RenderTileMap;
    procedure RenderTiles;
    procedure RenderSprites;
    procedure RenderFramebuffer;
    procedure RenderLayers;
    function PackBGSettings: uint16;
    procedure UnpackBGSettings(cr: uint16);
    procedure DispScreen;
    procedure DoScrollbar;
  public
    procedure UpdateObserver; override;
    class function OCaption: string; override;
    procedure LoadSettings(ini: TIniFile); override;
    procedure SaveSettings(ini: TIniFile); override;
  end;

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

var
  jdevVRAMViewer: TjdevVRAMViewer;

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

{$R *.DFM}

const
  binarySt: array[0..3] of string = ('%00', '%01', '%10', '%11');
  normalSizes: array[0..3] of TPoint = ((x:256; y:256), (x:512; y:256), (x:256; y:512), (x:512; y:512));
  rotScaleSizes: array[0..3] of TPoint = ((x:128; y:128), (x:256; y:256), (x:512; y:512), (x:1024; y:1024));

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

class function TjdevVRAMViewer.OCaption: string;
begin
  Result := 'Video Viewer';
end;

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

const
  layerStrings: array[0..5] of string = (
    'BG0', 'BG1', 'BG2', 'BG3', 'Sprite', 'Backdrop'
  );

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

procedure TjdevVRAMViewer.UpdateObserver;
var
  x, y: integer;
  line: Puint16;
begin
  // Precautions
  if not active then Exit;
  active := false;

  // Lock VM memory and make some backups
  vmLockMemory(banks);
  Move(banks.iospace^, backups, REGISTERS_MASK+1);

  // Render the observer display
  banks.iospace^[BLEND_S1] := 0;
  case pages.ActivePageIndex of
    0: RenderTileMap;
    1: RenderTiles;
    2: RenderSprites;
    3: RenderFramebuffer;
    4: RenderLayers;
  end;

  // Remap the colors to BGR, because windows is stupid
  if pages.ActivePageIndex in [0, 3, 4] then
    for y := 0 to myScreen.Height - 1 do begin
      line := myScreen.ScanLine[y];
      for x := 0 to myScreen.Width - 1 do begin
        line^ := (line^ shr 10) and $1f + (line^ and $1f) shl 10 + ((line^ shr 5) and $1f) shl 5;
        Inc(line);
      end;
    end;

  // Draw it
  DispScreen;

  // Restore the backups and unlock VM memory
  Move(backups, banks.iospace^, REGISTERS_MASK+1);
  vmUnlockMemory(banks);

  active := true;
end;

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

procedure TjdevVRAMViewer.FormCreate(Sender: TObject);
var
  i: integer;
begin
  HelpContext := LinkHelp('video_viewer.html');

  if (pageIndex >= 0) and (pageIndex < pages.PageCount) then pages.ActivePageIndex := pageIndex;
  if (zoom > 0) and (zoom <= magnifier.Max) then magnifier.Position := zoom;

  // Add entries to the tile map box, in increments of 2kb
  for i := 0 to 31 do
    cbTileMap.Items.Add(Format('$%2.2x ($%8.8x)', [i, $06000000+i*2048]));
  cbTileMap.ItemIndex := 0;

  // Set up the tileset address boxes and the screen size box
  for i := 0 to 3 do begin
    cbTileSet.Items.Add(Format('%s ($%8.8x)', [binarySt[i], $06000000+i*16384]));
    cbTileSetTiles.Items.Add(Format('%s ($%8.8x)', [binarySt[i], $06000000+i*16384]));
  end;
  cbTileSet.ItemIndex := 0;
  cbTileSetTiles.ItemIndex := 0;

  // Take care of the backgrounds avaiable for transfer
  for i := 0 to 3 do
    cbBackgrounds.Items.Add(Format('Background %d', [i]));
  cbBackgrounds.ItemIndex := 0;

  // Set up the frame buffer selection on the frame buffer page
  rMode4fb0.Checked := true;

  // Set up the color mode on each page
  r256Colors.Checked := true;
  r16Colors.Checked := not r256Colors.Checked;
  r256ColorTiles.Checked := true;
  r256ColorSprites.Checked := true;

  // Set up the general settins on the tile maps page
  rRotScale.Checked := false;
  rWraparound.Checked := false;
  rWraparound.Enabled := false;

  // Set up the default screen sizes
  for i := 0 to 3 do
    cbScreenSize.Items.Add(Format('%s (%dx%d)', [binarySt[i], normalSizes[i].x, normalSizes[i].y]));
  cbScreenSize.ItemIndex := 0;

  // Set up the screen
  myScreen := TBitmap.Create;
  myScreen.PixelFormat := pf15bit;
  myScreen.width := 256;
  myScreen.height := 256;

  // Set up the layers page
  reloadLayersFromDispCR(Sender);
  layerWatchX := -1;
  layerWatchY := -1;

  active := true;
end;

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

procedure TjdevVRAMViewer.toggleRotScaleMode(Sender: TObject);
var
  i: integer;
  sizeIndex: integer;
begin
  sizeIndex := cbScreenSize.ItemIndex;
  if sizeIndex < 0 then sizeIndex := 0;
  if rRotScale.Checked then begin
    // Toggle some things
    rWraparound.Enabled := true;
    r16Colors.Enabled := false;
    r256Colors.Checked := true;
    r16Colors.Checked := not r256Colors.Checked;

    // Take care of the screen size
    cbScreenSize.Items.Clear;
    for i := 0 to 3 do
      cbScreenSize.Items.Add(Format('%s (%dx%d)', [binarySt[i], rotScaleSizes[i].x, rotScaleSizes[i].y]));
    cbScreenSize.ItemIndex := 0;

    // Take care of the backgrounds avaiable for transfer
    cbBackgrounds.Clear;
    for i := 2 to 3 do
      cbBackgrounds.Items.Add(Format('Background %d', [i]));
    cbBackgrounds.ItemIndex := 0;
  end else begin
    // Toggle some things
    rWraparound.Enabled := false;
    r16Colors.Enabled := true;

    // Take care of the screen size
    cbScreenSize.Items.Clear;
    for i := 0 to 3 do
      cbScreenSize.Items.Add(Format('%s (%dx%d)', [binarySt[i], normalSizes[i].x, normalSizes[i].y]));
    cbScreenSize.ItemIndex := 0;

    // Take care of the backgrounds avaiable for transfer
    cbBackgrounds.Clear;
    for i := 0 to 3 do
      cbBackgrounds.Items.Add(Format('Background %d', [i]));
    cbBackgrounds.ItemIndex := 0;
  end;
  cbScreenSize.ItemIndex := sizeIndex;

  // Redraw
  UpdateScrollDisp(Sender);
  UpdateObserver;
end;

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

procedure TjdevVRAMViewer.FormDestroy(Sender: TObject);
begin
  myScreen.Free;
end;

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

procedure TjdevVRAMViewer.UpdateObserverX(Sender: TObject);
begin
  zoom := magnifier.Position;
  pageIndex := pages.ActivePageIndex;
  DoScrollbar;
  UpdateObserver;
end;

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

procedure TjdevVRAMViewer.paletteBaseChange(Sender: TObject);
begin
  lPaletteBaseDisp.Caption := Format('%d ($%2.2x)', [paletteBase.Position, paletteBase.Position*16]);
  UpdateObserver;
end;

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

procedure TjdevVRAMViewer.loadBGSettings(Sender: TObject);
var
  index: integer;
begin
  if cbBackgrounds.ItemIndex < 0 then cbBackgrounds.ItemIndex := 0;
  index := cbBackgrounds.ItemIndex;
  if rRotScale.Checked then Inc(index, 2);
  UnpackBGSettings(vmReadHalfword($04000000 + BG0_CR + index shl 1));
  UpdateObserver;
end;

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

function TjdevVRAMViewer.PackBGSettings: uint16;
var
  cr: uint16;
begin
  cr := 0;
  if cbTileSet.ItemIndex < 0 then cbTileSet.ItemIndex := 0;
  cr := cr or (cbTileSet.ItemIndex shl 2);
  if rWraparound.Checked then cr := cr or (1 shl 13);
  if r256Colors.Checked then cr := cr or TEXT_BG_256COLORS;
  if cbTileMap.ItemIndex < 0 then cbTileMap.ItemIndex := 0;
  cr := cr or (cbTileMap.ItemIndex shl 8);
  if cbScreenSize.ItemIndex < 0 then cbScreenSize.ItemIndex := 0;
  cr := cr or (cbScreenSize.ItemIndex shl 14);
  Result := cr;
end;

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

procedure TjdevVRAMViewer.UnpackBGSettings(cr: uint16);
begin
  // Pack the tile set
  r256Colors.Checked := cr and TEXT_BG_256COLORS <> 0;
  rWraparound.Checked := cr and (1 shl 13) <> 0;
  cbTileSet.ItemIndex := (cr shr 2) and 3;
  cbTileMap.ItemIndex := (cr shr 8) and $1F;
  cbScreenSize.ItemIndex := cr shr 14;

  if rRotScale.Checked then r256Colors.Checked := true;
  r16Colors.Checked := not r256Colors.Checked;

  DoScrollbar;
end;

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

procedure TjdevVRAMViewer.SaveBGSettings(Sender: TObject);
begin
  if cbBackgrounds.ItemIndex < 0 then cbBackgrounds.ItemIndex := 0;
  vmWriteHalfword($04000000 + BG0_CR + cbBackgrounds.ItemIndex shl 1, PackBGSettings);
end;

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

procedure TjdevVRAMViewer.paletteBase2Change(Sender: TObject);
begin
  lPaletteBaseDisp2.Caption := Format('%d ($%2.2x)', [paletteBase2.Position, paletteBase2.Position*16]);
  UpdateObserver;
end;

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

procedure TjdevVRAMViewer.UpdateScrollDisp(Sender: TObject);
begin
  if rRotScale.Checked then begin
    lPosX.Caption := Format('X: %d.0, Y: %d.0', [horizScroll.position, vertScroll.position]);
  end else begin
    lPosX.Caption := Format('X: %d, X: %d', [horizScroll.position, vertScroll.position]);
  end;
  UpdateObserver;
end;

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