-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Grid
-- Copyright   :  (c) Tim Docker 2010, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
-- A container type for values that can be composed by horizonal
-- and vertical layout.

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)

-- | When more space is available for an item than the total width of items,
--   extra added space is proportional to 'space weight'.
type SpaceWeight = (Double,Double)

type Cell a      = (a,Span,SpaceWeight)

-- | Abstract datatype representing a grid.
data Grid a
    = Value (a,Span,SpaceWeight)       -- ^ A singleton grid item "a" spanning
                                       --   a given rectangle (measured in grid
                                       --   cells), with given space weight.
    | Above (Grid a) (Grid a) Size     -- ^ One grid above the other. "Size" is
                                       --   their cached total size (so it is
                                       --   NOT specified manually).
    | Beside (Grid a) (Grid a) Size    -- ^ One grid horizontally beside
                                       --   the other.
    | Overlay (Grid a) (Grid a) Size   -- ^ Two grids positioned one over
                                       --   the other.
    | Empty                            -- ^ An empty 1x1 grid cell.
    | Null                             -- ^ An empty 0x0 grid cell.
   deriving (Int -> Grid a -> ShowS
[Grid a] -> ShowS
Grid a -> String
(Int -> Grid a -> ShowS)
-> (Grid a -> String) -> ([Grid a] -> ShowS) -> Show (Grid a)
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 :: 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 :: 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

-- | A 1x1 grid from a given value, with no extra space.
tval :: a -> Grid a
tval :: a -> Grid a
tval a
a = (a, Span, SpaceWeight) -> Grid a
forall a. (a, Span, SpaceWeight) -> Grid a
Value (a
a,(Int
1,Int
1),(Double
0,Double
0))

-- | A WxH (measured in cells) grid from a given value, with space weight (1,1).
tspan :: a -> Span -> Grid a
tspan :: a -> Span -> Grid a
tspan a
a Span
spn = (a, Span, SpaceWeight) -> Grid a
forall a. (a, Span, SpaceWeight) -> Grid a
Value (a
a,Span
spn,(Double
1,Double
1))

-- | A 1x1 empty grid.
empty :: Grid a
empty :: Grid a
empty = Grid a
forall a. Grid a
Empty

-- | A 0x0 empty grid.
nullt :: Grid a
nullt :: Grid a
nullt = Grid a
forall a. Grid a
Null

above, beside :: Grid a -> Grid a -> Grid a
above :: 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  = Grid a -> Grid a -> Span -> Grid a
forall a. Grid a -> Grid a -> Span -> Grid a
Above Grid a
t1 Grid a
t2 Span
size
  where size :: Span
size = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Grid a -> Int
forall a. Grid a -> Int
width Grid a
t1) (Grid a -> Int
forall a. Grid a -> Int
width Grid a
t2), Grid a -> Int
forall a. Grid a -> Int
height Grid a
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Grid a -> Int
forall a. Grid a -> Int
height Grid a
t2)

-- | A value occupying 1 row with the same  horizontal span as the grid.
wideAbove :: a -> Grid a -> Grid a
wideAbove :: a -> Grid a -> Grid a
wideAbove a
a Grid a
g = SpaceWeight -> Grid a -> Grid a
forall a. SpaceWeight -> Grid a -> Grid a
weights (Double
0,Double
0) (a -> Span -> Grid a
forall a. a -> Span -> Grid a
tspan a
a (Grid a -> Int
forall a. Grid a -> Int
width Grid a
g,Int
1)) Grid a -> Grid a -> Grid a
forall a. Grid a -> Grid a -> Grid a
`above` Grid a
g

-- | A value placed below the grid, occupying 1 row with the same
--   horizontal span as the grid.
aboveWide :: Grid a -> a -> Grid a
aboveWide :: Grid a -> a -> Grid a
aboveWide Grid a
g a
a = Grid a
g Grid a -> Grid a -> Grid a
forall a. Grid a -> Grid a -> Grid a
`above` SpaceWeight -> Grid a -> Grid a
forall a. SpaceWeight -> Grid a -> Grid a
weights (Double
0,Double
0) (a -> Span -> Grid a
forall a. a -> Span -> Grid a
tspan a
a (Grid a -> Int
forall a. Grid a -> Int
width Grid a
g,Int
1))

