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