-- | Display mode is for drawing a static picture.
module Brillo.Interface.IO.Interact (
  module Brillo.Data.Display,
  module Brillo.Data.Picture,
  module Brillo.Data.Color,
  interactIO,
  Controller (..),
  Event (..),
  Key (..),
  SpecialKey (..),
  MouseButton (..),
  KeyState (..),
  Modifiers (..),
)
where

import Brillo.Data.Color
import Brillo.Data.Controller
import Brillo.Data.Display
import Brillo.Data.Picture
import Brillo.Internals.Interface.Backend
import Brillo.Internals.Interface.Event
import Brillo.Internals.Interface.Interact


{-| Open a new window and interact with an infrequently updated picture.

  Similar to `displayIO`, except that you manage your own events.
-}
interactIO
  :: Display
  -- ^ Display mode.
  -> Color
  -- ^ Background color.
  -> world
  -- ^ Initial world state.
  -> (world -> IO Picture)
  -- ^ A function to produce the current picture.
  -> (Event -> world -> IO world)
  -- ^ A function to handle input events.
  -> (Controller -> IO ())
  -- ^ Callback to take the display controller.
  -> IO ()
interactIO :: forall world.
Display
-> Color
-> world
-> (world -> IO Picture)
-> (Event -> world -> IO world)
-> (Controller -> IO ())
-> IO ()
interactIO Display
dis Color
backColor world
worldInit world -> IO Picture
makePicture Event -> world -> IO world
handleEvent Controller -> IO ()
eatController =
  GLFWState
-> Display
-> Color
-> world
-> (world -> IO Picture)
-> (Event -> world -> IO world)
-> (Controller -> IO ())
-> IO ()
forall a world.
Backend a =>
a
-> Display
-> Color
-> world
-> (world -> IO Picture)
-> (Event -> world -> IO world)
-> (Controller -> IO ())
-> IO ()
interactWithBackend
    GLFWState
defaultBackendState
    Display
dis
    Color
backColor
    world
worldInit
    world -> IO Picture
makePicture
    Event -> world -> IO world
handleEvent
    Controller -> IO ()
eatController