-- |
-- Copyright  : (c) 2018-2023 Ivan Perez
--              (c) 2015-2018 Konstantin Saveljev
-- License    : MIT License (MIT)
-- Maintainer : ivan.perez@keera.co.uk
--
-- Gloss backend for Yampa.
--
-- Gloss is a purely functional library to create pictures and animations.
-- Yampa is a Functional Reactive Programming DSL structured around signal
-- functions.
--
-- This module provides a function to create an interactive Gloss animation
-- driven by a signal function that transforms a Gloss input signal into a
-- Gloss 'Picture'.
module Graphics.Gloss.Interface.FRP.Yampa
    (InputEvent, playYampa)
  where

-- External imports
import           Control.Monad                    (when)
import           Data.IORef                       (newIORef, readIORef,
                                                   writeIORef)
import           FRP.Yampa                        (DTime, Event (..), SF, react,
                                                   reactInit)
import           Graphics.Gloss                   (Color, Display, Picture,
                                                   blank)
import           Graphics.Gloss.Interface.IO.Game (playIO)
import qualified Graphics.Gloss.Interface.IO.Game as G

-- | Type representing input events to the signal function.
--
-- Note that this type represents the kind of information placed inside the
-- Yampa 'Event'. It will still be wrapped in an 'Event' to represent the fact
-- that an 'InputEvent' may or may not be present at one particular point in
-- time, and that it changes discretely.
type InputEvent = G.Event

-- | Play the game in a window, updating when the value of the provided
playYampa :: Display                       -- ^ The display method
          -> Color                         -- ^ The background color
          -> Int                           -- ^ The refresh rate, in Hertz
          -> SF (Event InputEvent) Picture -- ^ Signal function
          -> IO ()
playYampa :: Display -> Color -> Int -> SF (Event InputEvent) Picture -> IO ()
playYampa Display
display Color
color Int
frequency SF (Event InputEvent) Picture
mainSF = do
  IORef Picture
picRef <- forall a. a -> IO (IORef a)
newIORef Picture
blank

  ReactHandle (Event InputEvent) Picture
handle <- forall a b.
IO a
-> (ReactHandle a b -> Bool -> b -> IO Bool)
-> SF a b
-> IO (ReactHandle a b)
reactInit
              (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Event a
NoEvent)
              (\ReactHandle (Event InputEvent) Picture
_ Bool
updated Picture
pic -> do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
updated (IORef Picture
picRef forall a. IORef a -> a -> IO ()
`writeIORef` Picture
pic)
                                    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
              )
              SF (Event InputEvent) Picture
mainSF

  let -- An action to convert the world to a picture
      toPic :: DTime -> IO Picture
      toPic :: DTime -> IO Picture
toPic = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef Picture
picRef

      -- A function to handle input events
      handleInput :: G.Event -> DTime -> IO DTime
      handleInput :: InputEvent -> DTime -> IO DTime
handleInput InputEvent
event DTime
timeAcc = do
          Bool
_quit <- forall a b. ReactHandle a b -> (DTime, Maybe a) -> IO Bool
react ReactHandle (Event InputEvent) Picture
handle (DTime
delta, forall a. a -> Maybe a
Just (forall a. a -> Event a
Event InputEvent
event))
          forall (m :: * -> *) a. Monad m => a -> m a
return (DTime
timeAcc forall a. Num a => a -> a -> a
+ DTime
delta)
        where
          delta :: DTime
delta = DTime
0.01 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frequency

      -- A function to step the world one iteration. It is passed the period of
      -- time (in seconds) needing to be advanced
      stepWorld :: Float -> DTime -> IO DTime
      stepWorld :: Float -> DTime -> IO DTime
stepWorld Float
delta DTime
timeAcc
          | DTime
delta' forall a. Ord a => a -> a -> Bool
> DTime
0 = forall a b. ReactHandle a b -> (DTime, Maybe a) -> IO Bool
react ReactHandle (Event InputEvent) Picture
handle (DTime
delta', forall a. a -> Maybe a
Just forall a. Event a
NoEvent) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return DTime
0.0
          | Bool
otherwise  = forall (m :: * -> *) a. Monad m => a -> m a
return (-DTime
delta')
        where
          delta' :: DTime
delta' = forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
delta forall a. Num a => a -> a -> a
- DTime
timeAcc

  forall world.
Display
-> Color
-> Int
-> world
-> (world -> IO Picture)
-> (InputEvent -> world -> IO world)
-> (Float -> world -> IO world)
-> IO ()
playIO Display
display Color
color Int
frequency DTime
0 DTime -> IO Picture
toPic InputEvent -> DTime -> IO DTime
handleInput Float -> DTime -> IO DTime
stepWorld