module Termbox.Internal.Scene
  ( Scene,
    render,
    image,
    fill,
    cursor,
  )
where

import Termbox.Bindings.Hs hiding (bg)
import Termbox.Internal.Color (Color, MaybeColor, justColor, nothingColor, unMaybeColor)
import Termbox.Internal.Image (Image (..))
import Termbox.Internal.Pos (Pos (..))
import qualified Termbox.Internal.Style as Style

-- | A scene, which contains an image, an optional background fill color, and an optional cursor.
--
-- * Create a scene with 'image'.
-- * Set a scene\'s background fill color with 'fill'.
-- * Set a scene\'s cursor position with 'cursor'.
data Scene = Scene
  { Scene -> MaybeColor -> IO ()
sceneDraw :: !(MaybeColor -> IO ()),
    Scene -> MaybeColor
sceneFill :: {-# UNPACK #-} !MaybeColor
  }

-- | Render a scene.
render :: Scene -> IO ()
render :: Scene -> IO ()
render Scene {MaybeColor
$sel:sceneFill:Scene :: Scene -> MaybeColor
sceneFill :: MaybeColor
sceneFill, MaybeColor -> IO ()
$sel:sceneDraw:Scene :: Scene -> MaybeColor -> IO ()
sceneDraw :: MaybeColor -> IO ()
sceneDraw} = do
  Maybe (Int, Int) -> IO ()
tb_set_cursor Maybe (Int, Int)
forall a. Maybe a
Nothing
  Tb_attrs -> Tb_attrs -> IO ()
tb_set_clear_attributes Tb_attrs
_TB_DEFAULT (MaybeColor -> Tb_attrs
unMaybeColor MaybeColor
sceneFill)
  IO ()
tb_clear
  MaybeColor -> IO ()
sceneDraw MaybeColor
sceneFill
  IO ()
tb_present

-- | Create a scene from an image.
image :: Image -> Scene
image :: Image -> Scene
image (Image Pos -> Style -> IO ()
draw) =
  Scene
    { $sel:sceneDraw:Scene :: MaybeColor -> IO ()
sceneDraw = Pos -> Style -> IO ()
draw Pos
forall a. Monoid a => a
mempty (Style -> IO ()) -> (MaybeColor -> Style) -> MaybeColor -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeColor -> Style
Style.maybeFill,
      $sel:sceneFill:Scene :: MaybeColor
sceneFill = MaybeColor
nothingColor
    }

-- | Set a scene's background fill color.
fill :: Color -> Scene -> Scene
fill :: Color -> Scene -> Scene
fill Color
color Scene
scene =
  Scene
scene {sceneFill = justColor color}

-- | Set a scene's cursor position.
cursor :: Pos -> Scene -> Scene
cursor :: Pos -> Scene -> Scene
cursor Pos {Int
col :: Int
$sel:col:Pos :: Pos -> Int
col, Int
row :: Int
$sel:row:Pos :: Pos -> Int
row} Scene
scene =
  Scene
scene
    { sceneDraw = \MaybeColor
background -> do
        Scene -> MaybeColor -> IO ()
sceneDraw Scene
scene MaybeColor
background
        Maybe (Int, Int) -> IO ()
tb_set_cursor ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
col, Int
row))
    }