{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}

{- |
Module      : Granite.Render.Terminal
Copyright   : (c) 2025
License     : MIT
Maintainer  : mschavinda@gmail.com

Terminal backend.
-}
module Granite.Render.Terminal (
    renderScene,
    Canvas (..),
    Array2D,
    newCanvas,
    setDotC,
    fillDotsC,
    lineDotsC,
    renderCanvas,
    toBit,
    getA2D,
    setA2D,
    newA2D,
) where

import Data.Bits ((.|.))
import Data.Char (chr)
import Data.List qualified as List
import Data.Maybe (isNothing)
import Data.Text (Text)
import Data.Text qualified as Text

import Granite.Color (Color, ansiOff, ansiOn, paint)
import Granite.Internal.Util (setAt, updateAt)
import Granite.Render.Scene (
    Mark (..),
    Point (..),
    Rect (..),
    Scene (..),
    Style (..),
    TextAnchor (..),
    TextStyle (..),
    pxPerChar,
    pxPerLine,
 )

renderScene :: Scene -> Text
renderScene :: Scene -> Text
renderScene Scene
scene =
    let wChars :: Int
wChars = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Scene -> Double
sceneWidth Scene
scene Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerChar))
        hChars :: Int
hChars = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Scene -> Double
sceneHeight Scene
scene Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerLine))
        grid0 :: [[(Char, Maybe Color)]]
grid0 = Int -> [(Char, Maybe Color)] -> [[(Char, Maybe Color)]]
forall a. Int -> a -> [a]
replicate Int
hChars (Int -> (Char, Maybe Color) -> [(Char, Maybe Color)]
forall a. Int -> a -> [a]
replicate Int
wChars (Char
' ', Maybe Color
forall a. Maybe a
Nothing :: Maybe Color))
        canvas0 :: Canvas
canvas0 = Int -> Int -> Canvas
newCanvas Int
wChars Int
hChars
        ([[(Char, Maybe Color)]]
grid1, Canvas
canvas1) = (([[(Char, Maybe Color)]], Canvas)
 -> Mark -> ([[(Char, Maybe Color)]], Canvas))
-> ([[(Char, Maybe Color)]], Canvas)
-> [Mark]
-> ([[(Char, Maybe Color)]], Canvas)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (Int
-> Int
-> ([[(Char, Maybe Color)]], Canvas)
-> Mark
-> ([[(Char, Maybe Color)]], Canvas)
drawMark Int
wChars Int
hChars) ([[(Char, Maybe Color)]]
grid0, Canvas
canvas0) (Scene -> [Mark]
sceneMarks Scene
scene)
        grid2 :: [[(Char, Maybe Color)]]
grid2 = [[(Char, Maybe Color)]] -> Canvas -> [[(Char, Maybe Color)]]
mergeCanvas [[(Char, Maybe Color)]]
grid1 Canvas
canvas1
     in [Text] -> Text
Text.unlines (([(Char, Maybe Color)] -> Text)
-> [[(Char, Maybe Color)]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [(Char, Maybe Color)] -> Text
renderRuns [[(Char, Maybe Color)]]
grid2)

mergeCanvas :: [[(Char, Maybe Color)]] -> Canvas -> [[(Char, Maybe Color)]]
mergeCanvas :: [[(Char, Maybe Color)]] -> Canvas -> [[(Char, Maybe Color)]]
mergeCanvas [[(Char, Maybe Color)]]
grid Canvas
canvas =
    [ ((Char, Maybe Color) -> Int -> (Char, Maybe Color))
-> [(Char, Maybe Color)] -> [Int] -> [(Char, Maybe Color)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Char, Maybe Color) -> Int -> (Char, Maybe Color)
merge [(Char, Maybe Color)]
row [Int
0 :: Int ..]
    | (Int
y, [(Char, Maybe Color)]
row) <- [Int] -> [[(Char, Maybe Color)]] -> [(Int, [(Char, Maybe Color)])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [[(Char, Maybe Color)]]
grid
    , let merge :: (Char, Maybe Color) -> Int -> (Char, Maybe Color)
merge (Char
ch, Maybe Color
mc) Int
x =
            case (Char
ch, Maybe Color
mc) of
                (Char
' ', Maybe Color
Nothing) ->
                    let bits :: Int
bits = Array2D Int -> Int -> Int -> Int
forall a. Array2D a -> Int -> Int -> a
getA2D (Canvas -> Array2D Int
buffer Canvas
canvas) Int
x Int
y
                        col :: Maybe Color
col = Array2D (Maybe Color) -> Int -> Int -> Maybe Color
forall a. Array2D a -> Int -> Int -> a
getA2D (Canvas -> Array2D (Maybe Color)
cbuf Canvas
canvas) Int
x Int
y
                        glyph :: Char
glyph = if Int
bits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Char
' ' else Int -> Char
chr (Int
0x2800 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bits)
                     in (Char
glyph, Maybe Color
col)
                (Char, Maybe Color)
_ -> (Char
ch, Maybe Color
mc)
    ]

drawMark ::
    Int ->
    Int ->
    ([[(Char, Maybe Color)]], Canvas) ->
    Mark ->
    ([[(Char, Maybe Color)]], Canvas)
drawMark :: Int
-> Int
-> ([[(Char, Maybe Color)]], Canvas)
-> Mark
-> ([[(Char, Maybe Color)]], Canvas)
drawMark Int
wChars Int
hChars ([[(Char, Maybe Color)]]
grid, Canvas
canvas) Mark
mark = case Mark
mark of
    MRect (Rect Double
x Double
y Double
w Double
h) Style
sty ->
        let col :: Maybe Color
col = Style -> Maybe Color
styleFill Style
sty
            cx0 :: Int
cx0 = Int -> Int -> Int -> Int
clampInt Int
0 (Int
wChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerChar))
            cy0 :: Int
cy0 = Int -> Int -> Int -> Int
clampInt Int
0 (Int
hChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
y Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerLine))
            cx1 :: Int
cx1 = Int -> Int -> Int -> Int
clampInt Int
0 (Int
wChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerChar))
            cy1 :: Int
cy1 = Int -> Int -> Int -> Int
clampInt Int
0 (Int
hChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerLine))
            grid' :: [[(Char, Maybe Color)]]
grid' =
                ([[(Char, Maybe Color)]] -> Int -> [[(Char, Maybe Color)]])
-> [[(Char, Maybe Color)]] -> [Int] -> [[(Char, Maybe Color)]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
                    ( \[[(Char, Maybe Color)]]
g Int
cy ->
                        ([[(Char, Maybe Color)]] -> Int -> [[(Char, Maybe Color)]])
-> [[(Char, Maybe Color)]] -> [Int] -> [[(Char, Maybe Color)]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
                            (\[[(Char, Maybe Color)]]
g' Int
cx -> [[(Char, Maybe Color)]]
-> Int -> Int -> (Char, Maybe Color) -> [[(Char, Maybe Color)]]
setCell [[(Char, Maybe Color)]]
g' Int
cx Int
cy (Char
'█', Maybe Color
col))
                            [[(Char, Maybe Color)]]
g
                            [Int
cx0 .. Int
cx1]
                    )
                    [[(Char, Maybe Color)]]
grid
                    [Int
cy0 .. Int
cy1]
         in ([[(Char, Maybe Color)]]
grid', Canvas
canvas)
    MText (Point Double
x Double
y) Text
txt TextStyle
ts ->
        let cy :: Int
cy = Int -> Int -> Int -> Int
clampInt Int
0 (Int
hChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
y Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerLine))
            width :: Int
width = Text -> Int
Text.length Text
txt
            startCol :: Int
startCol = case TextStyle -> TextAnchor
textAnchor TextStyle
ts of
                TextAnchor
AnchorStart -> Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerChar)
                TextAnchor
AnchorMiddle -> Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerChar) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
width Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
                TextAnchor
AnchorEnd -> Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerChar) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
width
            grid' :: [[(Char, Maybe Color)]]
grid' = [[(Char, Maybe Color)]]
-> Int -> Int -> Int -> String -> Color -> [[(Char, Maybe Color)]]
placeChars [[(Char, Maybe Color)]]
grid Int
wChars Int
cy Int
startCol (Text -> String
Text.unpack Text
txt) (TextStyle -> Color
textFill TextStyle
ts)
         in ([[(Char, Maybe Color)]]
grid', Canvas
canvas)
    MCircle (Point Double
x Double
y) Double
r Style
sty ->
        let col :: Maybe Color
col = Style -> Maybe Color
styleFill Style
sty
            xDotC :: Int
xDotC = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerChar)
            yDotC :: Int
yDotC = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
4 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerLine)
            rDotX :: Int
rDotX = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerChar))
            rDotY :: Int
rDotY = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
4 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerLine))
            canvas' :: Canvas
canvas' =
                (Int, Int)
-> (Int, Int)
-> (Int -> Int -> Bool)
-> Maybe Color
-> Canvas
-> Canvas
fillDotsC
                    (Int
xDotC Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rDotX, Int
yDotC Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rDotY)
                    (Int
xDotC Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rDotX, Int
yDotC Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rDotY)
                    ( \Int
dx Int
dy ->
                        let ddx :: Double
ddx = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
dx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xDotC) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rDotX :: Double
                            ddy :: Double
ddy = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
dy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
yDotC) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rDotY :: Double
                         in Double
ddx Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ddx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ddy Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ddy Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
1
                    )
                    Maybe Color
col
                    Canvas
canvas
         in ([[(Char, Maybe Color)]]
grid, Canvas
canvas')
    MPolyline [Point]
pts Style
sty ->
        let col :: Maybe Color
col = Style -> Maybe Color
styleFill Style
sty
            toDot :: Point -> (a, b)
toDot (Point Double
x Double
y) =
                ( Double -> a
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerChar)
                , Double -> b
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
4 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerLine)
                )
            dots :: [(Int, Int)]
dots = (Point -> (Int, Int)) -> [Point] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map Point -> (Int, Int)
forall {a} {b}. (Integral a, Integral b) => Point -> (a, b)
toDot [Point]
pts
            pairs :: [((Int, Int), (Int, Int))]
pairs = [(Int, Int)] -> [(Int, Int)] -> [((Int, Int), (Int, Int))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int, Int)]
dots (Int -> [(Int, Int)] -> [(Int, Int)]
forall a. Int -> [a] -> [a]
drop Int
1 [(Int, Int)]
dots)
            canvas' :: Canvas
canvas' =
                (Canvas -> ((Int, Int), (Int, Int)) -> Canvas)
