1 files changed, 64 insertions(+), 3 deletions(-)

M Graphics/Layout/Arithmetic.hs

@@ 1,8 1,69 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Graphics.Layout.Arithmetic where
 
 import Data.CSS.Tokens (Token(..))
+import Data.Scientific (toRealFloat)
+import GHC.Real (infinity)
+import Data.Text (unpack, Text)
 
-data Opcode n = Add | Subtract | Multiply | Divide | Clamp | Num n
-parseCalc :: [Token] -> [Opcode Length]
-evalCalc :: [Opcode n] -> n
+data Opcode n = Add | Subtract | Multiply | Divide | Func Text | Num n
+parseCalc :: [Token] -> [Opcode (Float, String)] -> [Opcode (Float, String)]
+parseCalc (Number _ n:toks) stack = Num (val2float n, ""):parseCalc toks stack
+parseCalc (Percentage _ n:toks) stack = Num (val2float n, "%"):parseCalc toks stack
+parseCalc (Dimension _ n unit:toks) stack =
+    Num (val2float n, unpack unit):parseCalc toks stack
+parseCalc (Ident "e":toks) stack = Num (exp 1, ""):parseCalc toks stack
+parseCalc (Ident "pi":toks) stack = Num (pi, ""):parseCalc toks stack
+parseCalc (Ident "infinity":toks) stack = Num (infinity, ""):parseCalc toks stack
+parseCalc (Ident "-infinity":toks) stack = Num (-infinity, ""):parseCalc toks stack
+parseCalc (Ident "NaN":toks) stack = Num (0/0, ""):parseCalc toks stack
+
+parseCalc (Func x:toks) stack = parseCalc toks (Func x:stack)
+parseCalc (LeftParen:toks) stack = parseCalc toks (Func "calc":stack)
+parseCalc toks'@(Delim c:toks) (stack:stacks)
+    | prec stack >= prec (op c) = stack:parseCalc toks' stacks
+    | otherwise = parseCalc toks (op c:stack:stacks)
+  where
+    prec Comma = 1
+    prec Add = 2
+    prec Subtract = 2
+    prec Multiply = 3
+    prec Divide = 3
+    prec (Func _) = 0
+    prec (Num _) = error "Unexpected number on operand stack!"
+    op '+' = Add
+    op '-' = Subtract
+    op '*' = Multiply
+    op '/' = Divide
+    op ',' = Comma -- For function-calls.
+parseCalc (Comma:toks) stack = parseCalc (Delim ',':toks) stack
+parseCalc (RightParen:toks) (Func "calc":stack) = parseCalc toks stack
+parseCalc (RightParen:toks) (op@Func _:stack) = op:parseCalc toks stack
+parseCalc toks@(RightParen:_) (op:stack) = op:parseCalc toks stack
+
+evalCalc :: Num n => [Opcode n] -> [n] -> n
+evalCalc (Comma:expr) stack = evalCalc expr stack -- The function args off
+evalCalc (Add:expr) (y:x:stack) = evalCalc expr ((x + y):stack)
+evalCalc (Minus:expr) (y:x:stack) = evalCalc expr ((x - y):stack)
+evalCalc (Multiply:expr) (y:x:stack) = evalCalc expr ((x*y):stack)
+evalCalc (Divide:expr) (y:x:stack) = evalCalc expr ((x/y):stack)
+evalCalc (Num n:expr) stack = evalCalc expr (n:stack)
+
+evalCalc (Func "abs":expr) (x:stack) = evalCalc expr (abs x:stack)
+evalCalc (Func "acos":expr) (x:stack) = evalCalc expr (acos x:stack)
+evalCalc (Func "asin":expr) (x:stack) = evalCalc expr (asin x:stack)
+evalCalc (Func "atan":expr) (x:stack) = evalCalc expr (atan x:stack)
+evalCalc (Func "atan2":expr) (x:stack) = evalCalc expr (atan2 x:stack)
+evalCalc (Func "clamp":expr) (max:x:min:stack) =
+    evalCalc expr (clamp (min, max) x:stack)
+evalCalc (Func "cos":expr) (x:stack) = evalCalc expr (cos x:stack)
+evalCalc (Func "exp":expr) (x:stack) = evalCalc expr (exp x:stack)
+evalCalc (Func "log":expr) (x:stack) = evalCalc expr (log x:stack)
+evalCalc (Func "max":expr) (y:x:stack) = evalCalc expr (maximum x y:stack)
+
+evalCalc [] [ret] = ret
+evalCalc _ _ = error "Should have been caught by validation."
 mapCalc :: (a -> b) -> [Opcode a] -> [Opcode b]
+
+val2float (NVInteger n) = fromIntegral n
+val2float (NVScientific n) = toRealFloat n