第9章 対話プログラム #2

というわけでminttyからhugsを起動する方法にしたら捗った。 あと、今までは全部1ファイルでやろうとしていたが、色々無理が出てきたのでモジュール化した。

module NineSix where

import Parsing
import Expr
import NineFive

box :: [String]
box =  ["+---------------+",
        "|               |",
        "+---+---+---+---+",
        "| q | c | d | = |",
        "+---+---+---+---+",
        "| 1 | 2 | 3 | + |",
        "+---+---+---+---+",
        "| 4 | 5 | 6 | - |",
        "+---+---+---+---+",
        "| 7 | 8 | 9 | * |",
        "+---+---+---+---+",
        "| 0 | ( | ) | / |",
        "+---+---+---+---+"]

buttons :: [Char]
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    :: String -> IO ()
display xs =  do writeat (3,2) "             "
                 writeat (3,2) (reverse (take 13 (reverse xs)))

calc    :: String -> IO ()
calc xs =  do display xs
              c <- getChar
              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

プログラムを眺めるとわかるが、calc関数がメインループになっている。 もちろん、ループじゃなくて再帰だから、メイン再帰というべきなのか?