diff --git a/.gitattributes b/.gitattributes index 0f83cc5088..6525026416 100644 --- a/.gitattributes +++ b/.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 diff --git a/utils/ihx2tzx/ihx2tzx.lpi b/utils/ihx2tzx/ihx2tzx.lpi new file mode 100644 index 0000000000..8b0744deb4 --- /dev/null +++ b/utils/ihx2tzx/ihx2tzx.lpi @@ -0,0 +1,65 @@ + + + + + + + + + + + + + <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> diff --git a/utils/ihx2tzx/ihx2tzx.lpr b/utils/ihx2tzx/ihx2tzx.lpr new file mode 100644 index 0000000000..522dc7e71b --- /dev/null +++ b/utils/ihx2tzx/ihx2tzx.lpr @@ -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. + diff --git a/utils/ihx2tzx/ihxreader.pas b/utils/ihx2tzx/ihxreader.pas new file mode 100644 index 0000000000..14c886f705 --- /dev/null +++ b/utils/ihx2tzx/ihxreader.pas @@ -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. + diff --git a/utils/ihx2tzx/tzxwriter.pas b/utils/ihx2tzx/tzxwriter.pas new file mode 100644 index 0000000000..6da095f942 --- /dev/null +++ b/utils/ihx2tzx/tzxwriter.pas @@ -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. +