unit frmDebugger6502unt;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Profile,
  StdCtrls, Buttons, ExtCtrls, Dis6502;

Const
  LatchQueueSize    = 16;
  GameScreenSize    = 160 * 200;
  Index_Player0Set  = 1;
  Index_Player1Set  = 2;
  Index_Missile0Set = 4;
  Index_Missile1Set = 8;
  Index_BallSet     = 16;

type
  TfrmDebugger6502 = class(TForm)
    dlgSave: TSaveDialog;
    pnlButtons: TPanel;
    bvlInstructions: TBevel;
    bvlFlags: TBevel;
    bvlRegs: TBevel;
    bvlScreenData: TBevel;
    bvlTIARegs: TBevel;
    bvlInputRegs: TBevel;
    bvlObjectLoc: TBevel;
    bvlData: TBevel;
    btnGo: TBitBtn;
    btnTrace: TBitBtn;
    btnSkip: TBitBtn;
    btnReg: TBitBtn;
    btnMem: TBitBtn;
    btnExpression: TBitBtn;
    btnHere: TBitBtn;
    btnSave: TBitBtn;
    btnStop: TBitBtn;
    sbInstructions: TScrollBar;
    btnPC: TSpeedButton;
    btnTop: TSpeedButton;
    sbData: TScrollBar;
    procedure FormPaint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormResize(Sender: TObject);
    procedure btnTraceClick(Sender: TObject);
    procedure btnGoClick(Sender: TObject);
    procedure btnSkipClick(Sender: TObject);
    procedure btnHereClick(Sender: TObject);
    procedure btnMemClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure sbInstructionsScroll(Sender: TObject;
      ScrollCode: TScrollCode; var ScrollPos: Integer);
    procedure btnPCClick(Sender: TObject);
    procedure btnTopClick(Sender: TObject);
    procedure btnRegClick(Sender: TObject);
    procedure btnExpressionClick(Sender: TObject);
    procedure sbDataScroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
  private
    { Private declarations }
    DataTop  : Word;
    Opcode   : Byte;
    Addr     : Word;
    OTyp     : String[3];
    Operand  : String;
    Color    : Word;
    TopAddr  : Word;
//    Ch       : Char;
    _DLines  : Word;
    St       : String;
//    HaltNum  : Integer;
//    Code     : Integer;
//    HexVal   : LongInt;
//    HexAddr  : LongInt;
    OutFile  : File;
//    ExpError : Boolean;
    Procedure FBox(X1,Y1,X2,Y2: Integer; Col: Byte);
    Procedure Display;
    Procedure WriteOut(B: TBevel; X,Y: Integer; St: String; Col: Word);
    Procedure WriteOutBold(B: TBevel; X,Y: Integer; St: String; Col: Word);
    Procedure FillInBevel(B: TBevel; Col: Byte);
    Function  BufW(Addr: Word): Word;
  public
    { Public declarations }
    Showing : Boolean;
    Closing : Boolean;
    Procedure InitDebugger;
  end;

var
  frmDebugger6502 : TfrmDebugger6502;

implementation

{$R *.DFM}

Uses HexWrite,Base,frmMainUnt,Equation6502,KBComponent,ProtMenu,frmDebuggerUnt;

Const
  NormTextColor = 0;
  DataTextColor = 0;
  HiTextColor   = 6;
  PCTextColor   = 2;
  HelpTextColor = 8;
  HelpHiColor   = 6;
  LineColor     = 14;
  BackColor     = 0;
  DisasmColor   = 9;
  FlagsColor    = 15;
  RegsColor     = 12;
  DataColor     = 13;
  ScrDatColor   = 2;
  TIA_Color     = 1;
  TextBGColor   = 1;
  PopupColor    = 8;
  HelpColor     = 1;
  MarkTextColor = 7;
  MarkBackColor = 0;
  ObjLocColor   = 13;
  TopAsmColor   = 5;

  Input_Color   = 13;
  ObjLoc_Color  = 13;

