observerpalette.pas

一个不出名的GBA模拟器

//////////////////////////////////////////////////////////////////////
//                                                                  //
// observerPalette.pas: Palette 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 observerPalette; ////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

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

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

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

type
  TjdevPalette = class(TCpuObserver)
    lPaletteBackground: TLabel;
    lPaletteSprite: TLabel;
    details: TPanel;
    lPaletteDetails: TLabel;
    lPaletteViewing: TLabel;
    lPaletteR: TLabel;
    lPaletteG: TLabel;
    lPaletteB: TLabel;
    colorDialog: TColorDialog;
    cbUseGrid: TCheckBox;
    bLoadBG: TButton;
    bSaveBG: TButton;
    bLoadFG: TButton;
    bSaveFG: TButton;
    cbZoomed: TCheckBox;
    openDialog: TOpenDialog;
    saveDialog: TSaveDialog;
    cbDecimalMode: TCheckBox;

    procedure UpdateBGPaletteCoords(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure UpdateFGPaletteCoords(Sender: TObject; Shift: TShiftState; X, Y: Integer);

    procedure FormCreate(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);

    procedure SetDims(patchSize: integer; hasGrid: boolean);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure AlterDisplay(Sender: TObject);
    procedure LoadBGPalette(Sender: TObject);
    procedure SaveBGPalette(Sender: TObject);
    procedure LoadFGPalette(Sender: TObject);
    procedure SaveFGPalette(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    logDims, totalDims, gridFactor: integer;
    paletteCurrentColor: integer;

    decimalMode, doubleSize, showGrid: boolean;
  public
    procedure UpdateObserver; override;
    class function OCaption: string; override;
    procedure LoadSettings(ini: TIniFile); override;
    procedure SaveSettings(ini: TIniFile); override;
  end;

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

var
  jdevPalette: TjdevPalette;

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

{$R *.DFM}

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

procedure TjdevPalette.UpdateBGPaletteCoords(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  t: uint16;
begin
  paletteCurrentColor := X shr logDims + (Y shr logDims) shl 4;
  if (paletteCurrentColor >= 0) and (paletteCurrentColor < 512) then begin
    t := vmReadHalfword($05000000 + paletteCurrentColor shl 1);
    lPaletteViewing.caption := Format('BG Color #%d', [paletteCurrentColor]);

    if cbDecimalMode.Checked then begin
      lPaletteR.caption := Format('R: %d', [t and $1F]);
      lPaletteG.caption := Format('G: %d', [(t shr 5) and $1F]);
      lPaletteB.caption := Format('B: %d', [(t shr 10) and $1F]);
    end else begin
      lPaletteR.caption := Format('R: $%.2x', [t and $1F]);
      lPaletteG.caption := Format('G: $%.2x', [(t shr 5) and $1F]);
      lPaletteB.caption := Format('B: $%.2x', [(t shr 10) and $1F]);
    end;
  end;
end;

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

procedure TjdevPalette.UpdateFGPaletteCoords(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  t: uint16;
begin
  paletteCurrentColor := X shr logDims + (Y shr logDims) shl 4 + 256;
  if (paletteCurrentColor >= 0) and (paletteCurrentColor < 512) then begin
    t := vmReadHalfword($05000000 + paletteCurrentColor shl 1);
    lPaletteViewing.caption := Format('Sprite Color #%d', [paletteCurrentColor-256]);

    if cbDecimalMode.Checked then begin
      lPaletteR.caption := Format('R: %d', [t and $1F]);
      lPaletteG.caption := Format('G: %d', [(t shr 5) and $1F]);
      lPaletteB.caption := Format('B: %d', [(t shr 10) and $1F]);
    end else begin
      lPaletteR.caption := Format('R: $%.2x', [t and $1F]);
      lPaletteG.caption := Format('G: $%.2x', [(t shr 5) and $1F]);
      lPaletteB.caption := Format('B: $%.2x', [(t shr 10) and $1F]);
    end;
  end;
end;

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

procedure TjdevPalette.UpdateObserver;
var
  i, x, y: integer;
  w: uint32;
  offs: integer;
begin
  // Update the background palette display
  offs := details.width;
  for i := 0 to 255 do begin
    x := (i and $F) shl logDims + offs;
    y := (i shr 4) shl logDims;
    w := vmReadHalfword($05000000 + i shl 1);
    w := (w and $1F) shl 3 + ((w shr 5) and $1F) shl 11 + ((w shr 10) and $1F) shl 19;
    Canvas.Brush.Color := w;
    Canvas.FillRect(Rect(x+8, y+16, x+8+1 shl logDims-gridFactor, y+1 shl logDims+16-gridFactor));
  end;

  // Update the sprite palette display
  for i := 0 to 255 do begin
    x := (i and $F) shl logDims + offs;
    y := (i shr 4) shl logDims;
    w := vmReadHalfword($05000100 + i shl 1);
    w := (w and $1F) shl 3 + ((w shr 5) and $1F) shl 11 + ((w shr 10) and $1F) shl 19;
    Canvas.Brush.Color := w;
    Canvas.FillRect(Rect(x+totalDims+16, y+16, x+totalDims+16+1 shl logDims-gridFactor, y+1 shl logDims+16-gridFactor));
  end;

  // Draw the grid
  if gridFactor > 0 then begin
    Canvas.Pen.Color := $333333;
    for i := 1 to 16 do begin
      // Vertical lines for BG palette
      Canvas.MoveTo(i shl logDims - gridFactor + 8 + offs, 16);
      Canvas.LineTo(i shl logDims - gridFactor + 8 + offs, 16+totalDims);

      // Horizontal lines for BG palette
      Canvas.MoveTo(8 + offs,           i shl logDims - gridFactor + 16);
      Canvas.LineTo(8+totalDims + offs, i shl logDims - gridFactor + 16);

      // Vertical Lines for FG palette
      Canvas.MoveTo(i shl logDims - gridFactor+totalDims+16 + offs, 16);
      Canvas.LineTo(i shl logDims - gridFactor+totalDims+16 + offs, 16+totalDims);

      // Horizontal lines for FG palette
      Canvas.MoveTo(16+totalDims + offs,   i shl logDims - gridFactor + 16);
      Canvas.LineTo(16+totalDims*2 + offs, i shl logDims - gridFactor + 16);
    end;
  end;
end;

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

procedure TjdevPalette.FormCreate(Sender: TObject);
begin
  HelpContext := LinkHelp('palette_viewer.html');
  FormMouseMove(Sender, [], 0, 0);
  SetDims(3, true);
end;

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

class function TjdevPalette.OCaption: string;
begin
  Result := 'Palette Viewer';
end;

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

procedure TjdevPalette.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin