Haskellでオブジェクト指向を再発明する

状態管理のモデル案: spawn/killモデルの実装を作ってみた。

worldsパッケージがそれだ(露骨な名前だが赦してほしい)。前の記事と違う点は、Worldがモナド変換子として実装されている点だけである。

worlds-exampleは画面内のキャラクターを方向キーで操作する例。メインのプログラムは以下のようになっている:

import Include
import Types
import qualified Entity.Player as Player
import Assets

main = runGameDefault $ runWorldT $ do
    player <- spawn $ Player.new (V2 240 240)
    forever $ do
        whenM (lift $ keyPress KeyLeft)    $ player .! Player.Move L
        whenM (lift $ keyPress KeyRight)   $ player .! Player.Move R
        whenM (lift $ keyPress KeyDown)    $ player .! Player.Move D
        whenM (lift $ keyPress KeyUp)      $ player .! Player.Move U
        player .! update
        lift tick

見ての通り、Player内部の状態には直接関与しない。一方、Playerの実装では、mainから受け取ったメッセージを解釈し、実際の動作と状態遷移に変換する。

{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}

module Entity.Player where
import Include
import Types
import Assets

data States = States
  { _hp :: Float
  , _position :: Vec2
  , _direction :: Direction
  , _animation :: Int
  }
makeLenses ''States

data Actions x where
  GetCoord :: Actions Vec2
  Update :: Actions ()
  Move :: Direction -> Actions ()

instance Updatable Actions where
  update = Update

type Player s = Life (WorldT s Game) Actions ()

-- 命令を受け取る部分
handle :: (MonadState States m, FreeGame m) => Actions a -> m a
handle GetCoord = use position
handle Update = do
  d <- use direction
  n <- use animation
  p <- use position
  translate p $ bitmap $ playerBitmap (n `div` 5) d
handle (Move d) = do
  case d of
    L -> position -= V2 2 0
    R -> position += V2 2 0
    U -> position -= V2 0 2
    D -> position += V2 0 2
  direction .= d
  animation += 1

life :: States -> Player s
life s = Alive $ \e -> do
  (a, s') <- lift $ runStateT (handle e) s
  return (a, life s')

new :: Vec2 -> Player s
new p = life $ States
  { _hp = 8
  , _position = p
  , _direction = R
  , _animation = 0
  }

これはまさにカプセル化とメッセージパッシングであり、オブジェクト指向の実装であると言える。従来のオブジェクト指向と違う点は、インスタンス、メソッドなどの仕組み全てがファーストクラスであり、カスタマイズすることができることである。たとえば、メソッドをモナドにするのは、Operationalモナドを使えば高々2行の変更で可能だろう。

ゲーム開発などにおいてこのアプローチがどう使えるか、これからも調べていきたい。

追記

ドッペルゲンガーを作ってみた。インスタンスは霊本体と操作するクローンに分かれている。

haunt :: (Monad m, FreeGame m) => Name s Player.Actions r -> Life (WorldT s m) Identity ()
haunt she = go R where
  go d = Alive $ \(Identity pass) -> do
    r <- lift $ randomness (0 :: Int, 59)
    she .! Player.Move d
    if r == 0 then do
      i <- lift $ randomness (0, 3)
      return (pass, go (directions !! i))
    else return (pass, go d)

main = runGameDefault $ runWorldT $ do
    player <- spawn $ Player.new (V2 240 240)
    playerClone <- spawn $ Player.new (V2 320 240)
    doppelganger <- spawn $ haunt playerClone
    forever $ do
        whenM (lift $ keyPress KeyLeft)    $ player .! Player.Move L
        whenM (lift $ keyPress KeyRight)   $ player .! Player.Move R
        whenM (lift $ keyPress KeyDown)    $ player .! Player.Move D
        whenM (lift $ keyPress KeyUp)      $ player .! Player.Move U
        player .! update
        playerClone .! update
        doppelganger .! return ()
        lift tick