-----------------------------------------------------------------------------
-- |
-- 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
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

-- | A 1x1 grid from a given value, with no extra space.
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))

-- | A WxH (measured in cells) grid from a given value, with space weight (1,1).
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))

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

-- | A 0x0 empty grid.
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)

-- | A value occupying 1 row with the same  horizontal span as the grid.
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

-- | A value placed below the grid, occupying 1 row with the same
--   horizontal span as the grid.
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))

-- | 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 :: 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

-- | 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 :: 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))

-- | A value placed under a grid, with the same span as the grid.
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)

-- | A value placed over a grid, with the same span as the grid.
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

-- | One grid over the other. The first argument is shallow, the second is deep.
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))

-- | A synonym for 'beside'.
(.|.) :: Grid a -> Grid a -> Grid a
.|. :: forall 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
./. :: forall 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 :: 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

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

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

    -- (x borders, y borders) -> (x,y) -> grid -> drawing
    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))

    -- (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  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)
        -- 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 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)

    -- [1,2,3] -> [0,1,3,6].
    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))