LoginSignup
27
27

More than 5 years have passed since last update.

@CyLomw

Haskell でノベルゲームスクリプトのようなものを作る

Posted at

Haskell でノベルゲームのスクリプトのようなものを作ることを考えます．

素朴に考える

まず，簡単のため text と line という 2 つの命令を考えます．
text は 1 つの文字列を表示する命令で，line は発言者と発言の 2 つの文字列を表示する命令とします．

つまり，

text "今日は月曜日。"

line "Aさん" "今日は月曜日ですね。"

のように使われる命令となります．

命令をデータ型として定義する

今回のポイントは，命令をデータ型として定義してしまうことです．
次のデータ型を見てください．

data Script a = Text String (Script a)
              | Line String String (Script a)
              | Return a

このデータ型は text と line に対応する 2 つの値コンストラクタ Text と Line，それに加えて Return という値コンストラクタを持ちます．

値コンストラクタ Text, Line はおしりに (Script a) を持っています．即ち，再帰的な構造になっていることが解ると思います．

再帰的な構造の嬉しい点は，各命令を繋げていくことができるところです．
例えば Return () は Script () 型です．

ghci
ghci> :t Return ()
Return () :: Script ()

さらに，Text "text" (Return ()) とすると，これも Script () 型になることが解ると思います．

ghci
ghci> :t Text "text" (Return ())
Text "text" (Return ()) :: Script ()

これで Text と Return の 2 命令を繋ぐことができました．さらに Line を繋げてみます．

ghci
ghci> :t Line "chara" "line" (Text "text" (Return ()))
Line "chara" "line" (Text "text" (Return ())) :: Script ()

これもちゃんと Script () 型になりました．
このようにして，各命令を好きな順番に，好きなだけ繋げていくことができます．ただし，Return 命令はおしりに (Script a) を持っていないので一番末尾の命令になります．

というわけで，これだけで，もう簡単なスクリプトを書くことが出来るようになりました．

script1 :: Script ()
script1 = 
  Text "ルビーよりも赤くすきとおりリチウムよりもうつくしく酔ったようになってその火は燃えているのでした。"
    (Line "ジョバンニ" "あれは何の火だろう。あんな赤く光る火は何を燃やせばできるんだろう。" 
      (Line "カムパネルラ" "蝎の火だな。"
        (Line "女の子" "あら、蝎の火のことならあたし知ってるわ。" 
          (Return ()))))

括弧だらけで見難いので，$ を使って以下のように書き換えてみました．

script2 :: Script ()
script2 =
  Text "ルビーよりも赤くすきとおりリチウムよりもうつくしく酔ったようになってその火は燃えているのでした。" $
  Line "ジョバンニ" "あれは何の火だろう。あんな赤く光る火は何を燃やせばできるんだろう。" $
  Line "カムパネルラ" "蝎の火だな。" $
  Line "女の子" "あら、蝎の火のことならあたし知ってるわ。" $
  Return ()

実行用の函数を用意する

スクリプトを記述できるようになったので，それを実行する函数を用意してみましょう．

run :: Script a -> IO a
run (Return a) = return a
run (Text str next) = putStrLn str >> run next
run (Line str1 str2 next) = putStrLn (str1 ++ ": " ++ str2) >> run next

next の部分にはスクリプトの残りが入っているので，再帰的に run を作用させています．

スクリプトを実行してみましょう．

ghci
ghci> run script2
ルビーよりも赤くすきとおりリチウムよりもうつくしく酔ったようになってその火は燃えているのでした。
ジョバンニ: あれは何の火だろう。あんな赤く光る火は何を燃やせばできるんだろう。
カムパネルラ: 蝎の火だな。
女の子: あら、蝎の火のことならあたし知ってるわ。

さらにゲームっぽくするために，キーを押すと次の文章がでてくるような実装にしてみましょう．

-- 指定された文字が入力されるまで待つ
waitChar :: Char -> IO ()
waitChar c = getChar >>= \ipt ->
  if c == ipt then return () else waitChar c

-- 改行が入力されるまで待つ
waitNL :: IO ()
waitNL = waitChar '\n'

run' :: Script a -> IO a
run' (Return a) = return a
run' (Text str next) = putStrLn str >> waitNL >> run' next
run' (Line str1 str2 next) =
  putStrLn (str1 ++ ": " ++ str2) >> waitNL >> run' next
ghci
ghci> run' script2
ルビーよりも赤くすきとおりリチウムよりもうつくしく酔ったようになってその火は燃えているのでした。