-> Canvas -> [((Int, Int), (Int, Int))] -> Canvas
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
                    (\Canvas
c ((Int
x0, Int
y0), (Int
x1, Int
y1)) -> (Int, Int) -> (Int, Int) -> Maybe Color -> Canvas -> Canvas
lineDotsC (Int
x0, Int
y0) (Int
x1, Int
y1) Maybe Color
col Canvas
c)
                    Canvas
canvas
                    [((Int, Int), (Int, Int))]
pairs
         in ([[(Char, Maybe Color)]]
grid, Canvas
canvas')
    MPolygon [Point]
pts Style
sty ->
        let stroke :: Maybe Color
stroke = case Style -> Maybe Color
styleStroke Style
sty of
                Just Color
c -> Color -> Maybe Color
forall a. a -> Maybe a
Just Color
c
                Maybe Color
Nothing -> Style -> Maybe Color
styleFill Style
sty
            outline :: [Point]
outline =
                if [Point] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Point]
pts
                    then [Point]
pts
                    else [Point]
pts [Point] -> [Point] -> [Point]
forall a. Semigroup a => a -> a -> a
<> [[Point] -> Point
forall a. HasCallStack => [a] -> a
head [Point]
pts]
         in Int
-> Int
-> ([[(Char, Maybe Color)]], Canvas)
-> Mark
-> ([[(Char, Maybe Color)]], Canvas)
drawMark
                Int
wChars
                Int
hChars
                ([[(Char, Maybe Color)]]
grid, Canvas
canvas)
                ([Point] -> Style -> Mark
MPolyline [Point]
outline Style
sty{styleStroke = stroke})
    MAxisLine (Point Double
x1 Double
y1) (Point Double
x2 Double
y2) Style
sty ->
        let col :: Maybe Color
col = Style -> Maybe Color
styleStroke Style
sty
            grid' :: [[(Char, Maybe Color)]]
grid' = Int
-> Int
-> Double
-> Double
-> Double
-> Double
-> Maybe Color
-> [[(Char, Maybe Color)]]
-> [[(Char, Maybe Color)]]
drawAxisLine Int
wChars Int
hChars Double
x1 Double
y1 Double
x2 Double
y2 Maybe Color
col [[(Char, Maybe Color)]]
grid
         in ([[(Char, Maybe Color)]]
grid', Canvas
canvas)
    MArc (Point Double
cx Double
cy) Double
r Double
a0 Double
a1 Style
sty ->
        let nSeg :: Int
nSeg = Int
32 :: Int
            ang :: a -> Double
ang a
i = Double
a0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
a1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a0) Double -> Double -> Double
forall a. Num a => a -> a -> a
* a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nSeg
            pts :: [Point]
pts =
                [ Double -> Double -> Point
Point (Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos (Int -> Double
forall {a}. Integral a => a -> Double
ang Int
i)) (Double
cy Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin (Int -> Double
forall {a}. Integral a => a -> Double
ang Int
i))
                | Int
i <- [Int
0 .. Int
nSeg]
                ]
         in Int
-> Int
-> ([[(Char, Maybe Color)]], Canvas)
-> Mark
-> ([[(Char, Maybe Color)]], Canvas)
drawMark Int
wChars Int
hChars ([[(Char, Maybe Color)]]
grid, Canvas
canvas) ([Point] -> Style -> Mark
MPolyline [Point]
pts Style
sty)
    MPath Text
_ Style
_ -> ([[(Char, Maybe Color)]]
grid, Canvas
canvas)
    MGroup [Mark]
ms ->
        (([[(Char, Maybe Color)]], Canvas)
 -> Mark -> ([[(Char, Maybe Color)]], Canvas))
-> ([[(Char, Maybe Color)]], Canvas)
-> [Mark]
-> ([[(Char, Maybe Color)]], Canvas)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (Int
-> Int
-> ([[(Char, Maybe Color)]], Canvas)
-> Mark
-> ([[(Char, Maybe Color)]], Canvas)
drawMark Int
wChars Int
hChars) ([[(Char, Maybe Color)]]
grid, Canvas
canvas) [Mark]
ms

placeChars ::
    [[(Char, Maybe Color)]] ->
    Int ->
    Int ->
    Int ->
    String ->
    Color ->
    [[(Char, Maybe Color)]]
placeChars :: [[(Char, Maybe Color)]]
-> Int -> Int -> Int -> String -> Color -> [[(Char, Maybe Color)]]
placeChars [[(Char, Maybe Color)]]
grid Int
wChars Int
cy Int
startCol String
s Color
col
    | Int
cy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
cy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [[(Char, Maybe Color)]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[(Char, Maybe Color)]]
grid = [[(Char, Maybe Color)]]
grid
    | Bool
otherwise =
        let row0 :: [(Char, Maybe Color)]
row0 = [[(Char, Maybe Color)]]
grid [[(Char, Maybe Color)]] -> Int -> [(Char, Maybe Color)]
forall a. HasCallStack => [a] -> Int -> a
!! Int
cy
            row' :: [(Char, Maybe Color)]
row' = [(Char, Maybe Color)]
-> Int -> Int -> String -> [(Char, Maybe Color)]
forall {a}.
[(a, Maybe Color)] -> Int -> Int -> [a] -> [(a, Maybe Color)]
applyChars [(Char, Maybe Color)]
row0 Int
wChars Int
startCol String
s
         in [[(Char, Maybe Color)]]
