module Main where
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.GC
import Data.Char
import Data.Maybe
import Test.QuickCheck
{-
////////////////////////////////////////////////////////////
///////////////// __EXPRESSION PARSER__ ///////////////////
-}
data Expr = Num Double | Add Expr Expr | Mul Expr Expr | Fun Func Expr | Var
deriving (Show, Eq)
data Func = Sin | Cos
deriving (Show, Eq)
{-
instance Show Expr where
show = showExpr
-}
-- Converts an expression to a string.
showExpr :: Expr -> String
showExpr (Num x) = show x
showExpr (Add x y) = showExpr x ++ "+" ++ showExpr y
showExpr (Mul x y) = showFactor x ++ "*" ++ showFactor y
showExpr (Fun f x) = showFunc f ++ showArg x
showExpr Var = "x"
-- Decides whether or not to show parentheses
showFactor :: Expr -> String
showFactor (Add x y) = "(" ++ showExpr (Add x y) ++ ")"
showFactor x = showExpr x
showArg :: Expr -> String
showArg (Mul x y) = "(" ++ showExpr (Mul x y) ++ ")"
showArg (Add x y) = "(" ++ showExpr (Add x y) ++ ")"
showArg e = showExpr e
showFunc :: Func -> String
showFunc Sin = "sin "
showFunc Cos = "cos "
-- Calculates the value of an expression (evaluates).
eval :: Expr -> Double -> Double
eval (Num n) x = n
eval (Add a b) x = eval a x + eval b x
eval (Mul a b) x = eval a x * eval b x
eval Var x = x
eval (Fun Sin a) x = sin (eval a x)
eval (Fun Cos a) x = cos (eval a x)
type Parser a = String -> Maybe (a,String)
-- Parses a string to an expression.
readExpr :: String -> Maybe Expr
readExpr s =
case expr (filter (/= ' ') s) of
Just (a,"") -> Just a
_ -> Nothing
expr, term :: Parser Expr
expr = chain term '+' Add
term = chain factor '*' Mul
factor :: Parser Expr
factor ('x':s) = Just (Var, s)
factor ('s':'i':'n':s) =
case factor s of
Just (a, s1) -> Just (Fun Sin a, s1)
_ -> Nothing
factor ('c':'o':'s':s) =
case factor s of
Just (a, s1) -> Just (Fun Cos a, s1)
_ -> Nothing
factor ('(':s) =
case expr s of
Just (a, ')':s1) -> Just (a, s1)
_ -> Nothing
factor s = num s
num :: Parser Expr
num s =
case listToMaybe (reads s :: [(Double, String)]) of
Just (n,s') -> Just (Num n, s')
Nothing -> Nothing
chain :: Parser a -> Char -> (a -> a -> a) -> Parser a
chain p op f s1 =
case p s1 of
Just (a,s2) -> case s2 of
c:s3 | c == op -> case chain p op f s3 of
Just (b,s4) -> Just (f a b, s4)
Nothing -> Just (a,s2)
_ -> Just (a,s2)
Nothing -> Nothing
{-
/////////////////////////////////////////////////////////////////////
///////////////// __ARBITRARY EXPRESSION GENERATOR__ ///////////////
-}
instance Arbitrary Expr where
arbitrary = sized arbExpr
{- "t" is 4 times smaller in order to generate
tangible sin and cos expressions. -}
arbExpr :: Int -> Gen Expr
arbExpr s =
frequency [ (1, do n <- arbitrary
return (Num n))
, (s, do a <- arbExpr s'
b <- arbExpr s'
return (Add a b))
, (s, do a <- arbExpr s'
b <- arbExpr s'
return (Mul a b))
, (s, do a <- arbExpr t
return (Fun Sin a))
, (s, do a <- arbExpr t
return (Fun Cos a))
, (1, do return Var)
]
where
s' = s `div` 2
t = s `div` 4
{- Testing the parser by first showing,
then reading an expression, after which it
compares it to the original expression.-}
prop_ShowReadAssoc :: Expr -> Bool
prop_ShowReadAssoc a =
readExpr (showExpr a) == Just (assoc a)
-- Rearranges associative operators.
assoc :: Expr -> Expr
assoc (Add (Add a b) c) = assoc (Add a (Add b c))
assoc (Add a b) = Add (assoc a) (assoc b)
assoc (Mul (Mul a b) c) = assoc (Mul a (Mul b c))
assoc (Mul a b) = Mul (assoc a) (assoc b)
assoc (Fun Sin a) = Fun Sin (assoc a)
assoc (Fun Cos a) = Fun Cos (assoc a)
assoc a = a
{-
////////////////////////////////////////////////////////////
///////////////// __GRAPHICAL CALCULATOR__ ////////////////
-}
-- Calculates all the points of the graph in terms of pixels.
points :: Expr -> Double -> (Int, Int) -> [Point]
points exp scl (w,h) = zip [0..w] (map realToPix (map (eval exp) (map pixToReal [0..w])))
where
pixToReal :: Int -> Double -- converts a pixel x-coordinate to a real x-coordinate
pixToReal x = scl * fromIntegral (x - w `div` 2)
realToPix :: Double -> Int -- converts a real y-coordinate to a pixel y-coordinate
realToPix y = round ((-1)/scl*y) + (h `div` 2)
-- Calculates the lines that will connect the points.
linez :: Expr -> Double -> (Int, Int) -> [(Point, Point)]
linez exp scl size = linez' xs
where (xs) = points exp scl size
linez' :: [Point] -> [(Point, Point)]
linez' [] = error "can't make line"
linez' (a:[]) = error "can't make line"
linez' (a:b:[]) = (a,b):[]
linez' (a:b:xs) = (a,b):(linez' (b:xs))
---------------------------------------------------------------------------
-- Height, width and scale of the drawing area.
sizeX, sizeY :: Int
sizeX = 300
sizeY = 300
scale :: Double
scale = 0.04
main :: IO()
main =
do initGUI
win <- windowNew
windowSetTitle win "Calculator"
win `onDestroy` mainQuit
can <- drawingAreaNew
can `onSizeRequest` return (Requisition sizeX sizeY)
exp <- entryNew
entrySetText exp "(enter function here)"
exp `onEntryActivate` drawCanvas can exp
lay <- vBoxNew False 5
containerAdd lay can
containerAdd lay exp
containerAdd win lay
widgetShowAll win
mainGUI
drawCanvas :: DrawingArea -> Entry -> IO ()
drawCanvas can ent =
do dw <- widgetGetDrawWindow can
drawWindowClear dw
gc <- gcNew dw
ex <- entryGetText ent
case readExpr ex of
Nothing -> drawLine dw gc (0,0) (0,0)
(Just expr) -> sequence_ [ drawLine dw gc p q | (p,q) <-
linez expr scale (sizeX, sizeY) ]
