-- matdemo.ada    use gnatchop on this file for gnat compiler

-- Define_Real.ads
-- This package provides the definition of the type REAL and LONG_REAL.
-- For computers with only one floating point hardware both subtypes
-- become the same.
-- This technique provides for a balance of efficiency and accuracy
-- of the mathematical routines in this library.
-- A complete set of compiled packages is available to users.
-- A complete set of generic packages is also available to users.
-- On some systems this package may contain pragmas or other machine
-- dependencies

package DEFINE_REAL is
  subtype REAL is FLOAT ;
  subtype LONG_REAL is LONG_FLOAT ;
end DEFINE_REAL ;


-- Real_IO.ads
with DEFINE_REAL ; use DEFINE_REAL ;
with TEXT_IO ; use TEXT_IO ;
package REAL_IO is new FLOAT_IO ( REAL ) ;


-- Int_IO.ads
with TEXT_IO ; use TEXT_IO ;
package INT_IO is new INTEGER_IO ( INTEGER ) ;


-- Real_Matrix_Arithmetic.ads
with DEFINE_REAL ; use DEFINE_REAL ;

package REAL_MATRIX_ARITHMETIC is

  --   This is just a partial example of a full matrix arithmetic package


  --   Establish the type ( data structure) REAL_MATRIX
  type REAL_MATRIX is array ( INTEGER range <> , INTEGER range <> ) of REAL ;

  --   The first subscript is the row , the second subscript is the column
  --   Declare the matrix multiply function, parameters and return
  function "*" ( A , B : REAL_MATRIX ) return REAL_MATRIX ;

  --   Declare the PUT procedure
  procedure PUT ( A : REAL_MATRIX ;
                  WIDTH : INTEGER := 3 ;
                  FORE : INTEGER := 2 ; 
                  AFT : INTEGER := REAL'DIGITS - 1 ;
                  EXP : INTEGER := 3 ) ;

  --   Declare that MATRIX_ERROR is an exception
  MATRIX_ERROR : exception ;

end REAL_MATRIX_ARITHMETIC ;


-- Real_Matrix_Arithmetic.adb
with TEXT_IO ; use TEXT_IO ;
with INT_IO ; use INT_IO ;
with REAL_IO ; use REAL_IO ;

package body REAL_MATRIX_ARITHMETIC is

  function "*" ( A , B : REAL_MATRIX ) return REAL_MATRIX is

    --   Create an object C for temporary use
    --   The size is based on the formal parameters A and B when called
    C : REAL_MATRIX ( A'FIRST(1) .. A'LAST(1) , B'FIRST(2) .. B'LAST(2)) ;
  begin

    --              check for legal matricies to multiply 
    if A'LENGTH ( 2 ) /= B'LENGTH ( 1 ) then
      raise MATRIX_ERROR ;
    end if ;

    -- now, compute the product
    for I in A'RANGE ( 1 ) loop
      for J in B'RANGE ( 2 ) loop
        C ( I , J ) := 0.0 ;
        for K in A'RANGE ( 2 ) loop
          C ( I , J ) := C ( I , J ) + A ( I , K ) * 
                         B ( K - A'FIRST(2) + B'FIRST(1) , J) ;
          --                 <-- offset subscript ---> 
          --                 all other subscripts are in correct range
        end loop ;
      end loop ;
    end loop ;
    return C ;
  end ;

  procedure PUT ( A : REAL_MATRIX ;
                  WIDTH : INTEGER := 3 ;
                  FORE : INTEGER := 2 ; 
                  AFT : INTEGER := REAL'DIGITS - 1 ;
                  EXP : INTEGER := 3 ) is
  begin
    for I in A'RANGE ( 1 ) loop
      for J in A'RANGE ( 2 ) loop
        PUT ( "MAT(" ) ;
        PUT ( I , WIDTH ) ;
        PUT ( "," ) ;
        PUT ( J , WIDTH ) ;
        PUT ( " ) = " ) ;
        PUT ( A( I , J ) , FORE , AFT , EXP ) ;
        NEW_LINE ;
      end loop ;
    end loop ;
  end PUT ;
end REAL_MATRIX_ARITHMETIC ;


-- Matrix_Demo.adb
with TEXT_IO ; use TEXT_IO ;
with REAL_MATRIX_ARITHMETIC ; use REAL_MATRIX_ARITHMETIC ;

procedure MATRIX_DEMO is

  -- Establish the object MAT_1 with initial data

  MAT_1 : REAL_MATRIX ( - 1 .. 1 , - 1 .. 2 ) := -- initialization
    (( 1.1 , 1.2 , 1.3 , 1.4 ) ,   --               Note that the structure
     ( 2.1 , 2.2 , 2.3 , 2.4 ) ,   --               of the object must be
     ( 3.1 , 3.2 , 3.3 , 3.4 )) ;  --               used to initialize data.
                                   --               ( (), (), () )

  -- Declare additional objects

  MAT_1A : REAL_MATRIX ( 0 .. 2 , 0 .. 3 ) ; -- same structure as MAT_1

  MAT_2 : REAL_MATRIX ( 1 .. 4 , 0 .. 1 ) := 
          ( ( 1.0 , 1.1 ) ,
            ( 2.0 , 2.1 ) ,
            ( 3.0 , 3.1 ) ,
            ( 4.0 , 4.1 ) ) ;

  MAT_3 : REAL_MATRIX ( - 2 .. 0 , 5 .. 6 ) ;

  -- Declare an uncompatible matrix for multiply
  MAT_BAD : REAL_MATRIX ( 1 .. 3 , 0 .. 5 ) ;
begin

  -- Store MAT_1 into MAT_1A
  MAT_1A := MAT_1 ;

  -- Change the value 1.1 to -1.1
  MAT_1A ( 0 , 0 ) := - 1.1 ;

  -- Print MAT_1A
  PUT_LINE ( " DUMP OF MAT_1A " ) ;
  PUT ( MAT_1A ) ;

  -- Compute MAT_3 as the product of MAT_1 times MAT_2
  MAT_3 := MAT_1 * MAT_2 ;
  PUT_LINE ( " DUMP OF MAT_3 := MAT_1 * MAT_2 " ) ;
  PUT ( MAT_3 ) ;

  -- Remove following comments for homework 5 ( add declarations and data above )
  --  MAT_5 := MAT_1 * MAT_2 + MAT_4 ;
  --  PUT_LINE ( " DUMP OF MAT_5 " ) ;
  --  PUT ( MAT_5 ) ;
  --
  -- Cause an exception
  MAT_3 := MAT_3 * MAT_BAD ;
exception
  when MATRIX_ERROR =>
    PUT_LINE ( "matricies not compatable for requested operation" ) ;
end MATRIX_DEMO ;