-> Int -> [(Char, Maybe Color)] -> [[(Char, Maybe Color)]]
forall a. [a] -> Int -> a -> [a]
setAt [[(Char, Maybe Color)]]
grid Int
cy [(Char, Maybe Color)]
row'
  where
    applyChars :: [(a, Maybe Color)] -> Int -> Int -> [a] -> [(a, Maybe Color)]
applyChars [(a, Maybe Color)]
row Int
_ Int
_ [] = [(a, Maybe Color)]
row
    applyChars [(a, Maybe Color)]
row Int
w Int
c (a
ch : [a]
rest)
        | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w = [(a, Maybe Color)] -> Int -> Int -> [a] -> [(a, Maybe Color)]
applyChars [(a, Maybe Color)]
row Int
w (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
rest
        | Bool
otherwise =
            let row' :: [(a, Maybe Color)]
row' = [(a, Maybe Color)] -> Int -> (a, Maybe Color) -> [(a, Maybe Color)]
forall a. [a] -> Int -> a -> [a]
setAt [(a, Maybe Color)]
row Int
c (a
ch, Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col)
             in [(a, Maybe Color)] -> Int -> Int -> [a] -> [(a, Maybe Color)]
applyChars [(a, Maybe Color)]
row' Int
w (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
rest

setCell ::
    [[(Char, Maybe Color)]] ->
    Int ->
    Int ->
    (Char, Maybe Color) ->
    [[(Char, Maybe Color)]]
setCell :: [[(Char, Maybe Color)]]
-> Int -> Int -> (Char, Maybe Color) -> [[(Char, Maybe Color)]]
setCell [[(Char, Maybe Color)]]
grid Int
cx Int
cy (Char, Maybe Color)
cell =
    [[(Char, Maybe Color)]]
-> Int
-> ([(Char, Maybe Color)] -> [(Char, Maybe Color)])
-> [[(Char, Maybe Color)]]
forall a. [a] -> Int -> (a -> a) -> [a]
updateAt [[(Char, Maybe Color)]]
grid Int
cy (\[(Char, Maybe Color)]
row -> [(Char, Maybe Color)]
-> Int -> (Char, Maybe Color) -> [(Char, Maybe Color)]
forall a. [a] -> Int -> a -> [a]
setAt [(Char, Maybe Color)]
row Int
cx (Char, Maybe Color)
cell)

clampInt :: Int -> Int -> Int -> Int
clampInt :: Int -> Int -> Int -> Int
clampInt Int
low Int
high Int
x = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
low (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
high Int
x)

drawAxisLine ::
    Int ->
    Int ->
    Double ->
    Double ->
    Double ->
    Double ->
    Maybe Color ->
    [[(Char, Maybe Color)]] ->
    [[(Char, Maybe Color)]]
drawAxisLine :: Int
-> Int
-> Double
-> Double
-> Double
-> Double
-> Maybe Color
-> [[(Char, Maybe Color)]]
-> [[(Char, Maybe Color)]]
drawAxisLine Int
wChars Int
hChars Double
x1 Double
y1 Double
x2 Double
y2 Maybe Color
col [[(Char, Maybe Color)]]
grid
    | Double -> Double
forall a. Num a => a -> a
abs (Double
y2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y1) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1e-6 =
        let cy :: Int
cy = Int -> Int -> Int -> Int
clampInt Int
0 (Int
hChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
y1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerLine))
            cxL :: Int
cxL = Int -> Int -> Int -> Int
clampInt Int
0 (Int
wChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
x1 Double
x2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerChar))
            cxR :: Int
cxR = Int -> Int -> Int -> Int
clampInt Int
0 (Int
wChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
x1 Double
x2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerChar))
         in ([[(Char, Maybe Color)]] -> Int -> [[(Char, Maybe Color)]])
-> [[(Char, Maybe Color)]] -> [Int] -> [[(Char, Maybe Color)]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\[[(Char, Maybe Color)]]
g Int
cx -> [[(Char, Maybe Color)]]
-> Int -> Int -> Char -> Maybe Color -> [[(Char, Maybe Color)]]
writeAxisCell [[(Char, Maybe Color)]]
g Int
cx Int
cy Char
'─' Maybe Color
col) [[(Char, Maybe Color)]]
grid [Int
cxL .. Int
cxR]
    | Double -> Double
forall a. Num a => a -> a
abs (Double
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1e-6 =
        let cx :: Int
cx = Int -> Int -> Int -> Int
clampInt Int
0 (Int
wChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
x1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerChar))
            cyT :: Int
cyT = Int -> Int -> Int -> Int
clampInt Int
0 (Int
hChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
y1 Double
y2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerLine))
            cyB :: Int
cyB = Int -> Int -> Int -> Int
clampInt Int
0 (Int
hChars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
y1 Double
y2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
pxPerLine))
         in ([[(Char, Maybe Color)]] -> Int -> [[(Char, Maybe Color)]])
-> [[(Char, Maybe Color)]] -> [Int] -> [[(Char, Maybe Color)]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\[[(Char, Maybe Color)]]
g Int
cy -> [[(Char, Maybe Color)]]
-> Int -> Int -> Char -> Maybe Color -> [[(Char, Maybe Color)]]
writeAxisCell [[(Char, Maybe Color)]]
g Int
cx Int
cy Char
'│' Maybe Color
col) [[(Char, Maybe Color)]]
grid [Int
cyT .. Int
cyB]
    | Bool
