paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 10:07:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: branches/z80@44588 -
This commit is contained in:
nickysn 2020-04-05 04:23:46 +00:00
parent d8ca077c33
commit 175cbf672f
5 changed files with 480 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitattributes vendored
View File

@ -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

65
utils/ihx2tzx/ihx2tzx.lpi Normal file
View File

@ -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>

141
utils/ihx2tzx/ihx2tzx.lpr Normal file
View File

@ -0,0 +1,141 @@
{ <description>
Copyright (C) 2020 Nikolay Nikolov <nickysn@users.sourceforg.net>
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.

126
utils/ihx2tzx/ihxreader.pas Normal file
View File

@ -0,0 +1,126 @@
{ <description>
Copyright (C) 2020 Nikolay Nikolov <nickysn@users.sourceforg.net>
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.

144
utils/ihx2tzx/tzxwriter.pas Normal file
View File

@ -0,0 +1,144 @@
{ <description>
Copyright (C) 2020 Nikolay Nikolov <nickysn@users.sourceforg.net>
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.