Program BaseDumper;

{ Purpose: Dump a file in the required number base
  Started: 18-Feb-94
  Last release: 21-Jan-95       ** PARAMETERS PROCEDURE NEEDS TO BE **
  Last update: 25-May-96        **    RE-VAMPED BEFORE COMPILING    **

  Known bugs:
  * The byte count seems to be one less than the file length.  Either a byte
    is getting lost somewhere or my algorithm is incorrect.
  * The file read in for dumping is rarely left open for some weird reason!

  Note:
  This program was started two years ago when I was just starting Pascal on
  the Amiga and was more of an exercise in HSPascal for myself.  I first
  decided on making it into a proper utility but decided against it for two
  main reasons.  First, the final code was too big, and second, the program
  ran too slowly - mainly because of the check for the user pressing ctrl-c.
  This file is fully PD but PLEASE distribute the three include files should
  you decide to distribute it so someone else can compile it!  The two doc
  files mentioned in the program did get written but I can't find them! }

Uses Crt,DOS;

{$I baseconv.inc}
{$I style.inc}
{$I upstr.inc}

Const
  VNM='1.09';
  VDT='25-May-96';

Var
  IFS:Text;
  OFS,CTR,BSE,FLD,OFD,WTH,ROW:LongInt;
  LNE,LNC,ERR:Integer;
  FLN:String[79];
  RCH,OPT:Char;
  CHB:Array [1..16] of Char;
  FSZ:LongInt;
  ISZ:File of Byte;
  FLG:Boolean;
  XIT:Boolean;

Procedure ProgramTitle;
Begin
  Style(0,1);
  Style(1,1);
  Style(3,1);
  Write('BaseDump v',VNM,' by Zebedee ',#$a9,'1994-6 Carnage (');
  WriteLn(VDT,')');
  Style(0,1);
  WriteLn;
End;

Procedure Usage;
Begin
  WriteLn('Usage  : BaseDump <filename> [<base>] [<lines>]');
  WriteLn('Example: BaseDump s:startup-sequence 6 20');
  WriteLn('Try    : BaseDump values');
  WriteLn('         BaseDump greets');
  WriteLn('         BaseDump maths');
  WriteLn('While paused, press H for the list of available commands.');
  Style(2,1);
  WriteLn('Read BaseDump.doc or BaseDump.guide for more information.');
  Style(2,0);
  Halt(10);
  Write('$VER: BaseDump v1.09 (25-May-96) ');
End;

Procedure Values;
Begin
  Style(3,1);
  WriteLn('Accepted parameter values...');
  Style(3,0);
  WriteLn('<filename> This is the name of the file you which to dump.  You can have a');
  WriteLn('           maximum of 79 chars in the filename.');
  WriteLn('<base>     This is the number base you want to use.  The range is base 2 up');
  WriteLn('           to base 16.');
  WriteLn('<lines>    This is the number of lines to be displayed before the scroll');
  WriteLn('           pauses.  The range is 5 lines to 28 lines.  Pressing the H key');
  WriteLn('           while paused displays a list of available commands.');
  Halt(10);
End;

Procedure Greets;
Begin
  Style(3,1);
  WriteLn('Additional information...');
  Style(3,0);
  WriteLn('After all the frustration and many drinks, BaseDump is finally completed.  I');
  WriteLn('had big time problems reading the file in correctly, but at last here it is!');
  WriteLn('If you want the source code, send a disk with your address and £1.50 to...');
  WriteLn('72 Hessary Drive, Belliver, Plymouth, PL6 7DQ, England.  I''ll send you your');
  WriteLn('disk back with the source and some of my other work.  A disk with £3 will');
  WriteLn('give you all my programs as they are! You can call voice on +44(0)1752784262');
  WriteLn('for a chat.  This program is fully PD, so do with it what you want, but pls');
  WriteLn('include BaseDump.doc, BaseDump.guide, and the world will be a better place &');
  WriteLn('I''ll sleep better at night!');
  WriteLn;
  Style(3,1);
  WriteLn('Greetings to...');
  Style(3,0);
  WriteLn('Sirius, Sprinter, Devoe, Fireball, Spicoally/Paralax, Capone, Holsten,');
  WriteLn('Dillinger, Tempest, Quantum, Terminator, Verminator, Beaker, Stash, Kirsty J,');
  WriteLn('the Tiverton Posse, Barnstaple Posse, Serena Emberson, Rachel Chidgey, Gee,');
  WriteLn('Donna Howe, John Rood (my dad) and everyone else I''ve missed off.');
  WriteLn;
  Style(3,1);
  WriteLn('Messages to...');
  Style(3,0);
  WriteLn('Sirius => Thanks for all the warez');
  WriteLn('Tempest => Thanx for all the warez you sent me back in ''89 (?)');
  WriteLn('Spicoally/Paralax (Australia) => Keep sending the assembly source code');
  WriteLn('Kei/CyberDreams (UK) => Can you send me some more gfx?');
  WriteLn('Sprinter => CliTris and the Stereogram Creator is mega bugged!');
  WriteLn('Spare => Spare');
  WriteLn;
  Style(2,1);
  Style(1,1);
  WriteLn('Dedicated to all the file viewers everywhere !!!');
  Style(0,1);
  Halt(10);
End;

Procedure AlanBeer;
Begin
  Style(3,1);
  WriteLn('Thanks must go to...');
  Style(3,0);
  WriteLn('I must thank Alan Beer, who supplied me with the formula to convert a number');
  WriteLn('into a different base as without that formula, this program wouldn''t exist!!');
  Halt(10);
End;

Procedure GetParams;
Begin
  If UpStr(ParamStr(1))='VALUES' Then Values;
  If UpStr(ParamStr(1))='MATHS' Then AlanBeer;
  If UpStr(ParamStr(1))='GREETS' Then Greets;
  If ParamCount<>3 Then Usage;
  FLN:=ParamStr(1);
  Val(Copy(ParamStr(2),1,Length(ParamStr(2))),BSE,ERR);
  If (BSE<2) or (BSE>16) Then
  Begin
    BSE:=16;
    WriteLn(ParamStr(0),': Invalid base - set to hex (16)');
  End;
  Val(Copy(ParamStr(3),1,Length(ParamStr(3))),LNE,ERR);
  If (LNE<5) or (LNE>28) Then
  Begin
    LNE:=20;
    WriteLn(ParamStr(0),': Invalid line count - set to 20');
  End;
  Case BSE Of
    2:Begin
        FLD:=8;
        OFD:=16;
      End;
    3:Begin
        FLD:=6;
        OFD:=16;
      End;
    4:Begin
        FLD:=4;
        OFD:=12;
      End;
    5:Begin
        FLD:=4;
        OFD:=12;
      End;
    6:Begin
        FLD:=4;
        OFD:=12;
      End;
    7:Begin
        FLD:=3;
        OFD:=12;
      End;
    8:Begin
        FLD:=3;
        OFD:=12;
      End;
    9:Begin
        FLD:=3;
        OFD:=12;
      End;
    10:Begin
         FLD:=3;
         OFD:=12;
       End;
    11:Begin
         FLD:=3;
         OFD:=5;
       End;
    12:Begin
         FLD:=3;
         OFD:=5;
       End;
    13:Begin
         FLD:=3;
         OFD:=8;
       End;
    14:Begin
         FLD:=3;
         OFD:=8;
       End;
    15:Begin
         FLD:=3;
         OFD:=8;
       End;    
    16:Begin
         FLD:=2;
         OFD:=8;
       End;
  End;
  WTH:=8;
  If (BSE=2) or (BSE=3) Then WTH:=4;
  If BSE=16 Then WTH:=16;
End;

Procedure NotExist;
Begin
  WriteLn(ParamStr(0),': Can''t locate file `',FLN,'''');
  FLG:=False;
End;

Procedure GetFileLength;
Begin
  Assign(ISZ,FLN);
  Reset(ISZ);
  FSZ:=FileSize(ISZ);
  Close(ISZ);
End;

Procedure PrintChar(CHD:Char);
Begin
  If CHD<#$20 Then Write('.');
  If (CHD>#$1F) and (CHD<#$7f) Then Write(CHD);
  If CHD>#$7e Then Write('.');
End;

Procedure CloseFile;
Begin
  Close(IFS);
End;

Procedure DoPause;
Begin
  Repeat
    Repeat
      OPT:=UpCase(ReadKey);
    Until OPT In ['I','M','S','H','N','Q','L','V','A','C'];
    If OPT='I' Then WriteLn('INFO: Reading file `',UpStr(FLN),''' in base ',BSE);
    If OPT='S' Then WriteLn('INFO: Size of file `',UpStr(FLN),''' is ',FSZ,' bytes');
    If OPT='H' Then
    Begin
      WriteLn('KEYS: [S]ize; [M]ore; [I]nfo; [N]opause; set[L]ines; [V]iewlines; [Q]uit');
      WriteLn('      [A]bout; [C]redits');
    End;
    If OPT='C' Then WriteLn('INFO: Code & ideas by Zebedee, Maths by Alan Beer');
    If OPT='A' Then WriteLn('INFO: BaseDump v',VNM,' by Ivan Oliver ',#$a9,'1994 Amiga Format (',VDT,')');
    If OPT='L' Then
    Begin
      Write('Enter a new line setting (5-28): ');
      ReadLn(LNE);
      If (LNE<5) or (LNE>28) Then
      Begin
        WriteLn(ParamStr(0),': Invalid line setting - set to default of 20');
        LNE:=20;
      End;
    End;
    If OPT='V' Then WriteLn('INFO: The page size is ',LNE,' lines');
    If OPT='N' Then
    Begin
      LNE:=-1;
      WriteLn('INFO: Pause has been disabled');
    End;
    If OPT='Q' Then
    Begin
      WriteLn('INFO: Program aborted.');
      CloseFile;
      Halt(5);
      CTR:=FSZ;
    End;
  Until OPT='M';
  LNC:=0;
End;

Procedure DumpFile;
Var
  KEY:Char;
Begin
  OFS:=0;
  LNC:=0;
  FLG:=True;
  Assign(IFS,FLN);
  ReSet(IFS);
  If Not IOResult=0 Then NotExist;
  Close(IFS);
  If FLG Then
  Begin
    WriteLn('File dump of: ',FLN);
    GetFileLength;
    Assign(IFS,FLN);
    Reset(IFS);
    ROW:=1;
    Write(BaseConv(0,OFD,BSE),': ');
    For CTR:=1 To FSZ Do
    Begin
      Read(IFS,RCH);
      CHB[ROW]:=RCH;
      Write(BaseConv(Ord(CHB[ROW]),FLD,BSE),' ');
      Inc(ROW);
      If KeyPressed Then
      Begin
        KEY:=UpCase(ReadKey);
        If KEY=#3 Then
        Begin
          WriteLn('^C');
          Close(IFS);
          Halt(20);
        End;
      End;
      If ROW-1=WTH Then
      Begin
        Write('  ');
        For ERR:=1 To ROW-1 Do
          PrintChar(CHB[ERR]);
        ROW:=1;
        WriteLn;
        Inc(LNC);
        If LNC=LNE Then DoPause;
        OFS:=OFS+WTH;
        If CTR<FSZ Then Write(BaseConv(OFS,OFD,BSE),': ');
      End;
    End;
    If ROW>0 Then
    Begin
      For CTR:=1 To WTH-ROW+1 Do
      Begin
        For ERR:=1 To FLD Do
          Write('*');
        Write(' ');
      End;
      Write('  ');
      For CTR:=1 To ROW-1 Do
        PrintChar(CHB[CTR]);
    End;
    If ROW>0 Then WriteLn;
    Write('Dumped ',FSZ,' (',BaseConv(FSZ,OFD,BSE));
    WriteLn(') bytes from file `',FLN,'''');
    CloseFile;
  End;
End;

Begin
  ProgramTitle;
  GetParams;
  DumpFile;
End.