module Graphics.Gloss.Internals.Interface.Display
(displayWithBackend)
where
import Graphics.Gloss.Data.Color
import Graphics.Gloss.Data.Controller
import Graphics.Gloss.Data.Picture
import Graphics.Gloss.Data.ViewPort
import Graphics.Gloss.Data.ViewState
import Graphics.Gloss.Rendering
import Graphics.Gloss.Internals.Interface.Backend
import Graphics.Gloss.Internals.Interface.Window
import Graphics.Gloss.Internals.Interface.Common.Exit
import Graphics.Gloss.Internals.Interface.ViewState.KeyMouse
import Graphics.Gloss.Internals.Interface.ViewState.Motion
import Graphics.Gloss.Internals.Interface.ViewState.Reshape
import qualified Graphics.Gloss.Internals.Interface.Callback as Callback
import Data.IORef
import System.Mem
displayWithBackend
:: Backend a
=> a
-> Display
-> Color
-> IO Picture
-> (Controller -> IO ())
-> IO ()
displayWithBackend
backend displayMode background
makePicture
eatController
= do viewSR <- newIORef viewStateInit
renderS <- initState
renderSR <- newIORef renderS
let renderFun backendRef = do
port <- viewStateViewPort <$> readIORef viewSR
options <- readIORef renderSR
windowSize <- getWindowDimensions backendRef
picture <- makePicture
displayPicture
windowSize
background
options
(viewPortScale port)
(applyViewPortToPicture port picture)
performGC
let callbacks
= [ Callback.Display renderFun
, callback_exit ()
, callback_viewState_keyMouse viewSR
, callback_viewState_motion viewSR
, callback_viewState_reshape ]
createWindow backend displayMode background callbacks
$ \ backendRef
-> eatController
$ Controller
{ controllerSetRedraw
= do postRedisplay backendRef
, controllerModifyViewPort
= \modViewPort
-> do viewState <- readIORef viewSR
port' <- modViewPort $ viewStateViewPort viewState
let viewState' = viewState { viewStateViewPort = port' }
writeIORef viewSR viewState'
postRedisplay backendRef
}