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

import qualified Termbox.Bindings.Hs
import Termbox.Internal.Cell (Cell, drawCell)
import Termbox.Internal.Color (Color (Color))
import Termbox.Internal.Pos (Pos (..))

-- | A scene.
--
-- * Set individual cells with 'cell'.
-- * Set the background fill color with 'fill'.
-- * Set the cursor position with 'cursor'.
-- * Combine scenes together with @<>@.
data Scene = Scene
  { Scene -> Maybe Tb_color
sceneFill :: Maybe Termbox.Bindings.Hs.Tb_color,
    Scene -> Tb_color -> IO ()
sceneDraw :: Termbox.Bindings.Hs.Tb_color -> IO ()
  }

instance Monoid Scene where
  mempty :: Scene
mempty =
    Scene
      { $sel:sceneFill:Scene :: Maybe Tb_color
sceneFill = forall a. Maybe a
Nothing,
        $sel:sceneDraw:Scene :: Tb_color -> IO ()
sceneDraw = \Tb_color
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      }

instance Semigroup Scene where
  Scene Maybe Tb_color
fill0 Tb_color -> IO ()
draw0 <> :: Scene -> Scene -> Scene
<> Scene Maybe Tb_color
fill1 Tb_color -> IO ()
draw1 =
    Scene
      { $sel:sceneFill:Scene :: Maybe Tb_color
sceneFill =
          case Maybe Tb_color
fill1 of
            Maybe Tb_color
Nothing -> Maybe Tb_color
fill0
            Just Tb_color
_ -> Maybe Tb_color
fill1,
        $sel:sceneDraw:Scene :: Tb_color -> IO ()
sceneDraw =
          \Tb_color
color -> do
            Tb_color -> IO ()
draw0 Tb_color
color
            Tb_color -> IO ()
draw1 Tb_color
color
      }

-- | Render a scene.
render :: Scene -> IO ()
render :: Scene -> IO ()
render Scene {Maybe Tb_color
sceneFill :: Maybe Tb_color
$sel:sceneFill:Scene :: Scene -> Maybe Tb_color
sceneFill, Tb_color -> IO ()
sceneDraw :: Tb_color -> IO ()
$sel:sceneDraw:Scene :: Scene -> Tb_color -> IO ()
sceneDraw} = do
  let background :: Tb_color
background =
        case Maybe Tb_color
sceneFill of
          Maybe Tb_color
Nothing -> Tb_color
Termbox.Bindings.Hs.TB_DEFAULT
          Just Tb_color
color -> Tb_color
color
  Tb_color -> Tb_color -> IO ()
Termbox.Bindings.Hs.tb_set_clear_attributes Tb_color
Termbox.Bindings.Hs.TB_DEFAULT Tb_color
background
  IO ()
Termbox.Bindings.Hs.tb_clear
  Tb_color -> IO ()
sceneDraw Tb_color
background
  IO ()
Termbox.Bindings.Hs.tb_present

-- | Set the background fill color.
fill :: Color -> Scene
fill :: Color -> Scene
fill (Color Tb_color
color) =
  forall a. Monoid a => a
mempty {$sel:sceneFill:Scene :: Maybe Tb_color
sceneFill = forall a. a -> Maybe a
Just Tb_color
color}

-- | Set a single cell.
cell :: Pos -> Cell -> Scene
cell :: Pos -> Cell -> Scene
cell Pos {Int
$sel:col:Pos :: Pos -> Int
col :: Int
col, Int
$sel:row:Pos :: Pos -> Int
row :: Int
row} Cell
img =
  forall a. Monoid a => a
mempty {$sel:sceneDraw:Scene :: Tb_color -> IO ()
sceneDraw = \Tb_color
bg -> Tb_color -> Int -> Int -> Cell -> IO ()
drawCell Tb_color
bg Int
col Int
row Cell
img}

-- | Set the cursor position.
cursor :: Pos -> Scene
cursor :: Pos -> Scene
cursor Pos {Int
col :: Int
$sel:col:Pos :: Pos -> Int
col, Int
row :: Int
$sel:row:Pos :: Pos -> Int
row} =
  forall a. Monoid a => a
mempty {$sel:sceneDraw:Scene :: Tb_color -> IO ()
sceneDraw = \Tb_color
_ -> Maybe (Int, Int) -> IO ()
Termbox.Bindings.Hs.tb_set_cursor (forall a. a -> Maybe a
Just (Int
col, Int
row))}