otherwise = [[(Char, Maybe Color)]]
grid

writeAxisCell ::
    [[(Char, Maybe Color)]] ->
    Int ->
    Int ->
    Char ->
    Maybe Color ->
    [[(Char, Maybe Color)]]
writeAxisCell :: [[(Char, Maybe Color)]]
-> Int -> Int -> Char -> Maybe Color -> [[(Char, Maybe Color)]]
writeAxisCell [[(Char, Maybe Color)]]
grid Int
cx Int
cy Char
ch Maybe Color
col =
    let existing :: Char
existing = case [[(Char, Maybe Color)]]
grid [[(Char, Maybe Color)]] -> Int -> Maybe [(Char, Maybe Color)]
forall {a}. [a] -> Int -> Maybe a
`atRow` Int
cy Maybe [(Char, Maybe Color)]
-> ([(Char, Maybe Color)] -> Maybe (Char, Maybe Color))
-> Maybe (Char, Maybe Color)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([(Char, Maybe Color)] -> Int -> Maybe (Char, Maybe Color)
forall {a}. [a] -> Int -> Maybe a
`atCol` Int
cx) of
            Just (Char
c, Maybe Color
_) -> Char
c
            Maybe (Char, Maybe Color)
Nothing -> Char
' '
        finalCh :: Char
finalCh = Char -> Char -> Char
combineAxis Char
existing Char
ch
     in [[(Char, Maybe Color)]]
-> Int -> Int -> (Char, Maybe Color) -> [[(Char, Maybe Color)]]
setCell [[(Char, Maybe Color)]]
grid Int
cx Int
cy (Char
finalCh, Maybe Color
col)
  where
    atRow :: [a] -> Int -> Maybe a
atRow [a]
rs Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
rs = Maybe a
forall a. Maybe a
Nothing
        | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just ([a]
rs [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
i)
    atCol :: [a] -> Int -> Maybe a
atCol [a]
cs Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
cs = Maybe a
forall a. Maybe a
Nothing
        | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just ([a]
cs [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
i)

combineAxis :: Char -> Char -> Char
combineAxis :: Char -> Char -> Char
combineAxis Char
existing Char
new
    | Char
existing Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'│' Bool -> Bool -> Bool
&& Char
new Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'─' = Char
'┼'
    | Char
existing Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'─' Bool -> Bool -> Bool
&& Char
new Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'│' = Char
'┼'
    | Char
existing Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'┼' = Char
'┼'
    | Bool
otherwise = Char
new

renderRuns :: [(Char, Maybe Color)] -> Text
renderRuns :: [(Char, Maybe Color)] -> Text
renderRuns = [(Char, Maybe Color)] -> Text
go
  where
    go :: [(Char, Maybe Color)] -> Text
go [] = Text
Text.empty
    go xs :: [(Char, Maybe Color)]
xs@((Char
_, Maybe Color
Nothing) : [(Char, Maybe Color)]
_) =
        let ([(Char, Maybe Color)]
plain, [(Char, Maybe Color)]
rest) = ((Char, Maybe Color) -> Bool)
-> [(Char, Maybe Color)]
-> ([(Char, Maybe Color)], [(Char, Maybe Color)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\(Char
_, Maybe Color
mc) -> case Maybe Color
mc of Maybe Color
Nothing -> Bool
True; Maybe Color
_ -> Bool
False) [(Char, Maybe Color)]
xs
         in String -> Text
Text.pack (((Char, Maybe Color) -> Char) -> [(Char, Maybe Color)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char, Maybe Color) -> Char
forall a b. (a, b) -> a
fst [(Char, Maybe Color)]
plain) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Char, Maybe Color)] -> Text
go [(Char, Maybe Color)]
rest
    go ((Char
ch, Just Color
c) : [(Char, Maybe Color)]
rest) =
        let ([(Char, Maybe Color)]
run, [(Char, Maybe Color)]
after) =
                ((Char, Maybe Color) -> Bool)
-> [(Char, Maybe Color)]
-> ([(Char, Maybe Color)], [(Char, Maybe Color)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\(Char
_, Maybe Color
mc) -> Maybe Color
mc Maybe Color -> Maybe Color -> Bool
forall a. Eq a => a -> a -> Bool
== Color -> Maybe Color
forall a. a -> Maybe a
Just Color
c Bool -> Bool -> Bool
|| Maybe Color -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Color
mc) [(Char, Maybe Color)]
rest
            chunk :: String
chunk = Char
ch Char -> String -> String
forall a. a -> [a] -> [a]
: ((Char, Maybe Color) -> Char) -> [(Char, Maybe Color)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char, Maybe Color) -> Char
forall a b. (a, b) -> a
fst [(Char, Maybe Color)]
run
         in if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
chunk
                then String -> Text
Text.pack String
chunk Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Char, Maybe Color)] -> Text
go [(Char, Maybe Color)]
after
                else Color -> Text
ansiOn Color
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
chunk Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ansiOff Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Char, Maybe Color)] -> Text
go [(Char, Maybe Color)]
after

data Array2D a = A2D Int Int (Arr a)

getA2D :: Array2D a -> Int -> Int -> a
getA2D :: forall a. Array2D a -> Int -> Int -> a
getA2D (A2D Int
w Int
_ Arr a
xs) Int
x Int
y = Arr a -> Int -> a
forall a. Arr a -> Int -> a
indexA Arr a
xs (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)

