-------------------------------------------------------------------------------
-- 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
cds % p1 = \p2 -> pastePlane p1 p2 cds
infixl 4 %

-- | Apply style to plane, e.g.
--
-- > cell 'w' # bold
(#) :: Plane -> Draw -> Plane
p # sf = sf 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 p cps = L.foldl' addPlane p cps
    where
          addPlane :: Plane -> (Coords, Plane) -> Plane
          addPlane bp (cs, tp) = bp F.& cs % tp


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

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

-- | Apply bold style to 'Plane'.
bold :: Plane -> Plane
bold p = mapPlane boldCell p

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



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

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

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

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

-- xxx li vogliamo davvero transparent?
-- | A text-box. Assumes ' ' are transparent.
textBox :: String -> Width -> Height -> Plane
textBox cs w h = transparent
    where
          -- hypenathion
          hyp = Nothing -- Just english_GB
          bf  = BreakFormat (fromIntegral w) 4 '-' hyp
          hcs = breakStringLn bf (take (fromIntegral $ w*h) cs)

          f :: [String] -> [(Coords, Char)]
          f css = concatMap (uncurry rf) (zip [1..] css)
              where rf :: Integer -> String -> [(Coords, Char)]
                    rf cr ln = zip (zip (repeat cr) [1..]) ln

          out         = seqCellsDim w h (f hcs)
          transparent = makeTransparent ' ' out


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

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

seqCells :: Plane -> [(Coords, Char)] -> Plane
seqCells p cells = updatePlane p (map f cells)
    where
          f (cds, chr) = (cds, creaCell chr)