+ initial implementation of an .IHX (Intel hex format) to .TZX (ZX Spectrum tape file format) file conversion tool

git-svn-id: branches/z80@44588 -

.gitattributes

@@ -19052,6 +19052,10 @@ utils/h2pas/scan.pas svneol=native#text/plain
 utils/h2pas/testit.h -text
 utils/h2pas/yylex.cod svneol=native#text/plain
 utils/h2pas/yyparse.cod svneol=native#text/plain
+utils/ihx2tzx/ihx2tzx.lpi svneol=native#text/plain
+utils/ihx2tzx/ihx2tzx.lpr svneol=native#text/plain
+utils/ihx2tzx/ihxreader.pas svneol=native#text/plain
+utils/ihx2tzx/tzxwriter.pas svneol=native#text/plain
 utils/importtl/Makefile svneol=native#text/plain
 utils/importtl/Makefile.fpc svneol=native#text/plain
 utils/importtl/Makefile.fpc.fpcmake svneol=native#text/plain

utils/ihx2tzx/ihx2tzx.lpi

@@ -0,0 +1,65 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="ihx2tzx"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="ihx2tzx.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="ihxreader.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="tzxwriter.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="ihx2tzx"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

utils/ihx2tzx/ihx2tzx.lpr

@@ -0,0 +1,141 @@
+{ <description>
+
+  Copyright (C) 2020 Nikolay Nikolov <[email protected]>
+
+  This source 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 code 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.
+
+  A copy of the GNU General Public License is available on the World Wide Web
+  at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
+  to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
+  Boston, MA 02110-1335, USA.
+}
+
+program ihx2tzx;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, CustApp, ihxreader, tzxwriter
+  { you can add units after this };
+
+const
+  ShortOptions = 'h';
+  LongOptions: array [0..0] of string = (
+    'help'
+  );
+
+type
+
+  { TIHX2TZX }
+
+  TIHX2TZX = class(TCustomApplication)
+  private
+    FInputFileName: string;
+    FOutputFileName: string;
+    FInputImage: TIHXReader;
+    FOutputFile: TStream;
+    FTapeWriter: TTZXWriter;
+  protected
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure WriteHelp; virtual;
+  end;
+
+{ TIHX2TZX }
+
+procedure TIHX2TZX.DoRun;
+var
+  ErrorMsg: String;
+  NonOptions: TStringArray;
+  BasicProgram: AnsiString;
+  BasicLine1, BasicLine2: AnsiString;
+begin
+  // quick check parameters
+  ErrorMsg:=CheckOptions(ShortOptions, LongOptions);
+  if ErrorMsg<>'' then begin
+    ShowException(Exception.Create(ErrorMsg));
+    Terminate;
+    Exit;
+  end;
+
+  // parse parameters
+  if HasOption('h', 'help') then begin
+    WriteHelp;
+    Terminate;
+    Exit;
+  end;
+
+  NonOptions := GetNonOptions(ShortOptions, LongOptions);
+  if Length(NonOptions) = 0 then
+  begin
+    ShowException(Exception.Create('Missing input file'));
+    Terminate;
+    Exit;
+  end;
+  if Length(NonOptions) > 1 then
+  begin
+    ShowException(Exception.Create('Too many files specified'));
+    Terminate;
+    Exit;
+  end;
+  FInputFileName := NonOptions[0];
+  FOutputFileName := 'out.tap';
+
+  { add your program here }
+  FInputImage.ReadIHXFile(FInputFileName);
+
+  FOutputFile := TFileStream.Create(FOutputFileName, fmCreate);
+  FTapeWriter := TTZXWriter.Create(FOutputFile);
+
+  BasicLine1 := ' '#$EF'"" '#$AF#13;
+  BasicLine2 := ' '#$F5#$C0+IntToStr(FInputImage.Origin)+#14#0#0+Chr(Byte(FInputImage.Origin))+Chr(Byte(FInputImage.Origin shr 8))+#0#13;
+  BasicProgram := #0#10+Chr(Byte(Length(BasicLine1)))+Chr(Byte(Length(BasicLine1) shr 8))+BasicLine1+
+                  #0#20+Chr(Byte(Length(BasicLine2)))+Chr(Byte(Length(BasicLine2) shr 8))+BasicLine2;
+
+  FTapeWriter.AppendProgramFile('basic', 10, Length(BasicProgram), BasicProgram[1], Length(BasicProgram));
+  FTapeWriter.AppendCodeFile('test', FInputImage.Origin, FInputImage.Data[0], Length(FInputImage.Data));
+
+  // stop program loop
+  Terminate;
+end;
+
+constructor TIHX2TZX.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+  FInputImage := TIHXReader.Create;
+end;
+
+destructor TIHX2TZX.Destroy;
+begin
+  FreeAndNil(FInputImage);
+  FreeAndNil(FTapeWriter);
+  FreeAndNil(FOutputFile);
+  inherited Destroy;
+end;
+
+procedure TIHX2TZX.WriteHelp;
+begin
+  { add your help code here }
+  writeln('Usage: ', ExeName, ' -h');
+end;
+
+var
+  Application: TIHX2TZX;
+begin
+  Application:=TIHX2TZX.Create(nil);
+  Application.Title:='ihx2tzx';
+  Application.Run;
+  Application.Free;
+end.
+

