{-# Language DeriveFunctor, CPP #-}
module Csound.Typed.Gui.BoxModel(
    Rect(..), Offset(..), AbsScene(..), Scene(..),
    draw,
    hor, ver, sca, margin, padding, space, prim,
    appendContext, cascade, boundingRect, zeroRect
) where

import Control.Monad
import Control.Monad.Trans.State.Strict
import Data.Default

data Interval = Interval
    { Interval -> Int
start :: !Int
    , Interval -> Int
leng  :: !Int
    } deriving (Int -> Interval -> ShowS
[Interval] -> ShowS
Interval -> String
(Int -> Interval -> ShowS)
-> (Interval -> String) -> ([Interval] -> ShowS) -> Show Interval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Interval -> ShowS
showsPrec :: Int -> Interval -> ShowS
$cshow :: Interval -> String
show :: Interval -> String
$cshowList :: [Interval] -> ShowS
showList :: [Interval] -> ShowS
Show)

-- | A rectangle.
data Rect = Rect
    { Rect -> Int
px        :: !Int
    , Rect -> Int
py        :: !Int
    , Rect -> Int
width     :: !Int
    , Rect -> Int
height    :: !Int
    } deriving (Int -> Rect -> ShowS
[Rect] -> ShowS
Rect -> String
(Int -> Rect -> ShowS)
-> (Rect -> String) -> ([Rect] -> ShowS) -> Show Rect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rect -> ShowS
showsPrec :: Int -> Rect -> ShowS
$cshow :: Rect -> String
show :: Rect -> String
$cshowList :: [Rect] -> ShowS
showList :: [Rect] -> ShowS
Show)

fromRect :: Rect -> (Interval, Interval)
fromRect :: Rect -> (Interval, Interval)
fromRect Rect
r = (Int -> Int -> Interval
Interval (Rect -> Int
px Rect
r) (Rect -> Int
width Rect
r), Int -> Int -> Interval
Interval (Rect -> Int
py Rect
r) (Rect -> Int
height Rect
r))

toRect :: Interval -> Interval -> Rect
toRect :: Interval -> Interval -> Rect
toRect Interval
a Interval
b = Int -> Int -> Int -> Int -> Rect
Rect (Interval -> Int
start Interval
a) (Interval -> Int
start Interval
b) (Interval -> Int
leng Interval
a) (Interval -> Int
leng Interval
b)

data AbsScene ctx a
    = Elem !Rect !a
    | EmptyScene
    | Group ![AbsScene ctx a]
    | Ctx !Rect !ctx !(AbsScene ctx a)
    deriving (Int -> AbsScene ctx a -> ShowS
[AbsScene ctx a] -> ShowS
AbsScene ctx a -> String
(Int -> AbsScene ctx a -> ShowS)
-> (AbsScene ctx a -> String)
-> ([AbsScene ctx a] -> ShowS)
-> Show (AbsScene ctx a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ctx a. (Show a, Show ctx) => Int -> AbsScene ctx a -> ShowS
forall ctx a. (Show a, Show ctx) => [AbsScene ctx a] -> ShowS
forall ctx a. (Show a, Show ctx) => AbsScene ctx a -> String
$cshowsPrec :: forall ctx a. (Show a, Show ctx) => Int -> AbsScene ctx a -> ShowS
showsPrec :: Int -> AbsScene ctx a -> ShowS
$cshow :: forall ctx a. (Show a, Show ctx) => AbsScene ctx a -> String
show :: AbsScene ctx a -> String
$cshowList :: forall ctx a. (Show a, Show ctx) => [AbsScene ctx a] -> ShowS
showList :: [AbsScene ctx a] -> ShowS
Show)


#if MIN_VERSION_base(4,11,0)
instance Semigroup (AbsScene ctx a) where
    <> :: AbsScene ctx a -> AbsScene ctx a -> AbsScene ctx a
(<>) = AbsScene ctx a -> AbsScene ctx a -> AbsScene ctx a
forall ctx a. AbsScene ctx a -> AbsScene ctx a -> AbsScene ctx a
mappendAbsScene

instance Monoid (AbsScene ctx a) where
    mempty :: AbsScene ctx a
mempty  = AbsScene ctx a
forall ctx a. AbsScene ctx a
EmptyScene

#else

instance Monoid (AbsScene ctx a) where
    mempty  = EmptyScene
    mappend = mappendAbsScene

#endif

mappendAbsScene :: AbsScene ctx a -> AbsScene ctx a -> AbsScene ctx a
mappendAbsScene :: forall ctx a. AbsScene ctx a -> AbsScene ctx a -> AbsScene ctx a
mappendAbsScene AbsScene ctx a
a AbsScene ctx a
b = case (AbsScene ctx a
a, AbsScene ctx a
b) of
    (AbsScene ctx a
EmptyScene, AbsScene ctx a
_) -> AbsScene ctx a
b
    (AbsScene ctx a
_, AbsScene ctx a
EmptyScene) -> AbsScene ctx a
a
    (Elem Rect
_ a
_, Group [AbsScene ctx a]
bs) -> [AbsScene ctx a] -> AbsScene ctx a
forall ctx a. [AbsScene ctx a] -> AbsScene ctx a
Group (AbsScene ctx a
aAbsScene ctx a -> [AbsScene ctx a] -> [AbsScene ctx a]
forall a. a -> [a] -> [a]
:[AbsScene ctx a]
bs)
    (Group [AbsScene ctx a]
as, Elem Rect
_ a
_) -> [AbsScene ctx a] -> AbsScene ctx a
forall ctx a. [AbsScene ctx a] -> AbsScene ctx a
Group ([AbsScene ctx a]
as [AbsScene ctx a] -> [AbsScene ctx a] -> [AbsScene ctx a]
forall a. [a] -> [a] -> [a]
++ [AbsScene ctx a
b])
    (Group [AbsScene ctx a]
as, Group [AbsScene ctx a]
bs)   -> [AbsScene ctx a] -> AbsScene ctx a
forall ctx a. [AbsScene ctx a] -> AbsScene ctx a
Group ([AbsScene ctx a]
as [AbsScene ctx a] -> [AbsScene ctx a] -> [AbsScene ctx a]
forall a. [a] -> [a] -> [a]
++ [AbsScene ctx a]
bs)
    (AbsScene ctx a
_, AbsScene ctx a
_) -> [AbsScene ctx a] -> AbsScene ctx a
forall ctx a. [AbsScene ctx a] -> AbsScene ctx a
Group [AbsScene ctx a
a, AbsScene ctx a
b]

data Scene ctx a
    = Prim a
    | Space
    | Scale Double (Scene ctx a)
    | Hor Offset [Scene ctx a]
    | Ver Offset [Scene ctx a]
    | Context ctx (Scene ctx a)
    deriving (Int -> Scene ctx a -> ShowS
[Scene ctx a] -> ShowS
Scene ctx a -> String
(Int -> Scene ctx a -> ShowS)
-> (Scene ctx a -> String)
-> ([Scene ctx a] -> ShowS)
-> Show (Scene ctx a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ctx a. (Show a, Show ctx) => Int -> Scene ctx a -> ShowS
forall ctx a. (Show a, Show ctx) => [Scene ctx a] -> ShowS
forall ctx a. (Show a, Show ctx) => Scene ctx a -> String
$cshowsPrec :: forall ctx a. (Show a, Show ctx) => Int -> Scene ctx a -> ShowS
showsPrec :: Int -> Scene ctx a -> ShowS
$cshow :: forall ctx a. (Show a, Show ctx) => Scene ctx a -> String
show :: Scene ctx a -> String
$cshowList :: forall ctx a. (Show a, Show ctx) => [Scene ctx a] -> ShowS
showList :: [Scene ctx a] -> ShowS
Show, (forall a b. (a -> b) -> Scene ctx a -> Scene ctx b)
-> (forall a b. a -> Scene ctx b -> Scene ctx a)
-> Functor (Scene ctx)
forall a b. a -> Scene ctx b -> Scene ctx a
forall a b. (a -> b) -> Scene ctx a -> Scene ctx b
forall ctx a b. a -> Scene ctx b -> Scene ctx a
forall ctx a b. (a -> b) -> Scene ctx a -> Scene ctx b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall ctx a b. (a -> b) -> Scene ctx a -> Scene ctx b
fmap :: forall a b. (a -> b) -> Scene ctx a -> Scene ctx b
$c<$ :: forall ctx a b. a -> Scene ctx b -> Scene ctx a
<$ :: forall a b. a -> Scene ctx b -> Scene ctx a
Functor)

instance Applicative (Scene ctx) where
    pure :: forall a. a -> Scene ctx a
pure = a -> Scene ctx a
forall ctx a. a -> Scene ctx a
Prim
    <*> :: forall a b. Scene ctx (a -> b) -> Scene ctx a -> Scene ctx b
(<*>) = Scene ctx (a -> b) -> Scene ctx a -> Scene ctx b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (Scene ctx) where
    Scene ctx a
ma >>= :: forall a b. Scene ctx a -> (a -> Scene ctx b) -> Scene ctx b
>>= a -> Scene ctx b
mf = Scene ctx (Scene ctx b) -> Scene ctx b
forall a. Scene ctx (Scene ctx a) -> Scene ctx a
joinScene (Scene ctx (Scene ctx b) -> Scene ctx b)
-> Scene ctx (Scene ctx b) -> Scene ctx b
forall a b. (a -> b) -> a -> b
$ (a -> Scene ctx b) -> Scene ctx a -> Scene ctx (Scene ctx b)
forall a b. (a -> b) -> Scene ctx a -> Scene ctx b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Scene ctx b
mf Scene ctx a
ma
        where
            joinScene :: Scene ctx (Scene ctx a) -> Scene ctx a
            joinScene :: forall a. Scene ctx (Scene ctx a) -> Scene ctx a
joinScene Scene ctx (Scene ctx a)
x = case Scene ctx (Scene ctx a)
x of
                Prim Scene ctx a
rec    -> Scene ctx a
rec
                Scene ctx (Scene ctx a)
Space       -> Scene ctx a
forall ctx a. Scene ctx a
Space
                Scale   Double
d Scene ctx (Scene ctx a)
a -> Double -> Scene ctx a -> Scene ctx a
forall ctx a. Double -> Scene ctx a -> Scene ctx a
Scale   Double
d (Scene ctx (Scene ctx a) -> Scene ctx a
forall a. Scene ctx (Scene ctx a) -> Scene ctx a
joinScene Scene ctx (Scene ctx a)
a)
                Hor     Offset
o [Scene ctx (Scene ctx a)]
a -> Offset -> [Scene ctx a] -> Scene ctx a
forall ctx a. Offset -> [Scene ctx a] -> Scene ctx a
Hor     Offset
o ((Scene ctx (Scene ctx a) -> Scene ctx a)
-> [Scene ctx (Scene ctx a)] -> [Scene ctx a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scene ctx (Scene ctx a) -> Scene ctx a
forall a. Scene ctx (Scene ctx a) -> Scene ctx a
joinScene [Scene ctx (Scene ctx a)]
a)
                Ver     Offset
o [Scene ctx (Scene ctx a)]
a -> Offset -> [Scene ctx a] -> Scene ctx a
forall ctx a. Offset -> [Scene ctx a] -> Scene ctx a
Ver     Offset
o ((Scene ctx (Scene ctx a) -> Scene ctx a)
-> [Scene ctx (Scene ctx a)] -> [Scene ctx a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scene ctx (Scene ctx a) -> Scene ctx a
forall a. Scene ctx (Scene ctx a) -> Scene ctx a
joinScene [Scene ctx (Scene ctx a)]
a)
                Context ctx
c Scene ctx (Scene ctx a)
a -> ctx -> Scene ctx a -> Scene ctx a
forall ctx a. ctx -> Scene ctx a -> Scene ctx a
Context ctx
c (Scene ctx (Scene ctx a) -> Scene ctx a
forall a. Scene ctx (Scene ctx a) -> Scene ctx a
joinScene Scene ctx (Scene ctx a)
a)

data Offset = Offset
    { Offset -> Int
offsetOuter :: Int
    , Offset -> Int
offsetInner :: Int
    } deriving (Int -> Offset -> ShowS
[Offset] -> ShowS
Offset -> String
(Int -> Offset -> ShowS)
-> (Offset -> String) -> ([Offset] -> ShowS) -> Show Offset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Offset -> ShowS
showsPrec :: Int -> Offset -> ShowS
$cshow :: Offset -> String
show :: Offset -> String
$cshowList :: [Offset] -> ShowS
showList :: [Offset] -> ShowS
Show)

instance Default Offset where
    def :: Offset
def = Offset
            { offsetOuter :: Int
offsetOuter = Int
5
            , offsetInner :: Int
offsetInner = Int
25 }

appendContext :: Monoid ctx => ctx -> Scene ctx a -> Scene ctx a
appendContext :: forall ctx a. Monoid ctx => ctx -> Scene ctx a -> Scene ctx a
appendContext ctx
ctx Scene ctx a
x = case Scene ctx a
x of
    Context ctx
oldCtx Scene ctx a
a    -> ctx -> Scene ctx a -> Scene ctx a
forall ctx a. ctx -> Scene ctx a -> Scene ctx a
Context (ctx -> ctx -> ctx
forall a. Monoid a => a -> a -> a
mappend ctx
ctx ctx
oldCtx) Scene ctx a
a
    Scene ctx a
_                   -> ctx -> Scene ctx a -> Scene ctx a
forall ctx a. ctx -> Scene ctx a -> Scene ctx a
Context ctx
ctx Scene ctx a
x

hor, ver    :: [Scene a b] -> Scene a b
space       :: Scene a b
prim        :: a -> Scene ctx a

sca :: Double -> Scene a b -> Scene a b
margin, padding :: Int -> Scene a b -> Scene a b

hor :: forall a b. [Scene a b] -> Scene a b
hor     = Offset -> [Scene a b] -> Scene a b
forall ctx a. Offset -> [Scene ctx a] -> Scene ctx a
Hor Offset
forall a. Default a => a
def
ver :: forall a b. [Scene a b] -> Scene a b
ver     = Offset -> [Scene a b] -> Scene a b
forall ctx a. Offset -> [Scene ctx a] -> Scene ctx a
Ver Offset
forall a. Default a => a
def
sca :: forall ctx a. Double -> Scene ctx a -> Scene ctx a
sca     = Double -> Scene a b -> Scene a b
forall ctx a. Double -> Scene ctx a -> Scene ctx a
Scale
space :: forall ctx a. Scene ctx a
space   = Scene a b
forall ctx a. Scene ctx a
Space
prim :: forall a ctx. a -> Scene ctx a
prim    = a -> Scene ctx a
forall ctx a. a -> Scene ctx a
Prim

margin :: forall a b. Int -> Scene a b -> Scene a b
margin  Int
n = (Offset -> Offset) -> Scene a b -> Scene a b
forall ctx a. (Offset -> Offset) -> Scene ctx a -> Scene ctx a
withOffset (\Offset
x -> Offset
x{ offsetOuter = n })
padding :: forall a b. Int -> Scene a b -> Scene a b
padding Int
n = (Offset -> Offset) -> Scene a b -> Scene a b
forall ctx a. (Offset -> Offset) -> Scene ctx a -> Scene ctx a
withOffset (\Offset
x -> Offset
x{ offsetInner = n })

withOffset :: (Offset -> Offset) -> Scene ctx a -> Scene ctx a
withOffset :: forall ctx a. (Offset -> Offset) -> Scene ctx a -> Scene ctx a
withOffset Offset -> Offset
f Scene ctx a
x = case Scene ctx a
x of
    Hor Offset
off [Scene ctx a]
as -> Offset -> [Scene ctx a] -> Scene ctx a
forall ctx a. Offset -> [Scene ctx a] -> Scene ctx a
Hor (Offset -> Offset
f Offset
off) [Scene ctx a]
as
    Ver Offset
off [Scene ctx a]
as -> Offset -> [Scene ctx a] -> Scene ctx a
forall ctx a. Offset -> [Scene ctx a] -> Scene ctx a
Ver (Offset -> Offset
f Offset
off) [Scene ctx a]
as
    Scene ctx a
_ -> Scene ctx a
x

draw :: Rect -> Scene ctx a -> AbsScene ctx a
draw :: forall ctx a. Rect -> Scene ctx a -> AbsScene ctx a
draw Rect
rect Scene ctx a
x = case Scene ctx a
x of
    Scene ctx a
Space  -> AbsScene ctx a
forall a. Monoid a => a
mempty
    Prim a
a -> Rect -> a -> AbsScene ctx a
forall ctx a. Rect -> a -> AbsScene ctx a
Elem Rect
rect a
a
    Scale Double
_ Scene ctx a
a -> Rect -> Scene ctx a -> AbsScene ctx a
forall ctx a. Rect -> Scene ctx a -> AbsScene ctx a
draw Rect
rect Scene ctx a
a  -- no need to scale the rect we use
                              -- scaling factor in the groups (hor/ver)
    Hor Offset
off [Scene ctx a]
as -> (Offset -> [Double] -> [Rect])
-> Offset -> [Scene ctx a] -> AbsScene ctx a
forall {t} {ctx} {a}.
(t -> [Double] -> [Rect]) -> t -> [Scene ctx a] -> AbsScene ctx a
composite (Rect -> Offset -> [Double] -> [Rect]
horRects Rect
rect) Offset
off [Scene ctx a]
as
    Ver Offset
off [Scene ctx a]
as -> (Offset -> [Double] -> [Rect])
-> Offset -> [Scene ctx a] -> AbsScene ctx a
forall {t} {ctx} {a}.
(t -> [Double] -> [Rect]) -> t -> [Scene ctx a] -> AbsScene ctx a
composite (Rect -> Offset -> [Double] -> [Rect]
verRects Rect
rect) Offset
off [Scene ctx a]
as
    Context ctx
ctx Scene ctx a
a -> Rect -> ctx -> AbsScene ctx a -> AbsScene ctx a
forall ctx a. Rect -> ctx -> AbsScene ctx a -> AbsScene ctx a
Ctx Rect
rect ctx
ctx (Rect -> Scene ctx a -> AbsScene ctx a
forall ctx a. Rect -> Scene ctx a -> AbsScene ctx a
draw Rect
rect Scene ctx a
a)
    where
        composite :: (t -> [Double] -> [Rect]) -> t -> [Scene ctx a] -> AbsScene ctx a
composite t -> [Double] -> [Rect]
getRects t
off [Scene ctx a]
as = [AbsScene ctx a] -> AbsScene ctx a
forall a. Monoid a => [a] -> a
mconcat ([AbsScene ctx a] -> AbsScene ctx a)
-> [AbsScene ctx a] -> AbsScene ctx a
forall a b. (a -> b) -> a -> b
$ (Rect -> Scene ctx a -> AbsScene ctx a)
-> [Rect] -> [Scene ctx a] -> [AbsScene ctx a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Rect -> Scene ctx a -> AbsScene ctx a
forall ctx a. Rect -> Scene ctx a -> AbsScene ctx a
draw (t -> [Double] -> [Rect]
getRects t
off ([Double] -> [Rect]) -> [Double] -> [Rect]
forall a b. (a -> b) -> a -> b
$ [Scene ctx a] -> [Double]
forall a b. [Scene a b] -> [Double]
factors [Scene ctx a]
as) ((Scene ctx a -> Scene ctx a) -> [Scene ctx a] -> [Scene ctx a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scene ctx a -> Scene ctx a
forall a b. Scene a b -> Scene a b
stripScale [Scene ctx a]
as)

        horRects :: Rect -> Offset -> [Double] -> [Rect]
horRects Rect
r Offset
off [Double]
scales = (Interval -> Rect) -> [Interval] -> [Rect]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Interval -> Interval -> Rect) -> Interval -> Interval -> Rect
forall a b c. (a -> b -> c) -> b -> a -> c
flip Interval -> Interval -> Rect
toRect Interval
commonSide) [Interval]
is
            where commonSide :: Interval
commonSide = Offset -> Interval -> Interval
withoutMargin Offset
off Interval
iy
                  is :: [Interval]
is = Offset -> Interval -> [Double] -> [Interval]
intervals Offset
off Interval
ix [Double]
scales
                  (Interval
ix, Interval
iy) = Rect -> (Interval, Interval)
fromRect Rect
r

        verRects :: Rect -> Offset -> [Double] -> [Rect]
verRects Rect
r Offset
off [Double]
scales = (Interval -> Rect) -> [Interval] -> [Rect]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Interval -> Interval -> Rect
toRect Interval
commonSide) [Interval]
is
            where commonSide :: Interval
commonSide = Offset -> Interval -> Interval
withoutMargin Offset
off Interval
ix
                  is :: [Interval]
is = Offset -> Interval -> [Double] -> [Interval]
intervals Offset
off Interval
iy [Double]
scales
                  (Interval
ix, Interval
iy) = Rect -> (Interval, Interval)
fromRect Rect
r

intervals :: Offset -> Interval -> [Double] -> [Interval]
intervals :: Offset -> Interval -> [Double] -> [Interval]
intervals Offset
off Interval
total [Double]
scales = State Int [Interval] -> Int -> [Interval]
forall s a. State s a -> s -> a
evalState ((Double -> StateT Int Identity Interval)
-> [Double] -> State Int [Interval]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Double -> StateT Int Identity Interval
forall {m :: * -> *}. Monad m => Double -> StateT Int m Interval
next [Double]
scales') (Interval -> Int
start Interval
total')
    where total' :: Interval
total'  = Offset -> Interval -> Interval
withoutMargin Offset
off Interval
total
          leng' :: Double
leng'   = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Offset -> Int -> Int -> Int
withoutPaddings Offset
off ([Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
scales) (Interval -> Int
leng Interval
total')
          scales' :: [Double]
scales' = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
s) [Double]
scales
          s :: Double
s       = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
scales

          next :: Double -> StateT Int m Interval
next Double
d  = (Int -> (Interval, Int)) -> StateT Int m Interval
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Int -> (Interval, Int)) -> StateT Int m Interval)
-> (Int -> (Interval, Int)) -> StateT Int m Interval
forall a b. (a -> b) -> a -> b
$ \Int
soFar -> let l :: Int
l = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
leng'
                                      in  (Int -> Int -> Interval
Interval Int
soFar Int
l, Int
soFar Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Offset -> Int
offsetInner Offset
off)

          withoutPaddings :: Offset -> Int -> Int -> Int
withoutPaddings Offset
offset Int
n Int
a = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Offset -> Int
offsetInner Offset
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

withoutMargin :: Offset -> Interval -> Interval
withoutMargin :: Offset -> Interval -> Interval
withoutMargin Offset
off Interval
a = Int -> Int -> Interval
Interval (Interval -> Int
start Interval
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Offset -> Int
offsetOuter Offset
off) (Interval -> Int
leng Interval
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Offset -> Int
offsetOuter Offset
off)

factors :: [Scene a b] -> [Double]
factors :: forall a b. [Scene a b] -> [Double]
factors = (Scene a b -> Double) -> [Scene a b] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scene a b -> Double
forall {a} {b}. Scene a b -> Double
factor
    where factor :: Scene a b -> Double
factor = Double
-> ((Double, Scene a b) -> Double)
-> Maybe (Double, Scene a b)
-> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
1 (Double, Scene a b) -> Double
forall a b. (a, b) -> a
fst (Maybe (Double, Scene a b) -> Double)
-> (Scene a b -> Maybe (Double, Scene a b)) -> Scene a b -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scene a b -> Maybe (Double, Scene a b)
forall a b. Scene a b -> Maybe (Double, Scene a b)
maybeScale

stripScale :: Scene a b -> Scene a b
stripScale :: forall a b. Scene a b -> Scene a b
stripScale Scene a b
x = Scene a b
-> ((Double, Scene a b) -> Scene a b)
-> Maybe (Double, Scene a b)
-> Scene a b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Scene a b
x (Double, Scene a b) -> Scene a b
forall a b. (a, b) -> b
snd (Maybe (Double, Scene a b) -> Scene a b)
-> Maybe (Double, Scene a b) -> Scene a b
forall a b. (a -> b) -> a -> b
$ Scene a b -> Maybe (Double, Scene a b)
forall a b. Scene a b -> Maybe (Double, Scene a b)
maybeScale Scene a b
x

maybeScale :: Scene a b -> Maybe (Double, Scene a b)
maybeScale :: forall a b. Scene a b -> Maybe (Double, Scene a b)
maybeScale Scene a b
x = case Scene a b
x of
    Scale Double
d Scene a b
a   -> (Double, Scene a b) -> Maybe (Double, Scene a b)
forall a. a -> Maybe a
Just (Double
d, Scene a b
a)
    Scene a b
_           -> Maybe (Double, Scene a b)
forall a. Maybe a
Nothing

-----------------------------------------------
-- cascading update of the context

cascade ::
       (totalCtx -> Rect -> a -> res)
    -> res
    -> ([res] -> res)
    -> (Rect -> ctx -> res -> res)
    -> (ctx -> totalCtx -> totalCtx)
    -> totalCtx -> AbsScene ctx a -> res
cascade :: forall totalCtx a res ctx.
(totalCtx -> Rect -> a -> res)
-> res
-> ([res] -> res)
-> (Rect -> ctx -> res -> res)
-> (ctx -> totalCtx -> totalCtx)
-> totalCtx
-> AbsScene ctx a
-> res
cascade totalCtx -> Rect -> a -> res
onElem res
onEmptyScene [res] -> res
onGroup Rect -> ctx -> res -> res
onCtx ctx -> totalCtx -> totalCtx
updateCtx totalCtx
ctx AbsScene ctx a
x = case AbsScene ctx a
x of
    Elem Rect
r a
a    -> totalCtx -> Rect -> a -> res
onElem totalCtx
ctx Rect
r a
a
    AbsScene ctx a
EmptyScene  -> res
onEmptyScene
    Group [AbsScene ctx a]
as    -> [res] -> res
onGroup ((AbsScene ctx a -> res) -> [AbsScene ctx a] -> [res]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (totalCtx -> AbsScene ctx a -> res
rec totalCtx
ctx) [AbsScene ctx a]
as)
    Ctx Rect
r ctx
c AbsScene ctx a
a   -> Rect -> ctx -> res -> res
onCtx Rect
r ctx
c (res -> res) -> res -> res
forall a b. (a -> b) -> a -> b
$ totalCtx -> AbsScene ctx a -> res
rec (ctx -> totalCtx -> totalCtx
updateCtx ctx
c totalCtx
ctx) AbsScene ctx a
a
    where rec :: totalCtx -> AbsScene ctx a -> res
rec = (totalCtx -> Rect -> a -> res)
-> res
-> ([res] -> res)
-> (Rect -> ctx -> res -> res)
-> (ctx -> totalCtx -> totalCtx)
-> totalCtx
-> AbsScene ctx a
-> res
forall totalCtx a res ctx.
(totalCtx -> Rect -> a -> res)
-> res
-> ([res] -> res)
-> (Rect -> ctx -> res -> res)
-> (ctx -> totalCtx -> totalCtx)
-> totalCtx
-> AbsScene ctx a
-> res
cascade totalCtx -> Rect -> a -> res
onElem res
onEmptyScene [res] -> res
onGroup Rect -> ctx -> res -> res
onCtx ctx -> totalCtx -> totalCtx
updateCtx

-----------------------------------------------
-- calculate bounding rect

zeroRect :: Rect
zeroRect :: Rect
zeroRect = Int -> Int -> Int -> Int -> Rect
Rect Int
0 Int
0 Int
0 Int
0

boundingRect :: Scene ctx Rect -> Rect
boundingRect :: forall ctx. Scene ctx Rect -> Rect
boundingRect Scene ctx Rect
x = case Scene ctx Rect
x of
    Prim Rect
a      -> Rect
a
    Scene ctx Rect
Space       -> Rect
zeroRect
    Scale Double
_ Scene ctx Rect
a   -> Scene ctx Rect -> Rect
forall ctx. Scene ctx Rect -> Rect
boundingRect Scene ctx Rect
a
    Hor Offset
ofs [Scene ctx Rect]
as  -> Int -> Offset -> Rect -> Rect
appHorOffset ([Scene ctx Rect] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Scene ctx Rect]
as) Offset
ofs (Rect -> Rect) -> Rect -> Rect
forall a b. (a -> b) -> a -> b
$ [Rect] -> Rect
horMerge ([Rect] -> Rect) -> [Rect] -> Rect
forall a b. (a -> b) -> a -> b
$ (Scene ctx Rect -> Rect) -> [Scene ctx Rect] -> [Rect]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scene ctx Rect -> Rect
forall ctx. Scene ctx Rect -> Rect
boundingRect [Scene ctx Rect]
as
    Ver Offset
ofs [Scene ctx Rect]
as  -> Int -> Offset -> Rect -> Rect
appVerOffset ([Scene ctx Rect] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Scene ctx Rect]
as) Offset
ofs (Rect -> Rect) -> Rect -> Rect
forall a b. (a -> b) -> a -> b
$ [Rect] -> Rect
verMerge ([Rect] -> Rect) -> [Rect] -> Rect
forall a b. (a -> b) -> a -> b
$ (Scene ctx Rect -> Rect) -> [Scene ctx Rect] -> [Rect]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scene ctx Rect -> Rect
forall ctx. Scene ctx Rect -> Rect
boundingRect [Scene ctx Rect]
as
    Context ctx
_ Scene ctx Rect
a -> Scene ctx Rect -> Rect
forall ctx. Scene ctx Rect -> Rect
boundingRect Scene ctx Rect
a
    where
        appHorOffset :: Int -> Offset -> Rect -> Rect
appHorOffset Int
n Offset
offset Rect
r = Rect
r { width  = appOffset n offset (width r)
                                    , height = appOffset 1 offset (height r) }

        appVerOffset :: Int -> Offset -> Rect -> Rect
appVerOffset Int
n Offset
offset Rect
r = Rect
r { height = appOffset n offset (height r)
                                    , width  = appOffset 1 offset (width r) }

        appOffset :: Int -> Offset -> Int -> Int
appOffset Int
n Offset
offset Int
a = Int
a
              Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Offset -> Int
offsetOuter Offset
offset
              Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Offset -> Int
offsetInner Offset
offset

        horMerge :: [Rect] -> Rect
horMerge = (Rect -> Rect -> Rect) -> Rect -> [Rect] -> Rect
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Rect -> Rect -> Rect
iter Rect
zeroRect
            where iter :: Rect -> Rect -> Rect
iter Rect
r1 Rect
r2 = Rect
r1 { width  = width r1 + width r2
                                  , height = max (height r1) (height r2) }

        verMerge :: [Rect] -> Rect
verMerge = (Rect -> Rect -> Rect) -> Rect -> [Rect] -> Rect
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Rect -> Rect -> Rect
iter Rect
zeroRect
            where iter :: Rect -> Rect -> Rect
iter Rect
r1 Rect
r2 = Rect
r1 { height = height r1 + height r2
                                  , width  = max (width r1) (width r2) }