{-# LANGUAGE DeriveGeneric #-}

-------------------------------------------------------------------------------
-- Screen datatypes and functions
-- 2017 Francesco Ariis GPLv3
-------------------------------------------------------------------------------

-- a canvas where to draw our stuff

module Terminal.Game.Plane where

import qualified GHC.Generics as G
import qualified Data.Array as A
import qualified Data.Char as C
import qualified Data.List as L
import qualified Data.List.Split as LS
import qualified Data.Tuple as T


----------------
-- DATA TYPES --
----------------

type Width  = Integer
type Height = Integer
type Row    = Integer
type Column = Integer
type Coords = (Row, Column) -- row, column, from TL (TL = 1, 1)

-- can be an ASCIIChar or a special, transparent character
data Cell = CellChar Char
          | Transparent
          deriving (Show, Eq, Ord, G.Generic)

-- A place where to blit stuff. Coordinates starts from top left
-- corner (1, 1)
newtype Plane = Plane { fromPlane :: (A.Array Coords Cell) }
              deriving (Show, Eq, G.Generic)

----------
-- CREA --
----------

creaCell :: Char -> Cell
creaCell ch = CellChar ch

-- creates plane from a string, good to import ascii art/diagrams/etc.
-- Char indicates transparency, integer = pic width
stringPlane :: Maybe Char -> Integer -> String -> Plane
stringPlane mc w t = vitrous
    where
          lined = lines t

          h :: Integer
          h = L.genericLength lined

          pad :: Integer -> String -> String
          pad mw t = take (fromIntegral mw) (t ++ repeat ' ')

          padded :: [String]
          padded = map (pad w) lined

          celled :: [Cell]
          celled = map creaCell . concat $ padded

          plane :: Plane
          plane = Plane $ A.listArray ((1,1), (h, w)) celled

          vitrous :: Plane
          vitrous = case mc of
                      Just c  -> addVitrum c plane
                      Nothing -> plane


-- creates an empty, opaque Plane (limits: TL, BR)
blankPlane :: Width -> Height -> Plane
blankPlane w h = Plane $ A.listArray ((1,1), (h, w)) (repeat $ creaCell ' ')

-- add transparency to a plane, matching a given character
addVitrum :: Char -> Plane -> Plane
addVitrum tc p = mapPlane f p
    where
          f cl | cellChar cl == tc = Transparent
               | otherwise         = cl


-----------
-- SLICE --
-----------

-- copies a slice of the plane (bl, tr)
copyPlane :: Plane -> Coords -> Coords -> Plane
copyPlane p (r1, c1) (r2, c2) =
            Plane $ A.listArray ((1, 1), (w', h')) (map snd section)
    where
          inside ((r, c), _) | r >= r1 && r <= r2 &&
                               c >= c1 && c <= c2    = True
                             | otherwise             = False

          (w, h) = planeSize p

          w' = min w c2 - max c1 1 + 1
          h' = min h r2 - max r1 1 + 1

          section = filter inside (assocsPlane p)

-- paste one plane over the other at a certain position (p1 gets over p2).
-- Remember that coordinates start from bottom left!
-- Maybe char = possible transparency
pastePlane :: Plane -> Plane -> Coords -> Plane
pastePlane p1 p2 (r, c) = updatePlane p2 filtered
    where
          cs        = assocsPlane p1
          (w2, h2)  = planeSize p2
          traslated = fmap (\((r1, c1), cl) -> ((r1 + r - 1, c1 + c -1), cl))
                           cs
          filtered  = filter (\x -> inside x && solid x) traslated

          inside ((r1, c1), _) | r1 >= 1 && r1 <= h2 &&
                                 c1 >= 1 && c1 <= w2    = True
                               | otherwise              = False

          solid (_, Transparent) = False
          solid (_, otherwise)   = True


-------------
-- INQUIRE --
-------------

planeSize :: Plane -> (Width, Height)
planeSize p = T.swap . snd $ A.bounds (fromPlane p)

cellChar :: Cell -> Char
cellChar (CellChar ch) = ch
cellChar Transparent    = ' '

assocsPlane :: Plane -> [(Coords, Cell)]
assocsPlane p = A.assocs (fromPlane p)

-- an '\n' divided (and ended) String ready to be written on file
paperPlane :: Plane -> String
paperPlane p = unlines . LS.chunksOf w .
               map c2c . A.elems $ fromPlane p
    where
          w :: Int
          w = fromIntegral . fst . planeSize $ p

          c2c :: Cell -> Char
          c2c Transparent  = ' '
          c2c (CellChar c) = c


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

-- faux map
mapPlane :: (Cell -> Cell) -> Plane -> Plane
mapPlane f (Plane a) = Plane $ fmap f a

-- Array.//
updatePlane :: Plane -> [(Coords, Cell)] -> Plane
updatePlane (Plane a) kcs = Plane $ a A.// kcs