ジョバンニ: あれは何の火だろう。あんな赤く光る火は何を燃やせばできるんだろう。

カムパネルラ: 蝎の火だな。

女の子: あら、蝎の火のことならあたし知ってるわ。

今回は標準出力用の函数を考えましたが，例えば GUI で画面に出力したい等の場合も runGUI のような専用の出力函数を作ってあげれば済みます．
このように，出力先が変わってもスクリプトに変更を加える必要はないため，入出力とゲームのロジックの分離が可能になります．

命令を追加する

Text と Line だけではつまらないので，もうひとつ Choice 命令を追加してみます．
Choice は選択肢を表示させ，どれが選択されたかを何らかの方法で返します．

Choice 命令が今までの Text, Line と異なるのは，ユーザからの入力を受け付ける点です．これはどうしたらいいでしょうか．

例えば，Choice で 2 つの選択肢 ["Hello!", "Hi!"] を表示させ，そこでユーザがキーボードから入力した文字を返すだけのスクリプトを考えてみます．
すると，そのスクリプトは以下のようになってほしいわけです．

script3 :: Script Char
script3 = Choice ["Hello!", "Hi!"] (\c -> Return c)

ユーザからの入力をとりあえずラムダ式の引数 c として受け取っています．このようなことができれば，ユーザからの入力により分岐させることができるようになります．

script4 :: Script ()
script4 = 
  Line "John" "Hello!" $
  Choice ["Hello!", "Hi!"] $ \c -> case c of
    '1' -> Text "Hello!" $ Return ()
    '2' -> Text "Hi!"    $ Return ()
    _   -> Text "..."    $ Return ()

このときの Choice の型は 

Choice :: [String] -> (Char -> Script a)

であることがわかります．よって

data Script a = Text String (Script a)
              | Line String String (Script a)
              | Choice [String] (Char -> Script a)
              | Return a

となりました．これで本当にうまくいくのか試してみましょう．まずは run 函数に Choice に対する実装を与えます．

run :: Script a -> IO a
run (Return a) = return a
run (Text str next) = putStrLn str >> run next
run (Line str1 str2 next) = putStrLn (str1 ++ ": " ++ str2) >> run next
run (Choice strs g) = do
  print strs
  ch <- getChar
  putChar '\n'
  run (g ch)

Choice strs g の g は Char -> Script a という型を持つので，Char を与えると残りのスクリプトを返す函数になっています．
即ち next = g ch です．

実行してみましょう．

ghci
ghci> run script4
John: Hello!
["Hello!","Hi!"]
1
Hello!

ghci> run script4
John: Hello!
["Hello!","Hi!"]
2
Hi!

ghci> run script4
John: Hello!
["Hello!","Hi!"]
a
...

run' の方も似たような実装でいいでしょう．

run' :: Script a -> IO a
run' (Return a) = return a
run' (Text str next) = putStrLn str >> waitNL >> run' next
run' (Line str1 str2 next) =
  putStrLn (str1 ++ ": " ++ str2) >> waitNL >> run' next
run' (Choice strs g) = do
  print strs
  ch <- getChar
  putChar '\n'
  run' (g ch)

今回は Choice [String] (Char -> Script a) としましたが，Char ではなく Int で処理したい，等のときは Choice [String] (Int -> Script a) としてもよいでしょう．

また，Choice は実際に分岐を行っているわけではなく，選択肢の表示とユーザ入力の値を返すことしかやっていないことに注意してください．
スクリプト上で分岐やループ，変数への束縛などを行う場合，それらの機能を実装する必要はなく，Haskell の機能を使えばよいということです．

モナドを使って書き直す

さて，これで Text, Line, Choice の 3 命令を使えるスクリプトを書けるようになりましたが，モナドを使うとより簡単にスクリプトが書けるようになります．

いままで使ってきた

data Script a = Text String (Script a)
              | Line String String (Script a)
              | Choice [String] (Char -> Script a)
              | Return a

というデータ型ですが，実はこれはモナドのインスタンスになることができます．

ということで，実際にモナドのインスタンスにしてみました．

instance Monad Script where
  return = Return
  Text str next >>= f = Text str $ next >>= f
  Line str1 str2 next >>= f = Line str1 str2 $ next >>= f
  Choice strs g >>= f = Choice strs $ \c -> (g c >>= f)
  Return a >>= f = f a

(>>=) の実装は，基本的に next の部分に再帰的に (>>=) を適用していっているだけになっています．

スクリプトをモナドの記法で書く

