observersprites.pas

一个不出名的GBA模拟器

//////////////////////////////////////////////////////////////////////
//                                                                  //
// observerSprites.pas: Sprite 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 observerSprites; ////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

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

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, clipbrd,
  cpuObservers, console, nexus, addressSpace, Menus;

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

type
  TjdevSprites = class(TCpuObserver)
    llSpriteInFocus: TLabel;
    spriteOpen: TEdit;
    spriteOpenSpinner: TUpDown;
    gSpriteParams: TGroupBox;
    bSpritePreviewBevel: TBevel;
    spriteHeight: TLabel;
    spriteWidth: TLabel;
    llSpriteWidth: TLabel;
    llSpriteHeight: TLabel;
    llSpriteX: TLabel;
    spriteXPos: TLabel;
    spriteYPos: TLabel;
    llSpriteY: TLabel;
    spritePreview: TImage;
    lSpritePriority: TLabel;
    llSpriteName: TLabel;
    spriteName: TLabel;
    spritePriority: TLabel;
    spritePal: TLabel;
    llSpritePalette: TLabel;
    spriteVdy: TLabel;
    lSpriteDmy: TLabel;
    lSpriteDmx: TLabel;
    spriteVdx: TLabel;
    lSpriteDy: TLabel;
    spriteHdy: TLabel;
    lSpriteDx: TLabel;
    spriteHdx: TLabel;
    lSpriteMatrix: TLabel;
    spriteMatrixSet: TLabel;
    lSpriteMode: TLabel;
    spriteMode: TLabel;
    lSpritePreview: TLabel;
    spriteApplyBlending: TCheckBox;
    spriteApplyMosiac: TCheckBox;
    spriteFlipY: TCheckBox;
    spriteFlipX: TCheckBox;
    spriteDoubleSized: TCheckBox;
    saveDialog: TSaveDialog;
    bSaveToFile: TButton;
    bCopyToClipboard: TButton;
    lOccupied: TLabel;
    scrollbar: TTrackBar;
    occupied: TPaintBox;
    bHelp: TButton;

    procedure SelectNewSprite(Sender: TObject);

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SaveSprite(Sender: TObject);
    procedure CopySprite(Sender: TObject);
    procedure scrollbarChange(Sender: TObject);
    procedure ShowHelp(Sender: TObject);
  public
    activeSprite: uint32;
    bmp: TBitmap;

    procedure UpdateObserver; override;
    class function OCaption: string; override;
  end;

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

var
  jdevSprites: TjdevSprites;

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

{$R *.DFM}

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

procedure TjdevSprites.UpdateObserver;
type
  Pint16 = ^smallint;
var
  spr: PSprite;
  t: uint16;
  height, x, y: integer;
  line: PWordArray;
  banks: TvmMemoryLock1;
