{-# LANGUAGE CPP #-}
module Placers(linearP, verticalP, horizontalP, horizontalP', verticalP') where
import Geometry
import LayoutDir
import LayoutRequest
import Spacers(Distance(..))
import Data.List(mapAccumL)
import Utils(part)
import Defaults(defaultSep)
import Maptrace(ctrace)
import IntMemo
#ifndef __HBC__
#define fromInt fromIntegral
#endif
horizontalP :: Placer
horizontalP = Distance -> Placer
horizontalP' forall a. Num a => a
defaultSep
verticalP :: Placer
verticalP = Distance -> Placer
verticalP' forall a. Num a => a
defaultSep
horizontalP' :: Distance -> Placer
horizontalP' = LayoutDir -> Distance -> Placer
linearP LayoutDir
Horizontal
verticalP' :: Distance -> Placer
verticalP' = LayoutDir -> Distance -> Placer
linearP LayoutDir
Vertical
linearP :: LayoutDir -> Distance -> Placer
linearP :: LayoutDir -> Distance -> Placer
linearP LayoutDir
ld Distance
sep = Placer1 -> Placer
P forall a b. (a -> b) -> a -> b
$ LayoutDir -> Distance -> Placer1
linearP' LayoutDir
ld Distance
sep
linearP' :: LayoutDir -> Distance -> Placer1
linearP' LayoutDir
ld Distance
sep [] = forall {a1} {a2}. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"linearP" ([Char]
"linearP "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show LayoutDir
ldforall a. [a] -> [a] -> [a]
++[Char]
" []") forall a b. (a -> b) -> a -> b
$
(Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
1 (LayoutDir
ldforall a. Eq a => a -> a -> Bool
==LayoutDir
Horizontal) (LayoutDir
ldforall a. Eq a => a -> a -> Bool
==LayoutDir
Vertical),\ Rect
r -> [])
linearP' LayoutDir
ld Distance
sep [LayoutRequest]
requests =
let minsizes :: [Size]
minsizes = forall a b. (a -> b) -> [a] -> [b]
map LayoutRequest -> Size
minsize [LayoutRequest]
requests
totis :: Distance
totis = Distance
sep forall a. Num a => a -> a -> a
* (forall a. Ord a => a -> a -> a
max Distance
0 (forall (t :: * -> *) a. Foldable t => t a -> Distance
length [LayoutRequest]
requests forall a. Num a => a -> a -> a
- Distance
1))
h :: Distance
h = forall a. Ord a => a -> a -> a
max Distance
0 (Distance
h'forall a. Num a => a -> a -> a
-Distance
sep)
(Distance
h',[[Size]]
rpss) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Distance -> LayoutRequest -> (Distance, [Size])
adjust Distance
0 [LayoutRequest]
requests
where adjust :: Distance -> LayoutRequest -> (Distance, [Size])
adjust Distance
x (Layout {minsize :: LayoutRequest -> Size
minsize=Size
rsz,refpoints :: LayoutRequest -> [Size]
refpoints=[Size]
rps}) =
(Distance
xforall a. Num a => a -> a -> a
+Distance
rwforall a. Num a => a -> a -> a
+Distance
sep,forall a b. (a -> b) -> [a] -> [b]
map Size -> Size
adj1 [Size]
rps)
where adj1 :: Size -> Size
adj1 Size
p = LayoutDir -> Distance -> Distance -> Size
mkp LayoutDir
ld (Distance
xforall a. Num a => a -> a -> a
+LayoutDir -> Size -> Distance
xc LayoutDir
ld Size
p) (LayoutDir -> Size -> Distance
yc LayoutDir
ld Size
p)
rw :: Distance
rw = LayoutDir -> Size -> Distance
xc LayoutDir
ld Size
rsz
v :: Distance
v = (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Distance
0forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (LayoutDir -> Size -> Distance
yc LayoutDir
ld)) [Size]
minsizes
line2 :: Rect -> [Rect]
line2 Rect
gotr =
let goth :: Double
goth = (fromInt . xc ld . rectsize) gotr - fromInt totis
gotv :: Distance
gotv = (LayoutDir -> Size -> Distance
yc LayoutDir
ld forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect -> Size
rectsize) Rect
gotr
startx :: Double
startx = (fromInt . xc ld . rectpos) gotr
starty :: Distance
starty = (LayoutDir -> Size -> Distance
yc LayoutDir
ld forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect -> Size
rectpos) Rect
gotr
#if 0
requests' = requests
#else
requests' :: [LayoutRequest]
requests' = forall a b. (a -> b) -> [a] -> [b]
map LayoutRequest -> LayoutRequest
req' [LayoutRequest]
requests
where
req' :: LayoutRequest -> LayoutRequest
req' LayoutRequest
req = LayoutRequest
req {minsize :: Size
minsize=Distance -> Size
adj Distance
gotv}
where adj :: Distance -> Size
adj=forall {p}. LayoutDir -> p -> p -> p
orthogonal LayoutDir
ld (LayoutRequest -> Distance -> Size
wAdj LayoutRequest
req) (LayoutRequest -> Distance -> Size
hAdj LayoutRequest
req)
#endif
([LayoutRequest]
fih, [LayoutRequest]
flh) = forall {a}. (a -> Bool) -> [a] -> ([a], [a])
part (LayoutDir -> LayoutRequest -> Bool
fixh LayoutDir
ld) [LayoutRequest]
requests'
fixedh' :: Double
fixedh' =
(fromInt . sum . map (xc ld . minsize)) fih
floath :: Double
floath = (fromInt . sum . map (xc ld . minsize)) flh
fixedR :: Double
fixedR = if Double
floath forall a. Ord a => a -> a -> Bool
> Double
0.0 then Double
1.0 else Double
goth forall a. Fractional a => a -> a -> a
/ Double
fixedh'
floatR :: Double
floatR =
if Double
floath forall a. Eq a => a -> a -> Bool
== Double
0.0 then Double
1.0 else (Double
goth forall a. Num a => a -> a -> a
- Double
fixedh') forall a. Fractional a => a -> a -> a
/ Double
floath
rR' :: LayoutRequest -> Double
rR' LayoutRequest
req = if LayoutDir -> LayoutRequest -> Bool
fixh LayoutDir
ld LayoutRequest
req then Double
fixedR else Double
floatR
pl :: Double -> LayoutRequest -> (Double, Rect)
pl Double
x LayoutRequest
req =
let width :: Double
width = (fromInt . xc ld . minsize) req * rR' req
in (Double
x forall a. Num a => a -> a -> a
+ Double
width forall a. Num a => a -> a -> a
+ fromInt sep,
Size -> Size -> Rect
Rect (LayoutDir -> Distance -> Distance -> Size
mkp LayoutDir
ld (forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
x) Distance
starty)
(LayoutDir -> Distance -> Distance -> Size
mkp LayoutDir
ld (forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
width) Distance
gotv))
in forall a b. (a, b) -> b
snd (forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Double -> LayoutRequest -> (Double, Rect)
pl Double
startx [LayoutRequest]
requests')
(Bool
fh',Bool
fv') = forall {b}. LayoutDir -> (b, b) -> (b, b)
vswap LayoutDir
ld (forall {b} {t}.
([b] -> t) -> (LayoutDir -> LayoutRequest -> b) -> t
allf forall (t :: * -> *). Foldable t => t Bool -> Bool
and LayoutDir -> LayoutRequest -> Bool
fixh,forall {b} {t}.
([b] -> t) -> (LayoutDir -> LayoutRequest -> b) -> t
allf forall (t :: * -> *). Foldable t => t Bool -> Bool
or LayoutDir -> LayoutRequest -> Bool
fixv)
rps' :: [Size]
rps' = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Size]]
rpss
allf :: ([b] -> t) -> (LayoutDir -> LayoutRequest -> b) -> t
allf [b] -> t
conn LayoutDir -> LayoutRequest -> b
fix = [b] -> t
conn (forall a b. (a -> b) -> [a] -> [b]
map (LayoutDir -> LayoutRequest -> b
fix LayoutDir
ld) [LayoutRequest]
requests)
req0 :: LayoutRequest
req0 = Size -> Bool -> Bool -> [Size] -> LayoutRequest
refpLayout (LayoutDir -> Distance -> Distance -> Size
mkp LayoutDir
ld Distance
h Distance
v) Bool
fh' Bool
fv' [Size]
rps'
req :: LayoutRequest
req =
case LayoutDir
ld of
LayoutDir
Horizontal -> LayoutRequest
req0 { hAdj :: Distance -> Size
hAdj=forall a. (Distance -> a) -> Distance -> a
memoInt Distance -> Size
ha }
where ha :: Distance -> Size
ha Distance
h = Distance -> Distance -> Size
Point (Distance
totisforall a. Num a => a -> a -> a
+forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Distance]
ws) Distance
h
where ws :: [Distance]
ws = forall a b. (a -> b) -> [a] -> [b]
map (Size -> Distance
xcoord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip LayoutRequest -> Distance -> Size
hAdj Distance
h) [LayoutRequest]
requests
LayoutDir
Vertical -> LayoutRequest
req0 { wAdj :: Distance -> Size
wAdj=forall a. (Distance -> a) -> Distance -> a
memoInt Distance -> Size
wa }
where wa :: Distance -> Size
wa Distance
w = Distance -> Distance -> Size
Point Distance
w (Distance
totisforall a. Num a => a -> a -> a
+forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Distance]
hs)
where hs :: [Distance]
hs = forall a b. (a -> b) -> [a] -> [b]
map (Size -> Distance
ycoord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip LayoutRequest -> Distance -> Size
wAdj Distance
w) [LayoutRequest]
requests
in (LayoutRequest
req,Rect -> [Rect]
line2)
#ifdef __NHC__
fromInt = fromIntegral
#endif