]> gitweb.michael.orlitzky.com - spline3.git/commitdiff
Add the Cardinal and FunctionValues modules which will hopefully replace the existing...
authorMichael Orlitzky <michael@orlitzky.com>
Tue, 3 May 2011 21:48:36 +0000 (17:48 -0400)
committerMichael Orlitzky <michael@orlitzky.com>
Tue, 3 May 2011 21:48:36 +0000 (17:48 -0400)
src/Cardinal.hs [new file with mode: 0644]
src/FunctionValues.hs [new file with mode: 0644]

diff --git a/src/Cardinal.hs b/src/Cardinal.hs
new file mode 100644 (file)
index 0000000..e4e9464
--- /dev/null
@@ -0,0 +1,23 @@
+module Cardinal
+where
+
+data Cardinal = F
+              | B
+              | L
+              | R
+              | T
+              | D
+              | Sum Cardinal Cardinal
+              | Difference Cardinal Cardinal
+              | Product Cardinal Cardinal
+              | ScalarProduct Double Cardinal
+                deriving (Show, Eq)
+
+instance Num Cardinal where
+    x + y = Sum x y
+    x - y = Difference x y
+    x * y = Sum x y
+    negate x = ScalarProduct (-1) x
+    abs x = x
+    signum x = x
+    fromInteger _ = F -- Whatever.
diff --git a/src/FunctionValues.hs b/src/FunctionValues.hs
new file mode 100644 (file)
index 0000000..d477a38
--- /dev/null
@@ -0,0 +1,50 @@
+module FunctionValues
+where
+
+import Cardinal
+
+data FunctionValues =
+    FunctionValues { front  :: Double,
+                     back   :: Double,
+                     left   :: Double,
+                     right  :: Double,
+                     top    :: Double,
+                     down   :: Double,
+                     front_left :: Double,
+                     front_right :: Double,
+                     front_top :: Double,
+                     front_down :: Double,
+                     back_left :: Double,
+                     back_right :: Double,
+                     back_top :: Double,
+                     back_down :: Double,
+                     left_top :: Double,
+                     left_down :: Double,
+                     right_top :: Double,
+                     right_down :: Double,
+                     front_left_top :: Double,
+                     front_left_down :: Double,
+                     front_right_top :: Double,
+                     front_right_down :: Double,
+                     back_left_top :: Double,
+                     back_left_down :: Double,
+                     back_right_top :: Double,
+                     back_right_down :: Double,
+                     interior :: Double }
+      deriving (Eq, Show)
+
+empty_values :: FunctionValues
+empty_values =
+    FunctionValues 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+
+eval :: FunctionValues -> Cardinal -> Double
+eval f F = front f
+eval f B = back f
+eval f L = left f
+eval f R = right f
+eval f T = top f
+eval f D = down f
+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)