{-# LANGUAGE DeriveGeneric #-}

-------------------------------------------------------------------------------

-- Screen datatypes and functions

-- 2017 Francesco Ariis GPLv3

-------------------------------------------------------------------------------


-- a canvas where to draw our stuff


module Terminal.Game.Plane where

import Terminal.Game.Character

import qualified Data.Array          as A
import qualified Data.List.Split     as LS
import qualified Data.Tuple          as T
import qualified GHC.Generics        as G
import qualified System.Console.ANSI as CA


----------------

-- DATA TYPES --

----------------


-- | 'Row's and 'Column's are 1-based (top-left position is @1 1@).

type Coords = (Row, Column)
type Row    = Int
type Column = Int

-- | Size of a surface.

type Dimensions = (Width, Height)

-- | Expressed in 'Column's.

type Width  = Int
-- | Expressed in 'Row's.

type Height = Int

type Bold     = Bool
type Reversed = Bool

-- can be an ASCIIChar or a special, transparent character

data Cell = CellChar Char Bold
                     Reversed (Maybe (CA.Color, CA.ColorIntensity))
          | Transparent
          deriving (Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
(Int -> Cell -> ShowS)
-> (Cell -> String) -> ([Cell] -> ShowS) -> Show Cell
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cell] -> ShowS
$cshowList :: [Cell] -> ShowS
show :: Cell -> String
$cshow :: Cell -> String
showsPrec :: Int -> Cell -> ShowS
$cshowsPrec :: Int -> Cell -> ShowS
Show, Cell -> Cell -> Bool
(Cell -> Cell -> Bool) -> (Cell -> Cell -> Bool) -> Eq Cell
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cell -> Cell -> Bool
$c/= :: Cell -> Cell -> Bool
== :: Cell -> Cell -> Bool
$c== :: Cell -> Cell -> Bool
Eq, Eq Cell
Eq Cell
-> (Cell -> Cell -> Ordering)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Bool)
-> (Cell -> Cell -> Cell)
-> (Cell -> Cell -> Cell)
-> Ord Cell
Cell -> Cell -> Bool
Cell -> Cell -> Ordering
Cell -> Cell -> Cell
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Cell -> Cell -> Cell
$cmin :: Cell -> Cell -> Cell
max :: Cell -> Cell -> Cell
$cmax :: Cell -> Cell -> Cell
>= :: Cell -> Cell -> Bool
$c>= :: Cell -> Cell -> Bool
> :: Cell -> Cell -> Bool
$c> :: Cell -> Cell -> Bool
<= :: Cell -> Cell -> Bool
$c<= :: Cell -> Cell -> Bool
< :: Cell -> Cell -> Bool
$c< :: Cell -> Cell -> Bool
compare :: Cell -> Cell -> Ordering
$ccompare :: Cell -> Cell -> Ordering
$cp1Ord :: Eq Cell
Ord, (forall x. Cell -> Rep Cell x)
-> (forall x. Rep Cell x -> Cell) -> Generic Cell
forall x. Rep Cell x -> Cell
forall x. Cell -> Rep Cell x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cell x -> Cell
$cfrom :: forall x. Cell -> Rep Cell x
G.Generic)

-- | A two-dimensional surface (Row, Column) where to blit stuff.

newtype Plane = Plane { Plane -> Array Coords Cell
fromPlane :: A.Array Coords Cell }
              deriving (Int -> Plane -> ShowS
[Plane] -> ShowS
Plane -> String
(Int -> Plane -> ShowS)
-> (Plane -> String) -> ([Plane] -> ShowS) -> Show Plane
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Plane] -> ShowS
$cshowList :: [Plane] -> ShowS
show :: Plane -> String
$cshow :: Plane -> String
showsPrec :: Int -> Plane -> ShowS
$cshowsPrec :: Int -> Plane -> ShowS
Show, Plane -> Plane -> Bool
(Plane -> Plane -> Bool) -> (Plane -> Plane -> Bool) -> Eq Plane
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Plane -> Plane -> Bool
$c/= :: Plane -> Plane -> Bool
== :: Plane -> Plane -> Bool
$c== :: Plane -> Plane -> Bool
Eq, (forall x. Plane -> Rep Plane x)
-> (forall x. Rep Plane x -> Plane) -> Generic Plane
forall x. Rep Plane x -> Plane
forall x. Plane -> Rep Plane x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Plane x -> Plane
$cfrom :: forall x. Plane -> Rep Plane x
G.Generic)


----------

-- CREA --

----------


creaCell :: Char -> Cell
creaCell :: Char -> Cell
creaCell Char
ch = Char -> Bool -> Bool -> Maybe (Color, ColorIntensity) -> Cell
CellChar Char
chm Bool
False Bool
False Maybe (Color, ColorIntensity)
forall a. Maybe a
Nothing
    where
          chm :: Char