utils/ihx2tzx/ihxreader.pas

@@ -0,0 +1,126 @@
+{ <description>
+
+  Copyright (C) 2020 Nikolay Nikolov <[email protected]>
+
+  This source 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 code 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.
+
+  A copy of the GNU General Public License is available on the World Wide Web
+  at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
+  to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
+  Boston, MA 02110-1335, USA.
+}
+
+unit ihxreader;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+type
+
+  { TIHXReader }
+
+  TIHXReader = class
+  private
+    FOrigin: Word;
+  public
+    Data: array of Byte;
+
+    procedure ReadIHXFile(const FileName: string);
+
+    property Origin: Word read FOrigin;
+  end;
+
+implementation
+
+{ TIHXReader }
+
+procedure TIHXReader.ReadIHXFile(const FileName: string);
+var
+  InF: TextFile;
+  S: string;
+  I: Integer;
+  LineByteCount: Byte;
+  LineAddress: Word;
+  PrevLineAddress: LongInt = -1;
+  RecordType: Byte;
+  Checksum, ExpectedChecksum: Byte;
+  B: Byte;
+  OriginSet: Boolean = False;
+begin
+  FOrigin := 0;
+  SetLength(Data, 0);
+  AssignFile(InF, FileName);
+  Reset(InF);
+  try
+    while not EoF(InF) do
+    begin
+      ReadLn(InF, S);
+      S:=UpperCase(Trim(S));
+      if S='' then
+        continue;
+      if Length(S)<11 then
+        raise Exception.Create('Line too short');
+      if S[1]<>':' then
+        raise Exception.Create('Line must start with '':''');
+      for I:=2 to Length(S) do
+        if not (S[I] in ['0'..'9','A'..'F']) then
+          raise Exception.Create('Line contains an invalid character');
+      LineByteCount:=StrToInt('$'+Copy(S,2,2));
+      if (LineByteCount*2+11)<>Length(S) then
+        raise Exception.Create('Invalid line length');
+      LineAddress:=StrToInt('$'+Copy(S,4,4));
+      if (PrevLineAddress <> -1) and (PrevLineAddress < LineAddress) then
+        SetLength(Data, Length(Data) + (LineAddress - PrevLineAddress));
+      RecordType:=StrToInt('$'+Copy(S,8,2));
+      Checksum:=StrToInt('$'+Copy(S,Length(S)-1,2));
+      ExpectedChecksum := Byte(LineByteCount + RecordType + Byte(LineAddress) + Byte(LineAddress shr 8));
+      if not OriginSet then
+      begin
+        OriginSet := True;
+        FOrigin := LineAddress;
+      end;
+      for I:=0 to LineByteCount-1 do
+      begin
+        B := StrToInt('$' + Copy(S, 10 + 2*I, 2));
+        ExpectedChecksum := Byte(ExpectedChecksum + B);
+      end;
+      ExpectedChecksum := Byte(-ExpectedChecksum);
+      if ExpectedChecksum <> Checksum then
+        raise Exception.Create('Invalid checksum');
+      case RecordType of
+        0:
+          begin
+            SetLength(Data, Length(Data) + LineByteCount);
+            for I:=0 to LineByteCount-1 do
+            begin
+              B := StrToInt('$' + Copy(S, 10 + 2*I, 2));
+              Data[High(Data) - (LineByteCount-1) + I] := B;
+            end;
+          end;
+        1:
+          begin
+            { end of file }
+            break;
+          end;
+      end;
+      PrevLineAddress := LineAddress + LineByteCount;
+    end;
+  finally
+    CloseFile(InF);
+  end;
+end;
+
+end.
+

utils/ihx2tzx/tzxwriter.pas

