Question

I am testing out the simple pong game found here: https://github.com/shangaslammi/frp-pong

The problem is that the keyboard controls work very badly – the keys are very unresponsive and often have a delay of a few seconds. I assume that the author wrote the code for Windows because he included a .bat file and so this is a Linux-specific problem.

Why is this happening?

I am unsure of where the problem would be, but here is the file Keyboard.hs:

import Data.Set (Set)
import qualified Data.Set as Set
import Graphics.UI.GLUT (Key(..), KeyState(..))

-- | Set of all keys that are currently held down
newtype Keyboard = Keyboard (Set Key)

-- | Create a new Keyboard
initKeyboard :: Keyboard
initKeyboard = Keyboard Set.empty

-- | Record a key state change in the given Keyboard
handleKeyEvent :: Key -> KeyState -> Keyboard -> Keyboard
handleKeyEvent k Down = addKey k
handleKeyEvent k Up   = removeKey k

addKey :: Key -> Keyboard -> Keyboard
addKey k (Keyboard s) = Keyboard $ Set.insert k s

removeKey :: Key -> Keyboard -> Keyboard
removeKey k (Keyboard s) = Keyboard $ Set.delete k s

-- | Test if a key is currently held down in the given Keyboard
isKeyDown :: Keyboard -> Key -> Bool
isKeyDown (Keyboard s) k = Set.member k s

And setting the callbacks:

type KeyboardRef = IORef Keyboard
type TimeRef     = IORef POSIXTime
type AccumRef    = TimeRef
type PrevTimeRef = TimeRef
type GameRef     = IORef (Rects, GameLogic)

type CallbackRefs = (AccumRef, PrevTimeRef, KeyboardRef, GameRef)

initCallbackRefs :: IO CallbackRefs
initCallbackRefs = do
    accum <- newIORef secPerTick
    prev  <- getPOSIXTime >>= newIORef
    keyb  <- newIORef initKeyboard
    cont  <- newIORef ([],game)
    return (accum, prev, keyb, cont)

-- | Update the Keyboard state according to the event
handleKeyboard :: CallbackRefs -> KeyboardMouseCallback
handleKeyboard (_, _, kb, _) k ks _ _ = modifyIORef kb (handleKeyEvent k ks)

Answer 1

The lack of a GLUT timer seemed to be the problem.

Here is a correctly working version by Rian Hunter:

https://github.com/rianhunter/frp-pong