setA2D :: Array2D a -> Int -> Int -> a -> Array2D a
setA2D :: forall a. Array2D a -> Int -> Int -> a -> Array2D a
setA2D (A2D Int
w Int
h Arr a
xs) Int
x Int
y a
v =
    let i :: Int
i = Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
     in Int -> Int -> Arr a -> Array2D a
forall a. Int -> Int -> Arr a -> Array2D a
A2D Int
w Int
h (Arr a -> Int -> a -> Arr a
forall a. Arr a -> Int -> a -> Arr a
setArr Arr a
xs Int
i a
v)

newA2D :: Int -> Int -> a -> Array2D a
newA2D :: forall a. Int -> Int -> a -> Array2D a
newA2D Int
w Int
h a
v = Int -> Int -> Arr a -> Array2D a
forall a. Int -> Int -> Arr a -> Array2D a
A2D Int
w Int
h ([a] -> Arr a
forall a. [a] -> Arr a
fromList (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h) a
v))

toBit :: Int -> Int -> Int
toBit :: Int -> Int -> Int
toBit Int
ry Int
rx = case (Int
ry, Int
rx) of
    (Int
0, Int
0) -> Int
1
    (Int
1, Int
0) -> Int
2
    (Int
2, Int
0) -> Int
4
    (Int
3, Int
0) -> Int
64
    (Int
0, Int
1) -> Int
8
    (Int
1, Int
1) -> Int
16
    (Int
2, Int
1) -> Int
32
    (Int
3, Int
1) -> Int
128
    (Int, Int)
_ -> Int
0

data Canvas = Canvas
    { Canvas -> Int
cW :: Int
    , Canvas -> Int
cH :: Int
    , Canvas -> Array2D Int
buffer :: Array2D Int
    , Canvas -> Array2D (Maybe Color)
cbuf :: Array2D (Maybe Color)
    }

newCanvas :: Int -> Int -> Canvas
newCanvas :: Int -> Int -> Canvas
newCanvas Int
w Int
h = Int -> Int -> Array2D Int -> Array2D (Maybe Color) -> Canvas
Canvas Int
w Int
h (Int -> Int -> Int -> Array2D Int
forall a. Int -> Int -> a -> Array2D a
newA2D Int
w Int
h Int
0) (Int -> Int -> Maybe Color -> Array2D (Maybe Color)
forall a. Int -> Int -> a -> Array2D a
newA2D Int
w Int
h Maybe Color
forall a. Maybe a
Nothing)

setDotC :: Canvas -> Int -> Int -> Maybe Color -> Canvas
setDotC :: Canvas -> Int -> Int -> Maybe Color -> Canvas
setDotC Canvas
c Int
xDot Int
yDot Maybe Color
mcol
    | Int
xDot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yDot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xDot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Canvas -> Int
cW Canvas
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Bool -> Bool -> Bool
|| Int
yDot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Canvas -> Int
cH Canvas
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 = Canvas
c
    | Bool
otherwise =
        let (Int
cx, Int
rx) = Int
xDot Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2
            (Int
cy, Int
ry) = Int
yDot Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
4
            b :: Int
b = Int -> Int -> Int
toBit Int
ry Int
rx
            m :: Int
m = Array2D Int -> Int -> Int -> Int
forall a. Array2D a -> Int -> Int -> a
getA2D (Canvas -> Array2D Int
buffer Canvas
c) Int
cx Int
cy
            c' :: Canvas
c' = Canvas
c{buffer = setA2D (buffer c) cx cy (m .|. b)}
         in case Maybe Color
mcol of
                Maybe Color
Nothing -> Canvas
c'
                Just Color
col -> Canvas
c'{cbuf = setA2D (cbuf c) cx cy (Just col)}

fillDotsC ::
    (Int, Int) ->
    (Int, Int) ->
    (Int -> Int -> Bool) ->
    Maybe Color ->
    Canvas ->
    Canvas
fillDotsC :: (Int, Int)
-> (Int, Int)
-> (Int -> Int -> Bool)
-> Maybe Color
-> Canvas
-> Canvas
fillDotsC (Int
x0, Int
y0) (Int
x1, Int
y1) Int -> Int -> Bool
p Maybe Color
mcol Canvas
c0 =
    let xs :: [Int]
xs = [Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
x0 .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Canvas -> Int
cW Canvas
c0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
x1]
        ys :: [Int]
ys = [Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
y0 .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Canvas -> Int
cH Canvas
c0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
y1]
     in (Canvas -> Int -> Canvas) -> Canvas -> [Int] -> Canvas
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
            (\Canvas
c Int
y -> (Canvas -> Int -> Canvas) -> Canvas -> [Int] -> Canvas
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Canvas
c' Int
x -> if Int -> Int -> Bool
p Int
x Int
y then Canvas -> Int -> Int -> Maybe Color -> Canvas
setDotC Canvas
c' Int
x Int
y Maybe Color
mcol else Canvas
c') Canvas
c [Int]
xs)
            Canvas
c0
            [Int]
ys

lineDotsC :: (Int, Int) -> (Int, Int) -> Maybe Color -> Canvas -> Canvas
lineDotsC :: (Int, Int) -> (Int, Int) -> Maybe Color -> Canvas -> Canvas
lineDotsC (Int
x0, Int
y0) (Int
x1, Int
y1) Maybe Color
mcol Canvas
c0 =
    let dx :: Int