chm = Char -> Char
win32SafeChar Char
ch

colorCell :: CA.Color -> CA.ColorIntensity -> Cell -> Cell
colorCell :: Color -> ColorIntensity -> Cell -> Cell
colorCell Color
k ColorIntensity
i (CellChar Char
c Bool
b Bool
r Maybe (Color, ColorIntensity)
_) = Char -> Bool -> Bool -> Maybe (Color, ColorIntensity) -> Cell
CellChar Char
c Bool
b Bool
r ((Color, ColorIntensity) -> Maybe (Color, ColorIntensity)
forall a. a -> Maybe a
Just (Color
k, ColorIntensity
i))
colorCell Color
_ ColorIntensity
_ Cell
Transparent        = Cell
Transparent

boldCell :: Cell -> Cell
boldCell :: Cell -> Cell
boldCell (CellChar Char
c Bool
_ Bool
r Maybe (Color, ColorIntensity)
k) = Char -> Bool -> Bool -> Maybe (Color, ColorIntensity) -> Cell
CellChar Char
c Bool
True Bool
r Maybe (Color, ColorIntensity)
k
boldCell Cell
Transparent        = Cell
Transparent

reverseCell :: Cell -> Cell
reverseCell :: Cell -> Cell
reverseCell (CellChar Char
c Bool
b Bool
_ Maybe (Color, ColorIntensity)
k) = Char -> Bool -> Bool -> Maybe (Color, ColorIntensity) -> Cell
CellChar Char
c Bool
b Bool
True Maybe (Color, ColorIntensity)
k
reverseCell Cell
Transparent        = Cell
Transparent

-- | Creates 'Plane' from 'String', good way to import ASCII

-- art/diagrams.

stringPlane :: String -> Plane
stringPlane :: String -> Plane
stringPlane String
t = Maybe Char -> String -> Plane
stringPlaneGeneric Maybe Char
forall a. Maybe a
Nothing String
t

-- | Same as 'stringPlane', but with transparent 'Char'.

stringPlaneTrans :: Char -> String -> Plane
stringPlaneTrans :: Char -> String -> Plane
stringPlaneTrans Char
c String
t = Maybe Char -> String -> Plane
stringPlaneGeneric (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c) String
t

-- | Creates an empty, opaque 'Plane'.

blankPlane :: Width -> Height -> Plane
blankPlane :: Int -> Int -> Plane
blankPlane Int
w Int
h = Coords -> [Cell] -> Plane
listPlane (Int
h, Int
w) (Cell -> [Cell]
forall a. a -> [a]
repeat (Cell -> [Cell]) -> Cell -> [Cell]
forall a b. (a -> b) -> a -> b
$ Char -> Cell
creaCell Char
' ')

-- | Adds transparency to a plane, matching a given character

makeTransparent :: Char -> Plane -> Plane
makeTransparent :: Char -> Plane -> Plane
makeTransparent Char
tc Plane
p = (Cell -> Cell) -> Plane -> Plane
mapPlane Cell -> Cell
f Plane
p
    where
          f :: Cell -> Cell
f Cell
cl | Cell -> Char
cellChar Cell
cl Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
tc = Cell
Transparent
               | Bool
otherwise         = Cell
cl

-- | Changes every transparent cell in the 'Plane' to an opaque @' '@

-- character.

makeOpaque :: Plane -> Plane
makeOpaque :: Plane -> Plane
makeOpaque Plane
p = let (Int
w, Int
h) = Plane -> Coords
planeSize Plane
p
               in Plane -> Plane -> Coords -> Plane
pastePlane Plane
p (Int -> Int -> Plane
blankPlane Int
w Int
h) (Int
1, Int
1)



-----------

-- SLICE --

-----------


-- | Paste one plane over the other at a certain position (p1 gets over p2).

pastePlane :: Plane -> Plane -> Coords -> Plane
pastePlane :: Plane -> Plane -> Coords -> Plane
pastePlane Plane
p1 Plane
p2 (Int
r, Int
c) = Plane -> [(Coords, Cell)] -> Plane
updatePlane Plane
p2 [(Coords, Cell)]
filtered
    where
          cs :: [(Coords, Cell)]
cs        = Plane -> [(Coords, Cell)]
assocsPlane Plane
p1
          (Int
w2, Int
h2)  = Plane -> Coords
planeSize Plane
p2
          traslated :: [(Coords, Cell)]
traslated = ((Coords, Cell) -> (Coords, Cell))
-> [(Coords, Cell)] -> [(Coords, Cell)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((Int
r1, Int
c1), Cell
cl) -> ((Int
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), Cell
cl))
                           [(Coords, Cell)]
