Begin overhauling the program to handle other tetrahedra. Main is

[spline3.git] / src / FunctionValues.hs

diff --git a/src/FunctionValues.hs b/src/FunctionValues.hs
index d477a38f729cbbb99b970c9fe681848824fb5012..e9ff0647f413b3f530757725f3bab382ac33a730 100644 (file)
--- a/src/FunctionValues.hs
+++ b/src/FunctionValues.hs
@@ -1,6 +1,8 @@
 module FunctionValues
 where
 
+import Prelude hiding (LT)
+
 import Cardinal
 
 data FunctionValues =
@@ -44,7 +46,63 @@ eval f L = left f
 eval f R = right f
 eval f T = top f
 eval f D = down f
+eval f FL = front_left f
+eval f FR = front_right f
+eval f FD = front_down f
+eval f FT = front_top f
+eval f BL = back_left f
+eval f BR = back_right f
+eval f BD = back_down f
+eval f BT = back_top f
+eval f LD = left_down f
+eval f LT = left_top f
+eval f RD = right_down f
+eval f RT = right_top f
+eval f FLD = front_left_down f
+eval f FLT = front_left_top f
+eval f FRD = front_right_down f
+eval f FRT = front_right_top f
+eval f BLD = back_left_down f
+eval f BLT = back_left_top f
+eval f BRD = back_right_down f
+eval f BRT = back_right_top f
+eval f I   = interior f
+eval _ (Scalar x) = x
 eval f (Sum x y) = (eval f x) + (eval f y)
 eval f (Difference x y) = (eval f x) - (eval f y)
 eval f (Product x y) = (eval f x) * (eval f y)
-eval f (ScalarProduct x y) = x * (eval f y)
+eval f (Quotient x y) = (eval f x) / (eval f y)
+
+value_at :: [[[Double]]] -> Int -> Int -> Int -> Double            
+value_at values i j k =
+    ((values !! k) !! j) !! i
+
+make_values :: [[[Double]]] -> Int -> Int -> Int -> FunctionValues
+make_values values i j k =
+    empty_values { front  = value_at values (i-1) j k,
+                   back   = value_at values (i+1) j k,
+                   left   = value_at values i (j-1) k,
+                   right  = value_at values i (j+1) k,
+                   down   = value_at values i j (k-1),
+                   top    = value_at values i j (k+1),
+                   front_left = value_at values (i-1) (j-1) k,
+                   front_right = value_at values (i-1) (j+1) k,
+                   front_down =value_at values (i-1) j (k-1),
+                   front_top = value_at values (i-1) j (k+1),
+                   back_left = value_at values (i+1) (j-1) k,
+                   back_right = value_at values (i+1) (j+1) k,
+                   back_down = value_at values (i+1) j (k-1),
+                   back_top = value_at values (i+1) j (k+1),
+                   left_down = value_at values i (j-1) (k-1),
+                   left_top = value_at values i (j-1) (k+1),
+                   right_top = value_at values i (j+1) (k+1),
+                   right_down = value_at values i (j+1) (k-1),
+                   front_left_down = value_at values (i-1) (j-1) (k-1),
+                   front_left_top = value_at values (i-1) (j-1) (k+1),
+                   front_right_down = value_at values (i-1) (j+1) (k-1),
+                   front_right_top = value_at values (i-1) (j+1) (k+1),
+                   back_left_down = value_at values (i-1) (j-1) (k-1),
+                   back_left_top = value_at values (i+1) (j-1) (k+1),
+                   back_right_down = value_at values (i+1) (j+1) (k-1),
+                   back_right_top = value_at values (i+1) (j+1) (k+1),
+                   interior = value_at values i j k }