unit uCartPatch;
{
This code is part of the TiCodEd Application, designed to develop for the
TI-99/4a Homecomputer in a modern, structured way.

BSD License
Copyright (c) 2026, Stefan Bauch, TiCodEd <at> lizardware <dot> de

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

1. Redistributions of source code must retain the above copyright notice, this
   list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation
   and/or other materials provided with the distribution.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

}
{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
  EditBtn, ComCtrls, Buttons, Spin, MaskEdit, Grids, Menus, ExtendedNotebook;

type

  { TFormCartPatch }

  TFormCartPatch = class(TForm)
    bbPatch: TBitBtn;
    BitBtn1: TBitBtn;
    cbRelPad: TCheckBox;
    ExtendedNotebook1: TExtendedNotebook;
    FileNameEditDev: TFileNameEdit;
    FileNameEditRel: TFileNameEdit;
    GBHex: TGroupBox;
    MemoHex: TMemo;
    MenuItemInsertLine: TMenuItem;
    MenuItemDeleteLine: TMenuItem;
    OpenDialogSource: TOpenDialog;
    PanelCart: TPanel;
    PopupMenuCart: TPopupMenu;
    sbUp: TSpeedButton;
    sbDown: TSpeedButton;
    SpinEditDev: TSpinEdit;
    SpinEditRel: TSpinEdit;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    StaticText3: TStaticText;
    StaticText4: TStaticText;
    StaticTextBaseDev: TStaticText;
    sgCart: TStringGrid;
    StaticTextBaseRel: TStaticText;
    TabSheetRelease: TTabSheet;
    TabSheetDevelop: TTabSheet;
    procedure bbPatchClick(Sender: TObject);
    procedure FileNameEditDevChange(Sender: TObject);
    procedure FileNameEditRelChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure MenuItemDeleteLineClick(Sender: TObject);
    procedure MenuItemInsertLineClick(Sender: TObject);
    procedure PopupMenuCartPopup(Sender: TObject);
    procedure sbDownClick(Sender: TObject);
    procedure sbUpClick(Sender: TObject);
    procedure sgCartClick(Sender: TObject);
    procedure sgCartDblClick(Sender: TObject);
    procedure sgCartValidateEntry(Sender: TObject; aCol, aRow: Integer;
      const OldValue: string; var NewValue: String);
    procedure SpinEditDevChange(Sender: TObject);
    procedure SpinEditRelChange(Sender: TObject);
  private
    sRow, sCol : Integer;
  public

  end;


var
  FormCartPatch: TFormCartPatch;


implementation

{$R *.lfm}

{ TFormCartPatch }

uses FileUtil,math,uMain;

Type hexBlock = array[0..255] of byte;

VAR HexFN: String[128];
    HexOffset:Longint;

Procedure dbg(l:Integer; txt:ShortString);
begin
  writelogline(l,txt);
end;

procedure HexDisplay;
var i,j,blen,bsize : integer;
    sh,sc : shortstring;
    f : file of byte;
    hb: hexBlock;
    b : byte;
begin
  FormCartPatch.MemoHex.Clear;
  FormCartPatch.GBHex.Caption:='Hex Preview '+HexFN;
  if not fileexists(HexFN) then exit;
  Initialize(hb,256);
  assign(f,HexFN);
  reset(f);
  bsize:=filesize(f);
  if HexOffset>=bsize then HexOffset:=HexOffset-256;
  try
    Seek(f,HexOffset);
    if HexOffset+256<=bsize then blen:=256
                            else blen:=bsize-HexOffset;
    blockread(f,hb,blen);
  finally
    close(f);
  end;
  for i:=0 to 7 do begin
    sc:='';
    sh:='';
    for j:=0 to 31 do begin
      b := hb[i*32+j];
      if i*32+j< blen then sh:=sh+inttohex(b,2)+' '
                      else begin sh:=sh+'   '; b:=32 end;
      if (b>31) and (b<128) then sc:=sc+char(b)
                       else sc:=sc+'.';
    end;
    FormCartPatch.MemoHex.Append(IntToHex(HexOffset+i*32,4)+' : '+sh+'  '+sc);
  end;
  FormCartPatch.MemoHex.VertScrollBar.Position:=0;
end;

procedure HexDisplayNew(fn:String;Page:integer);
begin
  HexFn:=fn;
  HexOffset:=Page*8192;
  HexDisplay;
end;

procedure TFormCartPatch.sgCartDblClick(Sender: TObject);
var
  p: TPoint;
  aCol,aRow,fs: longint;
begin
  p := sgCart.ScreenToClient(Mouse.CursorPos);
  sgCart.MouseToCell(p.x, p.y,aCol,aRow);
  if (aCol=2) and (aRow>0) then if OpenDialogSource.Execute then begin
    sgCart.Cells[aCol,aRow] := OpenDialogSource.FileName;
    fs:=filesize(OpenDialogSource.FileName);
    sgCart.Cells[7,aRow] := IntToStr(fs);
  end;
end;

procedure TFormCartPatch.FormClose(Sender: TObject;
  var CloseAction: TCloseAction);
begin
  sgCart.SaveToCSVFile(ChangeFileExt(Form1.EdFilePrj.Text,'.cart'),';');
  CartDevPath := FileNameEditDev.Text;
  CartDevBase := SpinEditDev.Value;
  CartRelPath := FileNameEditRel.Text;
  CartRelBase := SpinEditRel.Value;
  CartRelPad  := cbRelPad.Checked;
end;

procedure TFormCartPatch.FormCreate(Sender: TObject);
begin
  SpinEditDevChange(NIL);
  SpinEditRelChange(NIL);
end;

procedure TFormCartPatch.FormResize(Sender: TObject);
var w:integer;
begin
  w:=sgCart.Width;
  w:=(w-64-80-80-80-36-80-64-90) DIV 2;
  sgCart.Columns.Items[2].Width:=w;
  sgCart.Columns.Items[9].Width:=w;
end;

procedure TFormCartPatch.FileNameEditDevChange(Sender: TObject);
begin
  if pos('XB29GEMC',UpperCase(FileNameEditDev.Text))>0 then SpinEditDev.Value:=38;
  if pos('XB29GEMG',UpperCase(FileNameEditDev.Text))>0 then ShowMessage('GROM-File! Use XB29GEMC');
  if pos('G.BIN',UpperCase(FileNameEditDev.Text))>0    then ShowMessage('GROM-File! Use xxxxC.BIN or xxxx8.BIN');
  HexDisplayNew(FileNameEditDev.Text,SpinEditDev.Value);
end;

procedure TFormCartPatch.FileNameEditRelChange(Sender: TObject);
begin
  if pos('G.BIN',UpperCase(FileNameEditDev.Text))>0    then ShowMessage('GROM-File! Use xxxxC.BIN or xxxx8.BIN');
  HexDisplayNew(FileNameEditRel.Text,SpinEditRel.Value);
end;

procedure TFormCartPatch.bbPatchClick(Sender: TObject);
type TPage = Array[0..8191] of byte;
var
  cart,fn: shortstring;
  base,r,i,bt: integer;
  p,ptop,pold,fs: longint;
  foffset, flength, fpad,fshift: longint;
  f : file of byte;
  buf : record case byte of
      1 : ( b   :  Array[0..1048575] of byte ); // one Megabyte
      2 : ( page : Array[0..127] of TPage );
  end;

begin
  if ExtendedNotebook1.TabIndex=0 then
  begin
    cart:=FileNameEditDev.Text;
    base:=strtoint(SpinEditDev.Text);
  end else begin
    cart:=FileNameEditRel.Text;
    base:=strtoint(SpinEditRel.Text);
  end;
  dbg(2,'Writing additional banks to cartridge '+cart+' starting with bank '+IntToStr(base)+' as bank 0.');
  if not FileExists(cart) then begin
    dbg(1,'File '+cart+' does not exist.');
    ShowMessage('File '+cart+' does not exist.');
    exit;
  end;
  AssignFile(f,cart);
  ptop := filesize(cart);
  reset(f);
  BlockRead(f,buf,ptop);
  dbg(4,inttostr(ptop)+' bytes read into buffer.');
  p := base*8192;
  CloseFile(f);
  for r:=1 to sgCart.RowCount-1 do begin

    if (r<sgCart.RowCount) and (sgCart.Cells[0,r]<>sgCart.Cells[0,r-1]) then begin
      p:= (strtoint(sgCart.Cells[0,r])+base)*8192;
      dbg(4,'Start new bank : '+inttostr(strtoint(sgCart.Cells[0,r])+base));
    end;

    sgCart.Cells[8,r] := '>'+inttohex((p MOD 8192) + $6000,4);
    fn := sgCart.Cells[2,r];
    fs := filesize(fn);
    AssignFile(f,fn);
    reset(f);
    dbg(4,' * Read file '+fn+' into >'+IntToHex(p));
    foffset := StrtoIntDef(sgCart.Cells[4,r],0);
    if foffset>0 then begin
       Seek(f,foffset);
       dbg(4,'     File Offset : '+inttostr(foffset));
       fs := fs - foffset;
    end;

    flength := StrtoIntDef(sgCart.Cells[5,r],0);
    if flength>0 then begin
       dbg(4,'     File Length : '+inttostr(flength));
       fs := flength;
    end;

    BlockRead(f,buf.b[p],fs);
    pold := p;
    p:=p+fs;

    fpad := StrtoIntDef(sgCart.Cells[3,r],0);
    if fpad>0 then begin
       dbg(4,'     Padding to  : '+inttostr(fpad)+' ('+inttostr(fpad-fs)+' byte)');
       for i:=0 to fpad-fs-1 do buf.b[p+i]:=0;
       p:=p+fpad-fs;
    end;

    if trim(sgCart.Cells[6,r])<>'' then begin
      fshift := StrtoIntDef(sgCart.Cells[6,r],96);
      dbg(4,'     Shifting     : '+inttostr(fshift));
      for i:=pold to p-1 do begin
        bt:=buf.b[i]+fshift;
        if bt>255 then bt:=bt-256;
        buf.b[i] := bt;
      end;
    end;

    CloseFile(f);

  end; //row
  if p>ptop then begin
    ptop := ((p div 8192)+1) * 8192;
    dbg(3,'New cartsize: '+inttostr(ptop)+', '+inttostr(ptop DIV 8192)+' banks');
  end;
  if cbRelPad.Checked then begin
    if (ptop>32768)   and (ptop<=65536)   then ptop:=65536;
    if (ptop>65536)   and (ptop<=131072)  then ptop:=131072;
    if (ptop>131072)  and (ptop<=262144)  then ptop:=262144;
    if (ptop>262144)  and (ptop<=524288)  then ptop:=524288;
    if (ptop>524288)  and (ptop<=1048576) then ptop:=1048576;
  end;
  AssignFile(f,cart);
  rewrite(f);
  Blockwrite(f,buf,ptop);
  dbg(2,'File '+cart+' patched.');
  ShowMessage('File '+cart+' patched, see log for details.');
  CloseFile(f);
end;

procedure TFormCartPatch.FormShow(Sender: TObject);
var s : string;
  i: Integer;
begin
  s := ChangeFileExt(Form1.EdFilePrj.Text,'.cart');
  if fileexists(s) then sgCart.LoadFromCSVFile(s,';');
  FileNameEditDev.Text := CartDevPath;
  FileNameEditRel.Text := CartRelPath;
  SpinEditDev.Value := CartDevBase;
  SpinEditRel.Value := CartRelBase;
  cbRelPad.Checked  := CartRelPad;

  for i:=1 to sgCart.RowCount-1 do begin
    if FileExists(sgCart.Cells[2,i]) then sgCart.Cells[7,i]:=inttostr(filesize(sgCart.Cells[2,i]))
                                     else sgCart.Cells[7,i]:='missing';
  end;
end;

procedure TFormCartPatch.MenuItemDeleteLineClick(Sender: TObject);
begin
  if (sRow>0) and (sgCart.RowCount>1) then sgCart.DeleteRow(sRow);
end;

procedure TFormCartPatch.MenuItemInsertLineClick(Sender: TObject);
begin
  sgCart.InsertRowWithValues(sRow,['0','0','','','','','']);
end;

procedure TFormCartPatch.PopupMenuCartPopup(Sender: TObject);
var p: TPoint;
begin
p := sgCart.ScreenToClient(Mouse.CursorPos);
sgCart.MouseToCell(p.x, p.y,sCol,sRow);
end;

procedure TFormCartPatch.sbDownClick(Sender: TObject);
begin
  HexOffset:=HexOffset+256;
  HexDisplay;
end;

procedure TFormCartPatch.sbUpClick(Sender: TObject);
begin
  HexOffset:=max(HexOffset-256,0);
  HexDisplay;
end;

procedure TFormCartPatch.sgCartClick(Sender: TObject);
var
  p: TPoint;
  aCol,aRow: longint;
begin
  p := sgCart.ScreenToClient(Mouse.CursorPos);
  sgCart.MouseToCell(p.x, p.y,aCol,aRow);
  // ShowMessage('Click:'+IntToStr(aCol)+':'+IntToStr(aRow));
  if (aRow>0) and FileExists(sgCart.Cells[2,aRow]) then begin
    HexFN:=sgCart.Cells[2,aRow];
    HexOffset:=0;
    HexDisplay;
  end;
end;

procedure TFormCartPatch.sgCartValidateEntry(Sender: TObject; aCol,
  aRow: Integer; const OldValue: string; var NewValue: String);
var t1,t2 : integer;
    s : string;
begin
  NewValue:=trim(NewValue);
  if aCol=0 then begin
    t1:=StrtoIntDef(NewValue,-1);
    if t1<0 then NewValue := OldValue
  end;
  if aCol=1 then begin
    t2:=StrtoIntDef(NewValue,-1);
    if t2<0 then NewValue := OldValue
  end;
  if (aCol<2) then begin
    t1 := StrtoIntDef(sgCart.Cells[0,aRow],0);
    t2 := StrtoIntDef(sgCart.Cells[1,aRow],100);
    s  := IntToStr(10000+t1*10000+t2);
    s  := copy('00000',1,7-length(s)) + s;
    sgCart.cells[10,aRow]:=s;
    sgCart.SortColRow(true,10);
  end;
  if aCol=2 then begin
    s := sgCart.Cells[2,aRow];
    if fileexists(s) then sgCart.Cells[7,aRow] := inttostr(filesize(s))
                     else NewValue := OldValue
  end;
  if (aCol>=3) and (aCol<=5)  then begin
      s :=NewValue;
      t1:=StrtoIntDef(s,-1);
      if ((aCol=3) and (s='none')) or (s='') then t1:=0;
      if t1<0 then NewValue := OldValue
    end;
end;

procedure TFormCartPatch.SpinEditDevChange(Sender: TObject);
var v : longint;
begin
  v := 8*1024*SpinEditDEV.Value;
  StaticTextBaseDev.Caption := '>'+IntToHex(v,4)+' / Dec '+IntToStr(v);
  HexDisplayNew(FileNameEditDev.Text,SpinEditDev.Value);
end;

procedure TFormCartPatch.SpinEditRelChange(Sender: TObject);
var v : longint;
begin
  v := 8*1024*SpinEditRel.Value;
  StaticTextBaseRel.Caption := '>'+IntToHex(v,4)+' / Dec '+IntToStr(v);
  HexDisplayNew(FileNameEditRel.Text,SpinEditRel.Value);
end;

end.