(*
  NormTextColor = 0;
  HiTextColor   = 30;
  PCTextColor   = 246;
  HelpTextColor = 10;
  HelpHiColor   = 28;
  LineColor     = 14;
  BackColor     = 4;
  DisasmColor   = 174;
  TopAsmColor   = 200;  // 190;
  FlagsColor    = 250;{254;}
  RegsColor     = 108;{110;}
  DataColor     = 158;
  ScrDatColor   = 90;
  TIA_Color     = 152;
  Input_Color   = 154;
  ObjLoc_Color  = 156;
  TextBGColor   = 148;
  PopupColor    = 10;
  HelpColor     = 132;
*)
  TextStart     = 2;
  TextHeight    = 8;
  DisasmLines   = 16;
//  HRDisasmLines = 32;
  DataLines     = 24;
  SmFontSize    = 1024;

Var
  BreakExp    : String;

Procedure TfrmDebugger6502.FBox(X1,Y1,X2,Y2: Integer; Col: Byte);
Begin
  Canvas.Pen.Color   := ScreenPalette[Col];
  Canvas.Brush.Color := ScreenPalette[Col];
  Canvas.Brush.Style := bsSolid;
  Canvas.Rectangle(X1,Y1,X2 + 1,Y2 + 1);
End; { TfrmDebugger6502.FBox }


Procedure TfrmDebugger6502.WriteOut(B: TBevel; X,Y: Integer; St: String; Col: Word);
Begin
  X := (X - 1) * Canvas.TextWidth('M')   + B.Left + 1;
  Y := (Y - 1) * Canvas.TextHeight('Mg') + B.Top  + 1;
  Canvas.Font.Color  := ScreenPalette[Lo(Col)];
  Canvas.Brush.Color := ScreenPalette[Hi(Col)];
  Canvas.TextOut(X,Y,St);
End; // TfrmDebugger6502.WriteOut


Procedure TfrmDebugger6502.WriteOutBold(B: TBevel; X,Y: Integer; St: String; Col: Word);
Begin
  X := (X - 1) * Canvas.TextWidth('M')   + B.Left + 1;
  Y := (Y - 1) * Canvas.TextHeight('Mg') + B.Top  + 1;
  Canvas.Font.Style := [fsBold];
  Canvas.Font.Color  := ScreenPalette[Lo(Col)];
  Canvas.Brush.Color := ScreenPalette[Hi(Col)];
  Canvas.TextOut(X,Y,St);
  Canvas.Font.Style := [];
End; // TfrmDebugger6502.WriteOutBold


Procedure TfrmDebugger6502.FillInBevel(B: TBevel; Col: Byte);
Begin
  FBox(B.Left + 1,B.Top + 1,B.Left + B.Width - 2,B.Top + B.Height - 2,Col);
End; // TfrmDebugger6502.FillInBevel

Procedure TfrmDebugger6502.Display;
Var I,J: Integer;

  Procedure ShowBasicInfo;
  Var I: Integer;
  Begin
    WriteOut(bvlFlags,1,1,'NV BDIZC',NormTextColor + (FlagsColor Shl 8));

    WriteOut(bvlRegs,1,1,'PC=    h',NormTextColor + (RegsColor Shl 8));
    WriteOut(bvlRegs,2,2,'P=  h  ',NormTextColor + (RegsColor Shl 8));
    WriteOut(bvlRegs,2,3,'A=  h  ',NormTextColor + (RegsColor Shl 8));
    WriteOut(bvlRegs,2,4,'X=  h  ',NormTextColor + (RegsColor Shl 8));
    WriteOut(bvlRegs,2,5,'Y=  h  ',NormTextColor + (RegsColor Shl 8));
    WriteOut(bvlRegs,2,6,'S=  h  ',NormTextColor + (RegsColor Shl 8));

    WriteOut(bvlScreenData,1,1,'Scan=',NormTextColor + (ScrDatColor Shl 8));
    WriteOut(bvlScreenData,1,2,'HPix=',NormTextColor + (ScrDatColor Shl 8));
    WriteOut(bvlScreenData,1,3,'Bank=',NormTextColor + (ScrDatColor Shl 8));
    WriteOut(bvlScreenData,1,4,'Addr=    h',NormTextColor + (ScrDatColor Shl 8));
    WriteOut(bvlScreenData,1,5,'GRP0=  h',NormTextColor + (ScrDatColor Shl 8));
    WriteOut(bvlScreenData,1,6,'GRP1=  h',NormTextColor + (ScrDatColor Shl 8));

    { Display flag data }

    For I := 0 To 7 Do
    Begin
      If (Game6502.P And (1 Shl I)) <> 0
       Then WriteOutBold(bvlFlags,8 - I,2,'1',HiTextColor + (FlagsColor Shl 8))
       Else WriteOutBold(bvlFlags,8 - I,2,'0',HiTextColor + (FlagsColor Shl 8));
    End; { For I }

    { Display reg data }

    WriteOutBold(bvlRegs,4,1,HexWord(Game6502.PC),HiTextColor + (RegsColor Shl 8));
    WriteOutBold(bvlRegs,4,2,HexByte(Game6502.P) ,HiTextColor + (RegsColor Shl 8));
    WriteOutBold(bvlRegs,4,3,HexByte(Game6502.A) ,HiTextColor + (RegsColor Shl 8));
    WriteOutBold(bvlRegs,4,4,HexByte(Game6502.X) ,HiTextColor + (RegsColor Shl 8));
    WriteOutBold(bvlRegs,4,5,HexByte(Game6502.Y) ,HiTextColor + (RegsColor Shl 8));
    WriteOutBold(bvlRegs,4,6,HexByte(Game6502.S) ,HiTextColor + (RegsColor Shl 8));

    { Display screen info data }

