module Graphics.Rendering.Chart.Grid (
Grid, Span, SpaceWeight,
tval, tspan,
empty, nullt,
(.|.), (./.),
above, aboveN,
beside, besideN,
overlay,
width, height,
gridToRenderable,
weights,
aboveWide,
wideAbove,
tallBeside,
besideTall,
fullOverlayUnder,
fullOverlayOver
) where
import Data.Array
import Control.Monad
import Graphics.Rendering.Chart.Renderable
import Graphics.Rendering.Chart.Geometry hiding (x0, y0)
import Graphics.Rendering.Chart.Drawing
type Span = (Int,Int)
type Size = (Int,Int)
type SpaceWeight = (Double,Double)
type Cell a = (a,Span,SpaceWeight)
data Grid a
= Value (a,Span,SpaceWeight)
| Above (Grid a) (Grid a) Size
| Beside (Grid a) (Grid a) Size
| Overlay (Grid a) (Grid a) Size
| Empty
| Null
deriving (Int -> Grid a -> ShowS
forall a. Show a => Int -> Grid a -> ShowS
forall a. Show a => [Grid a] -> ShowS
forall a. Show a => Grid a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Grid a] -> ShowS
$cshowList :: forall a. Show a => [Grid a] -> ShowS
show :: Grid a -> String
$cshow :: forall a. Show a => Grid a -> String
showsPrec :: Int -> Grid a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Grid a -> ShowS
Show)
width :: Grid a -> Int
width :: forall a. Grid a -> Int
width Grid a
Null = Int
0
width Grid a
Empty = Int
1
width (Value (a, Span, SpaceWeight)
_) = Int
1
width (Beside Grid a
_ Grid a
_ (Int
w,Int
_)) = Int
w
width (Above Grid a
_ Grid a
_ (Int
w,Int
_)) = Int
w
width (Overlay Grid a
_ Grid a
_ (Int
w,Int
_)) = Int
w
height :: Grid a -> Int
height :: forall a. Grid a -> Int
height Grid a
Null = Int
0
height Grid a
Empty = Int
1
height (Value (a, Span, SpaceWeight)
_) = Int
1
height (Beside Grid a
_ Grid a
_ (Int
_,Int
h)) = Int
h
height (Above Grid a
_ Grid a
_ (Int
_,Int
h)) = Int
h
height (Overlay Grid a
_ Grid a
_ (Int
_,Int
h)) = Int
h
tval :: a -> Grid a
tval :: forall a. a -> Grid a
tval a
a = forall a. (a, Span, SpaceWeight) -> Grid a
Value (a
a,(Int
1,Int
1),(Double
0,Double
0))
tspan :: a -> Span -> Grid a
tspan :: forall a. a -> Span -> Grid a
tspan a
a Span
spn = forall a. (a, Span, SpaceWeight) -> Grid a
Value (a
a,Span
spn,(Double
1,Double
1))
empty :: Grid a
empty :: forall a. Grid a
empty = forall a. Grid a
Empty
nullt :: Grid a
nullt :: forall a. Grid a
nullt = forall a. Grid a
Null
above, beside :: Grid a -> Grid a -> Grid a
above :: forall a. Grid a -> Grid a -> Grid a
above Grid a
Null Grid a
t = Grid a
t
above Grid a
t Grid a
Null = Grid a
t
above Grid a
t1 Grid a
t2 = forall a. Grid a -> Grid a -> Span -> Grid a
Above Grid a
t1 Grid a
t2 Span
size
where size :: Span
size = (forall a. Ord a => a -> a -> a
max (forall a. Grid a -> Int
width Grid a
t1) (forall a. Grid a -> Int
width Grid a
t2), forall a. Grid a -> Int
height Grid a
t1 forall a. Num a => a -> a -> a
+ forall a. Grid a -> Int
height Grid a
t2)
wideAbove :: a -> Grid a -> Grid a
wideAbove :: forall a. a -> Grid a -> Grid a
wideAbove a
a Grid a
g = forall a. SpaceWeight -> Grid a -> Grid a
weights (Double
0,Double
0) (forall a. a -> Span -> Grid a
tspan a
a (forall a. Grid a -> Int
width Grid a
g,Int
1)) forall a. Grid a -> Grid a -> Grid a
`above` Grid a
g
aboveWide :: Grid a -> a -> Grid a
aboveWide :: forall a. Grid a -> a -> Grid a
aboveWide Grid a
g a
a = Grid a
g forall a. Grid a -> Grid a -> Grid a
`above` forall a. SpaceWeight -> Grid a -> Grid a
weights (Double
0,Double
0) (forall a. a -> Span -> Grid a
tspan a
a (forall a. Grid a -> Int
width Grid a
g,Int
1))
tallBeside :: a -> Grid a -> Grid a
tallBeside :: forall a. a -> Grid a -> Grid a
tallBeside a
a Grid a
g = forall a. SpaceWeight -> Grid a -> Grid a
weights (Double
0,Double
0) (forall a. a -> Span -> Grid a
tspan a
a (Int
1,forall a. Grid a -> Int
height Grid a
g)) forall a. Grid a -> Grid a -> Grid a
`beside` Grid a
g
besideTall :: Grid a -> a -> Grid a
besideTall :: forall a. Grid a -> a -> Grid a
besideTall Grid a
g a
a = Grid a
g forall a. Grid a -> Grid a -> Grid a
`beside` forall a. SpaceWeight -> Grid a -> Grid a
weights (Double
0,Double
0) (forall a. a -> Span -> Grid a
tspan a
a (Int
1,forall a. Grid a -> Int
height Grid a
g))
fullOverlayUnder :: a -> Grid a -> Grid a
fullOverlayUnder :: forall a. a -> Grid a -> Grid a
fullOverlayUnder a
a Grid a
g = Grid a
g forall a. Grid a -> Grid a -> Grid a
`overlay` forall a. a -> Span -> Grid a
tspan a
a (forall a. Grid a -> Int
width Grid a
g,forall a. Grid a -> Int
height Grid a
g)
fullOverlayOver :: a -> Grid a -> Grid a
fullOverlayOver :: forall a. a -> Grid a -> Grid a
fullOverlayOver a
a Grid a
g = forall a. a -> Span -> Grid a
tspan a
a (forall a. Grid a -> Int
width Grid a
g,forall a. Grid a -> Int
height Grid a
g) forall a. Grid a -> Grid a -> Grid a
`overlay` Grid a
g
beside :: forall a. Grid a -> Grid a -> Grid a
beside Grid a
Null Grid a
t = Grid a
t
beside Grid a
t Grid a
Null = Grid a
t
beside Grid a
t1 Grid a
t2 = forall a. Grid a -> Grid a -> Span -> Grid a
Beside Grid a
t1 Grid a
t2 Span
size
where size :: Span
size = (forall a. Grid a -> Int
width Grid a
t1 forall a. Num a => a -> a -> a
+ forall a. Grid a -> Int
width Grid a
t2, forall a. Ord a => a -> a -> a
max (forall a. Grid a -> Int
height Grid a
t1) (forall a. Grid a -> Int
height Grid a
t2))
aboveN, besideN :: [Grid a] -> Grid a
aboveN :: forall a. [Grid a] -> Grid a
aboveN = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Grid a -> Grid a -> Grid a
above forall a. Grid a
nullt
besideN :: forall a. [Grid a] -> Grid a
besideN = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Grid a -> Grid a -> Grid a
beside forall a. Grid a
nullt
overlay :: Grid a -> Grid a -> Grid a
overlay :: forall a. Grid a -> Grid a -> Grid a
overlay Grid a
Null Grid a
t = Grid a
t
overlay Grid a
t Grid a
Null = Grid a
t
overlay Grid a
t1 Grid a
t2 = forall a. Grid a -> Grid a -> Span -> Grid a
Overlay Grid a
t1 Grid a
t2 Span
size
where size :: Span
size = (forall a. Ord a => a -> a -> a
max (forall a. Grid a -> Int
width Grid a
t1) (forall a. Grid a -> Int
width Grid a
t2), forall a. Ord a => a -> a -> a
max (forall a. Grid a -> Int
height Grid a
t1) (forall a. Grid a -> Int
height Grid a
t2))
(.|.) :: Grid a -> Grid a -> Grid a
.|. :: forall a. Grid a -> Grid a -> Grid a
(.|.) = forall a. Grid a -> Grid a -> Grid a
beside
(./.) :: Grid a -> Grid a -> Grid a
./. :: forall a. Grid a -> Grid a -> Grid a
(./.) = forall a. Grid a -> Grid a -> Grid a
above
weights :: SpaceWeight -> Grid a -> Grid a
weights :: forall a. SpaceWeight -> Grid a -> Grid a
weights SpaceWeight
_ Grid a
Null = forall a. Grid a
Null
weights SpaceWeight
_ Grid a
Empty = forall a. Grid a
Empty
weights SpaceWeight
sw (Value (a
v,Span
sp,SpaceWeight
_)) = forall a. (a, Span, SpaceWeight) -> Grid a
Value (a
v,Span
sp,SpaceWeight
sw)
weights SpaceWeight
sw (Above Grid a
t1 Grid a
t2 Span
sz) = forall a. Grid a -> Grid a -> Span -> Grid a
Above (forall a. SpaceWeight -> Grid a -> Grid a
weights SpaceWeight
sw Grid a
t1) (forall a. SpaceWeight -> Grid a -> Grid a
weights SpaceWeight
sw Grid a
t2) Span
sz
weights SpaceWeight
sw (Beside Grid a
t1 Grid a
t2 Span
sz) = forall a. Grid a -> Grid a -> Span -> Grid a
Beside (forall a. SpaceWeight -> Grid a -> Grid a
weights SpaceWeight
sw Grid a
t1) (forall a. SpaceWeight -> Grid a -> Grid a
weights SpaceWeight
sw Grid a
t2) Span
sz
weights SpaceWeight
sw (Overlay Grid a
t1 Grid a
t2 Span
sz) = forall a. Grid a -> Grid a -> Span -> Grid a
Overlay (forall a. SpaceWeight -> Grid a -> Grid a
weights SpaceWeight
sw Grid a
t1) (forall a. SpaceWeight -> Grid a -> Grid a
weights SpaceWeight
sw Grid a
t2) Span
sz
instance Functor Grid where
fmap :: forall a b. (a -> b) -> Grid a -> Grid b
fmap a -> b
f (Value (a
a,Span
spn,SpaceWeight
ew)) = forall a. (a, Span, SpaceWeight) -> Grid a
Value (a -> b
f a
a,Span
spn,SpaceWeight
ew)
fmap a -> b
f (Above Grid a
t1 Grid a
t2 Span
s) = forall a. Grid a -> Grid a -> Span -> Grid a
Above (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Grid a
t1) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Grid a
t2) Span
s
fmap a -> b
f (Beside Grid a
t1 Grid a
t2 Span
s) = forall a. Grid a -> Grid a -> Span -> Grid a
Beside (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Grid a
t1) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Grid a
t2) Span
s
fmap a -> b
f (Overlay Grid a
t1 Grid a
t2 Span
s) = forall a. Grid a -> Grid a -> Span -> Grid a
Overlay (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Grid a
t1) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Grid a
t2) Span
s
fmap a -> b
_ Grid a
Empty = forall a. Grid a
Empty
fmap a -> b
_ Grid a
Null = forall a. Grid a
Null
mapGridM :: Monad m => (a -> m b) -> Grid a -> m (Grid b)
mapGridM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grid a -> m (Grid b)
mapGridM a -> m b
f (Value (a
a,Span
spn,SpaceWeight
ew)) = do b
b <- a -> m b
f a
a
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. (a, Span, SpaceWeight) -> Grid a
Value (b
b,Span
spn,SpaceWeight
ew))
mapGridM a -> m b
f (Above Grid a
t1 Grid a
t2 Span
s) = do Grid b
t1' <- forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grid a -> m (Grid b)
mapGridM a -> m b
f Grid a
t1
Grid b
t2' <- forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grid a -> m (Grid b)
mapGridM a -> m b
f Grid a
t2
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Grid a -> Grid a -> Span -> Grid a
Above Grid b
t1' Grid b
t2' Span
s)
mapGridM a -> m b
f (Beside Grid a
t1 Grid a
t2 Span
s) = do Grid b
t1' <- forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grid a -> m (Grid b)
mapGridM a -> m b
f Grid a
t1
Grid b
t2' <- forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grid a -> m (Grid b)
mapGridM a -> m b
f Grid a
t2
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Grid a -> Grid a -> Span -> Grid a
Beside Grid b
t1' Grid b
t2' Span
s)
mapGridM a -> m b
f (Overlay Grid a
t1 Grid a
t2 Span
s) = do Grid b
t1' <- forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grid a -> m (Grid b)
mapGridM a -> m b
f Grid a
t1
Grid b
t2' <- forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grid a -> m (Grid b)
mapGridM a -> m b
f Grid a
t2
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Grid a -> Grid a -> Span -> Grid a
Overlay Grid b
t1' Grid b
t2' Span
s)
mapGridM a -> m b
_ Grid a
Empty = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Grid a
Empty
mapGridM a -> m b
_ Grid a
Null = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Grid a
Null
type FlatGrid a = Array (Int,Int) [(a,Span,SpaceWeight)]
flatten :: Grid a -> FlatGrid a
flatten :: forall a. Grid a -> FlatGrid a
flatten Grid a
t = forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray (forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] ((Int
0,Int
0), (forall a. Grid a -> Int
width Grid a
t forall a. Num a => a -> a -> a
- Int
1, forall a. Grid a -> Int
height Grid a
t forall a. Num a => a -> a -> a
- Int
1))
(forall a. Span -> Grid a -> [FlatEl a] -> [FlatEl a]
flatten2 (Int
0,Int
0) Grid a
t [])
type FlatEl a = ((Int,Int),Cell a)
flatten2 :: (Int,Int) -> Grid a -> [FlatEl a] -> [FlatEl a]
flatten2 :: forall a. Span -> Grid a -> [FlatEl a] -> [FlatEl a]
flatten2 Span
_ Grid a
Empty [FlatEl a]
els = [FlatEl a]
els
flatten2 Span
_ Grid a
Null [FlatEl a]
els = [FlatEl a]
els
flatten2 Span
i (Value (a, Span, SpaceWeight)
cell) [FlatEl a]
els = (Span
i,(a, Span, SpaceWeight)
cell)forall a. a -> [a] -> [a]
:[FlatEl a]
els
flatten2 i :: Span
i@(Int
x,Int
y) (Above Grid a
t1 Grid a
t2 Span
_) [FlatEl a]
els = ([FlatEl a] -> [FlatEl a]
f1forall b c a. (b -> c) -> (a -> b) -> a -> c
.[FlatEl a] -> [FlatEl a]
f2) [FlatEl a]
els
where
f1 :: [FlatEl a] -> [FlatEl a]
f1 = forall a. Span -> Grid a -> [FlatEl a] -> [FlatEl a]
flatten2 Span
i Grid a
t1
f2 :: [FlatEl a] -> [FlatEl a]
f2 = forall a. Span -> Grid a -> [FlatEl a] -> [FlatEl a]
flatten2 (Int
x,Int
y forall a. Num a => a -> a -> a
+ forall a. Grid a -> Int
height Grid a
t1) Grid a
t2
flatten2 i :: Span
i@(Int
x,Int
y) (Beside Grid a
t1 Grid a
t2 Span
_) [FlatEl a]
els = ([FlatEl a] -> [FlatEl a]
f1forall b c a. (b -> c) -> (a -> b) -> a -> c
.[FlatEl a] -> [FlatEl a]
f2) [FlatEl a]
els
where
f1 :: [FlatEl a] -> [FlatEl a]
f1 = forall a. Span -> Grid a -> [FlatEl a] -> [FlatEl a]
flatten2 Span
i Grid a
t1
f2 :: [FlatEl a] -> [FlatEl a]
f2 = forall a. Span -> Grid a -> [FlatEl a] -> [FlatEl a]
flatten2 (Int
x forall a. Num a => a -> a -> a
+ forall a. Grid a -> Int
width Grid a
t1, Int
y) Grid a
t2
flatten2 Span
i (Overlay Grid a
t1 Grid a
t2 Span
_) [FlatEl a]
els = ([FlatEl a] -> [FlatEl a]
f1forall b c a. (b -> c) -> (a -> b) -> a -> c
.[FlatEl a] -> [FlatEl a]
f2) [FlatEl a]
els
where
f1 :: [FlatEl a] -> [FlatEl a]
f1 = forall a. Span -> Grid a -> [FlatEl a] -> [FlatEl a]
flatten2 Span
i Grid a
t1
f2 :: [FlatEl a] -> [FlatEl a]
f2 = forall a. Span -> Grid a -> [FlatEl a] -> [FlatEl a]
flatten2 Span
i Grid a
t2
foldT :: ((Int,Int) -> Cell a -> r -> r) -> r -> FlatGrid a -> r
foldT :: forall a r. (Span -> Cell a -> r -> r) -> r -> FlatGrid a -> r
foldT Span -> Cell a -> r -> r
f r
iv FlatGrid a
ft = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {t :: * -> *}. Foldable t => (Span, t (Cell a)) -> r -> r
f' r
iv (forall i e. Ix i => Array i e -> [(i, e)]
assocs FlatGrid a
ft)
where
f' :: (Span, t (Cell a)) -> r -> r
f' (Span
i,t (Cell a)
vs) r
r = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Span -> Cell a -> r -> r
f Span
i) r
r t (Cell a)
vs
type DArray = Array Int Double
getSizes :: Grid (Renderable a) -> BackendProgram (DArray, DArray, DArray, DArray)
getSizes :: forall a.
Grid (Renderable a)
-> BackendProgram (DArray, DArray, DArray, DArray)
getSizes Grid (Renderable a)
t = do
Grid SpaceWeight
szs <- forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grid a -> m (Grid b)
mapGridM forall a. Renderable a -> BackendProgram SpaceWeight
minsize Grid (Renderable a)
t :: BackendProgram (Grid RectSize)
let szs' :: FlatGrid SpaceWeight
szs' = forall a. Grid a -> FlatGrid a
flatten Grid SpaceWeight
szs
let widths :: DArray
widths = forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray forall a. Ord a => a -> a -> a
max Double
0 (Int
0, forall a. Grid a -> Int
width Grid (Renderable a)
t forall a. Num a => a -> a -> a
- Int
1)
(forall a r. (Span -> Cell a -> r -> r) -> r -> FlatGrid a -> r
foldT (forall {a} {t} {t} {t} {a} {t}.
(Eq a, Num a) =>
(t -> t -> t -> a) -> (t -> a) -> t -> (t, t, t) -> [a] -> [a]
ef forall {a} {b} {b} {b} {p}. (a, b) -> (b, b) -> p -> (a, b)
wf forall a b. (a, b) -> a
fst) [] FlatGrid SpaceWeight
szs')
let heights :: DArray
heights = forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray forall a. Ord a => a -> a -> a
max Double
0 (Int
0, forall a. Grid a -> Int
height Grid (Renderable a)
t forall a. Num a => a -> a -> a
- Int
1)
(forall a r. (Span -> Cell a -> r -> r) -> r -> FlatGrid a -> r
foldT (forall {a} {t} {t} {t} {a} {t}.
(Eq a, Num a) =>
(t -> t -> t -> a) -> (t -> a) -> t -> (t, t, t) -> [a] -> [a]
ef forall {a} {a} {a} {b} {p}. (a, a) -> (a, b) -> p -> (a, b)
hf forall a b. (a, b) -> b
snd) [] FlatGrid SpaceWeight
szs')
let xweights :: DArray
xweights = forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray forall a. Ord a => a -> a -> a
max Double
0 (Int
0, forall a. Grid a -> Int
width Grid (Renderable a)
t forall a. Num a => a -> a -> a
- Int
1)
(forall a r. (Span -> Cell a -> r -> r) -> r -> FlatGrid a -> r
foldT (forall {a} {t} {t} {t} {a} {t}.
(Eq a, Num a) =>
(t -> t -> t -> a) -> (t -> a) -> t -> (t, t, t) -> [a] -> [a]
ef forall {a} {b} {p} {b} {b}. (a, b) -> p -> (b, b) -> (a, b)
xwf forall a b. (a, b) -> a
fst) [] FlatGrid SpaceWeight
szs')
let yweights :: DArray
yweights = forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray forall a. Ord a => a -> a -> a
max Double
0 (Int
0, forall a. Grid a -> Int
height Grid (Renderable a)
t forall a. Num a => a -> a -> a
- Int
1)
(forall a r. (Span -> Cell a -> r -> r) -> r -> FlatGrid a -> r
foldT (forall {a} {t} {t} {t} {a} {t}.
(Eq a, Num a) =>
(t -> t -> t -> a) -> (t -> a) -> t -> (t, t, t) -> [a] -> [a]
ef forall {a} {a} {p} {a} {b}. (a, a) -> p -> (a, b) -> (a, b)
ywf forall a b. (a, b) -> b
snd) [] FlatGrid SpaceWeight
szs')
forall (m :: * -> *) a. Monad m => a -> m a
return (DArray
widths,DArray
heights,DArray
xweights,DArray
yweights)
where
wf :: (a, b) -> (b, b) -> p -> (a, b)
wf (a
x,b
_) (b
w,b
_) p
_ = (a
x,b
w)
hf :: (a, a) -> (a, b) -> p -> (a, b)
hf (a
_,a
y) (a
_,b
h) p
_ = (a
y,b
h)
xwf :: (a, b) -> p -> (b, b) -> (a, b)
xwf (a
x,b
_) p
_ (b
xw,b
_) = (a
x,b
xw)
ywf :: (a, a) -> p -> (a, b) -> (a, b)
ywf (a
_,a
y) p
_ (a
_,b
yw) = (a
y,b
yw)
ef :: (t -> t -> t -> a) -> (t -> a) -> t -> (t, t, t) -> [a] -> [a]
ef t -> t -> t -> a
f t -> a
ds t
loc (t
size,t
spn,t
ew) [a]
r | t -> a
ds t
spn forall a. Eq a => a -> a -> Bool
== a
1 = t -> t -> t -> a
f t
loc t
size t
ewforall a. a -> [a] -> [a]
:[a]
r
| Bool
otherwise = [a]
r
instance (ToRenderable a) => ToRenderable (Grid a) where
toRenderable :: Grid a -> Renderable ()
toRenderable = forall a. Grid (Renderable a) -> Renderable a
gridToRenderable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToRenderable a => a -> Renderable ()
toRenderable
gridToRenderable :: Grid (Renderable a) -> Renderable a
gridToRenderable :: forall a. Grid (Renderable a) -> Renderable a
gridToRenderable Grid (Renderable a)
gt = forall a.
BackendProgram SpaceWeight
-> (SpaceWeight -> BackendProgram (PickFn a)) -> Renderable a
Renderable BackendProgram SpaceWeight
minsizef SpaceWeight
-> ProgramT ChartBackendInstr Identity (Point -> Maybe a)
renderf
where
minsizef :: BackendProgram RectSize
minsizef :: BackendProgram SpaceWeight
minsizef = do
(DArray
widths, DArray
heights, DArray
_, DArray
_) <- forall a.
Grid (Renderable a)
-> BackendProgram (DArray, DArray, DArray, DArray)
getSizes Grid (Renderable a)
gt
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall i e. Array i e -> [e]
elems DArray
widths), forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall i e. Array i e -> [e]
elems DArray
heights))
renderf :: SpaceWeight
-> ProgramT ChartBackendInstr Identity (Point -> Maybe a)
renderf (Double
w,Double
h) = do
(DArray
widths, DArray
heights, DArray
xweights, DArray
yweights) <- forall a.
Grid (Renderable a)
-> BackendProgram (DArray, DArray, DArray, DArray)
getSizes Grid (Renderable a)
gt
let widths' :: DArray
widths' = Double -> DArray -> DArray -> DArray
addExtraSpace Double
w DArray
widths DArray
xweights
let heights' :: DArray
heights' = Double -> DArray -> DArray -> DArray
addExtraSpace Double
h DArray
heights DArray
yweights
let borders :: (DArray, DArray)
borders = (DArray -> DArray
ctotal DArray
widths',DArray -> DArray
ctotal DArray
heights')
forall {a}.
(DArray, DArray)
-> Span
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (Point -> Maybe a)
rf1 (DArray, DArray)
borders (Int
0,Int
0) Grid (Renderable a)
gt
rf1 :: (DArray, DArray)
-> Span
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (Point -> Maybe a)
rf1 (DArray, DArray)
borders loc :: Span
loc@(Int
i,Int
j) Grid (Renderable a)
t = case Grid (Renderable a)
t of
Grid (Renderable a)
Null -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. PickFn a
nullPickFn
Grid (Renderable a)
Empty -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. PickFn a
nullPickFn
(Value (Renderable a
r,Span
spn,SpaceWeight
_)) -> do
let (Rect Point
p0 Point
p1) = (DArray, DArray) -> Span -> Span -> Rect
mkRect (DArray, DArray)
borders Span
loc Span
spn
(Point Double
x0 Double
y0) <- Point -> BackendProgram Point
alignFillPoint Point
p0
(Point Double
x1 Double
y1) <- Point -> BackendProgram Point
alignFillPoint Point
p1
forall a. Point -> BackendProgram a -> BackendProgram a
withTranslation (Double -> Double -> Point
Point Double
x0 Double
y0) forall a b. (a -> b) -> a -> b
$ do
Point -> Maybe a
pf <- forall a. Renderable a -> SpaceWeight -> BackendProgram (PickFn a)
render Renderable a
r (Double
x1forall a. Num a => a -> a -> a
-Double
x0,Double
y1forall a. Num a => a -> a -> a
-Double
y0)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall {t}. (Point -> t) -> Double -> Double -> Point -> t
newpf Point -> Maybe a
pf Double
x0 Double
y0)
(Above Grid (Renderable a)
t1 Grid (Renderable a)
t2 Span
_) -> do
Point -> Maybe a
pf1 <- (DArray, DArray)
-> Span
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (Point -> Maybe a)
rf1 (DArray, DArray)
borders (Int
i,Int
j) Grid (Renderable a)
t1
Point -> Maybe a
pf2 <- (DArray, DArray)
-> Span
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (Point -> Maybe a)
rf1 (DArray, DArray)
borders (Int
i,Int
jforall a. Num a => a -> a -> a
+forall a. Grid a -> Int
height Grid (Renderable a)
t1) Grid (Renderable a)
t2
let pf :: Point -> Maybe a
pf p :: Point
p@(Point Double
_ Double
y) = if Double
y forall a. Ord a => a -> a -> Bool
< (forall a b. (a, b) -> b
snd (DArray, DArray)
borders forall i e. Ix i => Array i e -> i -> e
! (Int
j forall a. Num a => a -> a -> a
+ forall a. Grid a -> Int
height Grid (Renderable a)
t1))
then Point -> Maybe a
pf1 Point
p else Point -> Maybe a
pf2 Point
p
forall (m :: * -> *) a. Monad m => a -> m a
return Point -> Maybe a
pf
(Beside Grid (Renderable a)
t1 Grid (Renderable a)
t2 Span
_) -> do
Point -> Maybe a
pf1 <- (DArray, DArray)
-> Span
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (Point -> Maybe a)
rf1 (DArray, DArray)
borders (Int
i,Int
j) Grid (Renderable a)
t1
Point -> Maybe a
pf2 <- (DArray, DArray)
-> Span
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (Point -> Maybe a)
rf1 (DArray, DArray)
borders (Int
iforall a. Num a => a -> a -> a
+forall a. Grid a -> Int
width Grid (Renderable a)
t1,Int
j) Grid (Renderable a)
t2
let pf :: Point -> Maybe a
pf p :: Point
p@(Point Double
x Double
_) = if Double
x forall a. Ord a => a -> a -> Bool
< (forall a b. (a, b) -> a
fst (DArray, DArray)
borders forall i e. Ix i => Array i e -> i -> e
! (Int
i forall a. Num a => a -> a -> a
+ forall a. Grid a -> Int
width Grid (Renderable a)
t1))
then Point -> Maybe a
pf1 Point
p else Point -> Maybe a
pf2 Point
p
forall (m :: * -> *) a. Monad m => a -> m a
return Point -> Maybe a
pf
(Overlay Grid (Renderable a)
t1 Grid (Renderable a)
t2 Span
_) -> do
Point -> Maybe a
pf2 <- (DArray, DArray)
-> Span
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (Point -> Maybe a)
rf1 (DArray, DArray)
borders (Int
i,Int
j) Grid (Renderable a)
t2
Point -> Maybe a
pf1 <- (DArray, DArray)
-> Span
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (Point -> Maybe a)
rf1 (DArray, DArray)
borders (Int
i,Int
j) Grid (Renderable a)
t1
let pf :: Point -> Maybe a
pf Point
p = Point -> Maybe a
pf1 Point
p forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Point -> Maybe a
pf2 Point
p
forall (m :: * -> *) a. Monad m => a -> m a
return Point -> Maybe a
pf
newpf :: (Point -> t) -> Double -> Double -> Point -> t
newpf Point -> t
pf Double
x0 Double
y0 (Point Double
x1 Double
y1) = Point -> t
pf (Double -> Double -> Point
Point (Double
x1forall a. Num a => a -> a -> a
-Double
x0) (Double
y1forall a. Num a => a -> a -> a
-Double
y0))
mkRect :: (DArray, DArray) -> (Int,Int) -> (Int,Int) -> Rect
mkRect :: (DArray, DArray) -> Span -> Span -> Rect
mkRect (DArray
cwidths,DArray
cheights) (Int
x,Int
y) (Int
w,Int
h) = Point -> Point -> Rect
Rect (Double -> Double -> Point
Point Double
x1 Double
y1) (Double -> Double -> Point
Point Double
x2 Double
y2)
where
x1 :: Double
x1 = DArray
cwidths forall i e. Ix i => Array i e -> i -> e
! Int
x
y1 :: Double
y1 = DArray
cheights forall i e. Ix i => Array i e -> i -> e
! Int
y
x2 :: Double
x2 = DArray
cwidths forall i e. Ix i => Array i e -> i -> e
! forall a. Ord a => a -> a -> a
min (Int
xforall a. Num a => a -> a -> a
+Int
w) (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall i e. Array i e -> (i, i)
bounds DArray
cwidths)
y2 :: Double
y2 = DArray
cheights forall i e. Ix i => Array i e -> i -> e
! forall a. Ord a => a -> a -> a
min (Int
yforall a. Num a => a -> a -> a
+Int
h) (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall i e. Array i e -> (i, i)
bounds DArray
cheights)
addExtraSpace :: Double -> DArray -> DArray -> DArray
addExtraSpace :: Double -> DArray -> DArray -> DArray
addExtraSpace Double
size DArray
sizes DArray
weights' =
if Double
totalws forall a. Eq a => a -> a -> Bool
== Double
0 then DArray
sizes
else forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (forall i e. Array i e -> (i, i)
bounds DArray
sizes) [Double]
sizes'
where
ws :: [Double]
ws = forall i e. Array i e -> [e]
elems DArray
weights'
totalws :: Double
totalws = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
ws
extra :: Double
extra = Double
size forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall i e. Array i e -> [e]
elems DArray
sizes)
extras :: [Double]
extras = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
*(Double
extraforall a. Fractional a => a -> a -> a
/Double
totalws)) [Double]
ws
sizes' :: [Double]
sizes' = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(+) [Double]
extras (forall i e. Array i e -> [e]
elems DArray
sizes)
ctotal :: DArray -> DArray
ctotal :: DArray -> DArray
ctotal DArray
a = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (let (Int
i,Int
j) = forall i e. Array i e -> (i, i)
bounds DArray
a in (Int
i,Int
jforall a. Num a => a -> a -> a
+Int
1))
(forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) Double
0 (forall i e. Array i e -> [e]
elems DArray
a))