続き。GUIアプリケーションは、絵を見せたり、イベントを貰ったりできるということだった。
もうちょっと抽象化すると、GUIアプリケーションというのは、何かを出したり何かをもらったりできると、いうことかもしれない。

type GUIApplication a = Get a -- 何かをもらう
                      | Show -- 何かを出す

っていうか、これって入力と出力じゃね?っていうか、

type GUIApplication a = IO a -- 入出力

これでいいんじゃない?って気がしてきた。つまり、GUIアプリケーションっていうのは、IOモナドのことだったのである。あー。


まあいい、まあいいや。

-- dispGraphicは絵を見せるアプリケーションを作る関数
dispGraphic :: Window -> Graphic -> GUIApplication ()

-- getEventはイベントをもらってくるアプリケーションを作る関数
getEvent :: Window -> GUIApplication Event

こんな感じだろうか。


でー、昨日の「クリックしたところに円を描く」アプリケーションを考える。

module Main where

import Graphics.HGL.Window
import Graphics.HGL.Draw.Monad
import Graphics.HGL.Draw.Picture
import Graphics.HGL.Run

type GUIApplication a = IO a -- GUIApplicationはIOモナド

-- getEventは引数にわたされたウィンドウに届いたイベントをとってくる
-- アプリケーションを作る関数
getEvent :: Window -> GUIApplication Event
getEvent = getWindowEvent -- HGLのをそのまま使う(…)

-- dispGraphicは引数にわたされたウィンドウに
-- 引数でわたされた絵を描くアプリケーションを作る関数
dispGraphic :: Window -> Graphic -> GUIApplication ()
dispGraphic = setGraphic -- 同じくHGLのを

-- drawBall は引数に渡されたウィンドウの上で動くアプリケーションを作る関数
drawBall :: Window -> GUIApplication ()
drawBall w = do
  ev <- getEvent w
  case ev of
    Button { pt=(x,y), isLeft=True, isDown=True } -> do -- 右クリックされたら
               dispGraphic w ( ellipse (x-10,y-10) (x+10,y+10) ) -- w の上に円を描く
               drawBall w -- んでdrawBallを実行
    _ -> drawBall w

main:: GUIApplication
main = runGraphics $ do
         win <- openWindowEx "Hello" Nothing (400,400) DoubleBuffered Nothing
         drawBall win
         closeWindow win

こんな感じ。


ここまでは、まあ普通、なんだけど、いくつか重要な点が

  • GUIApplicationは小さなGUIApplicationを合成して作ることができる
  • dispGraphicやgetEventはGUIApplicationではない。GUIApplicationを生成する関数である

モナドが値である、ということは重要なことだ。何故なら、関数によって生成することができるから。


今は、白い円が出るだけなんだけど、これを緑色にしてみる

               dispGraphic w ( withRGB (RGB 0 255 0) (ellipse (x-10,y-10) (x+10,y+10)) ) -- w の上に円を描く

こんな感じにしてやれば。
でも、これだとあんまり変わらないような気がしたので、色を引数で渡すようにしてみる。

-- drawBall は引数に渡されたウィンドウの上で動くアプリケーションを作る関数
drawBall :: RGB -> Window -> GUIApplication ()
drawBall color w next = do
  ev <- getEvent w
  case ev of
    Button { pt=(x,y), isLeft=True, isDown=True } -> do -- 右クリックされたら
               dispGraphic w ( withRGB color (ellipse (x-10,y-10) (x+10,y+10)) ) -- w の上に円を描く
               drawBall color w -- んでdrawBallを実行
    _ -> drawBall color w

こんな感じ。さて、ここで重要なのは、さっきも書いたけど、drawBallはアプリケーションを生成する関数である、ということだ。いっそのこと

module Main where

import Graphics.HGL.Window
import Graphics.HGL.Draw.Monad
import Graphics.HGL.Draw.Picture
import Graphics.HGL.Run
import Graphics.HGL.Utils
import Graphics.HGL.Draw.Text

type GUIApplication a = IO a -- GUIApplicationはIOモナド

-- getEventは引数にわたされたウィンドウに届いたイベントをとってくる
-- アプリケーションを作る関数
getEvent :: Window -> GUIApplication Event
getEvent = getWindowEvent -- HGLのをそのまま使う(…)

-- dispGraphicは引数にわたされたウィンドウに
-- 引数でわたされた絵を描くアプリケーションを作る関数
dispGraphic :: Window -> Graphic -> GUIApplication ()
dispGraphic = setGraphic -- 同じくHGLのを



