Step-by-step simulation with Gloss and IterT.

Simulation.hs

{-# LANGUAGE TemplateHaskell #-}
module Main where

import Control.Monad
import Control.Monad.State
import Control.Monad.Trans.Iter
import Control.Lens

import Data.Set (Set)
import qualified Data.Set as Set

import Graphics.Gloss
import Graphics.Gloss.Interface.IO.Game

type Sim = IterT (StateT Int IO)

step :: (Monad m) => IterT m a -> m (IterT m a)
step (IterT m) = either return id `liftM` m

data SimState a = SimState
  { _sim    :: Sim a
  , _keys   :: Set Key
  , _value  :: Int
  , _stepNo :: Int
  }
makeLenses ''SimState

initial :: SimState Int
initial = SimState simulation Set.empty 10 0
  
draw :: SimState a -> IO Picture
draw s = return . scale 300 300 ∘ pictures $
  [ text' $ s^.value.to show
  , translate 0 0.2 . text' $ "step #" ++ s^.stepNo.to show
  ]
  where
    text' = scale 0.0005 0.0005 . text

handle :: Event -> SimState a -> IO (SimState a)
handle (EventKey k ks _ _) s = return $ keys.contains k .~ (ks == Down) $ s
handle _ s = return s

update :: Float -> SimState a -> IO (SimState a)
update _ = execStateT $ do
  s <- get
  let keyPressed key = s^.keys.contains (SpecialKey key)
  when (keyPressed KeySpace) $ do
    keys.contains (SpecialKey KeySpace) .= False
    s <- use sim
    sim <~ zoom value (step s)
    stepNo += 1

simulation :: Sim Int
simulation = do
  modify (+2)
  delay $ modify (^2)
  delay $ modify (subtract 4)
  delay $ modify (2^)
  get

main :: IO ()
main = do
  let world = initial
  playIO display backColor fps world draw handle update
  where
    display   = InWindow "Iterative simulation" (640, 480) (200, 200)
    backColor = white
    fps       = 120