@@ -0,0 +1,144 @@
+{ <description>
+
+  Copyright (C) 2020 Nikolay Nikolov <[email protected]>
+
+  This source 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 code 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.
+
+  A copy of the GNU General Public License is available on the World Wide Web
+  at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
+  to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
+  Boston, MA 02110-1335, USA.
+}
+
+unit tzxwriter;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+type
+
+  { TTZXWriter }
+
+  TTZXWriter = class
+  private
+    FOutStream: TStream;
+  public
+    constructor Create(OutStream : TStream);
+    procedure AppendStandardSpeedDataBlock(const Buffer; Count: Word);
+    procedure AppendProgramFile(const FileName: string; AutostartLine, VarAreaOffset: Word; const Buffer; Count: Word);
+    procedure AppendCodeFile(const FileName: string; StartAddress: Word; const Buffer; Count: Word);
+  end;
+
+implementation
+
+{ TTZXWriter }
+
+constructor TTZXWriter.Create(OutStream: TStream);
+const
+  Header: string = 'ZXTape!'#$1A#1#20;
+begin
+  FOutStream := OutStream;
+  FOutStream.Seek(0, soFromBeginning);
+  FOutStream.Write(Header[1], Length(Header));
+end;
+
+procedure TTZXWriter.AppendStandardSpeedDataBlock(const Buffer; Count: Word);
+const
+  PauseMilliseconds = 1000;
+begin
+  FOutStream.WriteByte($10);
+  FOutStream.WriteByte(Byte(PauseMilliseconds));
+  FOutStream.WriteByte(Byte(PauseMilliseconds shr 8));
+  FOutStream.WriteByte(Byte(Count));
+  FOutStream.WriteByte(Byte(Count shr 8));
+  FOutStream.Write(Buffer, Count);
+end;
+
+procedure TTZXWriter.AppendProgramFile(const FileName: string; AutostartLine,
+  VarAreaOffset: Word; const Buffer; Count: Word);
+var
+  HeaderBlock: array [0..18] of Byte;
+  I: Integer;
+  Checksum: Byte;
+  DataBlock: array of Byte;
+begin
+  HeaderBlock[0] := 0;  { header }
+  HeaderBlock[1] := 0;  { Program file }
+  { file name }
+  for I := 1 to 10 do
+    if I <= Length(FileName) then
+      HeaderBlock[I + 1] := Ord(FileName[I])
+    else
+      HeaderBlock[I + 1] := Ord(' ');
+  HeaderBlock[12] := Byte(Count);
+  HeaderBlock[13] := Byte(Count shr 8);
+  HeaderBlock[14] := Byte(AutostartLine);
+  HeaderBlock[15] := Byte(AutostartLine shr 8);
+  HeaderBlock[16] := Byte(VarAreaOffset);
+  HeaderBlock[17] := Byte(VarAreaOffset shr 8);
+  Checksum := 0;
+  for I := 0 to 17 do
+    Checksum := Checksum xor HeaderBlock[I];
+  HeaderBlock[18] := Checksum;
+  AppendStandardSpeedDataBlock(HeaderBlock, SizeOf(HeaderBlock));
+  SetLength(DataBlock, Count + 2);
+  Move(Buffer, DataBlock[1], Count);
+  DataBlock[0] := $FF;  { data }
+  Checksum := 0;
+  for I := 0 to High(DataBlock) - 1 do
+    Checksum := Checksum xor DataBlock[I];
+  DataBlock[High(DataBlock)] := Checksum;
+  AppendStandardSpeedDataBlock(DataBlock[0], Length(DataBlock));
+end;
+
+procedure TTZXWriter.AppendCodeFile(const FileName: string; StartAddress: Word;
+  const Buffer; Count: Word);
+var
+  HeaderBlock: array [0..18] of Byte;
+  I: Integer;
+  Checksum: Byte;
+  DataBlock: array of Byte;
+begin
+  HeaderBlock[0] := 0;  { header }
+  HeaderBlock[1] := 3;  { Code file }
+  { file name }
+  for I := 1 to 10 do
+    if I <= Length(FileName) then
+      HeaderBlock[I + 1] := Ord(FileName[I])
+    else
+      HeaderBlock[I + 1] := Ord(' ');
+  HeaderBlock[12] := Byte(Count);
+  HeaderBlock[13] := Byte(Count shr 8);
+  HeaderBlock[14] := Byte(StartAddress);
+  HeaderBlock[15] := Byte(StartAddress shr 8);
+  HeaderBlock[16] := Byte(32768);
+  HeaderBlock[17] := Byte(32768 shr 8);
+  Checksum := 0;
+  for I := 0 to 17 do
+    Checksum := Checksum xor HeaderBlock[I];
+  HeaderBlock[18] := Checksum;
+  AppendStandardSpeedDataBlock(HeaderBlock, SizeOf(HeaderBlock));
+  SetLength(DataBlock, Count + 2);
+  Move(Buffer, DataBlock[1], Count);
+  DataBlock[0] := $FF;  { data }
+  Checksum := 0;
+  for I := 0 to High(DataBlock) - 1 do
+    Checksum := Checksum xor DataBlock[I];
+  DataBlock[High(DataBlock)] := Checksum;
+  AppendStandardSpeedDataBlock(DataBlock[0], Length(DataBlock));
+end;
+
+end.
+