-------------------------------------------------------------------------------
-- Print convenience functions
-- 2017 Francesco Ariis GPLv3
-------------------------------------------------------------------------------

-- Drawing primitives. If not stated otherwise (textbox, etc.), ' ' are
-- assumed to be opaque

module Terminal.Game.Draw (module Terminal.Game.Draw,
                           (F.&)
                          ) where

import Terminal.Game.Plane

import Text.LineBreak

import qualified Data.Colour.RGBSpace as S
import qualified Data.Function as F ( (&) )
import qualified Data.List as L
import qualified Data.Word as W
import qualified System.Console.ANSI as CA


-----------
-- TYPES --
-----------

-- | A drawing function, usually executed with the help of '%'.
type Draw = Plane -> Plane


-----------------
-- COMBINATORS --
-----------------

-- | Pastes one 'Plane' onto another. To be used along with 'F.&'
-- like this:
--
-- @
--  d :: Plane
--  d =          blankPlane 100 100  &
--      (3, 4) % box '_' 3 5         &
--      (a, b) % cell \'A\' '#' bold
-- @
(%) :: Coords -> Plane -> Draw
Coords
cds % :: Coords -> Plane -> Draw
% Plane
p1 = \Plane
p2 -> Plane -> Plane -> Coords -> Plane
pastePlane Plane
p1 Plane
p2 Coords
cds
infixl 4 %