//    WriteOutBold(bvlTIARegs,1,1,'TIA register contents',NormTextColor + (TIA_Color Shl 8));
//    WriteOutBold(bvlInputRegs,1,1,'Input register contents',NormTextColor + (Input_Color Shl 8));
//    WriteOutBold(bvlObjectLoc,1,1,'Horizontal object positions',NormTextColor + (ObjLoc_Color Shl 8));
    WriteOutBold(bvlData,1,1,'6502 RAM area',NormTextColor + (DataColor Shl 8));
  End; // ShowBasicInfo

Begin
  FillInBevel(bvlInstructions,DisasmColor);
  FillInBevel(bvlFlags,FlagsColor);
  FillInBevel(bvlRegs,RegsColor);
  FillInBevel(bvlScreenData,ScrDatColor);
  FillInBevel(bvlTIARegs,TIA_Color);
  FillInBevel(bvlInputRegs,Input_Color);
  FillInBevel(bvlObjectLoc,ObjLoc_Color);
  FillInBevel(bvlData,DataColor);
  
  ShowBasicInfo;

//  WriteOut(254,127,'F1-Help',FlagsColor + (BackColor Shl 8));

  { Display data area }

  For I := 0 To DataLines - 1 Do
  Begin
    WriteOutBold(bvlData,1,2 + I,HexWord(DataTop + I * $10),NormTextColor + (DataColor Shl 8));
    For J := 0 To $F Do
    Begin
      WriteOut(bvlData,6 + J * 3,2 + I, HexByte(Mem6502[DataTop + I * $10 + J]),
       NormTextColor + (DataColor Shl 8));
      If (J And $F) = 7 Then
       WriteOut(bvlData,8 + (J And $F) * 3,2 + I,'-',NormTextColor + (DataColor Shl 8));
    End; { For J }
  End; { For I }
{
  WriteOut(254,135,IntToStr(MemAvail),FlagsColor + (BackColor Shl 8));

  WriteOut(254,145,IntToStr(SN1),FlagsColor + (BackColor Shl 8));
  WriteOut(254,155,IntToStr(SN2),FlagsColor + (BackColor Shl 8));
  WriteOut(254,165,IntToStr(SN3),FlagsColor + (BackColor Shl 8));
  WriteOut(254,175,IntToStr(SN4),FlagsColor + (BackColor Shl 8));
}
End; { TfrmDebugger6502.Display }

Function TfrmDebugger6502.BufW(Addr: Word): Word;
Var L,H: Word;
Begin
  L := Mem6502[Addr];
  H := Mem6502[(Addr + 1) And $FFFF];
  BufW := L + (H Shl 8);
End; // TfrmDebugger6502.BufW

procedure TfrmDebugger6502.FormPaint(Sender: TObject);
Var I,J,K,H: Integer;
begin
  Display;

  H := Canvas.TextHeight('Mg');

  // Set scrollbar position

  I := TopAddr;
  If I < 0 Then I := 0;
  If I > sbInstructions.Max Then I := sbInstructions.Max;
  sbInstructions.Position := I;

  { Display instructions }

  Addr := TopAddr;
  _DLines := (bvlInstructions.Height - 2) Div H;
