gtk2hs - key event

キーイベントを拾った上でキーで操作できるようにした。コールバックの中でデータを変更する方法する作法がわからないMVarを使ったけどそれでいいの？命令的な書き方でいいのかどうか…。うーん、わからない。

module Main where

import Graphics.UI.Gtk
import Graphics.Rendering.Cairo
import Control.Monad.Trans(liftIO)
import Control.Concurrent.MVar

main = do
    initGUI
    mv <- newMVar (0,0)
    window <- windowNew
    widgetSetSizeRequest window 640 400
    on window exposeEvent $ exposeHandler mv
    on window keyPressEvent $ tryEvent $ onKeyboard window mv 
      
    on window deleteEvent (liftIO $ do 
                              mainQuit
                              return True)
    widgetShowAll window
    mainGUI
    
exposeHandler mv = do
      drawWin <- eventWindow
      liftIO $ do
        val <- readMVar mv
        renderWithDrawable drawWin $ do
          rectangle 50 50 100 100 
          fill
          setSourceRGB 1 0 0
          arc (200+(fst val)) (200+(snd val)) 30 0 (1 * pi)
          fill
          stroke
        return True

onKeyboard window mv = do
      keyName <- eventKeyName
      [] <- eventModifier
      liftIO $ case keyName of 
        "r" -> putStrLn "Key r pressed!"
        "a" -> do 
          modifyMVar_ mv (\x -> return ((fst x)-1, snd x))
          widgetQueueDraw window
        "d" -> do 
          modifyMVar_ mv (\x -> return ((fst x)+1, snd x))
          widgetQueueDraw window
        "w" -> do 
          modifyMVar_ mv (\x -> return ((fst x), (snd x)-1))
          widgetQueueDraw window
        "s" -> do 
          modifyMVar_ mv (\x -> return ((fst x), (snd x)+1))
          widgetQueueDraw window
        _   -> putStrLn "Other key pressed!"

IOrefを使ったバージョン。今の自分のＨａｓｋｅｌｌの知識ではこれが精一杯。

module Main where

import Graphics.UI.Gtk
import Graphics.Rendering.Cairo
import Control.Monad.Trans(liftIO)
import Data.IORef

main = do
    initGUI
    mv <- newIORef (0,0)
    window <- windowNew
    widgetSetSizeRequest window 640 400
    on window exposeEvent $ exposeHandler mv
    on window keyPressEvent $ tryEvent $ onKeyboard window mv 
      
    on window deleteEvent (liftIO $ do 
                              mainQuit
                              return True)
    widgetShowAll window
    mainGUI
    
exposeHandler mv = do
      drawWin <- eventWindow
      liftIO $ do
        val <- readIORef mv
        renderWithDrawable drawWin $ do
          rectangle 50 50 100 100 
          fill
          setSourceRGB 1 0 0
          arc (200+(fst val)) (200+(snd val)) 30 0 (1 * pi)
          fill
          stroke
        return True

onKeyboard window mv = do
      keyName <- eventKeyName
      [] <- eventModifier
      liftIO $ case keyName of 
        "r" -> putStrLn "Key r pressed!"
        "a" -> do 
          modifyIORef mv (\x -> ((fst x)-1, snd x))
          widgetQueueDraw window
        "d" -> do 
          modifyIORef mv (\x -> ((fst x)+1, snd x))
          widgetQueueDraw window
        "w" -> do 
          modifyIORef mv (\x -> ((fst x), (snd x)-1))
          widgetQueueDraw window
        "s" -> do 
          modifyIORef mv (\x -> ((fst x), (snd x)+1))
          widgetQueueDraw window
        _   -> putStrLn "Other key pressed!"