８．Animation
Reactive Bananaの基本的な機能の説明が続いたので、Functional Reactive Programming (FRP)の応用分野の一つであるアニメーション・プログラムの解説をしよう。とは、言ってもとても簡単なプログラムである。Reactive Bananaのロゴをカーソルがあるところに近づけるというプログラムである。画面は以下のようだが、ロゴがカーソルに向かって動き回るというのがこのプログラムである。
８．１ ユーザ・インタフェース
例によって、ユーザ・インタフェースを最初に用意する。今回の画面は、白地のパネルにロゴを張ることにすると、フレーム、パネルは次のように定義できる。
ff <- frame [ text := "It's functional programming time" , bgcolor := white , resizeable := False ] pp <- panel ff [ ] set ff [ layout := minsize (sz width height) $ widget pp ]
また、フレームの書き換え時間を、これはネットワークをモニタする時間にもなるが、20ミリ秒と定義しておく。
t <- timer ff [ interval := 20 ]
８．２イベント・ネットワークの構築
イベント・ネットワークは前の記事で説明した通り、入力、イベント・グラフ、出力から構成される。それでは、これらを順を追って説明しよう。
入力
まず、入力は（フレーム書き換えの）タイマーとマウスからになるので、次のようにする。
etick <- event0 t command -- frame timer emouse <- event1 pp mouse -- mouse events
イベント・グラフ
次はイベント・グラフである。これには、マウスの位置、ロゴ（spriteと呼ぶ）の位置、ロゴの描写が含まれる。
最初にマウスの位置を表すイベント・グラフを考える。マウスの位置はイベントとして離散的に入力される。これから、ある時間でのマウスの位置を知るためには、離散的に入力された位置の点列から、連続な時間で定義された位置に変更する必要がある。これには前に説明したstepperを用いる。
従って、連続的な時間に対して、マウスの位置は次のように変化する。
stepper (point 0 0) (filterJust $ justMotion <$> emouse)
ところで、イベントでの位置はデータ型Pointで与えられるが、計算をベクトルで行うために、位置をデータ型Vectorで表したい。この変換は関数fromPointが行ってくれる。しかし、stepperはモナドであるため、モナドに包まれたPointをVectorに変換するためにはfmap fromPointで行う必要がある。これを全ての時間に対して行うためには、
fmap (fmap fromPoint) (stepper (point 0 0) (filterJust $ justMotion <$> emouse))
となる。最初のfmapを中置関数<$>を用いて表すと
fmap fromPoint <$> (stepper (point 0 0) (filterJust $ justMotion <$> emouse))
となる。
従って、マウスの位置を表すイベント・グラフは次のようになる。
(bmouse :: Behavior Vector) <- fmap fromPoint <$> stepper (point 0 0) (filterJust $ justMotion <$> emouse)
なお、fromPointerは次のように定義されている。
type Vector = Vector2 Double fromPoint :: Point -> Vector fromPoint pt = vector (fromIntegral (pointX pt)) (fromIntegral (pointY pt))
また、マウスの位置を得るために用いたjustMotionは次のように定義されている。
justMotion :: EventMouse -> Maybe Point justMotion (MouseMotion pt _) = Just pt justMotion _ = Nothing
それでは、ロゴの位置をイベント・グラフで表すことにする。このプログラムでは、フレームの書き換え時間（20ミリ秒）が、モニターしている時間間隔である。現在の時点でモニターしたカーソルの位置(\(\vec{mouse}\))はロゴ(\(\vec{pos}\))の位置から離れていたとする。この時、次のモニターの時間が来たときに、先ほどのカーソルの位置にロゴを移動したい。このためには、1ミリ秒当たり、\( \frac{\vec{mouse}- \vec{pos}}{20} \)の速度で進めばよい。
これには、次のBehavior APIを利用すればよい。
上の図の(*)のところを速度とすればよいことが分かる。そこで、速度をspeedupで表すと次のように表すことができる。
bvelocity :: Behavior Vector bvelocity = (\pos mouse -> speedup $ mouse `vecSub` pos `vecSub` vec 0 45) <$> bposition <*> bmouse where speedup v = v `vecScale` (vecLengthDouble v / 20)
上のプログラムで、vec 0 45とあるのは、ロゴの左、真ん中の少し上にカーソルが来るようにするための調整値である。
この速度を用いて、次のロゴの位置を求めると以下のようになる。
(bposition :: Behavior Vector) <- accumB (vec 0 0) $ (\v pos -> clipToFrame $ (v `vecScale` dt) `vecAdd` pos) <$> bvelocity <@ etick
なお、<@はEvent & Behavior APIで次のような働きをする。
また、上記のプログラムで(vec 0 0)はロゴの初期位置であり、posは現在のモニター時点での位置である。現在の位置は、accumBで移動距離の累積を計算しそれより求められている。
accumBの関数がなかなかわかりにくいのでが、次のような例があるので、これから推察するとよい。
accumB "x" [(time1,(++"y")),(time2,(++"z"))] = stepper "x" [(time1,"xy"),(time2,"xyz")]
上記のプログラムで、初期値は"x"である。次の時間time1では、これに"y"が追加される。さらに、次の時間では、さらに"z"が追加される。
これと同じように、最初の場所に(vec 0 0)、次のモニター時間が来たときに、その時に進んだ距離が足され、さらに次のモニター時間で、さらに進んだ時間が足されるという操作が行われていると考えるとよい。
また、clipToFrameはロゴがフレームからはみ出さないようにする。プログラムは次のようになっている。
clipToFrame v = vec (clip 0 x (fromIntegral $ width - bitmapWidth )) (clip 0 y (fromIntegral $ height - bitmapHeight)) where x = vecX v; y = vecY v clip a x b = max a (min x b)
イベント・グラフの最後はロゴの描写である。これはロゴのビットマップをもらってposのところに描く。
clipToFrame v = vec (clip 0 x (fromIntegral $ width - bitmapWidth )) (clip 0 y (fromIntegral $ height - bitmapHeight)) where x = vecX v; y = vecY v clip a x b = max a (min x b)
また、ビットマップは次で与えられる。
sprite :: Bitmap () sprite = bitmap $ getDataFile "banana.png"
出力
出力は次のようになる。
sink pp [on paint :== drawSprite . toPoint <$> bposition] reactimate $ repaint pp <$ etick
８．３ プログラム
プログラムはこのホームページで公表されているが、転載しよう。
{----------------------------------------------------------------------------- reactive-banana-wx Example: A simple animation. ------------------------------------------------------------------------------} {-# LANGUAGE ScopedTypeVariables #-} -- allows pattern signatures like -- do -- (b :: Behavior Int) <- stepper 0 ... {-# LANGUAGE RecursiveDo #-} -- allows recursive do notation -- mdo -- ... import Graphics.UI.WX hiding (Event, Vector) import Reactive.Banana import Reactive.Banana.WX import Paths (getDataFile) {----------------------------------------------------------------------------- Constants ------------------------------------------------------------------------------} height, width :: Int height = 400 width = 400 dt :: Double dt = 20 * ms where ms = 1e-3 sprite :: Bitmap () sprite = bitmap $ getDataFile "banana.png" bitmapWidth, bitmapHeight :: Int bitmapWidth = 128 bitmapHeight = 128 {----------------------------------------------------------------------------- Main ------------------------------------------------------------------------------} main :: IO () main = start $ do ff <- frame [ text := "It's functional programming time" , bgcolor := white , resizeable := False ] t <- timer ff [ interval := ceiling (dt * 1e3) ] pp <- panel ff [ ] set ff [ layout := minsize (sz width height) $ widget pp ] -- event network let networkDescription :: MomentIO () networkDescription = mdo etick <- event0 t command -- frame timer emouse <- event1 pp mouse -- mouse events -- mouse pointer position (bmouse :: Behavior Vector) <- fmap fromPoint <$> stepper (point 0 0) (filterJust $ justMotion <$> emouse) let -- sprite velocity bvelocity :: Behavior Vector bvelocity = (\pos mouse -> speedup $ mouse `vecSub` pos `vecSub` vec 0 45) <$> bposition <*> bmouse where speedup v = v `vecScale` (vecLengthDouble v / 20) -- sprite position (bposition :: Behavior Vector) <- accumB (vec 0 0) $ (\v pos -> clipToFrame $ (v `vecScale` dt) `vecAdd` pos) <$> bvelocity <@ etick let clipToFrame v = vec (clip 0 x (fromIntegral $ width - bitmapWidth )) (clip 0 y (fromIntegral $ height - bitmapHeight)) where x = vecX v; y = vecY v clip a x b = max a (min x b) drawSprite :: Point -> DC a -> b -> IO () drawSprite pos dc _view = drawBitmap dc sprite pos True [] -- animate the sprite sink pp [on paint :== drawSprite . toPoint <$> bposition] reactimate $ repaint pp <$ etick network <- compile networkDescription actuate network {----------------------------------------------------------------------------- 2D Geometry ------------------------------------------------------------------------------} type Vector = Vector2 Double fromPoint :: Point -> Vector fromPoint pt = vector (fromIntegral (pointX pt)) (fromIntegral (pointY pt)) toPoint :: Vector -> Point toPoint v = point (ceiling (vecX v)) (ceiling (vecY v)) {----------------------------------------------------------------------------- wx stuff ------------------------------------------------------------------------------} justMotion :: EventMouse -> Maybe Point justMotion (MouseMotion pt _) = Just pt justMotion _ = Nothing
