-- |
-- This module provides an Elm Architecture interface to @termbox@, a simple C library for writing text-based user
-- interfaces: <https://github.com/termbox/termbox>
--
-- See also:
--
-- * @<https://hackage.haskell.org/package/termbox-banana termbox-banana>@, a @reactive-banana@ FRP interface.
--
-- This module is intended to be imported qualified.
--
-- ==== __👉 Quick start example__
--
-- This @termbox@ program displays the number of keys pressed.
--
-- @
-- {-\# LANGUAGE DerivingStrategies \#-}
-- {-\# LANGUAGE DuplicateRecordFields \#-}
-- {-\# LANGUAGE ImportQualifiedPost \#-}
-- {-\# LANGUAGE LambdaCase \#-}
-- {-\# LANGUAGE OverloadedRecordDot \#-}
-- {-\# LANGUAGE OverloadedStrings \#-}
-- {-\# LANGUAGE NoFieldSelectors \#-}
--
-- import Data.Foldable (fold)
-- import Data.Void (Void)
-- import Termbox.Tea qualified as Termbox
--
-- main :: IO ()
-- main = do
--   result <-
--     Termbox.'run'
--       Termbox.'Termbox.Tea.Program'
--         { initialize,
--           pollEvent,
--           handleEvent,
--           render,
--           finished
--         }
--   case result of
--     Left err -\> putStrLn (\"Termbox program failed to initialize: \" ++ show err)
--     Right state -\> putStrLn (\"Final state: \" ++ show state)
--
-- data MyState = MyState
--   { keysPressed :: Int,
--     pressedEsc :: Bool
--   }
--   deriving stock (Show)
--
-- initialize :: Termbox.'Termbox.Tea.Size' -\> MyState
-- initialize _size =
--   MyState
--     { keysPressed = 0,
--       pressedEsc = False
--     }
--
-- pollEvent :: Maybe (IO Void)
-- pollEvent =
--   Nothing
--
-- handleEvent :: MyState -\> Termbox.'Termbox.Tea.Event' Void -\> IO MyState
-- handleEvent state = \\case
--   Termbox.'Termbox.Tea.EventKey' key -\>
--     pure
--       MyState
--         { keysPressed = state.keysPressed + 1,
--           pressedEsc =
--             case key of
--               Termbox.'Termbox.Tea.KeyEsc' -\> True
--               _ -\> False
--         }
--   _ -\> pure state
--
-- render :: MyState -\> Termbox.'Termbox.Tea.Scene'
-- render state =
--   fold
--     [ string
--         Termbox.'Termbox.Tea.Pos' {row = 2, col = 4}
--         (\"Number of keys pressed: \" ++ map Termbox.'Termbox.Tea.char' (show state.keysPressed))
--     , string
--         Termbox.'Termbox.Tea.Pos' {row = 4, col = 4}
--         (\"Press \" ++ map (Termbox.'Termbox.Tea.bold' . Termbox.'Termbox.Tea.char') \"Esc\" ++ \" to quit.\")
--     ]
--
-- finished :: MyState -\> Bool
-- finished state =
--   state.pressedEsc
--
-- string :: Termbox.'Termbox.Tea.Pos' -\> [Termbox.'Termbox.Tea.Cell'] -\> Termbox.'Termbox.Tea.Scene'
-- string pos cells =
--   foldMap (\\(i, cell) -\> Termbox.'Termbox.Tea.cell' (Termbox.'Termbox.Tea.posRight' i pos) cell) (zip [0 ..] cells)
-- @
module Termbox.Tea
  ( -- * Main
    Program (..),
    run,
    Termbox.InitError (..),

    -- * Terminal contents

    -- ** Scene
    Termbox.Scene,
    Termbox.cell,
    Termbox.fill,
    Termbox.cursor,

    -- ** Cell
    Termbox.Cell,
    Termbox.char,
    Termbox.fg,
    Termbox.bg,
    Termbox.bold,
    Termbox.underline,
    Termbox.blink,

    -- ** Colors
    Termbox.Color,

    -- *** Basic colors
    Termbox.defaultColor,
    Termbox.red,
    Termbox.green,
    Termbox.yellow,
    Termbox.blue,
    Termbox.magenta,
    Termbox.cyan,
    Termbox.white,
    Termbox.bright,

    -- *** 216 miscellaneous colors
    Termbox.color,

    -- *** 24 monochrome colors
    Termbox.gray,

    -- * Event handling
    Termbox.Event (..),
    Termbox.Key (..),
    Termbox.Mouse (..),
    Termbox.MouseButton (..),

    -- * Miscellaneous types
    Termbox.Pos (..),
    Termbox.posUp,
    Termbox.posDown,
    Termbox.posLeft,
    Termbox.posRight,
    Termbox.Size (..),
  )
where

import Control.Concurrent.MVar
import Control.Monad (forever)
import qualified Ki
import qualified Termbox

-- | A @termbox@ program, parameterized by state __@s@__.
data Program s = forall e.
  Program
  { -- | The initial state, given the initial terminal size.
    forall s. Program s -> Size -> s
initialize :: Termbox.Size -> s,
    -- | Poll for a user event. Every value that this @IO@ action returns is provided to @handleEvent@.
    ()
pollEvent :: Maybe (IO e),
    -- | Handle an event.
    ()
handleEvent :: s -> Termbox.Event e -> IO s,
    -- | Render the current state.
    forall s. Program s -> s -> Scene
render :: s -> Termbox.Scene,
    -- | Is the current state finished?
    forall s. Program s -> s -> Bool
finished :: s -> Bool
  }

-- | Run a @termbox@ program.
--
-- @run@ either:
--
--   * Returns immediately with an 'InitError'.
--   * Returns the final state, once it's @finished@.
run :: Program s -> IO (Either Termbox.InitError s)
run :: forall s. Program s -> IO (Either InitError s)
run Program s
program =
  forall a. IO a -> IO (Either InitError a)
Termbox.run (forall s. Program s -> IO s
run_ Program s
program)

run_ :: Program s -> IO s
run_ :: forall s. Program s -> IO s
run_ Program {Size -> s
initialize :: Size -> s
$sel:initialize:Program :: forall s. Program s -> Size -> s
initialize, Maybe (IO e)
pollEvent :: Maybe (IO e)
$sel:pollEvent:Program :: ()
pollEvent, s -> Event e -> IO s
handleEvent :: s -> Event e -> IO s
$sel:handleEvent:Program :: ()
handleEvent, s -> Scene
render :: s -> Scene
$sel:render:Program :: forall s. Program s -> s -> Scene
render, s -> Bool
finished :: s -> Bool
$sel:finished:Program :: forall s. Program s -> s -> Bool
finished} = do
  s
state0 <- Size -> s
initialize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Size
Termbox.getSize

  let loop0 :: IO (Event e) -> s -> IO s
loop0 IO (Event e)
doPoll =
        let loop :: s -> IO s
loop s
s0 =
              if s -> Bool
finished s
s0
                then forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s0
                else do
                  Scene -> IO ()
Termbox.render (s -> Scene
render s
s0)
                  Event e
event <- IO (Event e)
doPoll
                  s
s1 <- s -> Event e -> IO s
handleEvent s
s0 Event e
event
                  s -> IO s
loop s
s1
         in s -> IO s
loop

  case Maybe (IO e)
pollEvent of
    Maybe (IO e)
Nothing -> IO (Event e) -> s -> IO s
loop0 forall e. IO (Event e)
Termbox.poll s
state0
    Just IO e
pollEvent1 -> do
      MVar (Event e)
eventVar <- forall a. IO (MVar a)
newEmptyMVar

      forall a. (Scope -> IO a) -> IO a
Ki.scoped \Scope
scope -> do
        Scope -> IO Void -> IO ()
Ki.fork_ Scope
scope do
          forall (f :: * -> *) a b. Applicative f => f a -> f b
forever do
            e
event <- IO e
pollEvent1
            forall a. MVar a -> a -> IO ()
putMVar MVar (Event e)
eventVar (forall e. e -> Event e
Termbox.EventUser e
event)

        Scope -> IO Void -> IO ()
Ki.fork_ Scope
scope do
          forall (f :: * -> *) a b. Applicative f => f a -> f b
forever do
            Event e
event <- forall e. IO (Event e)
Termbox.poll
            forall a. MVar a -> a -> IO ()
putMVar MVar (Event e)
eventVar Event e
event

        IO (Event e) -> s -> IO s
loop0 (forall a. MVar a -> IO a
takeMVar MVar (Event e)
eventVar) s
state0