-- drawNanika はクリックされた位置に何かをするアプリケーションを生成する関数
nanikaOnClick :: (Window -> (Int,Int) -> GUIApplication ()) -> Window -> GUIApplication ()
nanikaOnClick clickAction w = do
  ev <- getEvent w
  case ev of
    Button { pt=p, isLeft=True, isDown=True } ->
        do -- 右クリックされたら
          clickAction w p
          nanikaOnClick clickAction w
    _ -> nanikaOnClick clickAction w

white = RGB 255 255 255
yellow = RGB 255 255 0
green = RGB 0 255 0 

-- (x,y)の位置に引数colorで指定された円の絵を生成する関数
colorBall::RGB -> (Int,Int) -> Graphic
colorBall color (x,y) = withRGB color (ellipse (x-10,y-10) (x+10,y+10))

-- (x,y)の位置に円の絵を生成する関数
yellowBall::(Int,Int) -> Graphic
yellowBall = colorBall yellow -- 黄色い円
whiteBall = colorBall white
greenBall = colorBall green

-- drawBallPoint は windowの(x,y) の位置に何かを描くアプリケーションを生成する関数
drawNanikaAtPoint :: ((Int,Int) -> Graphic) -> Window -> (Int,Int) -> GUIApplication ()
drawNanikaAtPoint drawXY window point = 
    dispGraphic window (drawXY point)

-- drawYellowBallAtPoint は window の (x,y) の位置に黄色い円を描く
-- アプリケーションを生成する関数
drawYellowBallAtPoint :: Window -> (Int,Int) -> GUIApplication ()
drawYellowBallAtPoint = drawNanikaAtPoint yellowBall
drawWhiteBallAtPoint = drawNanikaAtPoint whiteBall
drawGreenBallAtPoint = drawNanikaAtPoint greenBall

-- クリックされた位置に黄色い円を描くアプリケーション
drawBallYellow :: Window -> GUIApplication ()
drawBallYellow = nanikaOnClick drawYellowBallAtPoint
drawBallWhite = nanikaOnClick drawWhiteBallAtPoint
drawBallGreen = nanikaOnClick drawGreenBallAtPoint

main::IO()
main = runGraphics $ do
         win <- openWindowEx "Hello" Nothing (400,400) DoubleBuffered Nothing
         drawBallWhite win
         closeWindow win

このぐらいやってもいいかもしれん。(もっと短くなりそうな気がしたけど書いてたらわからなくなってきた…って、それでいいのか)


さて、ここまでが前振りみたいな感じ(長いよ)。
で、こっからが本題。関数型言語のアレ具合を垣間見てみる。


次のアプリケーションを考える→「クリックした位置に緑、黄色、白の円を順番に表示するアプリケーション」。

どう実装すればいい?状態変数?
いや、状態変数なんていらないよ。


次のように考えるのである。「緑の円を表示するアプリケーション実行後、黄色いのを実行して、そのあと白いのをやって緑のをやって…」
アプリケーションが終わったら、次のアプリケーションを実行する。って感じで


nanikaOnClickを次のようにする。

-- drawNanika はクリックされた位置に何かをするアプリケーションを生成する関数
-- クリックされたら、nextを使って生成されたアプリケーションを実行する
nanikaOnClick :: (Window -> (Int,Int) -> GUIApplication ()) -> (Window->GUIApplication()) -> Window -> GUIApplication ()
nanikaOnClick clickAction next w = do -- next = クリックされたあと、実行するアプリケーション
  ev <- getEvent w
  case ev of
    Button { pt=p, isLeft=True, isDown=True } ->
        do -- 右クリックされたら
          clickAction w p
          next w
    _ -> nanikaOnClick clickAction next w

つまり、クリックしたあとに実行するアプリケーションを指定できるようにする、というわけだ。

module Main where

import Graphics.HGL.Window
import Graphics.HGL.Draw.Monad
import Graphics.HGL.Draw.Picture
import Graphics.HGL.Run
import Graphics.HGL.Utils
import Graphics.HGL.Draw.Text

type GUIApplication a = IO a -- GUIApplicationはIOモナド

-- getEventは引数にわたされたウィンドウに届いたイベントをとってくる
-- アプリケーションを作る関数
getEvent :: Window -> GUIApplication Event
getEvent = getWindowEvent -- HGLのをそのまま使う(…)

-- dispGraphicは引数にわたされたウィンドウに
-- 引数でわたされた絵を描くアプリケーションを作る関数
dispGraphic :: Window -> Graphic -> GUIApplication ()
dispGraphic = setGraphic -- 同じくHGLのを