begin
  vmLockMemory(banks);

  // Draw the occupancy graph
  for y := 0 to 127 do begin
    spr := @(banks.OAM[y shl 3]);

    if ((spr.a = 0) and (spr.b = 0) and (spr.c = 0)) or
       ((spr.a and SPRITE_A_DOUBLESIZE <> 0) and (spr.a and SPRITE_A_ROTSCALE = 0)) then
      occupied.canvas.Pen.Color := clWhite
    else
      occupied.canvas.Pen.Color := clBlack;

    occupied.Canvas.MoveTo(0, y);
    occupied.Canvas.LineTo(15, y);
  end;

  occupied.canvas.Pen.Color := clRed;
  occupied.Canvas.MoveTo(0, activeSprite);
  occupied.Canvas.LineTo(15, activeSprite);

  spr := @(banks.OAM[activeSprite shl 3]);

  t := ((spr.b shr 14) or ((spr.a shr 12) and $C)) shl 1;
  if t > 22 then begin
    spriteWidth.caption := 'inv';
    spriteHeight.caption := 'inv';
    height := -1;
  end else begin
    spriteWidth.caption := IntToStr(SpriteSizes[t]);
    height := SpriteSizes[t+1];
    spriteHeight.caption := IntToStr(height);
  end;

  spriteXPos.caption := IntToStr(spr.b and $1FF);
  spriteYPos.caption := IntToStr(spr.a and $FF);

  if spr.a and SPRITE_A_256MODE <> 0 then
    spritePal.caption := '1/1'
  else
    spritePal.caption := IntToStr(spr.c shr 12 + 1) + '/16';

  spriteName.caption := IntToHex(spr.c and $3FF, 5);
  spriteDoubleSized.checked := spr.a and SPRITE_A_DOUBLESIZE <> 0;
  if spriteDoubleSized.checked then height := height shl 1;
  spriteApplyMosiac.checked := spr.a and SPRITE_A_MOSAIC <> 0;
  spriteApplyBlending.checked := (spr.a shr 10) and 3 = 1;
  if spr.a and SPRITE_A_ROTSCALE <> 0 then begin
    spriteMode.caption := 'Rot / Scale';
    t := (spr.b shr 9) and $1F;
    spriteMatrixSet.caption := IntToStr(t);
    t := t shl 5 + 6;
    spriteHdx.caption := Format('%6f', [Pint16(@(banks.OAM[t]))^ / 256.0]);
    spriteHdy.caption := Format('%6f', [Pint16(@(banks.OAM[t + 8]))^ / 256.0]);
    spriteVdx.caption := Format('%6f', [Pint16(@(banks.OAM[t + 16]))^ / 256.0]);
    spriteVdy.caption := Format('%6f', [Pint16(@(banks.OAM[t + 24]))^ / 256.0]);
  end else begin
    spriteMode.caption := 'Normal';
    spriteMatrixSet.caption := 'n/a';
    spriteHdx.caption := 'n/a';
    spriteHdy.caption := 'n/a';
    spriteVdx.caption := 'n/a';
    spriteVdy.caption := 'n/a';
  end;

  for y := 0 to 127 do begin
    // Get the pointer and clear the scanline
    line := bmp.ScanLine[y];
    if not Assigned(line) then Exit;
    t := vmReadHalfword($05000000);
    for x := 0 to 127 do line^[x] := t;

    // Render the sprite
    if y < height then vmRenderSprite(activeSprite, y, @(line^));

    // Remap the colors to BGR, because windows is stupid
    for x := 0 to 127 do
      line^[x] := (line^[x] shr 10) and $1f + (line^[x] and $1f) shl 10 + ((line^[x] shr 5) and $1f) shl 5;
  end;

//  spritePreview.Canvas.StretchDraw(Rect(0, 0, 64, 64), bmp);
  spritePreview.Canvas.Draw(0, 0, bmp);

  spritePriority.caption := IntToStr((spr.c shr 10) and 3);
  spriteFlipX.checked := spr.b and SPRITE_B_FLIP_X <> 0;
  spriteFlipY.checked := spr.b and SPRITE_B_FLIP_Y <> 0;

  vmUnlockMemory(banks);
end;

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

procedure TjdevSprites.FormCreate(Sender: TObject);
begin
  HelpContext := LinkHelp('sprite_viewer.html');
  activeSprite := 0;
  bmp := TBitmap.Create;
  bmp.PixelFormat := pf15bit;
  bmp.width := 128;
  bmp.height := 128;
end;

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

procedure TjdevSprites.SelectNewSprite(Sender: TObject);
var
  num: integer;
begin
  num := StrToIntDef(spriteOpen.Text, 0);
  if num < 0 then num := 0;
  if num > 127 then num := 127;
  scrollbar.Position := num;
end;

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

procedure TjdevSprites.FormDestroy(Sender: TObject);
begin
  bmp.Free;
end;

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

class function TjdevSprites.OCaption: string;
begin
  Result := 'Sprite Viewer';
end;

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

procedure TjdevSprites.SaveSprite(Sender: TObject);
begin
  if saveDialog.Execute then
    spritePreview.Picture.SaveToFile(saveDialog.FileName);
end;

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

procedure TjdevSprites.CopySprite(Sender: TObject);
var
  myFormat: word;
  data: THandle;
  pal: HPalette;
begin
  spritePreview.Picture.SaveToClipBoardFormat(myFormat, data, pal);
  clipboard.SetAsHandle(myFormat, data);
end;

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

procedure TjdevSprites.scrollbarChange(Sender: TObject);
begin
  spriteOpen.Text := IntToStr(scrollbar.Position);
  activeSprite := scrollbar.Position;
  UpdateObserver;
end;

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

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

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

initialization
  RegisterViewer(TjdevSprites);
end.

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