-------------------------------------------------------------------------------
-- 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.Function       as F ( (&) )
import qualified Data.List           as L
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 (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 (Width
wa, Width
ha) = Plane -> Coords
planeSize Plane
a
                (Width
wb, Width
hb) = Plane -> Coords
planeSize Plane
b
            in Plane -> [(Coords, Plane)] -> Plane
mergePlanes (Width -> Width -> Plane
blankPlane (Width
wa Width -> Width -> Width
forall a. Num a => a -> a -> a
+ Width
wb) (Width -> Width -> Width
forall a. Ord a => a -> a -> a
max Width
ha Width
hb))
                           [((Width
1,Width
1),    Plane
a),
                            ((Width
1,Width
waWidth -> Width -> Width
forall a. Num a => a -> a -> a
+Width
1), Plane
b)]

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

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


-- | Place a list of 'Plane's side-by-side, horizontally.
hcat :: [Plane] -> Plane
hcat :: [Plane] -> Plane
hcat [Plane]
ps = (Plane -> Draw) -> Plane -> [Plane] -> Plane
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Plane -> Draw
(|||) (Width -> Width -> Plane
blankPlane Width
0 Width
0) [Plane]
ps

-- | Place a list of 'Plane's side-by-side, vertically.
vcat :: [Plane] -> Plane
vcat :: [Plane] -> Plane
vcat [Plane]
ps = (Plane -> Draw) -> Plane -> [Plane] -> Plane
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Plane -> Draw
(===) (Width -> Width -> Plane
blankPlane Width
0 Width
0) [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



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

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

-- | A 1×1 @Plane@.
cell :: Char -> Plane
cell :: Char -> Plane
cell Char
ch = Width -> Width -> Char -> Plane
box Width
1 Width
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 = Width -> Width -> [(Coords, Char)] -> Plane
seqCellsDim (String -> Width
forall i a. Num i => [a] -> i
L.genericLength String
w) Width
1 [(Coords, Char)]
cells
    where
          cells :: [(Coords, Char)]
cells = [Coords] -> String -> [(Coords, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Width] -> [Width] -> [Coords]
forall a b. [a] -> [b] -> [(a, b)]
zip (Width -> [Width]
forall a. a -> [a]
repeat Width
1) [Width
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 :: Width -> Width -> String -> Plane
textBox Width
w Width
h String
cs = Width -> Width -> Draw
frameTrans Width
w Width
h (Width -> String -> Plane
textBoxLiquid Width
w String
cs)

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

-- | As 'textBox', but hypenated. Example:
--
-- @
-- 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 sobbol-      del fornello a gas, su cui
-- liva quieta la pentola.                 sobbolliva quieta la pentola.
-- @
--
-- Notice how in the left 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 -> Width -> Width -> String -> Plane
textBoxHyphen Hyphenator
hp Width
w Width
h String
cs = Width -> Width -> Draw
frameTrans Width
w Width
h (Hyphenator -> Width -> String -> Plane
textBoxHyphenLiquid Hyphenator
hp Width
w String
cs)

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

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

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

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

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

seqCellsDim :: Width -> Height -> [(Coords, Char)] -> Plane
seqCellsDim :: Width -> Width -> [(Coords, Char)] -> Plane
seqCellsDim Width
w Width
h [(Coords, Char)]
cells = Plane -> [(Coords, Char)] -> Plane
seqCells (Width -> Width -> Plane
blankPlane Width
w Width
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 :: Width -> Width -> Draw
frameTrans Width
w Width
h Plane
p = let bt :: Plane
bt = Char -> Draw
makeTransparent Char
' ' (Width -> Width -> Plane
blankPlane Width
w Width
h)
                   in Plane
bt Plane -> Draw -> Plane
forall a b. a -> (a -> b) -> b
F.& (Width
1, Width
1) Coords -> Plane -> Draw
% Plane
p