observervram.pas

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

procedure TjdevVRAMViewer.reloadLayersFromDispCR(Sender: TObject);
var
  da: byte;
  index: integer;
begin
  da := vmReadByte($04000000 + DISPLAY_ACTIVE);
  for index := 0 to 7 do
    activeLayers.Checked[index] := da and (1 shl index) <> 0;
  UpdateObserver;
end;

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

procedure TjdevVRAMViewer.SaveLayersToDispCR(Sender: TObject);
var
  da: byte;
  index: integer;
begin
  da := 0;
  for index := 0 to 7 do
    if activeLayers.Checked[index] then da := da or (1 shl index);
  vmWriteByte($04000000 + DISPLAY_ACTIVE, da);
end;

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

procedure TjdevVRAMViewer.imageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  layerWatchX := X;
  layerWatchY := Y;

  lLayerPos.Caption := Format('Position: (%d, %d)', [layerWatchX, layerWatchY]);
  lLayerLayer.Caption := 'Top layer: <n/a>';
  lLayerColor.Caption := 'Color: <n/a>';

  lLayerPos.Visible := true;
  lLayerLayer.Visible := true;
  lLayerColor.Visible := true;

  UpdateObserver;
end;

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

procedure TjdevVRAMViewer.SaveToFile(Sender: TObject);
begin
  saveDialog.Filter := 'Bitmap Images|*.bmp|All files|*.*';
  saveDialog.DefaultExt := 'bmp';
  if saveDialog.Execute then myScreen.SaveToFile(saveDialog.FileName);
end;

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

procedure TjdevVRAMViewer.CopyToClipboard(Sender: TObject);
var
  myFormat: word;
  data: THandle;
  pal: HPalette;
begin
  myScreen.SaveToClipBoardFormat(myFormat, data, pal);
  clipboard.SetAsHandle(myFormat, data);
end;

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

procedure TjdevVRAMViewer.DispScreen;
var
  x, y: integer;
begin
  if pages.activePageIndex = 0 then begin
    image.Canvas.StretchDraw(Rect(0, 0, mult*256, mult*256), myScreen);

    x := lastFx;
    y := lastFy;

    // Draw the main piece
    image.Canvas.DrawFocusRect(Rect(x*mult, y*mult, (x+240)*mult-1, (y+160)*mult-1));

    // Display the (bottom) left wraparound portion if any
    if x+240 >= tileWidth then begin
      x := x - tileWidth;
      image.Canvas.DrawFocusRect(Rect(x*mult, y*mult, (x+240)*mult-1, (y+160)*mult-1));
    end;

    // Draw the top wraparound portions, if any
    if y+160 >= tileHeight then begin
      // Draw the top (left) wraparound portion
      y := y - tileHeight;
      image.Canvas.DrawFocusRect(Rect(x*mult, y*mult, (x+240)*mult-1, (y+160)*mult-1));

      // Draw the top right wraparound portion (if any)
      if x <> lastFx then begin
        x := lastFx;
        image.Canvas.DrawFocusRect(Rect(x*mult, y*mult, (x+240)*mult-1, (y+160)*mult-1));
      end;
    end;
  end else begin
    image.Canvas.StretchDraw(Rect(-mult*horizScroll.Position, -mult*vertScroll.Position,
                                  256*mult-mult*horizScroll.Position, 256*mult-mult*vertScroll.Position), myScreen);
  end;
end;

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

procedure TjdevVRAMViewer.imagePaint(Sender: TObject);
begin
  DispScreen;
end;

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

procedure TjdevVRAMViewer.DoScrollbar;
var
  i: integer;