//  _DLines := HRDisasmLines;
  For I := 0 To _DLines - 1 Do
  Begin
    If Addr = Game6502.PC Then
    Begin
      Color := PCTextColor + (HiTextColor Shl 8);
      FBox(bvlInstructions.Left + 1,bvlInstructions.Top + I * H + 1,
           bvlInstructions.Left + bvlInstructions.Width - 2,
           bvlInstructions.Top + I * H + 1 + H,HiTextColor);
    End
    Else
    Begin
      If I = 0 Then
      Begin
        Color := NormTextColor + (TopAsmColor Shl 8);
        FBox(bvlInstructions.Left + 1,bvlInstructions.Top + I * H + 1,
             bvlInstructions.Left + bvlInstructions.Width - 2,
             bvlInstructions.Top + I * H + 1 + H,TopAsmColor);
      End
      Else
      Begin
        Color := NormTextColor + (DisasmColor Shl 8);
        FBox(bvlInstructions.Left + 1,bvlInstructions.Top + I * H + 1,
             bvlInstructions.Left + bvlInstructions.Width - 2,
             bvlInstructions.Top + I * H + 1 + H,DisasmColor);
      End;
    End;
    Opcode := Mem6502[Addr];

    WriteOutBold(bvlInstructions,1,1 + I,HexWord(Addr),Color);

    For J := 0 To Bytes[Opcode] - 1 Do
     WriteOut(bvlInstructions,7 + J * 2,1 + I,HexByte(Mem6502[(Addr + J) And $FFFF]),Color);

    { Write cycles }

    WriteOut(bvlInstructions,15,1 + I,Mnem[Opcode],Color);
(*
    WriteSmOut(2,2 + I * 8,HexWord(Addr),Color);

    For J := 0 To Bytes[Opcode] - 1 Do
    Begin
      WriteSmOut(44 + J * 12,2 + I * 8,
       HexByte(Mem6502[Addr + J]),Color);
    End; { For J }

    { Write cycles }

    WriteSmOut(88,2 + I * 8,Mnem[Opcode],Color);
*)
    OTyp    := ATyp[Opcode];
    Operand := '';
    If OTyp = 'ABS' Then Operand := HexWord(BufW(Addr + 1) And $FFFF);
    If OTyp = 'A.X' Then Operand := HexWord(BufW(Addr + 1) And $FFFF) + ',X';
    If OTyp = 'A.Y' Then Operand := HexWord(BufW(Addr + 1) And $FFFF) + ',Y';
    If OTyp = 'ASY' Then Operand := '(' + HexWord(BufW(Addr + 1) And $FFFF) + ',Y) & S';
    If OTyp = 'IND' Then Operand := '(' + HexWord(BufW(Addr + 1) And $FFFF) + ')';
    If OTyp = 'I.X' Then Operand := '(' + HexByte(Mem6502[(Addr + 1) And $FFFF]) + ',X)';
    If OTyp = 'I.Y' Then Operand := '(' + HexByte(Mem6502[(Addr + 1) And $FFFF]) + '),Y';
    If OTyp = 'ACC' Then Operand := 'A';
    If OTyp = 'IMM' Then Operand := '#' + HexByte(Mem6502[(Addr + 1) And $FFFF]);
    If OTyp = 'Z.P' Then Operand := HexByte(Mem6502[(Addr + 1) And $FFFF]);
    If OTyp = 'Z.X' Then Operand := HexByte(Mem6502[(Addr + 1) And $FFFF]) + ',X';
    If OTyp = 'Z.Y' Then Operand := HexByte(Mem6502[(Addr + 1) And $FFFF]) + ',Y';
    If OTyp = 'I+A' Then Operand := '#' + HexByte(Mem6502[(Addr + 1) And $FFFF]) + ' + A';
    If OTyp = 'REL' Then
    Begin
      K := Mem6502[(Addr + 1) And $FFFF];
      J := Addr;
      Asm
        MOV   CX,WORD PTR J
        ADD   CX,2
        MOV   AL,BYTE PTR K
        CBW
        ADD   CX,AX
        MOV   WORD PTR J,CX
      End; { Asm }
      Operand := HexWord(J);
    End;
    WriteOut(bvlInstructions,21,1 + I,Operand,Color);