-- | A value placed to the left of the grid, occupying 1 column with
--   the same vertical span as the grid.
tallBeside  :: a -> Grid a -> Grid a
tallBeside :: a -> Grid a -> Grid a
tallBeside  a
a Grid a
g = SpaceWeight -> Grid a -> Grid a
forall a. SpaceWeight -> Grid a -> Grid a
weights (Double
0,Double
0) (a -> Span -> Grid a
forall a. a -> Span -> Grid a
tspan a
a (Int
1,Grid a -> Int
forall a. Grid a -> Int
height Grid a
g)) Grid a -> Grid a -> Grid a
forall a. Grid a -> Grid a -> Grid a
`beside` Grid a
g

-- | A value placed to the right of the grid, occupying 1 column with
--   the same vertical span as the grid.
besideTall :: Grid a -> a -> Grid a
besideTall :: Grid a -> a -> Grid a
besideTall Grid a
g a
a = Grid a
g Grid a -> Grid a -> Grid a
forall a. Grid a -> Grid a -> Grid a
`beside` SpaceWeight -> Grid a -> Grid a
forall a. SpaceWeight -> Grid a -> Grid a
weights (Double
0,Double
0) (a -> Span -> Grid a
forall a. a -> Span -> Grid a
tspan a
a (Int
1,Grid a -> Int
forall a. Grid a -> Int
height Grid a
g))

-- | A value placed under a grid, with the same span as the grid.
fullOverlayUnder :: a -> Grid a -> Grid a
fullOverlayUnder :: a -> Grid a -> Grid a
fullOverlayUnder a
a Grid a
g = Grid a
g Grid a -> Grid a -> Grid a
forall a. Grid a -> Grid a -> Grid a
`overlay` a -> Span -> Grid a
forall a. a -> Span -> Grid a
tspan a
a (Grid a -> Int
forall a. Grid a -> Int
width Grid a
g,Grid a -> Int
forall a. Grid a -> Int
height Grid a
g)

-- | A value placed over a grid, with the same span as the grid.
fullOverlayOver :: a -> Grid a -> Grid a
fullOverlayOver :: a -> Grid a -> Grid a
fullOverlayOver  a
a Grid a
g = a -> Span -> Grid a
forall a. a -> Span -> Grid a
tspan a
a (Grid a -> Int
forall a. Grid a -> Int
width Grid a
g,Grid a -> Int
forall a. Grid a -> Int
height Grid a
g) Grid a -> Grid a -> Grid a
forall a. Grid a -> Grid a -> Grid a
`overlay` Grid a
g

beside :: 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  = Grid a -> Grid a -> Span -> Grid a
forall a. Grid a -> Grid a -> Span -> Grid a
Beside Grid a
t1 Grid a
t2 Span
size
  where size :: Span
size  = (Grid a -> Int
forall a. Grid a -> Int
width Grid a
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Grid a -> Int
forall a. Grid a -> Int
width Grid a
t2, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Grid a -> Int
forall a. Grid a -> Int
height Grid a
t1) (Grid a -> Int
forall a. Grid a -> Int
height Grid a
t2))

aboveN, besideN :: [Grid a] -> Grid a
aboveN :: [Grid a] -> Grid a
aboveN  = (Grid a -> Grid a -> Grid a) -> Grid a -> [Grid a] -> Grid a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Grid a -> Grid a -> Grid a
forall a. Grid a -> Grid a -> Grid a
above Grid a
forall a. Grid a
nullt
besideN :: [Grid a] -> Grid a
besideN = (Grid a -> Grid a -> Grid a) -> Grid a -> [Grid a] -> Grid a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Grid a -> Grid a -> Grid a
forall a. Grid a -> Grid a -> Grid a
beside Grid a
forall a. Grid a
nullt

-- | One grid over the other. The first argument is shallow, the second is deep.
overlay :: Grid a -> Grid a -> Grid a
overlay :: 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  = Grid a -> Grid a -> Span -> Grid a
forall a. Grid a -> Grid a -> Span -> Grid a
Overlay Grid a
t1 Grid a
t2 Span
size
  where size :: Span
