WITH   Ada.Unchecked_Conversion ;
WITH   Interfaces.C ;
WITH   Stdarg ;
WITH   System ;
WITH   Win32 ;
WITH   Win32.Crt.Strings ;
WITH   Win32.Windef ;
WITH   Win32.Wingdi ;
WITH   Win32.Winuser ;

PACKAGE BODY   CharTb34_Pkg  IS

   FUNCTION   CP   ( I_Str : Win32.CHAR_Array )  RETURN  Win32.LPCSTR  IS
      FUNCTION   UC  IS
         new Ada.Unchecked_Conversion ( System.Address , Win32.LPCSTR );
   BEGIN
      RETURN  UC ( I_Str(I_Str'First)'Address );
   END CP;

   FUNCTION   CPS   ( I_Str : Win32.CHAR_Array )  RETURN  Win32.LPSTR  IS
      FUNCTION   UC  IS
         new Ada.Unchecked_Conversion ( System.Address , Win32.LPSTR );
   BEGIN
      RETURN  UC ( I_Str(I_Str'First)'Address );
   END CPS;

   FUNCTION   To_IntW  IS  new Ada.Unchecked_Conversion(Win32.PCHAR, Integer);
   FUNCTION   To_PCHAR  IS  new Ada.Unchecked_Conversion(Integer, Win32.PCHAR);

   FUNCTION   StPCpy   ( I_Dest : Win32.PSTR
                       ; I_Source : Win32.PCSTR )  RETURN  Win32.PSTR  IS
      L_IgnoredP : Win32.PSTR ;
      L_AddedLen : Standard.INTEGER ;
   BEGIN
      L_IgnoredP := Win32.Crt.Strings.StrCpy ( I_Dest , I_Source );
      L_AddedLen := Standard.INTEGER( Win32.Crt.Strings.StrLen(Win32.PCCH(I_Dest)) );
      RETURN  To_PCHAR(To_IntW(I_Dest) + L_AddedLen);
   END StPCPy;

   USE TYPE   Win32.CHAR_Array ;      --- To get "&"

   Nul : Win32.Char RENAMES Win32.Nul ;

   IgnoredI : Win32.INT ;
   IgnoredP : Win32.PSTR ;

   C_MainPMTitle : CONSTANT Win32.CHAR_Array := "Information"  &  Nul ;

   CRLF : CONSTANT Win32.CHAR_Array := Win32.Char(Character'Val(13))  &  Win32.Char(Character'Val(10));

   C_HexCh : CONSTANT Win32.CHAR_Array := "0123456789ABCDEF" ;
   C_TitleLn1 : CONSTANT Win32.CHAR_Array := "          0 1 2 3 4 5 6 7 8 9 A B C D E F"  &  CRLF  &  Nul ;
   C_TitleLn2 : CONSTANT Win32.CHAR_Array := "          -------------------------------"  &  CRLF  &  Nul ;
   C_NumberFmt: CONSTANT Win32.CHAR_Array := "%3u"  &  Nul ;
   C_sLeftPar : CONSTANT Win32.CHAR_Array := "("  &  Nul ;
   C_sRightPar: CONSTANT Win32.CHAR_Array := ") "  &  Nul ;
   SPACEz: CONSTANT Win32.CHAR_Array := " "  &  Nul ;
   CRLFz : CONSTANT Win32.CHAR_Array := Win32.Char(Character'Val(13))  &  Win32.Char(Character'Val(10))  &  Nul ;

   L_Buffer : ALIASED Win32.CHAR_Array(0..4096);
   L_Buf25  : ALIASED Win32.CHAR_Array(0..25);
   L_Buf01z : ALIASED Win32.CHAR_Array(0..1);
   L_Buf03z : ALIASED Win32.CHAR_Array(0..3);

   PROCEDURE   ShowCharTb34  IS
      FUNCTION   "&"  IS  new Stdarg.Concat ( Win32.LONG );

      L_P : Win32.LPSTR ;

      L_Code : Standard.INTEGER ;
   BEGIN
      L_Buffer(0) := Nul ;
      L_P := CPS(L_Buffer);

      L_P := StPCpy ( L_P , CP(C_TitleLn1) );
      L_P := StPCpy ( L_P , CP(C_TitleLn2) );

      L_Buf01z(1) := Nul ;
      L_Buf03z := "00>"  &  Nul ;

      ----- LOOP 1
      FOR L_i in 0..15 LOOP
         ----- Line address (in decimal) and in hexa
         IgnoredI := Win32.Winuser.wvsprintf ( CPS(L_Buf25) , CP(C_NumberFmt)
                                             , Stdarg.Empty & Win32.LONG(L_i*16) );
         L_P := StPCpy ( L_P , CP(C_sLeftPar) );
         L_P := StPCpy ( L_P , CP(L_Buf25) );
         L_P := StPCpy ( L_P , CP(C_sRightPar) );

         L_Buf03z(0) := C_HexCh(L_i);
         L_P := StPCpy ( L_P , CP(L_Buf03z) );

         ----- LOOP 2
         FOR L_j in 0..15 LOOP
            L_Code := L_i*16  +  L_j ;

            L_P := StPCpy ( L_P , CP(SPACEz) );

            ----- Write char  ( Ignoring problem chars )
            CASE L_Code IS
               WHEN 0  => L_Buf01z(0) := '-' ;      --- EOF   End Of File
               WHEN 9  => L_Buf01z(0) := '-' ;      --- HT    Tabulation
               WHEN 10 => L_Buf01z(0) := '-' ;      --- LF    Line Feed
               WHEN 13 => L_Buf01z(0) := '-' ;      --- CR    Carriage Return

               WHEN OTHERS =>
                  L_Buf01z(0) := Win32.Char(Character'Val(L_Code));
            END CASE;
            L_P := StPCpy ( L_P , CP(L_Buf01z) );

         END LOOP;--j

         L_P := StPCpy ( L_P , CP(CRLFz) );
      END LOOP;--i

      IgnoredI := Win32.Winuser.MessageBox ( System.Null_Address
                                           , CP(L_Buffer)
                                           , CP(C_MainPMTitle)
                                           , Win32.Winuser.MB_OK or Win32.Winuser.MB_ICONEXCLAMATION );
   END ShowCharTb34;
END CharTb34_Pkg;