//    WriteSmOut(136,2 + I * 8,Operand,Color);

    Inc(Addr,Bytes[Opcode]);
  End; { For I }
end;

Procedure TfrmDebugger6502.InitDebugger;
Begin
  Font.Name := FontName;
  Font.Size := FontSize;
  TopAddr   := Game6502.PC;
End; // TfrmDebugger6502.InitDebugger

procedure TfrmDebugger6502.FormShow(Sender: TObject);
begin
  If Not Showing Then
  Begin
    Showing := True;
    Caption := 'IntvWin ' + Version + ' Keyboard Component (6502)';
    InitDebugger;
    btnStop.Enabled := False;
    sbData.LargeChange := DataLines;
    If Not frmDebugger.Showing Then
    Begin
      If Not frmDebugger.Visible
       Then frmDebugger.Show
       Else frmDebugger.FormShow(Self);
    End;
    Showing := False;
  End;
end;

procedure TfrmDebugger6502.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  If Not Closing Then
  Begin
    Closing := True;
    If Not frmDebugger.Closing Then frmDebugger.Close;
    Closing := False;
  End; 
end;

procedure TfrmDebugger6502.FormResize(Sender: TObject);
Var W,H: Integer;
begin

  // Get character dimensions

  W := Canvas.TextWidth('M');
  H := Canvas.TextHeight('Mg');

  // There are a minimum required width and height.  Don't allow anything smaller.

  If ClientWidth < 53 * W + 10 Then ClientWidth := 53 * W + 10;
  If ClientHeight < (23 + DataLines) * H + 14 + pnlButtons.Height Then
   ClientHeight := (23 + DataLines) * H + 14 + pnlButtons.Height;

  // Set positions

  bvlFlags.Width         := 10 * W + 2;
  bvlRegs.Width          := bvlFlags.Width;
  bvlScreenData.Width    := bvlFlags.Width;

  bvlFlags.Height        := 2 * H + 2;
  bvlRegs.Height         := 6 * H + 2;
  bvlScreenData.Height   := 6 * H + 2;

  bvlRegs.Top            := bvlFlags.Height;
  bvlScreenData.Top      := bvlRegs.Top + bvlRegs.Height;

  bvlFlags.Left          := ClientWidth - bvlRegs.Width;
  bvlRegs.Left           := bvlFlags.Left;
  bvlScreenData.Left     := bvlFlags.Left;

  bvlinstructions.Width  := bvlFlags.Left - sbInstructions.Width;
  sbInstructions.Left    := bvlInstructions.Width;
  btnPC.Left             := sbInstructions.Left;
  btnTop.Left            := sbInstructions.Left;

  bvlTIARegs.Width       := ClientWidth;
  bvlInputRegs.Width     := ClientWidth;
  bvlObjectLoc.Width     := ClientWidth;
  bvlData.Width          := ClientWidth;

  bvlTIARegs.Height      := 4 * H + 2;
  bvlInputRegs.Height    := 2 * H + 2;
  bvlObjectLoc.Height    := 2 * H + 2;
  bvlData.Height         := (DataLines + 1) * H + 2;//9 * H + 2;

  sbData.Top             := bvlData.Top;
  sbData.Height          := bvlData.Height;
  sbData.Left            := bvlData.Left + bvlData.Width - sbData.Width;

  bvlData.Top            := pnlButtons.Top - bvlData.Height;
  bvlObjectLoc.Top       := bvlData.Top - bvlObjectLoc.Height;
  bvlInputRegs.Top       := bvlObjectLoc.Top - bvlInputRegs.Height;
  bvlTIARegs.Top         := bvlInputRegs.Top - bvlTIARegs.Height;
  bvlInstructions.Height := bvlTIARegs.Top - bvlInstructions.Top;
  sbInstructions.Height  := bvlInstructions.Height - btnPC.Height - btnTop.Height;
  btnPC.Top              := sbInstructions.Height + btnTop.Height;
end;