size   = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Grid a -> Int
forall a. Grid a -> Int
width Grid a
t1) (Grid a -> Int
forall a. Grid a -> Int
width Grid a
t2), Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Grid a -> Int
forall a. Grid a -> Int
height Grid a
t1) (Grid a -> Int
forall a. Grid a -> Int
height Grid a
t2))

-- | A synonym for 'beside'.
(.|.) :: Grid a -> Grid a -> Grid a
.|. :: Grid a -> Grid a -> Grid a
(.|.) = Grid a -> Grid a -> Grid a
forall a. Grid a -> Grid a -> Grid a
beside

-- | A synonym for 'above'.
(./.) :: Grid a -> Grid a -> Grid a
./. :: Grid a -> Grid a -> Grid a
(./.) = Grid a -> Grid a -> Grid a
forall a. Grid a -> Grid a -> Grid a
above

-- | Sets the space weight of *every* cell of the grid to given value.
weights :: SpaceWeight -> Grid a -> Grid a
weights :: SpaceWeight -> Grid a -> Grid a
weights SpaceWeight
_  Grid a
Null               = Grid a
forall a. Grid a
Null
weights SpaceWeight
_  Grid a
Empty              = Grid a
forall a. Grid a
Empty
weights SpaceWeight
sw (Value (a
v,Span
sp,SpaceWeight
_))   = (a, Span, SpaceWeight) -> Grid a
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)   = Grid a -> Grid a -> Span -> Grid a
forall a. Grid a -> Grid a -> Span -> Grid a
Above   (SpaceWeight -> Grid a -> Grid a
forall a. SpaceWeight -> Grid a -> Grid a
weights SpaceWeight
sw Grid a
t1) (SpaceWeight -> Grid a -> Grid a
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)  = Grid a -> Grid a -> Span -> Grid a
forall a. Grid a -> Grid a -> Span -> Grid a
Beside  (SpaceWeight -> Grid a -> Grid a
forall a. SpaceWeight -> Grid a -> Grid a
weights SpaceWeight
sw Grid a
t1) (SpaceWeight -> Grid a -> Grid a
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) = Grid a -> Grid a -> Span -> Grid a
forall a. Grid a -> Grid a -> Span -> Grid a
Overlay (SpaceWeight -> Grid a -> Grid a
forall a. SpaceWeight -> Grid a -> Grid a
weights SpaceWeight
sw Grid a
t1) (SpaceWeight -> Grid a -> Grid a
forall a. SpaceWeight -> Grid a -> Grid a
weights SpaceWeight
sw Grid a
t2) Span
sz

-- fix me, need to make .|. and .||. higher precedence
-- than ./. and .//.

instance Functor Grid where
    fmap :: (a -> b) -> Grid a -> Grid b
