Cursesというのは, TUIなアプリケーションを作るためのライブラリーの事です.
参考: http://ja.wikipedia.org/wiki/Curses
これを使ったら, ターミナルの上で, UIを実現するのが楽になるらしい.
色んな言語で実装されているので, みんなも好きな言語で探してみたらいいと思うよ.
HaskellのライブラリーにHSCursesというものがあり, これを使えばいいらしい.
あと, この記事に載せてる例は, 執筆時のHSCursesではちゃんと動くことを確認しています.
- hscurses-1.4.0.0
- ghc 7.0.2
リンク集
- hackageのなかの, 最新のCurses → UI.HSCurses.Curses ここと, ソースコードが一番のドキュメント
- Wikipedia [ja][en]
- TLDP(The Linux Document Project)の中のNCRSESのページ, NCURSES Programming HOWTO
- hscurses-fish-ex のソースコード. 実行すると楽しいですよ.
インストール
$ sudo cabal install hscurses
Hello, Curses
取り敢えず, ｢Hello, Curses｣と書くプログラムを書いてみました.
import qualified UI.HSCurses.Curses as Curses main :: IO () main = do Curses.initCurses -- initCurses :: IO () 初期化する Curses.wAddStr Curses.stdScr "Hello, Curses" -- wAddStr :: Window -> String -> IO () 標準の画面に文字を出力 Curses.refresh -- refresh :: IO () refreshすることが必要 Curses.getCh -- getCh :: IO Key 一文字入力を待つ Curses.endWin -- endWin :: IO () Cursesを用いたアプリケーションを終了するときは, これが必要
＼たったのこれだけ／
これを保存して, 実行すると, コンソールが全画面消えて,
のように表示されます.
そして, 適当なキーを押すとまたコンソールの画面に戻ります.
あまり説明いらないですね.
getChを書かないと, 一瞬で消えて戻ってしまいます.
注意点
- 更新したい時にはrefreshしましょう
文字を移動させてみよう
表示されて終わり, はつまらないので, 文字をグリグリ移動させてみましょう.
先程はwAddStr関数を用いました.
この関数の型は
wAddStr :: Window -> String -> IO ()
でした.
もう一つ, 文字列を出力する関数があります.
mvWAddStr関数です.
mvWAddStr :: Window -> Int -> Int -> String -> IO ()
2つ目と3つ目の引数で, 場所を指定します.
これら関数を用いたら, 任意の場所に文字を出力できるようになります.
ってことで適当に書いたコードがこちら.
import qualified UI.HSCurses.Curses as Curses import Control.Exception (finally) import System.Posix (usleep) move :: (Int, Int, Int, Int) -> IO (Int, Int, Int, Int) move (x, y, dx, dy) = do (height, width) <- Curses.scrSize let s = "Hello, Curses" t = " * " dx' = dx * (if x + dx < 0 || x + dx + length s + 1 > width then -1 else 1) dy' = dy * (if y + dy < 0 || y + dy + 1 > height then -1 else 1) x' = x + dx' y' = y + dy' Curses.mvWAddStr Curses.stdScr y x t Curses.mvWAddStr Curses.stdScr y' x' s Curses.refresh usleep 50000 return (x', y', dx', dy') rep :: (Monad m) => (a -> m a) -> a -> m b rep f x = f x >>= rep f main :: IO () main = do Curses.initCurses rep move (0, 0, 1, 1) `finally` Curses.endWin
実行すると
ってなります
昔のスクリーンセーバー的な何かですね
Ctrl-Cでたぶん終了します
注意点
- うちモナドよく分かってへん／(^o^)＼ 変数持ち歩く方法ってこれでいいんやろうか？
- [追記]usleepよりもControl.Concurrent モジュールの threadDelayを使うほうがいいらしいです. (thanks @shelarcy)
threadDelay 50000
色を変えてみよう
Cursesを使うと, 簡単に出力する色を変えることが出来ます.
色は, 背景色と, 文字色のペアで扱います. 型はそのままPairという名前です.
プログラムの最初にPairをいくつかセッティングする必要があります.
initScr
↓
startColor
↓
initPair
↓
attrSet
↓
普通に文字出力すると, 色がつく
例えば
import qualified UI.HSCurses.Curses as Curses import qualified UI.HSCurses.CursesHelper as CursesH main :: IO () main = do CursesH.start Curses.startColor Curses.initPair (Curses.Pair 1) CursesH.red Curses.defaultBackground Curses.initPair (Curses.Pair 2) CursesH.yellow Curses.defaultBackground Curses.initPair (Curses.Pair 3) CursesH.green Curses.defaultBackground Curses.initPair (Curses.Pair 4) CursesH.cyan Curses.defaultBackground Curses.initPair (Curses.Pair 5) CursesH.blue Curses.defaultBackground Curses.initPair (Curses.Pair 6) CursesH.magenta Curses.defaultBackground Curses.initPair (Curses.Pair 7) CursesH.white Curses.defaultBackground Curses.attrSet Curses.attr0 (Curses.Pair 3) Curses.mvWAddStr Curses.stdScr 0 0 "Hello, Color!" Curses.refresh Curses.getCh CursesH.end
とすると, Pair 3の設定, つまり文字がgreenで背景がdefaultと同じ色になり,
となります.
mapM (\x -> Curses.attrSet Curses.attr0 (Curses.Pair x) >> Curses.mvWAddStr Curses.stdScr x 0 "Hello, Color!") [0..7]
本当はcolorPairsとcolorsの値を見てinitPairを制限しなくてはいけないのですが,
まあいいでしょう(笑
hackageのAttributesのところを見ると, Attr -> Bool -> Attrの型を持った関数が幾つかあります.
これらを使うと,
import qualified UI.HSCurses.Curses as Curses import qualified UI.HSCurses.CursesHelper as CursesH main :: IO () main = do CursesH.start Curses.startColor Curses.initPair (Curses.Pair 1) CursesH.red Curses.defaultBackground Curses.initPair (Curses.Pair 2) CursesH.yellow Curses.defaultBackground Curses.initPair (Curses.Pair 3) CursesH.green Curses.defaultBackground Curses.initPair (Curses.Pair 4) CursesH.cyan Curses.defaultBackground Curses.initPair (Curses.Pair 5) CursesH.blue Curses.defaultBackground Curses.initPair (Curses.Pair 6) CursesH.magenta Curses.defaultBackground Curses.initPair (Curses.Pair 7) CursesH.white Curses.defaultBackground let attr = Curses.attr0 Curses.attrSet attr (Curses.Pair 3) Curses.mvWAddStr Curses.stdScr 0 0 "Hello, Color!" let attr = Curses.setUnderline Curses.attr0 True Curses.attrSet attr (Curses.Pair 3) Curses.mvWAddStr Curses.stdScr 1 0 "Hello, Color!" let attr = Curses.setBold Curses.attr0 True Curses.attrSet attr (Curses.Pair 3) Curses.mvWAddStr Curses.stdScr 2 0 "Hello, Color!" let attr = Curses.setStandout Curses.attr0 True Curses.attrSet attr (Curses.Pair 3) Curses.mvWAddStr Curses.stdScr 3 0 "Hello, Color!" Curses.refresh Curses.getCh CursesH.end
何かに使えそう？
キーボード入力を見てみよう
これまでは, 入力を全く見ないプログラムでした.
それじゃぁUIじゃないので, 入力の方法を見てみます.
まず, hscursesソースのtestに入ってるものを見てみましょう.
https://github.com/skogsbaer/hscurses のtest/key-test/の中です
ソースコードを引用します(一部消去しています)
import qualified UI.HSCurses.Curses as Curses import qualified UI.HSCurses.CursesHelper as CursesH import Data.Char import System.Exit import Control.Exception draw s = do (h, w) <- Curses.scrSize CursesH.gotoTop CursesH.drawLine w s Curses.refresh done = return () forever x = do x forever x main :: IO () main = do CursesH.start draw "" forever (do c <- CursesH.getKey done case c of Curses.KeyChar 'q' -> exitWith ExitSuccess x -> draw ("Last key: " ++ CursesH.displayKey x ++ " (" ++ show x ++ ")") ) `finally` CursesH.end
＼Cursesったら簡単ね／
文字の入力を見ているgetKeyの型はこんなふうになっています.
getKey :: MonadIO m => m () -> m Key
見よう見まねで, こんなコードを書いてみました.
import qualified UI.HSCurses.Curses as Curses import qualified UI.HSCurses.CursesHelper as CursesH import Control.Exception (finally) import System.Exit (exitWith, ExitCode (..) ) import Control.Monad (forever) data Direction = L | R | D | U move :: Direction -> IO () move d = do (height, width) <- Curses.scrSize (h, w) <- Curses.getYX Curses.stdScr Curses.wAddStr Curses.stdScr "*" let (h', w') = case d of L -> (h, (max (w - 1) 0)) R -> (h, (min (w + 1) (width - 2))) D -> ((min (h + 1) (height - 1)), w) U -> ((max (h - 1) 0), w) Curses.move h' w' Curses.refresh main :: IO () main = do CursesH.start Curses.echo False forever $ do Curses.refresh c <- CursesH.getKey (return ()) case CursesH.displayKey c of "<Down>" -> move D "<Up>" -> move U "<Left>" -> move L "<Right>" -> move R "j" -> move D "k" -> move U "h" -> move L "l" -> move R "q" -> exitWith ExitSuccess _ -> return () `finally` CursesH.end
実行して, 矢印キーをテキトーに押していくと
みたいになります.
｢q｣を押すと, 終了します.
注意点
- CursesHelperに含まれる関数を使うときは, Curses.initCursesではなく, CursesHelperのstartを使いましょう. こちらの中でinitCursesは呼ばれます. startのほうを使うべきな理由は, displayKey関数を使ってみるとすぐ気が付きます.
- 誤って, ターミナルの大きさを超えて出力したりカーソルを動かすと, エラーが飛んで落ちます. きちんと壁と比較するコードを書きましょう.
- ↑ なのですが, このプログラムでは(下の端はいいのですが, )右の端の端まで使い切れていません. width - 2のところ, - 1でいい気がするんやけど, なんか右下に来たときに, うまくいかへんの. どうやらmvWAddStrの右下の端はバグがあるらしい
- [追記]`finally`ではなく, bracket_を使うほうがいいらしいです. (thanks @shelarcy)
main = bracket_ CursesH.start CursesH.end $ do Curses.echo False forever $ do Curses.refresh c <- CursesH.getKey (return ()) case CursesH.displayKey c of "<Down>" -> move D "<Up>" -> move U "<Left>" -> move L "<Right>" -> move R "j" -> move D "k" -> move U "h" -> move L "l" -> move R "q" -> exitWith ExitSuccess _ -> return ()
Widgetを使ってみよう
UI.HSCurses.Widgetsというものがあります.
なんでしょうね. 気になります.
気になったものは使ってみましょう.
class Widgetというものがあって, そのインスタンスが
TableWidget TableCell TextWidget EditWidget OpaqueWidget EmptyWidget
の6つあります.
なんとなーく名前からどんなwidgetか想像つきますね.
最初にTextWidgetを使ってみましょう.
型を頼りに, 書いていきます.
import qualified UI.HSCurses.Curses as Curses import qualified UI.HSCurses.CursesHelper as CursesH import qualified UI.HSCurses.Widgets as CursesW main :: IO () main = do CursesH.start let options = CursesW.defaultTWOptions -- TW = Text Widget widget = CursesW.TextWidget "Hello, TextWidget" 0 0 options CursesW.draw (5, 15) (10, 40) CursesW.DHActive widget Curses.getCh CursesH.end
実行すると,
と表示され, 適当なキーを押すと, (正しく)終了します.
TextWidgetは, 文字を表示するだけみたい.
次はEditWidgetを使ってみましょう.
import qualified UI.HSCurses.Curses as Curses import qualified UI.HSCurses.CursesHelper as CursesH import qualified UI.HSCurses.Widgets as CursesW main :: IO () main = do CursesH.start let widget = CursesW.newEditWidget CursesW.defaultEWOptions "Hello, EditWidget" (_, s) <- CursesW.activate (return ()) (5, 15) (1, 30) widget putStrLn $ "Your input is \"" ++ s ++ "\"." Curses.getCh CursesH.end
実行すると,
と出てきます.
矢印キー, Delキー, Backspaceキーなど, 普通に使えると思います.
Enterを押すと
と確定します.
注意点
- 決定するときの入力はactivate関数からもらいます
- 日本語入力は無理
- Macのdeleteキーが効かないんですけど
EditWidgetを使うと簡単な入力フォームを作ることができそうです.
荒削りコードですが, 書いてみました.
import qualified UI.HSCurses.Curses as Curses import qualified UI.HSCurses.CursesHelper as CursesH import qualified UI.HSCurses.Widgets as CursesW import Data.List.Split (splitOn) done :: IO () done = return () scr :: Curses.Window scr = Curses.stdScr yes_or_no :: Bool -> IO Bool yes_or_no b = do Curses.wAddStr scr $ if b then " [Y/n] " else " [y/N] " Curses.refresh let loop = do c <- Curses.getCh case CursesH.displayKey c of "y" -> Curses.wAddStr scr "y" >> Curses.addLn >> return True "Y" -> Curses.wAddStr scr "Y" >> Curses.addLn >> return True "n" -> Curses.wAddStr scr "n" >> Curses.addLn >> return False "N" -> Curses.wAddStr scr "N" >> Curses.addLn >> return False "<Enter>" -> Curses.wAddStr scr (if b then "Y" else "N") >> Curses.addLn >> return b _ -> loop loop confirm :: String -> IO Bool confirm s = do (height, width) <- Curses.scrSize (y, x) <- Curses.getYX scr mapM (\(y, s) -> Curses.mvWAddStr scr y x s) $ zip [y..] $ splitOn "\n" s yes_or_no True dialog :: IO [String] dialog = do Curses.erase Curses.refresh let widget1 = CursesW.newEditWidget CursesW.defaultEWOptions "" widget2 = CursesW.newEditWidget CursesW.defaultEWOptions "" Curses.mvWAddStr scr 4 15 "What is your favorite fruit?" (_, s1) <- CursesW.activate done (5, 15) (1, 40) widget1 putStrLn $ " Input: " ++ s1 Curses.mvWAddStr scr 9 15 "What is your favorite programming language?" (_, s2) <- CursesW.activate done (10, 15) (1, 40) widget2 putStrLn $ " Input: " ++ s2 Curses.wMove scr 14 20 b <- confirm $ "You like " ++ s1 ++ " and " ++ s2 ++ ". \nValid input?" if b then return [s1, s2] else dialog main :: IO () main = do CursesH.start (s1:s2:_) <- dialog Curses.addLn Curses.addLn Curses.wAddStr scr $ " Here's a " ++ s1 ++ ". Feel free to eat it! And " ++ s2 ++ " is a good language." Curses.refresh Curses.getCh CursesH.end
