Create a gist now

Instantly share code, notes, and snippets.

Slight extension of http://blog.sigfpe.com/2011/10/quick-and-dirty-reinversion-of-control.html, which adds input capabilities
{--
This file is a slight extension of Sigfpe's "Quick and dirty reinversion of control":
http://blog.sigfpe.com/2011/10/quick-and-dirty-reinversion-of-control.html
I only added input capabilities: yieldInput + modification to yield
and of course the lines in imperative (i.e. our re-captured "main loop") which have to do with getting input.
--}
import Graphics.UI.GLUT
import Control.Monad.Cont
display :: GLdouble -> IO ()
display y = do
clear [ColorBuffer]
renderPrimitive LineStrip $ do
vertex (Vertex2 (-1) (-y))
vertex (Vertex2 1 y)
swapBuffers
postRedisplay Nothing
main = do
(progname, _) <- getArgsAndInitialize
initialWindowSize $= Size 500 500
initialDisplayMode $= [DoubleBuffered, RGBMode]
createWindow "Bounce!"
matrixMode $= Modelview 0
loadIdentity
matrixMode $= Projection
loadIdentity
ortho (-1) 1 (-1) 1 (-1) 1
imperative
mainLoop
imperative = flip runContT return $ do
liftIO $ print "Start!"
forever $ do
forM_ [-1, -0.992 .. 1.0] $ \y -> do
render $ display y
yield
liftIO $ print "Bounce!"
liftIO $ print "yielding for input now"
(key, _, _, _) <- yieldInput
liftIO $ putStrLn $ "user pressed: " ++ show key
forM_ [-1, -0.992 .. 1.0] $ \y -> do
render $ display (-y)
yield
liftIO $ print "Bounce!"
yield
render f = liftIO $ displayCallback $= f
-- modified yield!
yield :: ContT () IO ()
yield = ContT $ \k -> do
idleCallback $= Just (do
idleCallback $= Nothing -- unhook
k ()
)
-- wait for input
yieldInput :: ContT () IO (Key, KeyState, Modifiers, Position)
yieldInput = do
ContT $ \k -> do
keyboardMouseCallback $= Just (
\key state mod pos -> do
keyboardMouseCallback $= Nothing -- unhook
k (key, state, mod, pos)
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment