読者です 読者をやめる 読者になる 読者になる

HaskellでCurses!!! HSCursesライブラリーを使ってみたよ

Haskell

Cursesというのは, TUIなアプリケーションを作るためのライブラリーの事です.

参考: http://ja.wikipedia.org/wiki/Curses

これを使ったら, ターミナルの上で, UIを実現するのが楽になるらしい.

色んな言語で実装されているので, みんなも好きな言語で探してみたらいいと思うよ.

HaskellのライブラリーにHSCursesというものがあり, これを使えばいいらしい.


あと, この記事に載せてる例は, 執筆時のHSCursesではちゃんと動くことを確認しています.

  • hscurses-1.4.0.0
  • ghc 7.0.2

リンク集

インストール

  $ 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




感想

なんか冗長になってきたので締めます.

ここに書いたことはかなり基本的なことだけなので,

これだけでCursesでアプリケーションを作れるとかは, 思ってません.

自分のHaskell力がまだまだ未熟...


あと, 参考にできるものがhackageくらいしかなくて,

かなり手探り状態で書いています.

もうちょっと色々できるようになったら, また記事を書くかもしれません.

ではでは.