procedure TfrmDebugger6502.btnTraceClick(Sender: TObject);
begin
  Opcode := Mem6502[Game6502.PC];
  OTyp   := ATyp[Opcode];
  If Mnem[Opcode] = 'JSR' Then
  Begin
    DebugAddr := BufW((Game6502.PC + 1) And $FFFF);
  End
  Else
   If Mnem[Opcode] = 'JMP' Then
   Begin
     If OTyp = 'ABS'
      Then DebugAddr := BufW((Game6502.PC + 1) And $FFFF)
      Else DebugAddr := BufW(BufW((Game6502.PC + 1) And $FFFF));
   End
   Else
    If Mnem[Opcode] = 'BPL' Then
    Begin
      If (Game6502.P And $80) = 0
       Then DebugAddr := Game6502.PC + ShortInt(Mem6502[Game6502.PC + 1] + 2)
       Else DebugAddr := Game6502.PC + Bytes[Opcode];
    End
    Else
     If Mnem[Opcode] = 'BMI' Then
     Begin
       If (Game6502.P And $80) <> 0
        Then DebugAddr := Game6502.PC + ShortInt(Mem6502[Game6502.PC + 1] + 2)
        Else DebugAddr := Game6502.PC + Bytes[Opcode];
     End
     Else
      If Mnem[Opcode] = 'BVC' Then
      Begin
        If (Game6502.P And $40) = 0
         Then DebugAddr := Game6502.PC + ShortInt(Mem6502[Game6502.PC + 1] + 2)
         Else DebugAddr := Game6502.PC + Bytes[Opcode];
      End
      Else
       If Mnem[Opcode] = 'BVS' Then
       Begin
         If (Game6502.P And $40) <> 0
          Then DebugAddr := Game6502.PC + ShortInt(Mem6502[Game6502.PC + 1] + 2)
          Else DebugAddr := Game6502.PC + Bytes[Opcode];
       End
       Else
        If Mnem[Opcode] = 'BCC' Then
        Begin
          If (Game6502.P And 1) = 0
           Then DebugAddr := Game6502.PC + ShortInt(Mem6502[Game6502.PC + 1] + 2)
           Else DebugAddr := Game6502.PC + Bytes[Opcode];
        End
        Else
         If Mnem[Opcode] = 'BCS' Then
         Begin
           If (Game6502.P And 1) <> 0
            Then DebugAddr := Game6502.PC + ShortInt(Mem6502[Game6502.PC + 1] + 2)
            Else DebugAddr := Game6502.PC + Bytes[Opcode];
         End
         Else
          If Mnem[Opcode] = 'BNE' Then
          Begin
            If (Game6502.P And 2) = 0
             Then DebugAddr := Game6502.PC + ShortInt(Mem6502[Game6502.PC + 1] + 2)
             Else DebugAddr := Game6502.PC + Bytes[Opcode];
          End
          Else
           If Mnem[Opcode] = 'BEQ' Then
           Begin
             If (Game6502.P And 2) <> 0
              Then DebugAddr := Game6502.PC + ShortInt(Mem6502[Game6502.PC + 1] + 2)
              Else DebugAddr := Game6502.PC + Bytes[Opcode];
           End
           Else
            If Mnem[Opcode] = 'RTS' Then DebugAddr := (BufW(Game6502.S + $101) + 1) And $FFFF
            Else
             If Mnem[Opcode] = 'BRK' Then DebugAddr := BufW($FFFE)
             Else
              If Mnem[Opcode] = 'RTI' Then DebugAddr := BufW(Game6502.S + $102) And $FFFF
              Else DebugAddr := Game6502.PC + Bytes[Opcode];
  Debug6502 := True;
  frmDebugger.Enable(True);
  Emulate;
  frmDebugger.Enable(False);
  frmMain.Display;
end;

procedure TfrmDebugger6502.btnGoClick(Sender: TObject);
begin
  frmDebugger.btnGoClick(Self);
end;

procedure TfrmDebugger6502.btnSkipClick(Sender: TObject);
begin
  Opcode := Mem6502[Game6502.PC];
  OTyp   := ATyp[Opcode];
  If (Mnem[Opcode] = 'JSR') Or (Mnem[Opcode] = 'BRK') Then
  Begin
    DebugAddr := Game6502.PC + Bytes[Opcode];
    Debug6502 := True;
    frmDebugger.Enable(True);
    Emulate;
    frmDebugger.Enable(False);
    frmMain.Display;
  End
  Else btnTraceClick(Self);
end;