cs
          filtered :: [(Coords, Cell)]
filtered  = ((Coords, Cell) -> Bool) -> [(Coords, Cell)] -> [(Coords, Cell)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Coords, Cell)
x -> (Coords, Cell) -> Bool
forall b. (Coords, b) -> Bool
inside (Coords, Cell)
x Bool -> Bool -> Bool
&& (Coords, Cell) -> Bool
forall a. (a, Cell) -> Bool
solid (Coords, Cell)
x) [(Coords, Cell)]
traslated

          inside :: (Coords, b) -> Bool
inside ((Int
r1, Int
c1), b
_) | Int
r1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
r1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
h2 Bool -> Bool -> Bool
&&
                                 Int
c1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
c1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
w2    = Bool
True
                               | Bool
otherwise              = Bool
False

          solid :: (a, Cell) -> Bool
solid (a
_, Cell
Transparent) = Bool
False
          solid (a, Cell)
_                = Bool
True

-- | Cut out a plane by top-left and bottom-right coordinates.

subPlane :: Plane -> Coords -> Coords -> Plane
subPlane :: Plane -> Coords -> Coords -> Plane
subPlane Plane
p (Int
r1, Int
c1) (Int
r2, Int
c2)
        | Int
r1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
r2 Bool -> Bool -> Bool
|| Int
c1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
c2 = Coords -> Coords -> Plane
forall a a a. (Show a, Show a) => a -> a -> a
err (Int
r1, Int
c1) (Int
r2, Int
c2)
        | Bool
otherwise          =
            let cs :: [(Coords, Cell)]
cs       = Plane -> [(Coords, Cell)]
assocsPlane Plane
p
                fs :: [(Coords, Cell)]
fs       = ((Coords, Cell) -> Bool) -> [(Coords, Cell)] -> [(Coords, Cell)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Coords, Cell) -> Bool
forall b. (Coords, b) -> Bool
f [(Coords, Cell)]
cs
                (Int
pw, Int
ph) = Plane -> Coords
planeSize Plane
p
                (Int
w, Int
h)   = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
pw (Int
c2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
c1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1), Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
ph (Int
r2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
            in Coords -> [Cell] -> Plane
listPlane (Int
h, Int
w) (((Coords, Cell) -> Cell) -> [(Coords, Cell)] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map (Coords, Cell) -> Cell
forall a b. (a, b) -> b
snd [(Coords, Cell)]
fs)
    where
          f :: (Coords, b) -> Bool
f ((Int
rw, Int
cw), b
_) = Int
rw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
r1 Bool -> Bool -> Bool
&& Int
rw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
r2 Bool -> Bool -> Bool
&&
                            Int
cw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
c1 Bool -> Bool -> Bool
&& Int
cw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
c2

          err :: a -> a -> a
err a
p1 a
p2 = String -> a
forall a. HasCallStack => String -> a
error (String
"subPlane: top-left point " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
p1 String -> ShowS
forall a. [a] -> [a] -> [a]
++
                             String
" > bottom-right point " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
p2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".")

-------------

-- INQUIRE --

-------------


-- | Dimensions or a plane.

planeSize :: Plane -> Dimensions
planeSize :: Plane -> Coords
planeSize Plane
p = Coords -> Coords
forall a b. (a, b) -> (b, a)
T.swap (Coords -> Coords)
-> ((Coords, Coords) -> Coords) -> (Coords, Coords) -> Coords
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coords, Coords) -> Coords
forall a b. (a, b) -> b
snd ((Coords, Coords) -> Coords) -> (Coords, Coords) -> Coords
forall a b. (a -> b) -> a -> b
$ Array Coords Cell -> (Coords, Coords)
forall i e. Array i e -> (i, i)
A.bounds (Plane -> Array Coords Cell
fromPlane Plane
p)

cellChar :: Cell -> Char
cellChar :: Cell -> Char
cellChar (CellChar Char
c Bool
_ Bool
_ Maybe (Color, ColorIntensity)
_) = Char
c
cellChar Cell
Transparent        = Char
' '

cellColor :: Cell -> Maybe (CA.Color, CA.ColorIntensity)
cellColor :: Cell -> Maybe (Color, ColorIntensity)
cellColor (CellChar Char
_ Bool
_ Bool
_ Maybe (Color, ColorIntensity)
k) = Maybe (Color, ColorIntensity)
k
cellColor Cell
Transparent        = Maybe (Color, ColorIntensity)
forall a. Maybe a
Nothing