さて，モナドにすると何が嬉しいかというと，(>>) や do 記法を使ってスクリプトが書けるようになります．
今までのスクリプトをモナドを使って書き換えてみましょう．

簡単なものからいきましょう．例えば次のスクリプト

script5 :: Script ()
script5 = Line "chara" "line" (Text "text" (Return ()))

をモナドの記法を使って書いてみましょう．

2 つの命令 Line と Text を (>>=) でつなげることが出来ないか考えてみます．
モナドのインスタンスにした時の実装

Line str1 str2 next >>= f = Line str1 str2 $ next >>= f

の next に例えば Return () を入れてみると，

Line str1 str2 (Return ()) >>= f = Line str1 str2 $ (Return ()) >>= f

となります．ここで，Return a >>= f = f a であるので

Line str1 str2 (Return ()) >>= f = Line str1 str2 $ f ()

であることがわかります．ここで，

f = \_ -> Text "text" (Return ())

とおけば

Line str1 str2 (Return ()) >>= (\_ -> Text "text" (Return ())) 
  = Line str1 str2 $ Text "text" (Return ())

となります．ここで，x >>= \_ -> y は x >> y と書くことができるので

Line str1 str2 (Return ()) >> Text "text" (Return ()) 
  = Line str1 str2 $ Text "text" (Return ())

となりました．即ち

script5 :: Script ()
script5 = Line "chara" "line" (Text "text" (Return ()))

は

script6 :: Script ()
script6 = Line "chara" "line" (Return ()) >> Text "text" (Return ())

と書き換えることができます．
さらに do 記法を使うと

script7 :: Script ()
script7 = do
  Line "chara" "line" $ Return ()
  Text "text" $ Return ()

と書けます．また return = Return なので Return を return に書き換えることも出来ます．
いちいち return を書くのは面倒なので，次のような函数を定義してしまいましょう．

text :: String -> Script ()
text str = Text str $ return ()

line :: String -> String -> Script ()
line str1 str2 = Line str1 str2 $ return ()

choice :: [String] -> Script Char
choice strs = Choice strs $ \c -> return c

これらの函数を使うことで

script8 :: Script ()
script8 = do
  line "chara" "line"
  text "text"

のように簡潔に書くことができるようになりました．もはや Return も不要なのがわかります．

他の例も見てみましょう．

script9 :: Script ()
script9 = do
  text "ルビーよりも赤くすきとおりリチウムよりもうつくしく酔ったようになってその火は燃えているのでした。"
  line "ジョバンニ" "あれは何の火だろう。あんな赤く光る火は何を燃やせばできるんだろう。"
  line "カムパネルラ" "蝎の火だな。"
  line "女の子" "あら、蝎の火のことならあたし知ってるわ。"

script10 :: Script ()
script10 = do
  line "John" "Hello!"
  c <- choice ["Hello!", "Hi!"]
  case c of
    '1' -> text "Hello!"
    '2' -> text "Hi!"
    _   -> text "..."

これでとりあえず目標は達成できました．

ソースコード全文

data Script a = Text String (Script a)
              | Line String String (Script a)
              | Choice [String] (Char -> Script a)
              | Return a

instance Monad Script where
  return = Return
  Text str next >>= f = Text str $ next >>= f
  Line str1 str2 next >>= f = Line str1 str2 $ next >>= f
  Choice strs g >>= f = Choice strs $ \c -> (g c >>= f)
  Return a >>= f = f a

text :: String -> Script ()
text str = Text str $ return ()

line :: String -> String -> Script ()
line str1 str2 = Line str1 str2 $ return ()

choice :: [String] -> Script Char
choice strs = Choice strs $ \c -> return c


run :: Script a -> IO a
run (Return a) = return a
run (Text str next) = putStrLn str >> run next
run (Line str1 str2 next) = putStrLn (str1 ++ ": " ++ str2) >> run next
run (Choice strs f) = do
  print strs
  ch <- getChar
  putChar '\n'
  run (f ch)

waitChar :: Char -> IO ()
waitChar c = getChar >>= \ipt ->
  if c == ipt then return () else waitChar c

waitNL :: IO ()
waitNL = waitChar '\n'

run' :: Script a -> IO a
run' (Return a) = return a
run' (Text str next) = putStrLn str >> waitNL >> run' next
run' (Line str1 str2 next) =
  putStrLn (str1 ++ ": " ++ str2) >> waitNL >> run' next
run' (Choice strs f) = do
  print strs
  ch <- getChar
  putChar '\n'
  run' (f ch)


