module Terminal.Game.Draw (module Terminal.Game.Draw,
(F.&)
) where
import Terminal.Game.Plane
import Text.LineBreak
import qualified Data.Colour.RGBSpace as S
import qualified Data.Function as F ( (&) )
import qualified Data.List as L
import qualified Data.Word as W
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 b a. (b -> a -> b) -> b -> [a] -> b
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 (Column
wa, Column
ha) = Plane -> Coords
planeSize Plane
a
(Column
wb, Column
hb) = Plane -> Coords
planeSize Plane
b
in Plane -> [(Coords, Plane)] -> Plane
mergePlanes (Column -> Column -> Plane
blankPlane (Column
wa Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
wb) (Column -> Column -> Column
forall a. Ord a => a -> a -> a
max Column
ha Column
hb))
[((Column
1,Column
1), Plane
a),
((Column
1,Column
waColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
1), Plane
b)]
(===) :: Plane -> Plane -> Plane
=== :: Plane -> Draw
(===) Plane
a Plane
b = let (Column
wa, Column
ha) = Plane -> Coords
planeSize Plane
a
(Column
wb, Column
hb) = Plane -> Coords
planeSize Plane
b
in Plane -> [(Coords, Plane)] -> Plane
mergePlanes (Column -> Column -> Plane
blankPlane (Column -> Column -> Column
forall a. Ord a => a -> a -> a
max Column
wa Column
wb) (Column
ha Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
hb))
[((Column
1,Column
1), Plane
a),
((Column
haColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
1,Column
1), Plane
b)]
(***) :: Plane -> Plane -> Plane
*** :: Plane -> Draw
(***) Plane
a Plane
b = let (Column
aw, Column
ah) = Plane -> Coords
planeSize Plane
a
(Column
bw, Column
bh) = Plane -> Coords
planeSize Plane
b
r :: Column
r = Column -> Column -> Column
forall a. Integral a => a -> a -> a
quot (Column
ah Column -> Column -> Column
forall a. Num a => a -> a -> a
- Column
bh) Column
2 Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
1
c :: Column
c = Column -> Column -> Column
forall a. Integral a => a -> a -> a
quot (Column
aw Column -> Column -> Column
forall a. Num a => a -> a -> a
- Column
bw) Column
2 Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
1
in Plane
a Plane -> Draw -> Plane
forall a b. a -> (a -> b) -> b
F.&
(Column
r, Column
c) Coords -> Plane -> Draw
% Plane
b
hcat :: [Plane] -> Plane
hcat :: [Plane] -> Plane
hcat [] = Column -> Column -> Plane
blankPlane Column
1 Column
1 Plane -> Draw -> Plane
# Char -> Draw
makeTransparent Char
' '
hcat [Plane]
ps = (Plane -> Draw) -> [Plane] -> Plane
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
L.foldl1' Plane -> Draw
(|||) [Plane]
ps
vcat :: [Plane] -> Plane
vcat :: [Plane] -> Plane
vcat [] = Column -> Column -> Plane
blankPlane Column
1 Column
1 Plane -> Draw -> Plane
# Char -> Draw
makeTransparent Char
' '
vcat [Plane]
ps = (Plane -> Draw) -> [Plane] -> Plane
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
L.foldl1' Plane -> Draw
(===) [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
rgbColor :: S.Colour Float -> Plane -> Plane
rgbColor :: Colour Float -> Draw
rgbColor Colour Float
k Plane
p = (Cell -> Cell) -> Draw
mapPlane (Colour Float -> Cell -> Cell
rgbColorCell Colour Float
k) Plane
p
paletteColor :: W.Word8 -> Plane -> Plane
paletteColor :: Word8 -> Draw
paletteColor Word8
k Plane
p = (Cell -> Cell) -> Draw
mapPlane (Word8 -> Cell -> Cell
paletteColorCell Word8
k) Plane
p
box :: Width -> Height -> Char -> Plane
box :: Column -> Column -> Char -> Plane
box Column
w Column
h Char
chr = Column -> Column -> [(Coords, Char)] -> Plane
seqCellsDim Column
w Column
h [(Coords, Char)]
cells
where
cells :: [(Coords, Char)]
cells = [((Column
r, Column
c), Char
chr) | Column
r <- [Column
1..Column
h], Column
c <- [Column
1..Column
w]]
cell :: Char -> Plane
cell :: Char -> Plane
cell Char
ch = Column -> Column -> Char -> Plane
box Column
1 Column
1 Char
ch
word :: String -> Plane
word :: String -> Plane
word String
w = Column -> Column -> [(Coords, Char)] -> Plane
seqCellsDim (String -> Column
forall i a. Num i => [a] -> i
L.genericLength String
w) Column
1 [(Coords, Char)]
cells
where
cells :: [(Coords, Char)]
cells = [Coords] -> String -> [(Coords, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Column] -> [Column] -> [Coords]
forall a b. [a] -> [b] -> [(a, b)]
zip (Column -> [Column]
forall a. a -> [a]
repeat Column
1) [Column
1..]) String
w
textBox :: Width -> Height -> String -> Plane
textBox :: Column -> Column -> String -> Plane
textBox Column
w Column
h String
cs = Column -> Column -> Draw
frameTrans Column
w Column
h (Column -> String -> Plane
textBoxLiquid Column
w String
cs)
textBoxLiquid :: Width -> String -> Plane
textBoxLiquid :: Column -> String -> Plane
textBoxLiquid Column
w String
cs = Maybe Hyphenator -> Column -> String -> Plane
textBoxGeneralLiquid Maybe Hyphenator
forall a. Maybe a
Nothing Column
w String
cs
textBoxHyphen :: Hyphenator -> Width -> Height -> String -> Plane
textBoxHyphen :: Hyphenator -> Column -> Column -> String -> Plane
textBoxHyphen Hyphenator
hp Column
w Column
h String
cs = Column -> Column -> Draw
frameTrans Column
w Column
h (Hyphenator -> Column -> String -> Plane
textBoxHyphenLiquid Hyphenator
hp Column
w String
cs)
textBoxHyphenLiquid :: Hyphenator -> Width -> String -> Plane
textBoxHyphenLiquid :: Hyphenator -> Column -> String -> Plane
textBoxHyphenLiquid Hyphenator
h Column
w String
cs = Maybe Hyphenator -> Column -> String -> Plane
textBoxGeneralLiquid (Hyphenator -> Maybe Hyphenator
forall a. a -> Maybe a
Just Hyphenator
h) Column
w String
cs
textBoxGeneralLiquid :: Maybe Hyphenator -> Width -> String -> Plane
textBoxGeneralLiquid :: Maybe Hyphenator -> Column -> String -> Plane
textBoxGeneralLiquid Maybe Hyphenator
mh Column
w String
cs = Plane
transparent
where
bf :: BreakFormat
bf = Column -> Column -> Char -> Maybe Hyphenator -> BreakFormat
BreakFormat (Column -> Column
forall a b. (Integral a, Num b) => a -> b
fromIntegral Column
w) Column
4 Char
'-' Maybe Hyphenator
mh
hcs :: [String]
hcs = BreakFormat -> String -> [String]
breakStringLn BreakFormat
bf String
cs
h :: Column
h = [String] -> Column
forall i a. Num i => [a] -> i
L.genericLength [String]
hcs
f :: [String] -> [(Coords, Char)]
f :: [String] -> [(Coords, Char)]
f [String]
css = ((Column, String) -> [(Coords, Char)])
-> [(Column, String)] -> [(Coords, Char)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Column -> String -> [(Coords, Char)])
-> (Column, String) -> [(Coords, Char)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Column -> String -> [(Coords, Char)]
rf) ([Column] -> [String] -> [(Column, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Column
1..] [String]
css)
where rf :: Int -> String -> [(Coords, Char)]
rf :: Column -> String -> [(Coords, Char)]
rf Column
cr String
ln = [Coords] -> String -> [(Coords, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Column] -> [Column] -> [Coords]
forall a b. [a] -> [b] -> [(a, b)]
zip (Column -> [Column]
forall a. a -> [a]
repeat Column
cr) [Column
1..]) String
ln
out :: Plane
out = Column -> Column -> [(Coords, Char)] -> Plane
seqCellsDim Column
w Column
h ([String] -> [(Coords, Char)]
f [String]
hcs)
transparent :: Plane
transparent = Char -> Draw
makeTransparent Char
' ' Plane
out
recipCoords :: Coords -> Plane -> Plane -> Coords
recipCoords :: Coords -> Plane -> Plane -> Coords
recipCoords (Column
r, Column
c) Plane
p Plane
p1 =
let (Column
pw, Column
ph) = Plane -> Coords
planeSize Plane
p
(Column
p1w, Column
p1h) = Plane -> Coords
planeSize Plane
p1
r' :: Column
r' = Column
phColumn -> Column -> Column
forall a. Num a => a -> a -> a
-Column
p1hColumn -> Column -> Column
forall a. Num a => a -> a -> a
-Column
rColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
2
c' :: Column
c' = Column
pwColumn -> Column -> Column
forall a. Num a => a -> a -> a
-Column
p1wColumn -> Column -> Column
forall a. Num a => a -> a -> a
-Column
cColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
2
in (Column
r', Column
c')
(%^>) :: Coords -> Plane -> Draw
(Column
r, Column
c) %^> :: Coords -> Plane -> Draw
%^> Plane
p1 = \Plane
p ->
let (Column
_, Column
c') = Coords -> Plane -> Plane -> Coords
recipCoords (Column
r, Column
c) Plane
p Plane
p1
in Plane
p Plane -> Draw -> Plane
forall a b. a -> (a -> b) -> b
F.& (Column
r, Column
c') Coords -> Plane -> Draw
% Plane
p1
(%.<) :: Coords -> Plane -> Draw
(Column
r, Column
c) %.< :: Coords -> Plane -> Draw
%.< Plane
p1 = \Plane
p ->
let (Column
r', Column
_) = Coords -> Plane -> Plane -> Coords
recipCoords (Column
r, Column
c) Plane
p Plane
p1
in Plane
p Plane -> Draw -> Plane
forall a b. a -> (a -> b) -> b
F.& (Column
r', Column
c) Coords -> Plane -> Draw
% Plane
p1
(%.>) :: Coords -> Plane -> Draw
Coords
cs %.> :: Coords -> Plane -> Draw
%.> Plane
p1 = \Plane
p ->
let (Column
r', Column
c') = Coords -> Plane -> Plane -> Coords
recipCoords Coords
cs Plane
p Plane
p1
in Plane
p Plane -> Draw -> Plane
forall a b. a -> (a -> b) -> b
F.& (Column
r', Column
c') Coords -> Plane -> Draw
% Plane
p1
infixl 4 %^>
infixl 4 %.<
infixl 4 %.>
seqCellsDim :: Width -> Height -> [(Coords, Char)] -> Plane
seqCellsDim :: Column -> Column -> [(Coords, Char)] -> Plane
seqCellsDim Column
w Column
h [(Coords, Char)]
cells = Plane -> [(Coords, Char)] -> Plane
seqCells (Column -> Column -> Plane
blankPlane Column
w Column
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 :: Column -> Column -> Draw
frameTrans Column
w Column
h Plane
p = let bt :: Plane
bt = Char -> Draw
makeTransparent Char
' ' (Column -> Column -> Plane
blankPlane Column
w Column
h)
in Plane
bt Plane -> Draw -> Plane
forall a b. a -> (a -> b) -> b
F.& (Column
1, Column
1) Coords -> Plane -> Draw
% Plane
p