{-|
Module      : BearLibTerminal.Terminal.Print
Description : Printing text.
License     : MIT
Stability   : experimental
Portability : POSIX

Functions for printing text to the screen (given as `Data.Text.Text`), and a couple of helper functions for wrapping
strings with inline color strings.
-}

module BearLibTerminal.Terminal.Print
  ( textColor
  , textBkColor
  , terminalPrint
  , terminalPrint_
  , terminalPrintExt
  , terminalPrintExt_
  ) where

import BearLibTerminal.Raw
import Control.Monad.IO.Class

import Data.Text (Text)
import BearLibTerminal.Terminal.CString
import Data.String (IsString)
import Control.Monad (void)

-- | Wrap a string (in any `IsString` format) with color formatting tags.
textColor ::
  IsString a
  => Semigroup a
  => a -- ^ the color, from the list of valid color identifiers - http://foo.wyrd.name/en:bearlibterminal:reference#color_from_name.
  -> a -- ^ the text to wrap.
  -> a
textColor :: forall a. (IsString a, Semigroup a) => a -> a -> a
textColor a
col = a -> a -> a -> a
forall a. Semigroup a => a -> a -> a -> a
surround (a
"[color="a -> a -> a
forall a. Semigroup a => a -> a -> a
<>a
cola -> a -> a
forall a. Semigroup a => a -> a -> a
<>a
"]") a
"[/color]"

-- | Wrap a string (in any `IsString` format) with background color formatting tags.
textBkColor ::
  IsString a
  => Semigroup a
  => a -- ^ the background color, from the list of valid color identifiers - http://foo.wyrd.name/en:bearlibterminal:reference#color_from_name.
  -> a -- ^ the text to wrap.
  -> a
textBkColor :: forall a. (IsString a, Semigroup a) => a -> a -> a
textBkColor a
col = a -> a -> a -> a
forall a. Semigroup a => a -> a -> a -> a
surround (a
"[bkcolor="a -> a -> a
forall a. Semigroup a => a -> a -> a
<>a
cola -> a -> a
forall a. Semigroup a => a -> a -> a
<>a
"]") a
"[/bkcolor]"

-- | Print a string to the screen, given as a `Text`.
--
-- Wrapper around [@terminal_print@](http://foo.wyrd.name/en:bearlibterminal:reference#print).
terminalPrint ::
  MonadIO m
  => Int  -- ^ x-coordinate to start printing the string at.
  -> Int -- ^ y-coordinate to start printing the string at.
  -> Text -- ^ the string to print.
  -> m Dimensions -- ^ the `Dimensions` of the string as printed on screen.
terminalPrint :: forall (m :: * -> *).
MonadIO m =>
Int -> Int -> Text -> m Dimensions
terminalPrint Int
x Int
y = (CString -> IO Dimensions) -> Text -> m Dimensions
forall (m :: * -> *) a.
MonadIO m =>
(CString -> IO a) -> Text -> m a
textToCString (Int -> Int -> CString -> IO Dimensions
forall (m :: * -> *).
MonadIO m =>
Int -> Int -> CString -> m Dimensions
terminalPrintCString Int
x Int
y)

-- | Print a string to the screen, given as a `Text`, with (optional) auto-wrapping and alignment.
-- Wrapper around [@terminal_print_ext@](http://foo.wyrd.name/en:bearlibterminal:reference#print_ext)
terminalPrintExt ::
  MonadIO m
  => Int  -- ^ x-coordinate to start printing the string at.
  -> Int -- ^ y-coordinate to start printing the string at.
  -> Int -- ^ width of the bounding box for auto-wrapping and alignment.
  -> Int -- ^ height of the bounding box for auto-wrapping and alignment.
  -> Maybe PrintAlignment -- ^ alignment of the string within the bounding box.
  -> Text -- ^ the string to print.
  -> m Dimensions -- ^ the `Dimensions` of the string as printed on screen.
terminalPrintExt :: forall (m :: * -> *).
MonadIO m =>
Int
-> Int
-> Int
-> Int
-> Maybe PrintAlignment
-> Text
-> m Dimensions
terminalPrintExt Int
x Int
y Int
w Int
h Maybe PrintAlignment
align = (CString -> IO Dimensions) -> Text -> m Dimensions
forall (m :: * -> *) a.
MonadIO m =>
(CString -> IO a) -> Text -> m a
textToCString (Int
-> Int
-> Int
-> Int
-> Maybe PrintAlignment
-> CString
-> IO Dimensions
forall (m :: * -> *).
MonadIO m =>
Int
-> Int
-> Int
-> Int
-> Maybe PrintAlignment
-> CString
-> m Dimensions
terminalPrintExtCString Int
x Int
y Int
w Int
h Maybe PrintAlignment
align)

-- | Print a string to the screen, given as a `Text`. Ignore the dimensions of the printed string.
--
-- Wrapper around [@terminal_print@](http://foo.wyrd.name/en:bearlibterminal:reference#print).
terminalPrint_ ::
  MonadIO m
  => Int  -- ^ x-coordinate to start printing the string at.
  -> Int -- ^ y-coordinate to start printing the string at.
  -> Text -- ^ the string to print.
  -> m ()
terminalPrint_ :: forall (m :: * -> *). MonadIO m => Int -> Int -> Text -> m ()
terminalPrint_ Int
x Int
y Text
t = m Dimensions -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Dimensions -> m ()) -> m Dimensions -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Text -> m Dimensions
forall (m :: * -> *).
MonadIO m =>
Int -> Int -> Text -> m Dimensions
terminalPrint Int
x Int
y Text
t

-- | Print a string to the screen, given as a `Text`, with (optional) auto-wrapping and alignment.
-- gnore the dimensions of the printed string.
-- Wrapper around [@terminal_print_ext@](http://foo.wyrd.name/en:bearlibterminal:reference#print_ext)
terminalPrintExt_ ::
  MonadIO m
  => Int  -- ^ x-coordinate to start printing the string at.
  -> Int -- ^ y-coordinate to start printing the string at.
  -> Int -- ^ width of the bounding box for auto-wrapping and alignment.
  -> Int -- ^ height of the bounding box for auto-wrapping and alignment.
  -> Maybe PrintAlignment -- ^ alignment of the string within the bounding box.
  -> Text -- ^ the string to print.
  -> m ()
terminalPrintExt_ :: forall (m :: * -> *).
MonadIO m =>
Int -> Int -> Int -> Int -> Maybe PrintAlignment -> Text -> m ()
terminalPrintExt_ Int
x Int
y Int
w Int
h Maybe PrintAlignment
align Text
t = m Dimensions -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Dimensions -> m ()) -> m Dimensions -> m ()
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Int
-> Int
-> Maybe PrintAlignment
-> Text
-> m Dimensions
forall (m :: * -> *).
MonadIO m =>
Int
-> Int
-> Int
-> Int
-> Maybe PrintAlignment
-> Text
-> m Dimensions
terminalPrintExt Int
x Int
y Int
w Int
h Maybe PrintAlignment
align Text
t