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
type Draw = Plane -> Plane
(%) :: 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 %
(#) :: Plane -> Draw -> Plane
Plane
p # :: Plane -> Draw -> Plane
# Draw
sf = Draw
sf Plane
p
infixl 8 #
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
(|||) :: 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)]
(===) :: 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)]
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
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 |||, ===
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
bold :: Plane -> Plane
bold :: Draw
bold Plane
p = (Cell -> Cell) -> Draw
mapPlane Cell -> Cell
boldCell Plane
p
invert :: Plane -> Plane
invert :: Draw
invert Plane
p = (Cell -> Cell) -> Draw
mapPlane Cell -> Cell
reverseCell Plane
p
box :: Char -> Width -> Height -> Plane
box :: Char -> Width -> Width -> Plane
box Char
chr Width
w Width
h = 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]]
cell :: Char -> Plane
cell :: Char -> Plane
cell Char
ch = Char -> Width -> Width -> Plane
box Char
ch Width
1 Width
1
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
textBox :: String -> Width -> Height -> Plane
textBox :: String -> Width -> Width -> Plane
textBox String
cs Width
w Width
h = let pt :: Plane
pt = String -> Width -> Plane
textBoxLiquid String
cs Width
w
in Width -> Width -> Plane
blankPlane Width
w Width
h Plane -> Draw -> Plane
forall a b. a -> (a -> b) -> b
F.& (Width
1, Width
1) Coords -> Plane -> Draw
% Plane
pt
textBoxLiquid :: String -> Width -> Plane
textBoxLiquid :: String -> Width -> Plane
textBoxLiquid String
cs Width
w = Plane
transparent
where
hyp :: Maybe a
hyp = Maybe a
forall a. Maybe a
Nothing
bf :: BreakFormat
bf = Int -> Int -> Char -> Maybe Hyphenator -> BreakFormat
BreakFormat (Width -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Width
w) Int
4 Char
'-' Maybe Hyphenator
forall a. Maybe a
hyp
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 :: Integer -> 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
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)