fmap a -> b
f (Value (a
a,Span
spn,SpaceWeight
ew))  = (b, Span, SpaceWeight) -> Grid b
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)     = Grid b -> Grid b -> Span -> Grid b
forall a. Grid a -> Grid a -> Span -> Grid a
Above   ((a -> b) -> Grid a -> Grid b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Grid a
t1) ((a -> b) -> Grid a -> Grid b
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)    = Grid b -> Grid b -> Span -> Grid b
forall a. Grid a -> Grid a -> Span -> Grid a
Beside  ((a -> b) -> Grid a -> Grid b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Grid a
t1) ((a -> b) -> Grid a -> Grid b
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)   = Grid b -> Grid b -> Span -> Grid b
forall a. Grid a -> Grid a -> Span -> Grid a
Overlay ((a -> b) -> Grid a -> Grid b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Grid a
t1) ((a -> b) -> Grid a -> Grid b
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               = Grid b
forall a. Grid a
Empty
    fmap a -> b
_ Grid a
Null                = Grid b
forall a. Grid a
Null

mapGridM :: Monad m => (a -> m b) -> Grid a -> m (Grid b)
mapGridM :: (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
                                   Grid b -> m (Grid b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((b, Span, SpaceWeight) -> Grid b
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' <- (a -> m b) -> Grid a -> m (Grid b)
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' <- (a -> m b) -> Grid a -> m (Grid b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grid a -> m (Grid b)
mapGridM a -> m b
f Grid a
t2
                                   Grid b -> m (Grid b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Grid b -> Grid b -> Span -> Grid b
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' <- (a -> m b) -> Grid a -> m (Grid b)
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' <- (a -> m b) -> Grid a -> m (Grid b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grid a -> m (Grid b)
mapGridM a -> m b
f Grid a
t2
                                   Grid b -> m (Grid b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Grid b -> Grid b -> Span -> Grid b
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' <- (a -> m b) -> Grid a -> m (Grid b)
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' <- (a -> m b) -> Grid a -> m (Grid b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grid a -> m (Grid b)
mapGridM a -> m b
f Grid a
t2
                                   Grid b -> m (Grid b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Grid b -> Grid b -> Span -> Grid b
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              = Grid b -> m (Grid b)
forall (m :: * -> *) a. Monad m => a -> m a
return Grid b
forall a. Grid a
Empty
mapGridM a -> m b
_ Grid a
Null               = Grid b -> m (Grid b)
forall (m :: * -> *) a. Monad m => a -> m a
return Grid b
forall a. Grid a
Null

----------------------------------------------------------------------
type FlatGrid a = Array (Int,Int) [(a,Span,SpaceWeight)]

flatten :: Grid a -> FlatGrid a
flatten :: Grid a -> FlatGrid a
flatten Grid a
t = ([Cell a] -> Cell a -> [Cell a])
-> [Cell a] -> (Span, Span) -> [(Span, Cell a)] -> FlatGrid a
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray ((Cell a -> [Cell a] -> [Cell a]) -> [Cell a] -> Cell a -> [Cell a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] ((Int
0,Int
0), (Grid a -> Int
forall a. Grid a -> Int
width Grid a
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Grid a -> Int
forall a. Grid a -> Int
height Grid a
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
                       (Span -> Grid a -> [(Span, Cell a)] -> [(Span, Cell a)]
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 :: 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)FlatEl a -> [FlatEl a] -> [FlatEl a]
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]
f1([FlatEl a] -> [FlatEl a])
-> ([FlatEl a] -> [FlatEl a]) -> [FlatEl a] -> [FlatEl a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[FlatEl a] -> [FlatEl a]
f2) [FlatEl a]
els
  where
    f1 :: [FlatEl a] -> [FlatEl a]
f1 = Span -> Grid a -> [FlatEl a] -> [FlatEl a]
forall a. Span -> Grid a -> [FlatEl a] -> [FlatEl a]
flatten2 Span
i Grid a
t1
    f2 :: [FlatEl a] -> [FlatEl a]
f2 = Span -> Grid a -> [FlatEl a] -> [FlatEl a]
forall a. Span -> Grid a -> [FlatEl a] -> [FlatEl a]
flatten2 (Int
x,Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Grid a -> Int
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]
f1([FlatEl a] -> [FlatEl a])
-> ([FlatEl a] -> [FlatEl a]) -> [FlatEl a] -> [FlatEl a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[FlatEl a] -> [FlatEl a]
f2) [FlatEl a]
els
  where
    f1 :: [FlatEl a] -> [FlatEl a]
f1 = Span -> Grid a -> [FlatEl a] -> [FlatEl a]
forall a. Span -> Grid a -> [FlatEl a] -> [FlatEl a]
flatten2 Span
i Grid a
t1
    f2 :: [FlatEl a] -> [FlatEl a]
f2 = Span -> Grid a -> [FlatEl a] -> [FlatEl a]
forall a. Span -> Grid a -> [FlatEl a] -> [FlatEl a]
flatten2 (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Grid a -> Int
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]
f1([FlatEl a] -> [FlatEl a])
-> ([FlatEl a] -> [FlatEl a]) -> [FlatEl a] -> [FlatEl a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[FlatEl a] -> [FlatEl a]
f2) [FlatEl a]
els
  where
    f1 :: [FlatEl a] -> [FlatEl a]
f1 = Span -> Grid a -> [FlatEl a] -> [FlatEl a]
forall a. Span -> Grid a -> [FlatEl a] -> [FlatEl a]
flatten2 Span
i Grid a
t1
    f2 :: [FlatEl a] -> [FlatEl a]
f2 = Span -> Grid a -> [FlatEl a] -> [FlatEl a]
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 :: (Span -> Cell a -> r -> r) -> r -> FlatGrid a -> r
foldT Span -> Cell a -> r -> r
f r
iv FlatGrid a
ft = ((Span, [Cell a]) -> r -> r) -> r -> [(Span, [Cell a])] -> r
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Span, [Cell a]) -> r -> r
forall (t :: * -> *). Foldable t => (Span, t (Cell a)) -> r -> r
f' r
iv (FlatGrid a -> [(Span, [Cell a])]
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 = (Cell a -> r -> r) -> r -> t (Cell a) -> 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 :: Grid (Renderable a)
-> BackendProgram (DArray, DArray, DArray, DArray)
getSizes Grid (Renderable a)
t = do
    Grid SpaceWeight
szs <- (Renderable a -> ProgramT ChartBackendInstr Identity SpaceWeight)
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (Grid SpaceWeight)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Grid a -> m (Grid b)
mapGridM Renderable a -> ProgramT ChartBackendInstr Identity SpaceWeight
forall a.
Renderable a -> ProgramT ChartBackendInstr Identity SpaceWeight
minsize Grid (Renderable a)
t :: BackendProgram (Grid RectSize)
    let szs' :: FlatGrid SpaceWeight
szs'     = Grid SpaceWeight -> FlatGrid SpaceWeight
forall a. Grid a -> FlatGrid a
flatten Grid SpaceWeight
szs
    let widths :: DArray
widths   = (Double -> Double -> Double)
-> Double -> Span -> [(Int, Double)] -> DArray
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Int
0, Grid (Renderable a) -> Int
forall a. Grid a -> Int
width  Grid (Renderable a)
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                                   ((Span -> Cell SpaceWeight -> [(Int, Double)] -> [(Int, Double)])
-> [(Int, Double)] -> FlatGrid SpaceWeight -> [(Int, Double)]
forall a r. (Span -> Cell a -> r -> r) -> r -> FlatGrid a -> r
foldT ((Span -> SpaceWeight -> SpaceWeight -> (Int, Double))
-> (Span -> Int)
-> Span
-> Cell SpaceWeight
-> [(Int, Double)]
-> [(Int, Double)]
forall a t t t a t.
(Eq a, Num a) =>
(t -> t -> t -> a) -> (t -> a) -> t -> (t, t, t) -> [a] -> [a]
ef Span -> SpaceWeight -> SpaceWeight -> (Int, Double)
forall a b b b p. (a, b) -> (b, b) -> p -> (a, b)
wf  Span -> Int
forall a b. (a, b) -> a
fst) [] FlatGrid SpaceWeight
szs')
    let heights :: DArray
heights  = (Double -> Double -> Double)
-> Double -> Span -> [(Int, Double)] -> DArray
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Int
0, Grid (Renderable a) -> Int
forall a. Grid a -> Int
height Grid (Renderable a)
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                                   ((Span -> Cell SpaceWeight -> [(Int, Double)] -> [(Int, Double)])
-> [(Int, Double)] -> FlatGrid SpaceWeight -> [(Int, Double)]
forall a r. (Span -> Cell a -> r -> r) -> r -> FlatGrid a -> r
foldT ((Span -> SpaceWeight -> SpaceWeight -> (Int, Double))
-> (Span -> Int)
-> Span
-> Cell SpaceWeight
-> [(Int, Double)]
-> [(Int, Double)]
forall a t t t a t.
(Eq a, Num a) =>
(t -> t -> t -> a) -> (t -> a) -> t -> (t, t, t) -> [a] -> [a]
ef Span -> SpaceWeight -> SpaceWeight -> (Int, Double)
forall a a a b p. (a, a) -> (a, b) -> p -> (a, b)
hf  Span -> Int
forall a b. (a, b) -> b
snd) [] FlatGrid SpaceWeight
szs')
    let xweights :: DArray
xweights = (Double -> Double -> Double)
-> Double -> Span -> [(Int, Double)] -> DArray
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Int
0, Grid (Renderable a) -> Int
forall a. Grid a -> Int
width  Grid (Renderable a)
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                                   ((Span -> Cell SpaceWeight -> [(Int, Double)] -> [(Int, Double)])
-> [(Int, Double)] -> FlatGrid SpaceWeight -> [(Int, Double)]
forall a r. (Span -> Cell a -> r -> r) -> r -> FlatGrid a -> r
foldT ((Span -> SpaceWeight -> SpaceWeight -> (Int, Double))
-> (Span -> Int)
-> Span
-> Cell SpaceWeight
-> [(Int, Double)]
-> [(Int, Double)]
forall a t t t a t.
(Eq a, Num a) =>
(t -> t -> t -> a) -> (t -> a) -> t -> (t, t, t) -> [a] -> [a]
ef Span -> SpaceWeight -> SpaceWeight -> (Int, Double)
forall a b p b b. (a, b) -> p -> (b, b) -> (a, b)
xwf Span -> Int
forall a b. (a, b) -> a
fst) [] FlatGrid SpaceWeight
szs')
    let yweights :: DArray
yweights = (Double -> Double -> Double)
-> Double -> Span -> [(Int, Double)] -> DArray
forall i e a.
Ix i =>
(e -> a -> e) -> e -> (i, i) -> [(i, a)] -> Array i e
accumArray Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Int
0, Grid (Renderable a) -> Int
forall a. Grid a -> Int
height Grid (Renderable a)
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                                   ((Span -> Cell SpaceWeight -> [(Int, Double)] -> [(Int, Double)])
-> [(Int, Double)] -> FlatGrid SpaceWeight -> [(Int, Double)]
forall a r. (Span -> Cell a -> r -> r) -> r -> FlatGrid a -> r
foldT ((Span -> SpaceWeight -> SpaceWeight -> (Int, Double))
-> (Span -> Int)
-> Span
-> Cell SpaceWeight
-> [(Int, Double)]
-> [(Int, Double)]
forall a t t t a t.
(Eq a, Num a) =>
(t -> t -> t -> a) -> (t -> a) -> t -> (t, t, t) -> [a] -> [a]
ef Span -> SpaceWeight -> SpaceWeight -> (Int, Double)
forall a a p a b. (a, a) -> p -> (a, b) -> (a, b)
ywf Span -> Int
forall a b. (a, b) -> b
snd) [] FlatGrid SpaceWeight
szs')
    (DArray, DArray, DArray, DArray)
-> BackendProgram (DArray, DArray, DArray, DArray)
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = t -> t -> t -> a
f t
loc t
size t
ewa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
r
                                  | Bool
otherwise    = [a]
r

instance (ToRenderable a) => ToRenderable (Grid a) where
  toRenderable :: Grid a -> Renderable ()
toRenderable = Grid (Renderable ()) -> Renderable ()
forall a. Grid (Renderable a) -> Renderable a
gridToRenderable (Grid (Renderable ()) -> Renderable ())
-> (Grid a -> Grid (Renderable ())) -> Grid a -> Renderable ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Renderable ()) -> Grid a -> Grid (Renderable ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Renderable ()
forall a. ToRenderable a => a -> Renderable ()
toRenderable

gridToRenderable :: Grid (Renderable a) -> Renderable a
gridToRenderable :: Grid (Renderable a) -> Renderable a
gridToRenderable Grid (Renderable a)
gt = ProgramT ChartBackendInstr Identity SpaceWeight
-> (SpaceWeight -> BackendProgram (PickFn a)) -> Renderable a
forall a.
ProgramT ChartBackendInstr Identity SpaceWeight
-> (SpaceWeight -> BackendProgram (PickFn a)) -> Renderable a
Renderable ProgramT ChartBackendInstr Identity SpaceWeight
minsizef SpaceWeight -> BackendProgram (PickFn a)
renderf
  where
    minsizef :: BackendProgram RectSize
    minsizef :: ProgramT ChartBackendInstr Identity SpaceWeight
minsizef = do
        (DArray
widths, DArray
heights, DArray
_, DArray
_) <- Grid (Renderable a)
-> BackendProgram (DArray, DArray, DArray, DArray)
forall a.
Grid (Renderable a)
-> BackendProgram (DArray, DArray, DArray, DArray)
getSizes Grid (Renderable a)
gt
        SpaceWeight -> ProgramT ChartBackendInstr Identity SpaceWeight
forall (m :: * -> *) a. Monad m => a -> m a
return ([Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (DArray -> [Double]
forall i e. Array i e -> [e]
elems DArray
widths), [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (DArray -> [Double]
forall i e. Array i e -> [e]
elems DArray
heights))

    renderf :: SpaceWeight -> BackendProgram (PickFn a)
renderf (Double
w,Double
h)  = do
        (DArray
widths, DArray
heights, DArray
xweights, DArray
yweights) <- Grid (Renderable a)
-> BackendProgram (DArray, DArray, DArray, DArray)
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')
        (DArray, DArray)
-> Span -> Grid (Renderable a) -> BackendProgram (PickFn a)
forall a.
(DArray, DArray)
-> Span
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (PickFn a)
rf1 (DArray, DArray)
borders (Int
0,Int
0) Grid (Renderable a)
gt

    -- (x borders, y borders) -> (x,y) -> grid -> drawing
    rf1 :: (DArray, DArray)
-> Span
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (PickFn 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  -> PickFn a -> ProgramT ChartBackendInstr Identity (PickFn a)
forall (m :: * -> *) a. Monad m => a -> m a
return PickFn a
forall a. PickFn a
nullPickFn
        Grid (Renderable a)
Empty -> PickFn a -> ProgramT ChartBackendInstr Identity (PickFn a)
forall (m :: * -> *) a. Monad m => a -> m a
return PickFn a
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
            Point
-> ProgramT ChartBackendInstr Identity (PickFn a)
-> ProgramT ChartBackendInstr Identity (PickFn a)
forall a. Point -> BackendProgram a -> BackendProgram a
withTranslation (Double -> Double -> Point
Point Double
x0 Double
y0) (ProgramT ChartBackendInstr Identity (PickFn a)
 -> ProgramT ChartBackendInstr Identity (PickFn a))
-> ProgramT ChartBackendInstr Identity (PickFn a)
-> ProgramT ChartBackendInstr Identity (PickFn a)
forall a b. (a -> b) -> a -> b
$ do
              PickFn a
pf <- Renderable a
-> SpaceWeight -> ProgramT ChartBackendInstr Identity (PickFn a)
forall a. Renderable a -> SpaceWeight -> BackendProgram (PickFn a)
render Renderable a
r (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x0,Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y0)
              PickFn a -> ProgramT ChartBackendInstr Identity (PickFn a)
forall (m :: * -> *) a. Monad m => a -> m a
return (PickFn a -> Double -> Double -> PickFn a
forall t. (Point -> t) -> Double -> Double -> Point -> t
newpf PickFn a
pf Double
x0 Double
y0)
        (Above Grid (Renderable a)
t1 Grid (Renderable a)
t2 Span
_) -> do
             PickFn a
pf1 <- (DArray, DArray)
-> Span
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (PickFn a)
rf1 (DArray, DArray)
borders (Int
i,Int
j) Grid (Renderable a)
t1
             PickFn a
pf2 <- (DArray, DArray)
-> Span
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (PickFn a)
rf1 (DArray, DArray)
borders (Int
i,Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Grid (Renderable a) -> Int
forall a. Grid a -> Int
height Grid (Renderable a)
t1) Grid (Renderable a)
t2
             let pf :: PickFn a
pf p :: Point
p@(Point Double
_ Double
y) = if Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< ((DArray, DArray) -> DArray
forall a b. (a, b) -> b
snd (DArray, DArray)
borders DArray -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
! (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Grid (Renderable a) -> Int
forall a. Grid a -> Int
height Grid (Renderable a)
t1))
                                    then PickFn a
pf1 Point
p else PickFn a
pf2 Point
p
             PickFn a -> ProgramT ChartBackendInstr Identity (PickFn a)
forall (m :: * -> *) a. Monad m => a -> m a
return PickFn a
pf
        (Beside Grid (Renderable a)
t1 Grid (Renderable a)
t2 Span
_) -> do
             PickFn a
pf1 <- (DArray, DArray)
-> Span
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (PickFn a)
rf1 (DArray, DArray)
borders (Int
i,Int
j) Grid (Renderable a)
t1
             PickFn a
pf2 <- (DArray, DArray)
-> Span
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (PickFn a)
rf1 (DArray, DArray)
borders (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Grid (Renderable a) -> Int
forall a. Grid a -> Int
width Grid (Renderable a)
t1,Int
j) Grid (Renderable a)
t2
             let pf :: PickFn a
pf p :: Point
p@(Point Double
x Double
_) = if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< ((DArray, DArray) -> DArray
forall a b. (a, b) -> a
fst (DArray, DArray)
borders DArray -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Grid (Renderable a) -> Int
forall a. Grid a -> Int
width Grid (Renderable a)
t1))
                                    then PickFn a
pf1 Point
p else PickFn a
pf2 Point
p
             PickFn a -> ProgramT ChartBackendInstr Identity (PickFn a)
forall (m :: * -> *) a. Monad m => a -> m a
return PickFn a
pf
        (Overlay Grid (Renderable a)
t1 Grid (Renderable a)
t2 Span
_) ->  do
             PickFn a
pf2 <- (DArray, DArray)
-> Span
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (PickFn a)
rf1 (DArray, DArray)
borders (Int
i,Int
j) Grid (Renderable a)
t2
             PickFn a
pf1 <- (DArray, DArray)
-> Span
-> Grid (Renderable a)
-> ProgramT ChartBackendInstr Identity (PickFn a)
rf1 (DArray, DArray)
borders (Int
i,Int
j) Grid (Renderable a)
t1
             let pf :: PickFn a
pf Point
p = PickFn a
pf1 Point
p Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` PickFn a
pf2 Point
p
             PickFn a -> ProgramT ChartBackendInstr Identity (PickFn a)
forall (m :: * -> *) a. Monad m => a -> m a
return PickFn 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
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x0) (Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y0))

    -- (x borders, y borders) -> (x,y) -> (w,h)
    --     -> rectangle of grid[x..x+w, y..y+h]
    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  DArray -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
! Int
x
        y1 :: Double
y1 = DArray
cheights DArray -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
! Int
y
        x2 :: Double
x2 = DArray
cwidths  DArray -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
! Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w) (Span -> Int
forall a b. (a, b) -> b
snd (Span -> Int) -> Span -> Int
forall a b. (a -> b) -> a -> b
$ DArray -> Span
forall i e. Array i e -> (i, i)
bounds DArray
cwidths)
        y2 :: Double
y2 = DArray
cheights DArray -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
! Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h) (Span -> Int
forall a b. (a, b) -> b
snd (Span -> Int) -> Span -> Int
forall a b. (a -> b) -> a -> b
$ DArray -> Span
forall i e. Array i e -> (i, i)
bounds DArray
cheights)
        -- mx = fst (bounds cwidths)
        -- my = fst (bounds cheights)

    -- total size -> item sizes -> item weights -> new item sizes such that
    -- their sum == total size, and added size is proportional to weight
    addExtraSpace :: Double -> DArray -> DArray -> DArray
    addExtraSpace :: Double -> DArray -> DArray -> DArray
addExtraSpace Double
size DArray
sizes DArray
weights' =
        if Double
totalws Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 then DArray
sizes
                        else Span -> [Double] -> DArray
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (DArray -> Span
forall i e. Array i e -> (i, i)
bounds DArray
sizes) [Double]
sizes'
      where
        ws :: [Double]
ws      = DArray -> [Double]
forall i e. Array i e -> [e]
elems DArray
weights'
        totalws :: Double
totalws = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
ws
        extra :: Double
extra   = Double
size Double -> Double -> Double
forall a. Num a => a -> a -> a
- [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (DArray -> [Double]
forall i e. Array i e -> [e]
elems DArray
sizes)
        extras :: [Double]
extras  = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Num a => a -> a -> a
*(Double
extraDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
totalws)) [Double]
ws
        sizes' :: [Double]
sizes'  = (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) [Double]
extras (DArray -> [Double]
forall i e. Array i e -> [e]
elems DArray
sizes)

    -- [1,2,3] -> [0,1,3,6].
    ctotal :: DArray -> DArray
    ctotal :: DArray -> DArray
ctotal DArray
a = Span -> [Double] -> DArray
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (let (Int
i,Int
j) = DArray -> Span
forall i e. Array i e -> (i, i)
bounds DArray
a in (Int
i,Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
                         ((Double -> Double -> Double) -> Double -> [Double] -> [Double]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) Double
0 (DArray -> [Double]
forall i e. Array i e -> [e]
elems DArray
a))