------------------------------------------------------------------
--|
--| Hex Dump
--|
--| Author: John B. Matthews
--| Last Modified: 25-Oct-2009
--|
------------------------------------------------------------------

with Ada.Command_Line;
with Ada.Exceptions;
with Ada.Streams.Stream_IO;
with Ada.Text_IO;
with Ada.Text_IO.Text_Streams;

procedure HD is

   package CLI renames Ada.Command_Line;
   package TIO renames Ada.Text_IO;

   function Hex_Byte(B : Integer) return String is
      C : constant := 2 ** 4;
      H : constant array(0 .. C - 1) of Character := "0123456789abcdef";
      S : String(1 .. 2);
   begin
      S(1) := H(B / C);
      S(2) := H(B mod C);
      return S;
   end Hex_Byte;

   function Hex_Word(W : Integer) return String is
      C : constant := 2 ** 8;
   begin
      return Hex_Byte(W / C) & Hex_Byte(W mod C);
   end Hex_Word;
   
   function Hex_Addr(A : Integer) return String is
      C : constant := 2 ** 16;
   begin
      return Hex_Byte(A / C) & Hex_Word(A mod C);
   end Hex_Addr;

   -- Output C in hex; update ASCII in S(I) and address A on line break
   procedure Dump(C : Character; S : in out String; I, A : in out Integer) is
      P : Integer;
   begin
      if I = 0 then
         TIO.Put(Hex_Addr(A) & ":");
      end if;
      P := Character'Pos(C);
      TIO.Put(" " & Hex_Byte(P));
      I := I + 1;
      if P > 31 and P < 127 then -- printable ASCII
         S(I) := C;
      else
         S(I) := '.';
      end if;
      if I = 16 then -- line break
         TIO.Put("  " & S);
         TIO.New_Line;
         S := (others => ' ');
         I := 0;
         A := A + 16;
      end if;
   end Dump;

   -- Output ASCII for partial line
   procedure Tail(I : Integer; S : String) is
   begin
      if I > 0 then
         for K in i .. 15 loop
            TIO.Put("   ");
         end loop;
         TIO.Put("  " & S);
         TIO.New_Line;
      end if;
   end Tail;

   -- Hex dump current input
   procedure Hex_Dump is
      package TTS renames TIO.Text_Streams;
      Stream_Ptr : TTS.Stream_Access;
      C : Character;
      S : String(1 .. 16) := (others => ' ');
      I : Integer := 0;
      A : Integer := 0;
   begin
      Stream_Ptr := TTS.Stream(TIO.Current_Input);
      loop
         Character'Read(Stream_Ptr, C);
         Dump(C, S, I, A);
      end loop;
   exception
      when TIO.End_Error => Tail(I, S);
   end Hex_Dump;

   -- Hex dump a named file
   procedure Hex_Dump(File_Name : String) is
      package SIO renames Ada.Streams.Stream_IO;
      Input_File : SIO.File_Type;
      Stream_Ptr : SIO.Stream_Access;
      C : Character;
      S : String(1 .. 16) := (others => ' ');
      I : Integer := 0;
      A : Integer := 0;
   begin
      SIO.Open(Input_File, SIO.In_File, CLI.Argument(1));
      Stream_Ptr := SIO.Stream(Input_File);
      loop
         Character'Read(Stream_Ptr, C);
         Dump(C, S, I, A);
      end loop;
   exception
      when SIO.End_Error =>
         Tail(I, S);
         SIO.Close(Input_File);
   end Hex_Dump;

   procedure Show_Usage is
   begin
      TIO.Put_Line("HexDump: hd [file | stdin]");
   end Show_Usage;

begin
   if CLI.Argument_Count = 0 then
      Hex_Dump;
   elsif CLI.Argument(1) = "-h" then
      Show_Usage;
   else
      Hex_Dump(CLI.Argument(1));
   end if;
exception
   when Error : others =>
      TIO.Put_Line(Ada.Exceptions.Exception_Name(Error));
      Show_Usage;
end HD;