{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : Dep.Bricks.Utils
Description : A module that provides utility functions to render 'Image's.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

A module that is used to render lines, arrows, rasters, etc.
-}

module Dep.Bricks.Utils (
    -- * Convert to an 'Image'
    fromRaster
    -- * Lines
  , hline, hline'
  , vline, vline'
    -- * Arrows
  , harrow, harrow'
  , varrow, varrow'
    -- * Type aliasses for rows and rasters
  , Row, Raster
    -- * Raster (for Karnaugh cards)
  , inRaster, inRaster'
  ) where

import Data.Text(Text, cons, pack, singleton, unpack)
import qualified Data.Text as T

import Dep.Utils(udiv)

import Graphics.Vty.Attributes(Attr)
import Graphics.Vty.Image(Image, (<->), (<|>), char, emptyImage, imageWidth, imageHeight, string, text', vertCat)

-- | A Row is a simple 'String', typically a row in an 'Raster' (and later an 'Image').
type Row = String

-- | A list of lists of 'Char'acters is a 'Raster', typically this is used to convert this to an 'Image'.
type Raster = [Row]

-- | Convert a given list of strings to an 'Image' where all the
-- images have the same attribute.
fromRaster
  :: Attr  -- ^ The 'Attr'ibute that determines how to render the raster.
  -> Raster  -- ^ The given list of strings that we want to render.
  -> Image  -- ^ The corresponding image by vertically aligning the rows of the raster.
fromRaster :: Attr -> Raster -> Image
fromRaster Attr
atr = (String -> Image -> Image) -> Image -> Raster -> Image
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Image -> Image -> Image
(<->) (Image -> Image -> Image)
-> (String -> Image) -> String -> Image -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> String -> Image
string Attr
atr) Image
emptyImage

-- | Render a /horizontal/ arrow with the given number of characters between the arrow heads. The 'Text'
-- in the middle is "/cycled/".
harrow
  :: Char  -- ^ The left arrow head.
  -> Text  -- ^ The 'Text' in the middle that is constantly repeated.
  -> Char  -- ^ The right arrow head.
  -> Attr  -- ^ The 'Attr'ibute to specify the style of the arrow.
  -> Int  -- ^ The number characters between the arrow heads (so we are /not/ counting the arrow heads).
  -> Image  -- ^ An image that shows a horizontal arrow with a given number of characters in the middle.
harrow :: Char -> Text -> Char -> Attr -> Int -> Image
harrow Char
c0 Text
ci Char
cn = Attr -> Int -> Image
go
  where go :: Attr -> Int -> Image
go Attr
atr Int
n = Attr -> Text -> Image
text' Attr
atr (Char -> Text -> Text
cons Char
c0 (Int -> Text -> Text
T.take Int
n (Int -> Text -> Text
T.replicate (Int -> Int -> Int
forall i. Integral i => i -> i -> i
udiv Int
n (Text -> Int
T.length Text
ci)) Text
ci) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
singleton Char
cn))

-- | A function equivalent to 'harrow', but where we use a 'String' to specify the 'Char'acters in the middle.
harrow'
  :: Char  -- ^ The left arrow head.
  -> String -- ^ The 'String' in the middle that is constantly repeated.
  -> Char  -- ^ The right arrow head.
  -> Attr  -- ^ The 'Attr'ibute to specify the style of the arrow.
  -> Int  -- ^ The number characters between the arrow heads (so we are /not/ counting the arrow heads).
  -> Image  -- ^ An image that shows a horizontal arrow with a given number of characters in the middle.
harrow' :: Char -> String -> Char -> Attr -> Int -> Image
harrow' Char
c0 = Char -> Text -> Char -> Attr -> Int -> Image
harrow Char
c0 (Text -> Char -> Attr -> Int -> Image)
-> (String -> Text) -> String -> Char -> Attr -> Int -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