begin
  mult := magnifier.position;
  case pages.ActivePageIndex of
    0: begin
      i := cbScreenSize.ItemIndex;
      if i = -1 then i := 0;

      if rRotScale.Checked then begin
        horizScroll.Max := Max(rotScaleSizes[i].x - 1 - image.width div mult, 0);
        vertScroll.Max := Max(rotScaleSizes[i].y - 1 - image.height div mult, 0);
        r256Colors.Checked := true;
        tileWidth := rotScaleSizes[i].x;
        tileHeight := rotScaleSizes[i].y;
      end else begin
        horizScroll.Max := Max(normalSizes[i].x - 1 - image.width div mult, 0);
        vertScroll.Max := Max(normalSizes[i].y - 1 - image.height div mult, 0);
        tileWidth := normalSizes[i].x;
        tileHeight := normalSizes[i].y;
      end;
    end;
    1: begin
      horizScroll.Max := Max(127 - image.width div mult, 0);
      vertScroll.Max := Max(127 - image.height div mult, 0);
    end;
    2: begin
      horizScroll.Max := Max(255 - image.width div mult, 0);
      vertScroll.Max := Max(127 - image.height div mult, 0);
    end;
    3, 4: begin
      horizScroll.Max := Max(239 - image.width div mult, 0);
      vertScroll.Max := Max(159 - image.height div mult, 0);
    end;
  end;
  horizScroll.Enabled := horizScroll.Max <> 0;
  vertScroll.Enabled := vertScroll.Max <> 0;
end;

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

procedure TjdevVRAMViewer.RenderTileMap;
var
  x, y: integer;
  line: Puint16;
begin
  // Render a tile map
  Puint16(@(banks.iospace^[BG2_CR]))^ := PackBgSettings;
  banks.iospace^[DISPLAY_ACTIVE] := 4;

  if rRotScale.Checked then begin
    banks.iospace^[DISPLAY_CR] := 1;
    Puint16(@(banks.iospace^[BG2_A]))^ := 256;
    Puint16(@(banks.iospace^[BG2_C]))^ := 0;
    Puint32(@(banks.iospace^[BG2_X]))^ := horizScroll.Position shl 8;
    Puint32(@(banks.iospace^[BG2_Y]))^ := vertScroll.Position shl 8;
  end else begin
    banks.iospace^[DISPLAY_CR] := 0;
    Puint16(@(banks.iospace^[BG2_X0]))^ := horizScroll.Position;
    Puint16(@(banks.iospace^[BG2_Y0]))^ := vertScroll.Position;
  end;

  // Draw the screen
  for y := 0 to 255 do begin
    line := vmDrawScanline(y, 256);
    Move(line^, myScreen.ScanLine[y]^, 256*2);
    Inc(Puint32(@(banks.iospace^[BG2_Y]))^, 256);
  end;

  // Draw some selection windows
  if rRotScale.Checked then begin
    x := Puint32(@(backups[BG2_X + cbBackgrounds.ItemIndex*$10]))^ shr 8;
    y := Puint32(@(backups[BG2_Y + cbBackgrounds.ItemIndex*$10]))^ shr 8;
  end else begin
    x := Puint16(@(backups[BG0_X0 + cbBackgrounds.ItemIndex*4]))^;
    y := Puint16(@(backups[BG0_Y0 + cbBackgrounds.ItemIndex*4]))^;
  end;
  x := x - horizScroll.Position;
  y := y - vertScroll.Position;

  lastFx := x;
  lastFy := y;

  lTileMapCR.Caption := 'Current CR: $' + IntToHex(PackBgSettings, 4);
end;

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

procedure TjdevVRAMViewer.RenderTiles;
var
  x, y, rbase, base, palBase: integer;
  pix: uint16;
  line: Puint16;
