4Blocks-0.2: Interface/KeyEvents.hs

module Interface.KeyEvents ( onKeyDownEvent,
                             onKeyUpEvent )

where

import Control.Monad.State
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.Events
import qualified Data.Set as Set; import Data.Set (Set)
import Data.IORef;

------------------------------------------------------------------------------------------------------------------------- 
-- Handling OnKeyDown and OnKeyUp workaround as gtk2hs does not provide innate support

onKeyDownEvent :: DrawingArea ->  String -> IORef (Set String) -> IO () -> Event -> IO Bool
onKeyDownEvent drawArea chrString keysIORef eventResponse (Key { eventKeyName = key } )
  = if (chrString == key)
      then do keys <- readIORef keysIORef
              unless (key `Set.member `keys) $ writeIORef keysIORef (Set.insert key keys) >> eventResponse
              return False
      else return False
         
onKeyUpEvent :: DrawingArea -> String -> IORef (Set String) -> Event -> IO Bool  
onKeyUpEvent drawArea chrString keysIORef (Key { eventKeyName = key } )
  = if (chrString == key)
      then do keys <- readIORef keysIORef
              writeIORef keysIORef (Set.delete key keys)
              return False
      else return False