-- | Render a /vertical/ arrow with the given number of characters between the arrow heads. The 'Text'
-- in the middle is "/cycled/".
varrow
  :: Char  -- ^ The top arrow head.
  -> Text  -- ^ The 'Text' in the middle that is constantly repeated.
  -> Char  -- ^ The bottom arrow head.
  -> Attr  -- ^ The 'Attr'ibute to specify the style of the arrow.
  -> Int  -- ^ The number characters between the arrow heads (so we are /not/ counting the arrow heads).
  -> Image  -- ^ An image that shows a vertical arrow with a given number of characters in the middle.
varrow :: Char -> Text -> Char -> Attr -> Int -> Image
varrow Char
c0 = Char -> String -> Char -> Attr -> Int -> Image
varrow' Char
c0 (String -> Char -> Attr -> Int -> Image)
-> (Text -> String) -> Text -> Char -> Attr -> Int -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack

-- | A function equivalent to 'varrow', but where we use a 'String' to specify the 'Char'acters in the middle.
varrow'
  :: Char  -- ^ The top arrow head.
  -> String  -- ^ The 'String' in the middle that is constantly repeated.
  -> Char  -- ^ The bottom arrow head.
  -> Attr  -- ^ The 'Attr'ibute to specify the style of the arrow.
  -> Int  -- ^ The number characters between the arrow heads (so we are /not/ counting the arrow heads).
  -> Image  -- ^ An image that shows a vertical arrow with a given number of characters in the middle.
varrow' :: Char -> String -> Char -> Attr -> Int -> Image
varrow' Char
c0 String
ci Char
cn = Attr -> Int -> Image
go
  where go :: Attr -> Int -> Image
go Attr
atr Int
n = [Image] -> Image
vertCat ((Char -> Image) -> String -> [Image]
forall a b. (a -> b) -> [a] -> [b]
map (Attr -> Char -> Image
char Attr
atr) (Char
c0 Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n (String -> String
forall a. [a] -> [a]
cycle String
ci) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
cn]))

-- | Render a /horizontal/ line by cycling through the given 'Text' and apply the given 'Attr'ibute to
-- the result.
hline
  :: Text  -- ^ The 'Text' object that determines how to render the line. The items will be /cycled/.
  -> Attr  -- ^ The 'Attr'ibute that determines how to render the line.
  -> Int  -- ^ The given length of the line.
  -> Image  -- ^ An 'Image' that contains a /horizontal/ line with the given length.
hline :: Text -> Attr -> Int -> Image
hline Text
ci = Attr -> Int -> Image
go
  where go :: Attr -> Int -> Image
go Attr
atr Int
n = Attr -> Text -> Image
text' Attr
atr (Int -> Text -> Text
T.take Int
n (Int -> Text -> Text
T.replicate (Int -> Int -> Int
forall i. Integral i => i -> i -> i
udiv Int
n (Text -> Int
T.length Text
ci)) Text
ci))

-- | A function equivalent to 'hline', but with a 'String' to specify the 'Char'acters instead of a 'Text' object.
hline'
  :: String  -- ^ The 'String' object that determines how to render the line. The items will be /cycled/.
  -> Attr  -- ^ The 'Attr'ibute that determines how to render the line.
  -> Int  -- ^ The given length of the line.
  -> Image  -- ^ An 'Image' that contains a /horizontal/ line with the given length.
hline' :: String -> Attr -> Int -> Image
hline' = Text -> Attr -> Int -> Image
hline (Text -> Attr -> Int -> Image)
-> (String -> Text) -> String -> Attr -> Int -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

-- | Render a /vertical/ line by cycling through the given 'Text' and apply the given 'Attr'ibute to
-- the result.
vline
  :: Text  -- ^ The 'String' object that determines how to render the line. The items will be /cycled/.
  -> Attr  -- ^ The 'Attr'ibute that determines how to render the line.
  -> Int  -- ^ The given length of the line.
  -> Image  -- ^ An 'Image' that contains a /vertical/ line with the given length.
vline :: Text -> Attr -> Int -> Image
vline = String -> Attr -> Int -> Image
vline' (String -> Attr -> Int -> Image)
-> (Text -> String) -> Text -> Attr -> Int -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack

-- | A function equivalent to 'vline', but with a 'String' to specify the 'Char'acters instead of a 'Text' object.
vline'
  :: String  -- ^ The 'String' object that determines how to render the line. The items will be /cycled/.
  -> Attr  -- ^ The 'Attr'ibute that determines how to render the line.
  -> Int  -- ^ The given length of the line.
  -> Image  -- ^ An 'Image' that contains a /vertical/ line with the given length.
vline' :: String -> Attr -> Int -> Image
vline' String
ci = Attr -> Int -> Image
go
  where go :: Attr -> Int -> Image
go Attr
atr Int
n = [Image] -> Image
vertCat ((Char -> Image) -> String -> [Image]
forall a b. (a -> b) -> [a] -> [b]
map (Attr -> Char -> Image
char Attr
atr) (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n (String -> String
forall a. [a] -> [a]
cycle String
ci)))

-- | Wrap the given 'Image' in a raster structure with thick borders
-- and with small lines for the raster image in the middle.
inRaster
  :: Attr  -- ^ The 'Attr'ibute that specifies how to render the raster border.
  -> Image  -- ^ The 'Image' that we want to wrap in a /raster/.
  -> Image  -- ^ An 'Image' that contains the given image wrapped in a /raster/.
inRaster :: Attr -> Image -> Image
inRaster Attr
atr Image
img = Image
top Image -> Image -> Image
<-> (Image
lft Image -> Image -> Image
<|> Image
img Image -> Image -> Image
<|> Image
rght) Image -> Image -> Image
<-> Image
bot
    where w :: Int
w = Image -> Int
imageWidth Image
img
          h :: Int
h = Image -> Int
imageHeight Image
img
          lft :: Image
lft = Text -> Attr -> Int -> Image
vline Text
"\x2503\x2520" Attr
atr Int
h
          rght :: Image
rght = Text -> Attr -> Int -> Image
vline Text
"\x2503\x2528" Attr
atr Int
h
          top :: Image
top = Char -> Text -> Char -> Attr -> Int -> Image
harrow Char
'\x250f' Text
"\x2501\x252f\x2501\x252f\x2501\x252f\x2501\x2513" Char
'\x2513' Attr
atr Int
w
          bot :: Image
bot = Char -> Text -> Char -> Attr -> Int -> Image
harrow Char
'\x2517' Text
"\x2501\x2537" Char
'\x251b'Attr
atr  Int
w

-- | Wrap the given list of 'String's in a raster structure with thick borders
-- and with small lines for the raster image in the middle.
inRaster'
  :: Raster  -- ^ The given list of 'String's that we want to wrap in a /raster/.
  -> Raster  -- ^ A list of 'String's that contains the given image wrapped in a /raster/.
inRaster' :: Raster -> Raster
inRaster' Raster
img = (Char
'\x250f' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
w (String -> String
forall a. [a] -> [a]
cycle String
"\x2501\x252f\x2501\x252f\x2501\x252f\x2501\x2513 \x250f") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\x2513") String -> Raster -> Raster
forall a. a -> [a] -> [a]
: String -> String -> Raster -> Raster
forall a. [a] -> [a] -> [[a]] -> [[a]]
go (String -> String
forall a. [a] -> [a]
cycle String
"\x2503\x2520\x2503\x2520\x2503\x2520\x2503\x2517 \x250f") (String -> String
forall a. [a] -> [a]
cycle String
"\x2503\x2528\x2503\x2528\x2503\x2528\x2503\x251b \x2513") Raster
img Raster -> Raster -> Raster
forall a. [a] -> [a] -> [a]
++ [Char
'\x2517' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
w (String -> String
forall a. [a] -> [a]
cycle String
"\x2501\x2537\x2501\x2537\x2501\x2537\x2501\x251b \x2517") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\x251b"]
    where w :: Int
w = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((String -> Int) -> Raster -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Raster
img)
          go :: [a] -> [a] -> [[a]] -> [[a]]
go = (a -> a -> [a] -> [a]) -> [a] -> [a] -> [[a]] -> [[a]]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\a
x a
y [a]
z -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
z [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
y])