begin
  // BG tile rendering
  // Render tiles
  if cbTileSetTiles.ItemIndex < 0 then cbTileSetTiles.ItemIndex := 0;
  rbase := cbTileSetTiles.ItemIndex * $4000;

  if r256ColorTiles.Checked then begin
    // Draw the tiles as 256 color ones
    for y := 0 to 127 do begin
      base := rbase + (y and 7) shl 3 + (y shr 3) shl 10;
      line := @(myScreen.ScanLine[y]^);
      for x := 0 to 127 do begin
        pix := banks.VRAM[base + x and 7 + (x shr 3) shl 6];
        pix := Puint16(@(banks.palette[pix shl 1]))^;
        line^ := (pix shr 10) and $1f + (pix and $1f) shl 10 + ((pix shr 5) and $1f) shl 5;
        Inc(line);
      end;

      // Fill the rest of the line with backdrop
      pix := Puint16(@(banks.palette[0]))^;
      pix := (pix shr 10) and $1f + (pix and $1f) shl 10 + ((pix shr 5) and $1f) shl 5;
      for x := 128 to 255 do begin
        line^ := pix;
        Inc(line);
      end;
    end;

    // Fill the rest of the lines with backdrop
    pix := Puint16(@(banks.palette[0]))^;
    pix := (pix shr 10) and $1f + (pix and $1f) shl 10 + ((pix shr 5) and $1f) shl 5;
    for y := 128 to 255 do begin
      line := @(myScreen.ScanLine[y]^);
      for x := 0 to 255 do begin
        line^ := pix;
        Inc(line);
      end;
    end;
  end else begin
    // Draw the tiles as 16 color ones
    palBase := paletteBase.Position*32;
    for y := 0 to 127 do begin
      base := rbase + (y and 7) shl 2 + (y shr 3) shl 10;
      line := @(myScreen.ScanLine[y]^);
      for x := 0 to 255 do begin
        pix := banks.VRAM[base + (x and 7) shr 1 + (x shr 3) shl 5];
        if Odd(x) then pix := pix shr 4 else pix := pix and $F;
        pix := Puint16(@(banks.palette[pix shl 1 + palBase]))^;
        line^ := (pix shr 10) and $1f + (pix and $1f) shl 10 + ((pix shr 5) and $1f) shl 5;
        Inc(line);
      end;
    end;

    // Fill the rest of the lines with backdrop
    pix := Puint16(@(banks.palette[0]))^;
    pix := (pix shr 10) and $1f + (pix and $1f) shl 10 + ((pix shr 5) and $1f) shl 5;
    for y := 128 to 255 do begin
      line := @(myScreen.ScanLine[y]^);
      for x := 0 to 255 do begin
        line^ := pix;
        Inc(line);
      end;
    end;
  end;
end;

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

procedure TjdevVRAMViewer.RenderSprites;
var
  x, y, rbase, base, palBase: integer;
  pix: uint16;
  line: Puint16;
begin
  // Sprite tile rendering
  // Render sprites
  if r256ColorSprites.Checked then begin
    rbase := $10000;
    palBase := 512;
    // Draw the tiles as 256 color ones
    for y := 0 to 127 do begin
      base := rbase + (y and 7) shl 3 + (y shr 3) shl 11;
      line := @(myScreen.ScanLine[y]^);
      for x := 0 to 255 do begin
        pix := banks.VRAM[base + x and 7 + (x shr 3) shl 6];
        pix := Puint16(@(banks.palette[pix shl 1 + palBase]))^;
        line^ := (pix shr 10) and $1f + (pix and $1f) shl 10 + ((pix shr 5) and $1f) shl 5;
        Inc(line);
      end;
    end;

    // Fill the rest of the lines with backdrop
    pix := Puint16(@(banks.palette[0]))^;
    pix := (pix shr 10) and $1f + (pix and $1f) shl 10 + ((pix shr 5) and $1f) shl 5;
    for y := 128 to 255 do begin
      line := @(myScreen.ScanLine[y]^);
      for x := 0 to 255 do begin
        line^ := pix;
        Inc(line);
      end;
    end;
  end else begin
    // Draw the tiles as 16 color ones
    palBase := paletteBase2.Position*32+512;
    for y := 0 to 255 do begin
      base := $10000 + (y and 7) shl 2 + (y shr 3) shl 10;
      line := @(myScreen.ScanLine[y]^);
      for x := 0 to 255 do begin
        pix := banks.VRAM[base + (x and 7) shr 1 + (x shr 3) shl 5];
        if Odd(x) then pix := pix shr 4 else pix := pix and $F;
        pix := Puint16(@(banks.palette[pix shl 1 + palBase]))^;
        line^ := (pix shr 10) and $1f + (pix and $1f) shl 10 + ((pix shr 5) and $1f) shl 5;
        Inc(line);
      end;
    end;
  end;