-- drawNanika はクリックされた位置に何かをするアプリケーションを生成する関数
-- クリックされたら、nextを使って生成されたアプリケーションを実行する
nanikaOnClick :: (Window -> (Int,Int) -> GUIApplication ()) -> (Window->GUIApplication()) -> Window -> GUIApplication ()
nanikaOnClick clickAction next w = do -- next = クリックされたあと、実行するアプリケーション
  ev <- getEvent w
  case ev of
    Button { pt=p, isLeft=True, isDown=True } ->
        do -- 右クリックされたら
          clickAction w p
          next w
    _ -> nanikaOnClick clickAction next w

white = RGB 255 255 255
yellow = RGB 255 255 0
green = RGB 0 255 0 

-- (x,y)の位置に引数colorで指定された円の絵を生成する関数
colorBall::RGB -> (Int,Int) -> Graphic
colorBall color (x,y) = withRGB color (ellipse (x-10,y-10) (x+10,y+10))

-- (x,y)の位置に円の絵を生成する関数
yellowBall::(Int,Int) -> Graphic
yellowBall = colorBall yellow -- 黄色い円
whiteBall = colorBall white
greenBall = colorBall green


-- drawBallPoint は windowの(x,y) の位置に何かを描くアプリケーションを生成する関数
drawNanikaAtPoint :: ((Int,Int) -> Graphic) -> Window -> (Int,Int) -> GUIApplication ()
drawNanikaAtPoint drawXY window point = 
    dispGraphic window (drawXY point)

-- drawYellowBallAtPoint は window の (x,y) の位置に黄色い円を描く
-- アプリケーションを生成する関数
drawYellowBallAtPoint :: Window -> (Int,Int) -> GUIApplication ()
drawYellowBallAtPoint = drawNanikaAtPoint yellowBall
drawWhiteBallAtPoint = drawNanikaAtPoint whiteBall
drawGreenBallAtPoint = drawNanikaAtPoint greenBall

-- クリックされた位置に黄色い円を描くアプリケーション
drawBallYellow :: Window -> GUIApplication ()
drawBallYellow = nanikaOnClick drawYellowBallAtPoint drawBallWhite -- 黄色の次は白を実行する
drawBallWhite = nanikaOnClick drawWhiteBallAtPoint drawBallGreen -- 白の次は緑を実行する
drawBallGreen = nanikaOnClick drawGreenBallAtPoint drawBallYellow -- 緑の次は黄色を実行する

main::IO()
main = runGraphics $ do
         win <- openWindowEx "Hello" Nothing (400,400) DoubleBuffered Nothing
         drawBallGreen win
         closeWindow win

これで良い。


うーん、すばらしく参照が透明な世界だ。向こう側が見えてしまいそうだ。
そのおかげで、上のプログラムはひっっじょーーに改良が容易だ。GUIApplicationを作って順番を変えればよいだけだ。他のことは全く考えなくてよい。


例えば、上のに「緑色の円の次は、青い四角を描く」、というルールを追加するなら、

drawBallGreen = nanikaOnClick drawGreenBallAtPoint drawRectBlue -- 緑の次は青い四角

blue = RGB 0 0 255
colorRect color (x,y) = withRGB color $ polygon [(x-10,y-10),
                                                 (x+10,y-10),
                                                 (x+10,y+10),
                                                 (x-10,y+10)]
drawRectBlueAtPoint = drawNanikaAtPoint (colorRect blue)
drawRectBlue = nanikaOnClick drawRectBlueAtPoint drawBallYellow

このように変更するだけだ。そして、そこにバグが入り込む余地なんてほとんど無い。条件分岐は一切変更していないから。


IORefはいらない、Stateモナドもいらない。やっていることは、ただひたすら順番に実行するアプリケーションを生成しているだけ。
トリックもない。ただ、そこにあるのは、

  • アプリケーションは値なので、関数によって生成できるし、引数に渡すこともできる
  • アプリケーションは小さなアプリケーションを合成してつくられたもの

という、たったふたつのシンプルなルールだけだ。


関数型言語GUIアプリケーションを美しく書くことができる」という可能性を垣間見た、気がしてきたりしないだろうか。
まあ、文章がわかりにくいから、全然伝わってないかもしれんけど…


あー、あと、補足として、イベントが飛んでくる順番っていうのが非常に重要になるんではないかと思う。
http://d.hatena.ne.jp/w_o/20051217#p1
ここで、wxHaskellはよくわからんと描いたのは、つまり、コールバック風のイベント処理はあんまりよろしくないのでは、という説。