1 {-
    2  -  Fulsom (The Solid Modeller, written in Haskell)
    3  -
    4  -  Copyright 1990,1991,1992,1993 Duncan Sinclair
    5  -
    6  - Permissiom to use, copy, modify, and distribute this software for any 
    7  - purpose and without fee is hereby granted, provided that the above
    8  - copyright notice and this permission notice appear in all copies, and
    9  - that my name not be used in advertising or publicity pertaining to this
   10  - software without specific, written prior permission.  I makes no
   11  - representations about the suitability of this software for any purpose.
   12  - It is provided ``as is'' without express or implied warranty.
   13  - 
   14  - Duncan Sinclair 1993.
   15  - 
   16  - Matrix arithmetic functions.
   17  -
   18  -}
   19 
   20 module Matrix where
   21 
   22 import Types
   23 import Interval -- not used.
   24 
   25 #if __HASKELL1__ < 5
   26 #define realToFrac fromRealFrac
   27 #endif
   28 
   29 mat4x1 :: (Fractional a) => Arr -> R3 a -> R3 a
   30 mat4x1 (r1,r2,r3) xyz = (x,y,z)
   31                           where
   32                              x = dorow r1 xyz
   33                              y = dorow r2 xyz
   34                              z = dorow r3 xyz
   35 
   36 dorow :: (Fractional a) => Row -> R3 a -> a
   37 dorow (m11,m12,m13,m14) (x,y,z) 
   38     = case  (m1 * x) + (m2 * y) + (m3 * z) + m4 of n -> n
   39        where
   40          m1 = realToFrac m11
   41          m2 = realToFrac m12
   42          m3 = realToFrac m13
   43          m4 = realToFrac m14
   44 
   45 mat4x1' :: (Fractional a) => Arr -> R3 a -> R3 a
   46 mat4x1' (r1,r2,r3) xyz = (x,y,z)
   47                           where
   48                              x = dorow r1 xyz
   49                              y = dorow r2 xyz
   50                              z = dorow r3 xyz
   51 
   52 dorow' :: (Fractional a) => Row -> R3 a -> a
   53 dorow' (m11,m12,m13,m14) (x,y,z) 
   54     = case (m1 * x) + (m2 * y) + (m3 * z) of n -> n
   55        where
   56          m1 = realToFrac m11
   57          m2 = realToFrac m12
   58          m3 = realToFrac m13
   59 
   60 mat1x4 :: Row -> Arr -> Row
   61 mat1x4 a (b1,b2,b3) = (c1,c2,c3,c4)
   62    where
   63      c1 = dorow' a (b11,b21,b31)
   64      c2 = dorow' a (b12,b22,b32)
   65      c3 = dorow' a (b13,b23,b33)
   66      c4 = dorow  a (b14,b24,b34)
   67      (b11,b12,b13,b14) = b1
   68      (b21,b22,b23,b24) = b2
   69      (b31,b32,b33,b34) = b3
   70 
   71 mat4x4 :: Arr -> Arr -> Arr
   72 mat4x4 a (b1,b2,b3) = (c1,c2,c3)
   73    where
   74      c1 = (c11,c12,c13,c14)
   75      c2 = (c21,c22,c23,c24)
   76      c3 = (c31,c32,c33,c34)
   77      (b11,b12,b13,b14) = b1
   78      (b21,b22,b23,b24) = b2
   79      (b31,b32,b33,b34) = b3
   80      (c11,c21,c31) = mat4x1' a (b11,b21,b31)
   81      (c12,c22,c32) = mat4x1' a (b12,b22,b32)
   82      (c13,c23,c33) = mat4x1' a (b13,b23,b33)
   83      (c14,c24,c34) = mat4x1  a (b14,b24,b34)
   84 
   85 
   86 
   87