reinversion.1.1.hs

module Main where

import Graphics.UI.GLFW
import Control.Monad.Cont

import System.Exit                  ( exitSuccess )

main :: IO ()
main = do
    putStrLn "Running glfw-cont-test."
    True <- initialize
    True <- openWindow defaultDisplayOptions

    -- Make sure GLFW quits for us if we close the window.
    setWindowCloseCallback exitSuccess

    forever $ do
        -- Run the computation.
        k <- flip runContT return $ do
            -- This yield ends execution until the continuation is called by
            -- the key callback. Until then swapBuffers will give you seizures.
            (key, isPressed) <- yieldInput

            -- Continuation was called and now the computation completes and
            -- runs again due to $ forever
            mapM_ liftIO [ putStrLn $ showKeyPress key isPressed
                         , when (isPressed && key == KeyEsc) $ void exitSuccess ]
            return (Just key)

        stepAndRender k

stepAndRender :: Maybe Key -> IO ()
stepAndRender mLastKey =
    case mLastKey of
        Just key -> do
            putStrLn $ "Last key pressed was: "++show key
            swapBuffers
        Nothing  -> do
            putStrLn "No key has been pressed."
            swapBuffers


showKeyPress :: Key -> Bool -> String
showKeyPress k b = show k ++ if b
                             then " is pressed."
                             else " is not pressed."

yieldInput :: ContT (Maybe Key) IO (Key, Bool)
yieldInput = ContT $ \f -> do
    liftIO $ putStrLn "Setting key callback."
    -- Curry the args of the callback to (key, isPressed) and call the
    -- continuation.
    setKeyCallback $ curry f

{-
    Main.hs|49 col 14 error| Couldn't match type `()' with `Maybe Key'
    || Expected type: ContT (Maybe Key) IO (Key, Bool)
    ||   Actual type: ContT () IO (Key, Bool)
    || In the expression:
    ||   ContT
    ||   $ \ f
    ||       -> do { liftIO $ putStrLn "Setting key callback.";
    ||               setKeyCallback $ curry f }
    || In an equation for `yieldInput':
    ||     yieldInput
    ||       = ContT
    ||         $ \ f
    ||             -> do { liftIO $ putStrLn "Setting key callback.";
    ||                     setKeyCallback $ curry f }
-}

So - how do we use re-inversion of control to pass the last passed key into stepAndRender?