-- | Apply style to plane, e.g.
--
-- > cell 'w' # bold
(#) :: Plane -> Draw -> Plane
Plane
p # :: Plane -> Draw -> Plane
# Draw
sf = Draw
sf Plane
p
infixl 8 #

-- | Shorthand for sequencing 'Plane's, e.g.
--
-- @
--           firstPlane  &
--  (3, 4) '%' secondPlane &
--  (1, 9) '%' thirdPlane
-- @
--
-- is equal to
--
-- @
--  mergePlanes firstPlane [((3,4), secondPlane),
--                          ((1,9), thirdPlane)]
-- @
mergePlanes :: Plane -> [(Coords, Plane)] -> Plane
mergePlanes :: Plane -> [(Coords, Plane)] -> Plane
mergePlanes Plane
p [(Coords, Plane)]
cps = (Plane -> (Coords, Plane) -> Plane)
-> Plane -> [(Coords, Plane)] -> Plane
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Plane -> (Coords, Plane) -> Plane
addPlane Plane
p [(Coords, Plane)]
cps
    where
          addPlane :: Plane -> (Coords, Plane) -> Plane
          addPlane :: Plane -> (Coords, Plane) -> Plane
addPlane Plane
bp (Coords
cs, Plane
tp) = Plane
bp Plane -> Draw -> Plane
forall a b. a -> (a -> b) -> b
F.& Coords
cs Coords -> Plane -> Draw
% Plane
tp

-- | Place two 'Plane's side-by-side, horizontally.
(|||) :: Plane -> Plane -> Plane
||| :: Plane -> Draw
(|||) Plane
a Plane
b = let (Column
wa, Column
ha) = Plane -> Coords
planeSize Plane
a
                (Column
wb, Column
hb) = Plane -> Coords
planeSize Plane
b
            in Plane -> [(Coords, Plane)] -> Plane
mergePlanes (Column -> Column -> Plane
blankPlane (Column
wa Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
wb) (Column -> Column -> Column
forall a. Ord a => a -> a -> a
max Column
ha Column
hb))
                           [((Column
1,Column
1),    Plane
a),
                            ((Column
1,Column
waColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
1), Plane
b)]

-- | Place two 'Plane's side-by-side, vertically.
(===) :: Plane -> Plane -> Plane
=== :: Plane -> Draw
(===) Plane
a Plane
b = let (Column
wa, Column
ha) = Plane -> Coords
planeSize Plane
a
                (Column
wb, Column
hb) = Plane -> Coords
planeSize Plane
b
            in Plane -> [(Coords, Plane)] -> Plane
mergePlanes (Column -> Column -> Plane
blankPlane (Column -> Column -> Column
forall a. Ord a => a -> a -> a
max Column
wa Column
wb) (Column
ha Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
hb))
                           [((Column
1,Column
1),    Plane
a),
                            ((Column
haColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
1,Column
1), Plane
b)]

-- | @a *** b@ blits @b@ in the centre of @a@.
(***) :: Plane -> Plane -> Plane
*** :: Plane -> Draw
(***) Plane
a Plane
b = let (Column
aw, Column
ah) = Plane -> Coords
planeSize Plane
a
                (Column
bw, Column
bh) = Plane -> Coords
planeSize Plane
b
                r :: Column
r = Column -> Column -> Column
forall a. Integral a => a -> a -> a
quot (Column
ah Column -> Column -> Column
forall a. Num a => a -> a -> a
- Column
bh) Column
2 Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
1
                c :: Column
c = Column -> Column -> Column
forall a. Integral a => a -> a -> a
quot (Column
aw Column -> Column -> Column
forall a. Num a => a -> a -> a
- Column
bw) Column
2 Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
1
            in           Plane
a Plane -> Draw -> Plane
forall a b. a -> (a -> b) -> b
F.&
                (Column
r, Column
c) Coords -> Plane -> Draw
% Plane
b


-- | Place a list of 'Plane's side-by-side, horizontally. Returns a 1×1
-- transparent plane on empty list.
hcat :: [Plane] -> Plane
hcat :: [Plane] -> Plane
hcat [] = Column -> Column -> Plane
blankPlane Column
1 Column
1 Plane -> Draw -> Plane
# Char -> Draw
makeTransparent Char
' '
hcat [Plane]
ps = (Plane -> Draw) -> [Plane] -> Plane
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
L.foldl1' Plane -> Draw
(|||) [Plane]
ps

-- | Place a list of 'Plane's side-by-side, vertically. Returns a 1×1
-- transparent plane on empty list.
vcat :: [Plane] -> Plane
vcat :: [Plane] -> Plane
vcat [] = Column -> Column -> Plane
blankPlane Column
1 Column
1 Plane -> Draw -> Plane
# Char -> Draw
makeTransparent Char
' '
vcat [Plane]
ps = (Plane -> Draw) -> [Plane] -> Plane
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
L.foldl1' Plane -> Draw
(===) [Plane]
ps

infixl 6 |||, ===, ***


------------
-- STYLES --
------------

-- | Set foreground color.
color :: CA.Color -> CA.ColorIntensity -> Plane -> Plane
color :: Color -> ColorIntensity -> Draw
color Color
c ColorIntensity
i Plane
p = (Cell -> Cell) -> Draw
mapPlane (Color -> ColorIntensity -> Cell -> Cell
colorCell Color
c ColorIntensity
i) Plane
p

-- | Apply bold style to 'Plane'.
bold :: Plane -> Plane
bold :: Draw
bold Plane
p = (Cell -> Cell) -> Draw
mapPlane Cell -> Cell
boldCell Plane
p

-- | Swap foreground and background colours of 'Plane'.
invert :: Plane -> Plane
invert :: Draw
invert Plane
p = (Cell -> Cell) -> Draw
mapPlane Cell -> Cell
reverseCell Plane
p

-- | Set RGB color
rgbColor :: S.Colour Float -> Plane -> Plane
rgbColor :: Colour Float -> Draw
rgbColor Colour Float
k Plane
p = (Cell -> Cell) -> Draw
mapPlane (Colour Float -> Cell -> Cell
rgbColorCell Colour Float
k) Plane
p

-- | Set Palette color
paletteColor :: W.Word8 -> Plane -> Plane
paletteColor :: Word8 -> Draw
paletteColor Word8
k Plane
p = (Cell -> Cell) -> Draw
mapPlane (Word8 -> Cell -> Cell
paletteColorCell Word8
k) Plane
p


-------------
-- DRAWING --
-------------

-- | A box of dimensions @w h@.
box :: Width -> Height -> Char -> Plane
box :: Column -> Column -> Char -> Plane
box Column
w Column
h Char
chr = Column -> Column -> [(Coords, Char)] -> Plane
seqCellsDim Column
w Column
h [(Coords, Char)]
cells
    where
          cells :: [(Coords, Char)]
cells = [((Column
r, Column
c), Char
chr) | Column
r <- [Column
1..Column
h], Column
c <- [Column
1..Column
w]]

-- | A 1×1 @Plane@.
cell :: Char -> Plane
cell :: Char -> Plane
cell Char
ch = Column -> Column -> Char -> Plane
box Column
1 Column
1 Char
ch

-- | @1xn@ 'Plane' with a word in it. If you need to import multiline
-- ASCII art, check 'stringPlane' and 'stringPlaneTrans'.
word :: String -> Plane
word :: String -> Plane
word String
w = Column -> Column -> [(Coords, Char)] -> Plane
seqCellsDim (String -> Column
forall i a. Num i => [a] -> i
L.genericLength String
w) Column
1 [(Coords, Char)]
cells
    where
          cells :: [(Coords, Char)]
cells = [Coords] -> String -> [(Coords, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Column] -> [Column] -> [Coords]
forall a b. [a] -> [b] -> [(a, b)]
zip (Column -> [Column]
forall a. a -> [a]
repeat Column
1) [Column
1..]) String
w

-- opaque :: Plane -> Plane
-- opaque p = pastePlane p (box ' ' White w h) (1, 1)
--     where
--           (w, h) = pSize p

-- | A text-box. Assumes @' '@s are transparent.
textBox :: Width -> Height -> String -> Plane
textBox :: Column -> Column -> String -> Plane
textBox Column
w Column
h String
cs = Column -> Column -> Draw
frameTrans Column
w Column
h (Column -> String -> Plane
textBoxLiquid Column
w String
cs)

-- | Like 'textBox', but tall enough to fit @String@.
textBoxLiquid :: Width -> String -> Plane
textBoxLiquid :: Column -> String -> Plane
textBoxLiquid Column
w String
cs = Maybe Hyphenator -> Column -> String -> Plane
textBoxGeneralLiquid Maybe Hyphenator
forall a. Maybe a
Nothing Column
w String
cs

-- | As 'textBox', but hypenated. Example:
--
-- @
-- (normal textbox)                        (hyphenated textbox)
-- Rimasi un po’ a meditare nel buio       Rimasi un po’ a meditare nel buio
-- velato appena dal barlume azzurrino     velato appena dal barlume azzurrino
-- del fornello a gas, su cui              del fornello a gas, su cui sobbol-
-- sobbolliva quieta la pentola.           liva quieta la pentola.
-- @
--
-- Notice how in the right box /sobbolliva/ is broken in two. This
-- can be useful and aesthetically pleasing when textboxes are narrow.
textBoxHyphen :: Hyphenator -> Width -> Height -> String -> Plane
textBoxHyphen :: Hyphenator -> Column -> Column -> String -> Plane
textBoxHyphen Hyphenator
hp Column
w Column
h String
cs = Column -> Column -> Draw
frameTrans Column
w Column
h (Hyphenator -> Column -> String -> Plane
textBoxHyphenLiquid Hyphenator
hp Column
w String
cs)

-- | As 'textBoxLiquid', but hypenated.
textBoxHyphenLiquid :: Hyphenator -> Width -> String -> Plane
textBoxHyphenLiquid :: Hyphenator -> Column -> String -> Plane
textBoxHyphenLiquid Hyphenator
h Column
w String
cs = Maybe Hyphenator -> Column -> String -> Plane
textBoxGeneralLiquid (Hyphenator -> Maybe Hyphenator
forall a. a -> Maybe a
Just Hyphenator
h) Column
w String
cs

textBoxGeneralLiquid :: Maybe Hyphenator -> Width -> String -> Plane
textBoxGeneralLiquid :: Maybe Hyphenator -> Column -> String -> Plane
textBoxGeneralLiquid Maybe Hyphenator
mh Column
w String
cs = Plane
transparent
    where
          -- hypenathion
          bf :: BreakFormat
bf  = Column -> Column -> Char -> Maybe Hyphenator -> BreakFormat
BreakFormat (Column -> Column
forall a b. (Integral a, Num b) => a -> b
fromIntegral Column
w) Column
4 Char
'-' Maybe Hyphenator
mh
          hcs :: [String]
hcs = BreakFormat -> String -> [String]
breakStringLn BreakFormat
bf String
cs
          h :: Column
h   = [String] -> Column
forall i a. Num i => [a] -> i
L.genericLength [String]
hcs

          f :: [String] -> [(Coords, Char)]
          f :: [String] -> [(Coords, Char)]
f [String]
css = ((Column, String) -> [(Coords, Char)])
-> [(Column, String)] -> [(Coords, Char)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Column -> String -> [(Coords, Char)])
-> (Column, String) -> [(Coords, Char)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Column -> String -> [(Coords, Char)]
rf) ([Column] -> [String] -> [(Column, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Column
1..] [String]
css)
              where rf :: Int -> String -> [(Coords, Char)]
                    rf :: Column -> String -> [(Coords, Char)]
rf Column
cr String
ln = [Coords] -> String -> [(Coords, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Column] -> [Column] -> [Coords]
forall a b. [a] -> [b] -> [(a, b)]
zip (Column -> [Column]
forall a. a -> [a]
repeat Column
cr) [Column
1..]) String
ln

          out :: Plane
out         = Column -> Column -> [(Coords, Char)] -> Plane
seqCellsDim Column
w Column
h ([String] -> [(Coords, Char)]
f [String]
hcs)
          transparent :: Plane
transparent = Char -> Draw
makeTransparent Char
' ' Plane
out


----------------------------
-- ADDITIONAL COMBINATORS --
----------------------------

-- Coords as if origin were @ bottom-right
recipCoords :: Coords -> Plane -> Plane -> Coords
recipCoords :: Coords -> Plane -> Plane -> Coords
recipCoords (Column
r, Column
c) Plane
p Plane
p1 =
            let (Column
pw, Column
ph) = Plane -> Coords
planeSize Plane
p
                (Column
p1w, Column
p1h) = Plane -> Coords
planeSize Plane
p1
                r' :: Column
r' = Column
phColumn -> Column -> Column
forall a. Num a => a -> a -> a
-Column
p1hColumn -> Column -> Column
forall a. Num a => a -> a -> a
-Column
rColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
2
                c' :: Column
c' = Column
pwColumn -> Column -> Column
forall a. Num a => a -> a -> a
-Column
p1wColumn -> Column -> Column
forall a. Num a => a -> a -> a
-Column
cColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
2
            in (Column
r', Column
c')

-- | Pastes a plane onto another (origin: top-right).
(%^>) :: Coords -> Plane -> Draw
(Column
r, Column
c) %^> :: Coords -> Plane -> Draw
%^> Plane
p1 = \Plane
p ->
            let (Column
_, Column
c') = Coords -> Plane -> Plane -> Coords
recipCoords (Column
r, Column
c) Plane
p Plane
p1
            in Plane
p Plane -> Draw -> Plane
forall a b. a -> (a -> b) -> b
F.& (Column
r, Column
c') Coords -> Plane -> Draw
% Plane
p1

-- | Pastes a plane onto another (origin: bottom-left).
(%.<) :: Coords -> Plane -> Draw
(Column
r, Column
c) %.< :: Coords -> Plane -> Draw
%.< Plane
p1 = \Plane
p ->
            let (Column
r', Column
_) = Coords -> Plane -> Plane -> Coords
recipCoords (Column
r, Column
c) Plane
p Plane
p1
            in Plane
p Plane -> Draw -> Plane
forall a b. a -> (a -> b) -> b
F.& (Column
r', Column
c) Coords -> Plane -> Draw
% Plane
p1

-- | Pastes a plane onto another (origin: bottom-right).
(%.>) :: Coords -> Plane -> Draw
Coords
cs %.> :: Coords -> Plane -> Draw
%.> Plane
p1 = \Plane
p ->
            let (Column
r', Column
c') = Coords -> Plane -> Plane -> Coords
recipCoords Coords
cs Plane
p Plane
p1
            in Plane
p Plane -> Draw -> Plane
forall a b. a -> (a -> b) -> b
F.& (Column
r', Column
c') Coords -> Plane -> Draw
% Plane
p1

infixl 4 %^>
infixl 4 %.<
infixl 4 %.>


-----------------
-- ANCILLARIES --
-----------------

seqCellsDim :: Width -> Height -> [(Coords, Char)] -> Plane
seqCellsDim :: Column -> Column -> [(Coords, Char)] -> Plane
seqCellsDim Column
w Column
h [(Coords, Char)]
cells = Plane -> [(Coords, Char)] -> Plane
seqCells (Column -> Column -> Plane
blankPlane Column
w Column
h) [(Coords, Char)]
cells

seqCells :: Plane -> [(Coords, Char)] -> Plane
seqCells :: Plane -> [(Coords, Char)] -> Plane
seqCells Plane
p [(Coords, Char)]
cells = Plane -> [(Coords, Cell)] -> Plane
updatePlane Plane
p (((Coords, Char) -> (Coords, Cell))
-> [(Coords, Char)] -> [(Coords, Cell)]
forall a b. (a -> b) -> [a] -> [b]
map (Coords, Char) -> (Coords, Cell)
forall {a}. (a, Char) -> (a, Cell)
f [(Coords, Char)]
cells)
    where
          f :: (a, Char) -> (a, Cell)
f (a
cds, Char
chr) = (a
cds, Char -> Cell
creaCell Char
chr)

-- paste plane on a blank one, and make ' ' transparent
frameTrans :: Width -> Height -> Plane -> Plane
frameTrans :: Column -> Column -> Draw
frameTrans Column
w Column
h Plane
p = let bt :: Plane
bt = Char -> Draw
makeTransparent Char
' ' (Column -> Column -> Plane
blankPlane Column
w Column
h)
                   in Plane
bt Plane -> Draw -> Plane
forall a b. a -> (a -> b) -> b
F.& (Column
1, Column
1) Coords -> Plane -> Draw
% Plane
p