isBold :: Cell -> Bool
isBold :: Cell -> Bool
isBold (CellChar Char
_ Bool
b Bool
_ Maybe (Color, ColorIntensity)
_) = Bool
b
isBold Cell
_                  = Bool
False

isReversed :: Cell -> Bool
isReversed :: Cell -> Bool
isReversed (CellChar Char
_ Bool
_ Bool
r Maybe (Color, ColorIntensity)
_) = Bool
r
isReversed Cell
_                  = Bool
False

assocsPlane :: Plane -> [(Coords, Cell)]
assocsPlane :: Plane -> [(Coords, Cell)]
assocsPlane Plane
p = Array Coords Cell -> [(Coords, Cell)]
forall i e. Ix i => Array i e -> [(i, e)]
A.assocs (Plane -> Array Coords Cell
fromPlane Plane
p)

-- | A String (@\n@ divided and ended) representing the 'Plane'. Useful

-- for debugging/testing purposes.

planePaper :: Plane -> String
planePaper :: Plane -> String
planePaper Plane
p = [String] -> String
unlines ([String] -> String)
-> (Array Coords Cell -> [String]) -> Array Coords Cell -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [String]
forall e. Int -> [e] -> [[e]]
LS.chunksOf Int
w (String -> [String])
-> (Array Coords Cell -> String) -> Array Coords Cell -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               (Cell -> Char) -> [Cell] -> String
forall a b. (a -> b) -> [a] -> [b]
map Cell -> Char
cellChar ([Cell] -> String)
-> (Array Coords Cell -> [Cell]) -> Array Coords Cell -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Coords Cell -> [Cell]
forall i e. Array i e -> [e]
A.elems (Array Coords Cell -> String) -> Array Coords Cell -> String
forall a b. (a -> b) -> a -> b
$ Plane -> Array Coords Cell
fromPlane Plane
p
    where
          w :: Int
          w :: Int
w = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (Plane -> Int) -> Plane -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coords -> Int
forall a b. (a, b) -> a
fst (Coords -> Int) -> (Plane -> Coords) -> Plane -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plane -> Coords
planeSize (Plane -> Int) -> Plane -> Int
forall a b. (a -> b) -> a -> b
$ Plane
p

-----------------

-- ANCILLARIES --

-----------------


-- faux map

mapPlane :: (Cell -> Cell) -> Plane -> Plane
mapPlane :: (Cell -> Cell) -> Plane -> Plane
mapPlane Cell -> Cell
f (Plane Array Coords Cell
a) = Array Coords Cell -> Plane
Plane (Array Coords Cell -> Plane) -> Array Coords Cell -> Plane
forall a b. (a -> b) -> a -> b
$ (Cell -> Cell) -> Array Coords Cell -> Array Coords Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cell -> Cell
f Array Coords Cell
a

-- Array.//

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

listPlane :: Coords -> [Cell] -> Plane
listPlane :: Coords -> [Cell] -> Plane
listPlane (Int
r, Int
c) [Cell]
cs = Array Coords Cell -> Plane
Plane (Array Coords Cell -> Plane) -> Array Coords Cell -> Plane
forall a b. (a -> b) -> a -> b
$ (Coords, Coords) -> [Cell] -> Array Coords Cell
forall i e. Ix i => (i, i) -> [e] -> Array i e
A.listArray ((Int
1,Int
1), (Int
r, Int
c)) [Cell]
cs

stringPlaneGeneric :: Maybe Char -> String -> Plane
stringPlaneGeneric :: Maybe Char -> String -> Plane
stringPlaneGeneric Maybe Char
mc String
t = Plane
vitrous
    where
          lined :: [String]
lined = String -> [String]
lines String
t

          h :: Int
          h :: Int
h = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
lined

          w :: Int
          w :: Int
w = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
lined)

          pad :: Int -> String -> String
          pad :: Int -> ShowS
pad Int
mw String
tl = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
mw (String
tl String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. a -> [a]
repeat Char
' ')

          padded :: [String]
          padded :: [String]
padded = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> ShowS
pad Int
w) [String]
lined

          celled :: [Cell]
          celled :: [Cell]
celled = (Char -> Cell) -> String -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Cell
creaCell (String -> [Cell]) -> ([String] -> String) -> [String] -> [Cell]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> [Cell]) -> [String] -> [Cell]
forall a b. (a -> b) -> a -> b
$ [String]
padded

          plane :: Plane
          plane :: Plane
plane = Coords -> [Cell] -> Plane
listPlane (Int
h, Int
w) [Cell]
celled

          vitrous :: Plane
          vitrous :: Plane
vitrous = case Maybe Char
mc of
                      Just Char
c  -> Char -> Plane -> Plane
makeTransparent Char
c Plane
plane
                      Maybe Char
Nothing -> Plane
plane