{- | Example application for the @gloss@ wrapper. -}
{-# LANGUAGE TypeFamilies #-}
-- base
import qualified Control.Category as Category
import Data.Maybe (maybeToList)
-- rhine-gloss
import FRP.Rhine.Gloss
-- | Calculate a gear wheel rotated by a certain angle.
gears :: Float -> Picture
gears angle = color green $ pictures
$ circleSolid 60
: map (rotate angle) [ rotate (45 * n) $ rectangleSolid 20 150 | n <- [0..3] ]
-- | Rotate the gear with a constant angular velocity.
-- Disregards all events.
sim :: Monad m => BehaviourF m Float [Event] Picture
sim = timeInfoOf sinceInit >>> arr (* 50) >>> arr gears
main :: IO ()
main = do
putStrLn "Please choose between the pure (1), the pure combined (2), and the IO backend (3):"
n <- readLn
case n of
1 -> flowGloss defaultSettings pureClSF
2 -> flowGlossCombined defaultSettings pureRhine
3 -> flowGlossIO defaultSettings ioRhine
-- | Run the gears simulation with the pure backend synchronously.
pureClSF = currentEvent >>> arr maybeToList >>> sim
-- | Run the gears simulation with the pure backend with two subsystems,
-- one at the rate of events, one at the rate of simulation.
pureRhine = tagS @@ glossEventClock >-- collect -@- glossSchedule --> sim >-> arrMCl paintAll @@ glossSimulationClock
-- | Run the gears simulation with the 'IO' backend.
ioRhine = tagS @@ GlossEventClockIO >-- collect -@- glossConcurrently --> sim >-> arrMCl paintAllIO @@ GlossSimClockIO