calculatorWin.lhs
作成者 管理者
最終変更日時
2011年12月28日 13時31分
Click here to get the file
サイズ
5.7 kB
-
File type
text/x-literate-haskell
ファイルのコンテンツ
Calculator example from section 9.6 of Programming in Haskell,
Graham Hutton, Cambridge University Press, 2007.
Note: the definition for getCh in this example works with the
Glasgow Haskell Compiler, but may not work with some Haskell
systems, such as Hugs. Moreover, the use of control characters
may not work on some systems, such as WinHugs.
> import Parsing
> import System.IO
> import System.Console.ANSI
Parser for expressions
----------------------
> expr :: Parser Int
> expr = do t <- term
> do symbol "+"
> e <- expr
> return (t + e)
> +++ do symbol "-"
> e <- expr
> return (t - e)
> +++ return t
>
> term :: Parser Int
> term = do f <- factor
> do symbol "*"
> t <- term
> return (f * t)
> +++ do symbol "/"
> t <- term
> return (f `div` t)
> +++ return f
>
> factor :: Parser Int
> factor = do symbol "("
> e <- expr
> symbol ")"
> return e
> +++ integer
Derived primitives
------------------
> getCh :: IO Char
> getCh = do hSetEcho stdin False
> c <- getChar
> hSetEcho stdin True
> return c
>
> beep :: IO ()
> beep = putStr "\BEL"
>
> cls :: IO ()
> cls = clearScreen
> -- cls = putStr "\ESC[2J"
>
> type Pos = (Int,Int)
>
> goto :: Pos -> IO ()
> goto (x,y) = setCursorPosition y x
> -- goto (x,y) = putStr ("\ESC[" ++ show y ++ ";" ++ show x ++ "H")
>
> writeat :: Pos -> String -> IO ()
> writeat p xs = do goto p
> putStr xs
>
> seqn :: [IO a] -> IO ()
> seqn [] = return ()
> seqn (a:as) = do a
> seqn as
The calculator
--------------
> box :: [String]
> box = ["+---------------+",
> "| |",
> "+---+---+---+---+",
> "| q | c | d | = |",
> "+---+---+---+---+",
> "| 1 | 2 | 3 | + |",
> "+---+---+---+---+",
> "| 4 | 5 | 6 | - |",
> "+---+---+---+---+",
> "| 7 | 8 | 9 | * |",
> "+---+---+---+---+",
> "| 0 | ( | ) | / |",
> "+---+---+---+---+"]
>
> buttons :: String
> buttons = standard ++ extra
> where
> standard = "qcd=123+456-789*0()/"
> extra = "QCD \ESC\BS\DEL\n"
>
>
> showbox :: IO ()
> showbox = seqn [writeat (1,y) xs | (y,xs) <- zip [1..13] box]
>
> display xs = do writeat (3,2) " "
> writeat (3,2) (reverse (take 13 (reverse xs)))
>
> calc :: String -> IO ()
> calc xs = do display xs
> c <- getCh
> if elem c buttons then
> process c xs
> else
> do beep
> calc xs
>
> process :: Char -> String -> IO ()
> process c xs
> | elem c "qQ\ESC" = quit
> | elem c "dD\BS\DEL" = delete xs
> | elem c "=\n" = eval xs
> | elem c "cC" = clear
> | otherwise = press c xs
>
> quit :: IO ()
> quit = goto (1,14)
>
> delete :: String -> IO ()
> delete "" = calc ""
> delete xs = calc (init xs)
>
> eval :: String -> IO ()
> eval xs = case parse expr xs of
> [(n,"")] -> calc (show n)
> _ -> do beep
> calc xs
>
> clear :: IO ()
> clear = calc ""
>
> press :: Char -> String -> IO ()
> press c xs = calc (xs ++ [c])
>
> run :: IO ()
> run = do cls
> showbox
> clear