unit fm_IOPort1;
{ PortTest program  IO Port form

Revisions
---------
98-06-01 GW Original

Copyright info: see main form unit
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, ExtCtrls, StdCtrls, Menus;

type
  Tfm_IOPort = class(TForm)
    Panel1: TPanel;
    sg_Heads: TStringGrid;
    sg_IOPort: TStringGrid;
    lb_Scratch: TLabel;
    bt_Change: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure sg_IOPortSelectCell(Sender: TObject; Col, Row: Integer;
      var CanSelect: Boolean);
    procedure sg_IOPortMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure bt_ChangeClick(Sender: TObject);
    procedure sg_IOPortEnter(Sender: TObject);
    procedure sg_IOPortExit(Sender: TObject);
  private
    { Private declarations }
    AddrBase:  integer;
    AddrCount: integer;

    sg_IOPort_EditCol  : integer;
    sg_IOPort_EditRow  : integer;

    procedure  sg_IOPort_Init;
    procedure  UpdateBinFromHex(RowNum: integer; RW: char);
    procedure  UpdateHexFromBin(RowNum: integer; RW: char);

    procedure  sg_IOPort_EditClear;
    procedure  sg_IOPort_Editing(NewCol, NewRow: integer);
    procedure  sg_IOPort_EditCommitCheck(NewCol, NewRow: integer; Leaving: Boolean);
    procedure  sg_IOPort_EditCommit; // OldCol, OldRow

    procedure WriteValueChangeCheck(RowNum: integer);

  public
    { Public declarations }
  end;

var
  fm_IOPort: Tfm_IOPort;

//==========================================================
implementation
//==========================================================

uses fm_BaseCount1, gwutil_1, gwportio;

{$R *.DFM}

Type
  Tgcf1 = (gcf_Addr, gcf_Read, gcf_Write, gcf_Old);

  TColInfo = record
    Width: integer;
    Caption: string;
    Func: Tgcf1;
    Base:  shortint;   //0-7, 10=decimal, 16=hex, -1 = none
  end;

Const
  { grid col constants }
  gc_Begin  =  0;
  gc_AddHex =  0; gc_AddDec =  1;
  gc_RR     =  2; gc_RHex   =  3;
  gc_R7     =  4; gc_R6     =  5; gc_R5     =  6; gc_R4     =  7;
  gc_R3     =  8; gc_R2     =  9; gc_R1     = 10; gc_R0     = 11;
  gc_WArrow = 12; gc_WW     = 13; gc_WHex   = 14;
  gc_W7     = 15; gc_W6     = 16; gc_W5     = 17; gc_W4     = 18;
  gc_W3     = 19; gc_W2     = 20; gc_W1     = 21; gc_W0     = 22;
  gc_WOld   = 23;
  gc_End    = 23;
  gc_Count = gc_End-gc_Begin+1;

  gcb_Doit  =  -1;
  gcb_Arrow =  -2;
  gcb_Dec   = -10;
  gcb_Hex   = -16;

  MainColInfo : array[gc_Begin..gc_End] of TColInfo = (
    (Width: 40; Caption: 'Hex' ; Func: gcf_Addr ;  Base: gcb_Hex ),
    (Width: 40; Caption: 'Dec' ; Func: gcf_Addr ;  Base: gcb_Dec ),

    (Width: 16; Caption: 'R'   ; Func: gcf_Read ;  Base: gcb_Doit ),
    (Width: 40; Caption: 'Hex' ; Func: gcf_Read ;  Base: gcb_Hex  ),
    (Width: 16; Caption: '7'   ; Func: gcf_Read ;  Base:  7 ),
    (Width: 16; Caption: '6'   ; Func: gcf_Read ;  Base:  6 ),
    (Width: 16; Caption: '5'   ; Func: gcf_Read ;  Base:  5 ),
    (Width: 16; Caption: '4'   ; Func: gcf_Read ;  Base:  4 ),
    (Width: 16; Caption: '3'   ; Func: gcf_Read ;  Base:  3 ),
    (Width: 16; Caption: '2'   ; Func: gcf_Read ;  Base:  2 ),
    (Width: 16; Caption: '1'   ; Func: gcf_Read ;  Base:  1 ),
    (Width: 16; Caption: '0'   ; Func: gcf_Read ;  Base:  0 ),

    (Width: 16; Caption: '->'  ; Func: gcf_Write;  Base: gcb_Arrow),
    (Width: 16; Caption: 'W'   ; Func: gcf_Write;  Base: gcb_Doit ),
    (Width: 40; Caption: 'Hex' ; Func: gcf_Write;  Base: gcb_Hex  ),
    (Width: 16; Caption: '7'   ; Func: gcf_Write;  Base:  7 ),
    (Width: 16; Caption: '6'   ; Func: gcf_Write;  Base:  6 ),
    (Width: 16; Caption: '5'   ; Func: gcf_Write;  Base:  5 ),
    (Width: 16; Caption: '4'   ; Func: gcf_Write;  Base:  4 ),
    (Width: 16; Caption: '3'   ; Func: gcf_Write;  Base:  3 ),
    (Width: 16; Caption: '2'   ; Func: gcf_Write;  Base:  2 ),
    (Width: 16; Caption: '1'   ; Func: gcf_Write;  Base:  1 ),
    (Width: 16; Caption: '0'   ; Func: gcf_Write;  Base:  0 ),
    (Width: 0; Caption: 'Old' ; Func: gcf_Old ;  Base:  gcb_Hex )
  );

  gch_Begin  =  0;
  gch_Add    =  0;
  gch_Read   =  1;
  gch_Write  =  2;
  gch_Dummy  =  3;
  gch_End    =  3;

  gch_Count = gch_End-gch_Begin+1;

  HeadColInfo : array[gch_Begin..gch_End] of TColInfo = (
    (Width: 80+1;      Caption: 'Port Address' ),
    (Width: 40+ 9*17;  Caption: '     Read'    ),
    (Width: 40+10*17;  Caption: '     Write'   ),
    (Width: 0;         Caption: ''             )
  );


//----------------------------------------------
procedure Tfm_IOPort.sg_IOPort_Init;
//----------------------------------------------
Var
  AddrIx, RowNum: integer;
  rect: TGridRect;
Begin
  sg_IOPort.RowCount := 1; { to clear existing data }
  sg_IOPort.RowCount := 1 + AddrCount;
  If sg_IOPort.RowCount < 2 then
  Begin { fixup due to losing fixed row if rowcount < 2 }
    sg_IOPort.RowCount := 2;
  end;
  sg_IOPort.FixedRows := 1;

  For AddrIx := 0 to AddrCount-1 do
  Begin
    RowNum := AddrIx + 1;
    sg_IOPort.Cells[gc_AddHex , RowNum] := IntToHex(AddrBase+AddrIx,4);
    sg_IOPort.Cells[gc_AddDec , RowNum] := IntToStr(AddrBase+AddrIx);
    sg_IOPort.Cells[gc_RR     , RowNum] := 'R';
    sg_IOPort.Cells[gc_RHex   , RowNum] := '??'; // IntToHex(ByteFake,2);
    sg_IOPort.Cells[gc_WArrow , RowNum] := '->';
    sg_IOPort.Cells[gc_WW     , RowNum] := '-';
    sg_IOPort.Cells[gc_WOld   , RowNum] := '--';

    UpdateBinFromHex(RowNum,'R');
  end;
  rect.Left   := gc_WHex;
  rect.Right  := gc_WHex;
  rect.Top    := 1;
  rect.Bottom := 1;

  sg_IOPort.Selection := rect;
end;

//----------------------------------------------
procedure Tfm_IOPort.UpdateBinFromHex(RowNum: integer; RW: char);
//----------------------------------------------
Var
  HexCol, HexVal, B, N: integer;
  BitChar: char;
Label the_end;
Begin
  HexCol := 0;
  Case RW of
    'R': HexCol :=  gc_RHex;
    'W': HexCol :=  gc_WHex;
  end;
  If HexCol = 0 then goto the_end;

  If sg_IOPort.Cells[HexCol,RowNum] = '??' then
  For N := 0 to 7 do
  Begin
    BitChar := ' ';
    sg_IOPort.Cells[HexCol+8-N,RowNum] := BitChar;
    goto the_end;
  end;


  HexVal := HexToIntDef(sg_IOPort.Cells[HexCol,RowNum], -1);
  For N := 0 to 7 do
  Begin
    BitChar := '1';
    B := 1 shl N;
    If (B and HexVal) = 0 then BitChar := '0';
    sg_IOPort.Cells[HexCol+8-N,RowNum] := BitChar;
  end;
the_end:
end;

//----------------------------------------------
procedure Tfm_IOPort.UpdateHexFromBin(RowNum: integer; RW: char);
//----------------------------------------------
Var
  HexCol, HexVal, B, N: integer;
  BitChar: char;
Label the_end;
Begin
  HexCol := 0;
  Case RW of
    'R': HexCol :=  gc_RHex;
    'W': HexCol :=  gc_WHex;
  end;
  If HexCol = 0 then goto the_end;

  HexVal := 0;
  For N := 0 to 7 do
  Begin
    BitChar := (sg_IOPort.Cells[HexCol+8-N,RowNum] + '0')[1];
    If BitChar = '1' then
    Begin
      B := 1 shl N;
      HexVal := HexVal or B;
    end;
  end;
  sg_IOPort.Cells[HexCol,RowNum] := IntToHex(HexVal, 2);
the_end:
end;

//----------------------------------------------
procedure Tfm_IOPort.FormCreate(Sender: TObject);
//----------------------------------------------
Var
  ColNum: integer;

begin
  // Set up string grids
  sg_IOPort.ColCount := gc_Count;
  For ColNum := gc_Begin to gc_End do
  Begin
    sg_IOPort.ColWidths[ColNum] := MainColInfo[ColNum].Width;
    sg_IOPort.Cells[ColNum,0]   := MainColInfo[ColNum].Caption;
  end;

  sg_Heads.ColCount := gch_Count;
  For ColNum := gch_Begin to gch_End do
  Begin
    sg_Heads.ColWidths[ColNum] := HeadColInfo[ColNum].Width;
    sg_Heads.Cells[ColNum,0]   := HeadColInfo[ColNum].Caption;
  end;

  AddrBase  := 0;
  AddrCount := $10;

  sg_IOPort_Init;
  sg_IOPort_EditClear;
end;

//--------------------------------------------------
procedure Tfm_IOPort.sg_IOPortSelectCell(Sender: TObject; Col, Row: Integer;
  var CanSelect: Boolean);
//--------------------------------------------------
Var
  CellRect: TRect;
  OldRow, OldCol: integer;

begin
  CanSelect := (
    (MainColInfo[Col].Func = gcf_Write) and
      ((MainColInfo[Col].Base >= 0) or (MainColInfo[Col].Base = gcb_Hex))
    );

  sg_IOPort_EditCommitCheck(Col, Row, CanSelect);

  if CanSelect then
  Begin
    sg_IOPort_Editing(Col, Row);
  end;
end;

//--------------------------------------------------
procedure Tfm_IOPort.sg_IOPortMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
//--------------------------------------------------
Var
  ColNum, RowNum: integer;
  S, OutB, AddHex: string;
  Addr: integer;
  TempByte: byte;

begin
  sg_IOPort.MouseToCell(X, Y, ColNum, RowNum);
  // sg_IOPort_EditCommitCheck(ColNum, RowNum, false); redundant

  // lb_Scratch.Caption := 'Col ' + IntToStr(ColNum) + ',Row ' + IntToStr(RowNum);

  Case ColNum of
    gc_RR: Begin
      AddHex := sg_IOPort.Cells[gc_AddHex, RowNum];
      Addr := HexToIntDef(AddHex,0);
      TempByte := PortIn(Addr);
      sg_IOPort.Cells[gc_RHex   , RowNum] := IntToHex(TempByte,2);
      UpdateBinFromHex(RowNum,'R');
    end;
    gc_WArrow: Begin
      S := sg_IOPort.Cells[gc_RHex   , RowNum];
      If S = '??' then S := '00';
      sg_IOPort.Cells[gc_WHex   , RowNum] := S;
      UpdateBinFromHex(RowNum,'W');
      WriteValueChangeCheck(RowNum);
    end;
    gc_WW: Begin
      OutB     := Copy(sg_IOPort.Cells[gc_WHex  , RowNum]+'00',1,2);
      TempByte := HexToIntDef(OutB,0);
      AddHex := sg_IOPort.Cells[gc_AddHex, RowNum];
      Addr := HexToIntDef(AddHex,0);
      S := 'Writing '+ OutB +' to port '+AddHex;
      Application.MessageBox(PChar(S), '',MB_OK );
      PortOut(Addr, TempByte);
      sg_IOPort.Cells[gc_WW  , RowNum] := '-';
      sg_IOPort.Cells[gc_WOld, RowNum] := OutB;
    end;
  end; { case }
end;

//--------------------------------------------------
procedure Tfm_IOPort.bt_ChangeClick(Sender: TObject);
//--------------------------------------------------
Var
  Status: integer;
begin
  fm_BaseCount.Top := Top+50;
  fm_BaseCount.Left := Left+50;

  status := fm_BaseCount.ShowModal;
  if status = mrOK then
  Begin
    AddrBase  := fm_BaseCount.LastBase;
    AddrCount := fm_BaseCount.LastCount;
    sg_IOPort_Init;
  end;
end;

//------------------------------------------------
procedure Tfm_IOPort.sg_IOPortEnter(Sender: TObject);
//------------------------------------------------
begin  // Don't insert code in this proc
  sg_IOPort_Editing(sg_IOPort.Selection.Left, sg_IOPort.Selection.Top);
end;

//------------------------------------------------
procedure Tfm_IOPort.sg_IOPortExit(Sender: TObject);
//------------------------------------------------
begin // Don't insert code in this proc
  sg_IOPort_EditCommitCheck(-1,-1, true);
end;

//------------------------------------------------
procedure Tfm_IOPort.sg_IOPort_EditCommitCheck(NewCol, NewRow: integer; Leaving: Boolean);
//------------------------------------------------
Label the_end;
Begin // Don't insert code in this proc
  If (sg_IOPort_EditCol <> -1) and (sg_IOPort_EditRow <> -1 ) then
    sg_IOPort_EditCommit;

  if Leaving then sg_IOPort_EditClear;
the_end:
end;

//------------------------------------------------
procedure Tfm_IOPort.sg_IOPort_EditClear;
//------------------------------------------------
Begin // Don't insert code in this proc
  sg_IOPort_EditCol   := -1;
  sg_IOPort_EditRow   := -1;
end;

//------------------------------------------------
procedure  Tfm_IOPort.sg_IOPort_Editing(NewCol, NewRow: integer);
//------------------------------------------------
Begin
  sg_IOPort_EditCol   := NewCol;
  sg_IOPort_EditRow   := NewRow;
end;

//------------------------------------------------
procedure  Tfm_IOPort.sg_IOPort_EditCommit;
//------------------------------------------------
// Get here ONLY from EditCommitCheck !!!
Var
  S: string;
Begin
  S := sg_IOPort.Cells[sg_IOPort_EditCol, sg_IOPort_EditRow];

  Case sg_IOPort_EditCol of
    gc_WHex: Begin
      S := IntToHex(HexToIntDef(S,0),2);
      sg_IOPort.Cells[sg_IOPort_EditCol, sg_IOPort_EditRow] := S;

      UpdateBinFromHex(sg_IOPort_EditRow, 'W');
      WriteValueChangeCheck(sg_IOPort_EditRow);
    end;
    gc_W7..gc_W0: Begin
      If Length(S) > 0 then
      Begin
        if S[1] = '1' then S := '1' else
          if S[1] = '0' then S := '0' else S := '0';
      end else S := '0';
      sg_IOPort.Cells[sg_IOPort_EditCol, sg_IOPort_EditRow] := S;
      UpdateHexFromBin(sg_IOPort_EditRow, 'W');
      WriteValueChangeCheck(sg_IOPort_EditRow);
    end;
  end; {case}
end;

//------------------------------------------------------------
procedure Tfm_IOPort.WriteValueChangeCheck(RowNum: integer);
//------------------------------------------------------------
Var
  S: string;
  C: char;
Begin
  S := sg_IOPort.Cells[gc_WOld, RowNum];
  C := '-';
  If S <> sg_IOPort.Cells[gc_WHex, RowNum] then C := 'W';
  sg_IOPort.Cells[gc_WW, RowNum] := C;
end;

end.