procedure TfrmDebugger6502.btnHereClick(Sender: TObject);
begin
  Opcode    := Mem6502[TopAddr];
  DebugAddr := TopAddr;
  Debug6502 := True;
  frmDebugger.Enable(True);
  Emulate;
  frmDebugger.Enable(False);
  frmMain.Display;
end;

procedure TfrmDebugger6502.btnMemClick(Sender: TObject);
Var
  St                  : String;
  HexAddr,Code,HexVal : Integer;

begin
  St := Trim(InputBox('Change memory contents','Enter new data in the form "address=value"',''));
  If St <> '' Then
  Begin
    Code := Pos('=',St);
    If Code <> 0 Then
    Begin
      HexAddr := ValHex(Trim(Copy(St,1,Code - 1)));
      If (HexAddr >= 0) And (HexAddr >= $80) Then
      Begin
        St   := Trim(Copy(St,Code + 1,Length(St) - Code));
        Code := Pos(' ',St);
        If (Code = 0) And (St <> '') Then Code := Length(St) + 1;
        While Code <> 0 Do
        Begin
          HexVal := ValHex(Trim(Copy(St,1,Code - 1)));
          If HexVal >= 0 Then Mem6502[HexAddr] := HexVal And $FF;
          Inc(HexAddr);
          St   := Trim(Copy(St,Code + 1,Length(St) - Code));
          Code := Pos(' ',St);
          If (Code = 0) And (St <> '') Then Code := Length(St) + 1;
        End; { While }
        Repaint;
      End;
    End;
  End;
end;

procedure TfrmDebugger6502.btnSaveClick(Sender: TObject);
begin
  If dlgSave.Execute Then
  Begin
    St := Trim(dlgSave.FileName);
    If St <> '' Then
    Begin
    {$I-}
      AssignFile(OutFile,St);
      ReWrite(OutFile,1);
    {$I+}
      If IOResult = 0 Then
      Begin
        BlockWrite(OutFile,Mem6502,SizeOf(Mem6502));
        CloseFile(OutFile);
      End;
    End;
  End;
end;

procedure TfrmDebugger6502.btnStopClick(Sender: TObject);
begin
  frmDebugger.btnStopClick(Self);
end;

procedure TfrmDebugger6502.FormCreate(Sender: TObject);
begin
  Scaled  := False;
  Showing := False;
  Closing := False;
  DataTop := 0;
end;

procedure TfrmDebugger6502.sbInstructionsScroll(Sender: TObject;
  ScrollCode: TScrollCode; var ScrollPos: Integer);
Var I,J,K: Integer;
begin
  Case ScrollCode Of
    scLineUp: If TopAddr > 0 Then Dec(TopAddr);
  scLineDown: Begin
                Opcode := Mem6502[TopAddr];
                Inc(TopAddr,Bytes[Opcode]);
              End;
    scPageUp: Begin
                I := TopAddr;
                Repeat
                  J := 0;
                  K := I;
                  While K < TopAddr Do
                  Begin
                    Inc(J);
                    Opcode := Mem6502[K];
                    Inc(K,Bytes[Opcode]);
                  End; { While }
                  If J < _DLines - 1 Then Dec(I);
                Until J >= _Dlines - 1;
                TopAddr := I;
              End;
  scPageDown: TopAddr := Addr;
  scPosition,scTrack: TopAddr := ScrollPos;
       scTop: TopAddr := 0;
    scBottom: TopAddr := $FFFF;       
  End; // Case

//  TopAddr := sbInstructions.Position + $1000;
//  If TopAddr < 0     Then TopAddr := 0;
  Repaint;
end;

procedure TfrmDebugger6502.btnPCClick(Sender: TObject);
begin
  TopAddr := Game6502.PC;
  Repaint;
end;

procedure TfrmDebugger6502.btnTopClick(Sender: TObject);
begin
  TopAddr := 0;
  Repaint;
end;

procedure TfrmDebugger6502.btnRegClick(Sender: TObject);
Var
  St          : String;
  Code,HexVal : Integer;