end;

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

procedure TjdevVRAMViewer.RenderFramebuffer;
var
  x, y: integer;
  pix: uint16;
  line: Puint16;
begin
  // Framebuffer rendering
  // Render the frame buffer
  banks.iospace^[DISPLAY_ACTIVE] := 4;
  if rMode4fb0.Checked then
    banks.iospace^[DISPLAY_CR] := 4
  else if rMode4fb1.Checked then
    banks.iospace^[DISPLAY_CR] := 4 or DISPLAY_CR_FB
  else if rMode5fb0.Checked then
    banks.iospace^[DISPLAY_CR] := 5
  else if rMode5fb1.Checked then
    banks.iospace^[DISPLAY_CR] := 5 or DISPLAY_CR_FB
  else
    banks.iospace^[DISPLAY_CR] := 3;

  Puint32(@(banks.iospace^[BG2_X]))^ := 0;
  Puint32(@(banks.iospace^[BG2_Y]))^ := 0;

  for y := 0 to 159 do begin
    // Render a bitmapped scanline
    line := vmDrawScanline(y, 256);
    Move(line^, myScreen.ScanLine[y]^, 256*2);
    Inc(Puint32(@(banks.iospace^[BG2_Y]))^, 256);

    // Fill the rest of the line with backdrop
    line := @(PWordArray(line)^[240]);
    pix := Puint16(@(banks.palette[0]))^;
    for x := 240 to 255 do begin
      line^ := pix;
      Inc(line);
    end;
  end;

  // Fill the rest of the lines with backdrop
  pix := Puint16(@(banks.palette[0]))^;
  for y := 160 to 255 do begin
    line := @(myScreen.ScanLine[y]^);
    for x := 0 to 255 do begin
      line^ := pix;
      Inc(line);
    end;
  end;
end;

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

procedure TjdevVRAMViewer.RenderLayers;
var
  x, y: integer;
  pix: uint16;
  line: Puint16;
begin
  // Layer rendering
  pix := 0;
  for y := 0 to 7 do
    if activeLayers.Checked[y] then pix := pix or (1 shl y);
      banks.iospace^[DISPLAY_ACTIVE] := pix;

  for y := 0 to 159 do begin
    // Draw
    line := vmDrawScanline(y, 256);
    Move(line^, myScreen.ScanLine[y]^, 256*2);
    Inc(Puint32(@(banks.iospace^[BG2_Y]))^, 256);

    // Layer watch
    if (y = layerWatchY) and (layerWatchX > -1) and (layerWatchX < 240) then begin
      pix := PWordArray(line)^[layerWatchX];
      lLayerLayer.Caption := Format('Top layer: %s', [layerStrings[vmGetLayerID(layerWatchX)] ]);
      lLayerColor.Caption := Format('Color: (%d, %d, %d)', [(pix shr 10) and $1F, (pix shr 5) and $1F, pix and $1F]);
    end;

    // Fill the rest of the line with backdrop
    line := @(PWordArray(line)^[240]);
    pix := Puint16(@(banks.palette[0]))^;
    for x := 240 to 255 do begin
      line^ := pix;
      Inc(line);
    end;
  end;

  // Fill the rest of the lines with backdrop
  pix := Puint16(@(banks.palette[0]))^;
  for y := 160 to 255 do begin
    line := @(myScreen.ScanLine[y]^);
    for x := 0 to 255 do begin
      line^ := pix;
      Inc(line);
    end;
  end;
end;

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

procedure TjdevVRAMViewer.LoadSettings(ini: TIniFile);
begin
  inherited;
  zoom := ini.ReadInteger(OCaption, 'Zoom', 1);
  pageIndex := ini.ReadInteger(OCaption, 'LastPage', 0);
end;

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

procedure TjdevVRAMViewer.SaveSettings(ini: TIniFile);
begin
  inherited;
  ini.WriteInteger(OCaption, 'Zoom', zoom);
  ini.WriteInteger(OCaption, 'LastPage', pageIndex);
end;

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

initialization
  RegisterViewer(TjdevVRAMViewer);
end.

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