dx = Int -> Int
forall a. Num a => a -> a
abs (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x0)
        sx :: Int
sx = if Int
x0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
x1 then Int
1 else -Int
1
        dy :: Int
dy = Int -> Int
forall a. Num a => a -> a
negate (Int -> Int
forall a. Num a => a -> a
abs (Int
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y0))
        sy :: Int
sy = if Int
y0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y1 then Int
1 else -Int
1
        go :: Int -> Int -> Int -> Canvas -> Canvas
go Int
x Int
y Int
err Canvas
c
            | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x1 Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y1 = Canvas -> Int -> Int -> Maybe Color -> Canvas
setDotC Canvas
c Int
x Int
y Maybe Color
mcol
            | Bool
otherwise =
                let e2 :: Int
e2 = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
err
                    (Int
x', Int
err') = if Int
e2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
dy then (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sx, Int
err Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dy) else (Int
x, Int
err)
                    (Int
y', Int
err'') = if Int
e2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dx then (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sy, Int
err' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dx) else (Int
y, Int
err')
                 in Int -> Int -> Int -> Canvas -> Canvas
go Int
x' Int
y' Int
err'' (Canvas -> Int -> Int -> Maybe Color -> Canvas
setDotC Canvas
c Int
x Int
y Maybe Color
mcol)
     in Int -> Int -> Int -> Canvas -> Canvas
go Int
x0 Int
y0 (Int
dx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dy) Canvas
c0

renderCanvas :: Canvas -> Text
renderCanvas :: Canvas -> Text
renderCanvas (Canvas Int
w Int
h Array2D Int
a Array2D (Maybe Color)
colA) =
    let glyph :: Int -> Char
glyph Int
0 = Char
' '
        glyph Int
m = Int -> Char
chr (Int
0x2800 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m)
        rows :: [[Text]]
rows =
            (Int -> [Text]) -> [Int] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                ( \Int
y -> ((Int -> Text) -> [Int] -> [Text])
-> [Int] -> (Int -> Text) -> [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int
0 .. Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> Text) -> [Text]) -> (Int -> Text) -> [Text]
forall a b. (a -> b) -> a -> b
$ \Int
x ->
                    let m :: Int
m = Array2D Int -> Int -> Int -> Int
forall a. Array2D a -> Int -> Int -> a
getA2D Array2D Int
a Int
x Int
y
                        ch :: Char
ch = Int -> Char
glyph Int
m
                        mc :: Maybe Color
mc = Array2D (Maybe Color) -> Int -> Int -> Maybe Color
forall a. Array2D a -> Int -> Int -> a
getA2D Array2D (Maybe Color)
colA Int
x Int
y
                     in Text -> (Color -> Text) -> Maybe Color -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Char -> Text
Text.singleton Char
ch) (Color -> Char -> Text
`paint` Char
ch) Maybe Color
mc
                )
                [Int
0 .. Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
     in [Text] -> Text
Text.unlines (([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
Text.concat [[Text]]
rows)

data Arr a
    = E
    | N Int Int (Arr a) a (Arr a)

sizeA :: Arr a -> Int
sizeA :: forall a. Arr a -> Int
sizeA Arr a
E = Int
0
sizeA (N Int
sz Int
_ Arr a
_ a
_ Arr a
_) = Int
sz

heightA :: Arr a -> Int
heightA :: forall a. Arr a -> Int
heightA Arr a
E = Int
0
heightA (N Int
_ Int
h Arr a
_ a
_ Arr a
_) = Int
h

mk :: Arr a -> a -> Arr a -> Arr a
mk :: forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
l a
x Arr a
r = Int -> Int -> Arr a -> a -> Arr a -> Arr a
forall a. Int -> Int -> Arr a -> a -> Arr a -> Arr a
N Int
sz Int
h Arr a
l a
x Arr a
r
  where
    sl :: Int
sl = Arr a -> Int
forall a. Arr a -> Int
sizeA Arr a
l
    sr :: Int
sr = Arr a -> Int
forall a. Arr a -> Int
sizeA Arr a
r
    hl :: Int
hl = Arr a -> Int
forall a. Arr a -> Int
heightA Arr a
l
    hr :: Int
hr = Arr a -> Int
forall a. Arr a -> Int
heightA Arr a
r
    sz :: Int
sz = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sr
    h :: Int
h = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
hl Int
hr

rotateL :: Arr a -> Arr a
rotateL :: forall a. Arr a -> Arr a
rotateL (N Int
_ Int
_ Arr a
l a
x (N Int
_ Int
_ Arr a
rl a
y Arr a
rr)) = Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk (Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
l a
x Arr a
rl) a
y Arr a
rr
rotateL Arr a
_ = String -> Arr a
forall a. HasCallStack => String -> a
error String
"rotateL: malformed tree"

rotateR :: Arr a -> Arr a
rotateR :: forall a. Arr a -> Arr a
rotateR (N Int
_ Int
_ (N Int
_ Int
_ Arr a
ll a
y Arr a
lr) a
x Arr a
r) = Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
ll a
y (Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
lr a
x Arr a
r)
rotateR Arr a
_ = String -> Arr a
forall a. HasCallStack => String -> a
error String
"rotateR: malformed tree"

balance :: Arr a -> Arr a
balance :: forall a. Arr a -> Arr a
balance t :: Arr a
t@(N Int
_ Int
_ Arr a
l a
x Arr a
r)
    | Arr a -> Int
forall a. Arr a -> Int
heightA Arr a
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Arr a -> Int
forall a. Arr a -> Int
heightA Arr a
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 =
        case Arr a
l of
            N Int
_ Int
_ Arr a
ll a
_ Arr a
lr ->
                if Arr a -> Int
forall a. Arr a -> Int
heightA Arr a
ll Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Arr a -> Int
forall a. Arr a -> Int
heightA Arr a
lr
                    then Arr a -> Arr a
forall a. Arr a -> Arr a
rotateR Arr a
t
                    else Arr a -> Arr a
forall a. Arr a -> Arr a
rotateR (Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk (Arr a -> Arr a
forall a. Arr a -> Arr a
rotateL Arr a
l) a
x Arr a
r)
            Arr a
_ -> Arr a
t
    | Arr a -> Int
forall a. Arr a -> Int
heightA Arr a
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Arr a -> Int
forall a. Arr a -> Int
heightA Arr a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 =
        case Arr a
r of
            N Int
_ Int
_ Arr a
rl a
_ Arr a
rr ->
                if Arr a -> Int
forall a. Arr a -> Int
heightA Arr a
rr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Arr a -> Int
forall a. Arr a -> Int
heightA Arr a
rl
                    then Arr a -> Arr a
forall a. Arr a -> Arr a
rotateL Arr a
t
                    else Arr a -> Arr a
forall a. Arr a -> Arr a
rotateL (Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
l a
x (Arr a -> Arr a
forall a. Arr a -> Arr a
rotateR Arr a
r))
            Arr a
_ -> Arr a
t
    | Bool
otherwise = Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
l a
x Arr a
r
balance Arr a
t = Arr a
t

indexA :: Arr a -> Int -> a
indexA :: forall a. Arr a -> Int -> a
indexA Arr a
t Int
i =
    case Arr a
t of
        Arr a
E -> String -> a
forall a. HasCallStack => String -> a
error (String
"index out of bounds: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)
        N Int
_ Int
_ Arr a
l a
x Arr a
r ->
            let sl :: Int
sl = Arr a -> Int
forall a. Arr a -> Int
sizeA Arr a
l
             in if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Arr a -> Int
forall a. Arr a -> Int
sizeA Arr a
r
                    then String -> a
forall a. HasCallStack => String -> a
error (String
"index out of bounds: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)
                    else
                        if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sl
                            then Arr a -> Int -> a
forall a. Arr a -> Int -> a
indexA Arr a
l Int
i
                            else
                                if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sl
                                    then a
x
                                    else Arr a -> Int -> a
forall a. Arr a -> Int -> a
indexA Arr a
r (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

setArr :: Arr a -> Int -> a -> Arr a
setArr :: forall a. Arr a -> Int -> a -> Arr a
setArr Arr a
t Int
i a
y =
    case Arr a
t of
        Arr a
E -> String -> Arr a
forall a. HasCallStack => String -> a
error (String
"index out of bounds when setting: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)
        N Int
_ Int
_ Arr a
l a
x Arr a
r ->
            let sl :: Int
sl = Arr a -> Int
forall a. Arr a -> Int
sizeA Arr a
l
             in if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Arr a -> Int
forall a. Arr a -> Int
sizeA Arr a
r
                    then String -> Arr a
forall a. HasCallStack => String -> a
error (String
"index out of bounds: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)
                    else
                        if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sl
                            then Arr a -> Arr a
forall a. Arr a -> Arr a
balance (Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk (Arr a -> Int -> a -> Arr a
forall a. Arr a -> Int -> a -> Arr a
setArr Arr a
l Int
i a
y) a
x Arr a
r)
                            else
                                if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sl
                                    then Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
l a
y Arr a
r
                                    else Arr a -> Arr a
forall a. Arr a -> Arr a
balance (Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
l a
x (Arr a -> Int -> a -> Arr a
forall a. Arr a -> Int -> a -> Arr a
setArr Arr a
r (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
y))

fromList :: [a] -> Arr a
fromList :: forall a. [a] -> Arr a
fromList [a]
xs = (Arr a, [a]) -> Arr a
forall a b. (a, b) -> a
fst (Int -> [a] -> (Arr a, [a])
forall a. Int -> [a] -> (Arr a, [a])
build ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) [a]
xs)
  where
    build :: Int -> [a] -> (Arr a, [a])
    build :: forall a. Int -> [a] -> (Arr a, [a])
build Int
0 [a]
ys = (Arr a
forall a. Arr a
E, [a]
ys)
    build Int
n [a]
ys =
        let (Arr a
l, [a]
ys1) = Int -> [a] -> (Arr a, [a])
forall a. Int -> [a] -> (Arr a, [a])
build (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [a]
ys
            (a
x, [a]
ys2) = case [a]
ys1 of
                [] -> String -> (a, [a])
forall a. HasCallStack => String -> a
error String
"IMPOSSIBLE"
                (a
v : [a]
vs) -> (a
v, [a]
vs)
            (Arr a
r, [a]
ys3) = Int -> [a] -> (Arr a, [a])
forall a. Int -> [a] -> (Arr a, [a])
build (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
ys2
         in (Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
l a
x Arr a
r, [a]
ys3)