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)]
(***) :: 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
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 :: 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]]
cell :: Char -> Plane
cell :: Char -> Plane
cell Char
ch = Width -> Width -> Char -> Plane
box Width
1 Width
1 Char
ch
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 :: 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)
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
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)
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
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
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)
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