script1 :: Script ()
script1 = 
  Text "ルビーよりも赤くすきとおりリチウムよりもうつくしく酔ったようになってその火は燃えているのでした。"
    (Line "ジョバンニ" "あれは何の火だろう。あんな赤く光る火は何を燃やせばできるんだろう。" 
      (Line "カムパネルラ" "蝎の火だな。"
        (Line "女の子" "あら、蝎の火のことならあたし知ってるわ。" 
          (Return ()))))

script2 :: Script ()
script2 =
  Text "ルビーよりも赤くすきとおりリチウムよりもうつくしく酔ったようになってその火は燃えているのでした。" $
  Line "ジョバンニ" "あれは何の火だろう。あんな赤く光る火は何を燃やせばできるんだろう。" $
  Line "カムパネルラ" "蝎の火だな。" $
  Line "女の子" "あら、蝎の火のことならあたし知ってるわ。" $
  Return ()

script3 :: Script Char
script3 = Choice ["Hello!", "Hi!"] (\c -> Return c)

script4 :: Script ()
script4 = 
  Line "John" "Hello!" $
  Choice ["Hello!", "Hi!"] $ \c -> case c of
    '1' -> Text "Hello!" $ Return ()
    '2' -> Text "Hi!"    $ Return ()
    _   -> Text "..."    $ Return ()

script5 :: Script ()
script5 = Line "chara" "line" (Text "text" (Return ()))

script6 :: Script ()
script6 = Line "chara" "line" (Return ()) >> Text "text" (Return ())

script7 :: Script ()
script7 = do
  Line "chara" "line" $ Return ()
  Text "text" $ Return ()

script8 :: Script ()
script8 = do
  line "chara" "line"
  text "text"

script9 :: Script ()
script9 = do
  text "ルビーよりも赤くすきとおりリチウムよりもうつくしく酔ったようになってその火は燃えているのでした。"
  line "ジョバンニ" "あれは何の火だろう。あんな赤く光る火は何を燃やせばできるんだろう。"
  line "カムパネルラ" "蝎の火だな。"
  line "女の子" "あら、蝎の火のことならあたし知ってるわ。"

script10 :: Script ()
script10 = do
  line "John" "Hello!"
  c <- choice ["Hello!", "Hi!"]
  case c of
    '1' -> text "Hello!"
    '2' -> text "Hi!"
    _   -> text "..."

あとがき

知っている方は気づいたと思いますが，実はわざわざ Script をモナドにせずとも Free モナドや Operational モナドというものを使えば以上のことが簡単に実現できます．

Free モナドは，次のように再帰的な構造をとっています．

data Free f a = Pure a | Free (f (Free f a))

この f に例えば今回の Script のようなものを突っ込んであげることでデータ型をモナドとして扱うことが出来るようになるわけです．ただし，データ型はファンクターである必要があります．

Free モナドを使った実装は次のようになると思います．

{-# LANGUAGE DeriveFunctor #-}

data Free f a = Pure a | Free (f (Free f a))

instance Functor f => Monad (Free f) where
  return = Pure
  Pure a >>= f = f a
  Free m >>= f = Free (fmap (>>= f) m)

liftF :: Functor f => f a -> Free f a
liftF = Free . fmap return


data Script a = Text String a
              | Line String String a
              | Choice [String] (Char -> a)
  deriving (Functor)

text :: String -> Free Script ()
text str = liftF $ Text str ()

line :: String -> String -> Free Script ()
line str1 str2 = liftF $ Line str1 str2 ()

choice :: [String] -> Free Script Char
choice strs = liftF $ Choice strs id

run :: Free Script a -> IO a
run (Pure a) = return a
run (Free (Text str next)) = putStrLn str >> run next
run (Free (Line str1 str2 next)) = putStrLn (str1 ++ ": " ++ str2) >> run next
run (Free (Choice strs f)) = do
  print strs
  ch <- getChar
  putChar '\n'
  run (f ch)

script :: Free Script ()
script = do
  line "John" "Hello!"
  c <- choice ["Hello!", "Hi!"]
  case c of
    '1' -> text "Hello!"
    '2' -> text "Hi!"
    _   -> text "..."

Free モナドは自分で作らなくても Hackage に The free package などがあります．

本当は Free モナドや更にすごい Operational モナド等についてももう少し詳しく書きたかったのですが，気力がもうありませんでした．

参考

Haskell for all: Why free monads matter

27
27
2

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
27
27