begin
  St   := UpperCase(Trim(InputBox('Change register contents','Enter new value in the form reg=value','')));
  Code := Pos(' ',St);
  While Code <> 0 Do
  Begin
    Delete(St,Code,1);
    Code := Pos(' ',St);
  End; { While }
  If St <> '' Then
  Begin
    If Copy(St,1,3) = 'PC=' Then
    Begin
      HexVal := ValHex(Copy(St,4,Length(St) - 3));
      If HexVal >= 0 Then
      Begin
        Game6502.PC := HexVal And $FFFF;
        Repaint;
      End;
    End;
    If Copy(St,1,2) = 'P=' Then
    Begin
      HexVal := ValHex(Copy(St,3,Length(St) - 2));
      If HexVal >= 0 Then
      Begin
        Game6502.P := HexVal And $FF;
        Repaint;
      End;
    End;
    If Copy(St,1,2) = 'A=' Then
    Begin
      HexVal := ValHex(Copy(St,3,Length(St) - 2));
      If HexVal >= 0 Then
      Begin
        Game6502.A := HexVal And $FF;
        Repaint;
      End;
    End;
    If Copy(St,1,2) = 'X=' Then
    Begin
      HexVal := ValHex(Copy(St,3,Length(St) - 2));
      If HexVal >= 0 Then
      Begin
        Game6502.X := HexVal And $FF;
        Repaint;
      End;
    End;
    If Copy(St,1,2) = 'Y=' Then
    Begin
      HexVal := ValHex(Copy(St,3,Length(St) - 2));
      If HexVal >= 0 Then
      Begin
        Game6502.Y := HexVal And $FF;
        Repaint;
      End;
    End;
    If Copy(St,1,2) = 'S=' Then
    Begin
      HexVal := ValHex(Copy(St,3,Length(St) - 2));
      If HexVal >= 0 Then
      Begin
        Game6502.S := HexVal And $FF;
        Repaint;
      End;
    End;
  End;
end;

procedure TfrmDebugger6502.btnExpressionClick(Sender: TObject);
Var ExpError: Boolean;
begin
  St := Trim(InputBox('Break on expression','Enter breakpoint expression',BreakExp));

  { Get rid of the last break expression collection, if any }

  If BreakExpColl6502 <> Nil Then
  Begin
    BreakExpColl6502.Free;
    BreakExpColl6502 := Nil;
  End;
  ExpError := False;
  If St <> '' Then
  Begin
    BreakExpColl6502 := PostFix(St);
    If BreakExpColl6502 <> Nil Then
    Begin

      { Try to evaluate it to make sure it's ok (ignore the result) }

      Evaluate6502(BreakExpColl6502,Mem6502,0,0,0,0,0,0,False,False,0,ExpError);
      If ExpError Then
      Begin
        BreakExpColl6502.Free;
        BreakExpColl6502 := Nil;
        St := '';
      End;
    End
    Else
    Begin
      St       := '';
      ExpError := True;
    End;
  End;
  BreakExp := St;  { Remember the last one }
  If ExpError Then ShowMessage('Error in expression');
end;

procedure TfrmDebugger6502.sbDataScroll(Sender: TObject;
  ScrollCode: TScrollCode; var ScrollPos: Integer);
Var I: Integer;
begin
  Case ScrollCode Of
    scLineUp: If DataTop > 15 Then Dec(DataTop,16);
  scLineDown: If DataTop < 65536 - (DataLines * 16) Then Inc(DataTop,16);
    scPageUp,
  scPageDown,
  scPosition,scTrack: Begin
                        I := ScrollPos * 16;
                        If I < 0 Then I := 0;
                        If I > 65536 - (DataLines * 16) Then I := 65536 - (DataLines * 16);
                        DataTop := I;
                      End;
       scTop: DataTop := 0;
    scBottom: DataTop := 65536 - (DataLines * 16);
  End; // Case
  Repaint;
end;

Initialization
  BreakExp := '';
end.

// ----------------------------------------------------------------------
// IntvWin - Mattel Intellivision Emulator
// Copyright (C) 2000 John Dullea
//
//  This program is free software; you can redistribute it and/or modify
//  it under the terms of the GNU General Public License as published by
//  the Free Software Foundation; either version 2 of the License, or
//  (at your option) any later version.
//
//  This program is distributed in the hope that it will be useful,
//  but WITHOUT ANY WARRANTY; without even the implied warranty of
//  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
//  GNU General Public License for more details.
//
//  You should have received a copy of the GNU General Public License
//  along with this program; if not, write to the Free Software
//  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
// ----------------------------------------------------------------------
