{-# LANGUAGE CPP #-}
module TableP(tableP,tableP') where
import Geometry(Point(..), Rect(..), rR, xcoord, ycoord)
import LayoutDir(LayoutDir(..), vswap)
import LayoutRequest
import Spacers(Distance(..))
import HbcUtils(chopList)
import Data.List(transpose,mapAccumL)
import Utils(lhead)
import Defaults(defaultSep)
import IntMemo
import Maptrace(ctrace)
tr :: a2 -> a2
tr a2
x = forall {a1} {a2}. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"tableP" a2
x a2
x
tableP :: Int -> Placer
tableP Int
n = Int -> LayoutDir -> Int -> Placer
tableP' Int
n LayoutDir
Horizontal forall a. Num a => a
defaultSep
tableP' :: Int -> LayoutDir -> Distance -> Placer
tableP' :: Int -> LayoutDir -> Int -> Placer
tableP' Int
count' LayoutDir
ld Int
sep = Placer1 -> Placer
P forall a b. (a -> b) -> a -> b
$ \ [LayoutRequest]
requests ->
let
([[LayoutRequest]]
rows, [[LayoutRequest]]
columns) =
let hmatrix :: [[LayoutRequest]]
hmatrix = forall a b. ([a] -> (b, [a])) -> [a] -> [b]
chopList (forall a. Int -> [a] -> ([a], [a])
splitAt Int
count') [LayoutRequest]
requests
vmatrix :: [[LayoutRequest]]
vmatrix = forall a. [[a]] -> [[a]]
transpose [[LayoutRequest]]
hmatrix
in forall {b}. LayoutDir -> (b, b) -> (b, b)
vswap LayoutDir
ld ([[LayoutRequest]]
hmatrix, [[LayoutRequest]]
vmatrix)
nrows :: Int
nrows = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[LayoutRequest]]
rows
ncols :: Int
ncols = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[LayoutRequest]]
columns
vsep :: Int
vsep = (Int
nrows forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
* Int
sep
hsep :: Int
hsep = (Int
ncols forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
* Int
sep
rowhs :: [Int]
rowhs = forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Point -> Int
ycoordforall b c a. (b -> c) -> (a -> b) -> a -> c
.LayoutRequest -> Point
minsize)) [[LayoutRequest]]
rows
colws :: [Int]
colws = forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Point -> Int
xcoordforall b c a. (b -> c) -> (a -> b) -> a -> c
.LayoutRequest -> Point
minsize)) [[LayoutRequest]]
columns
rowfixhs :: [Bool]
rowfixhs = forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map LayoutRequest -> Bool
fixedv) [[LayoutRequest]]
rows
colfixws :: [Bool]
colfixws = forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map LayoutRequest -> Bool
fixedh) [[LayoutRequest]]
columns
h :: Int
h = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
rowhs
w :: Int
w = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
colws
toth :: Int
toth = Int
h forall a. Num a => a -> a -> a
+ Int
vsep
totw :: Int
totw = Int
w forall a. Num a => a -> a -> a
+ Int
hsep
tot :: Point
tot = Int -> Int -> Point
Point Int
totw Int
toth
totfh :: Bool
totfh = forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
rowfixhs
totfw :: Bool
totfw = forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
colfixws
rps :: [Point]
rps = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(LayoutRequest
r,Point
p)->forall a b. (a -> b) -> [a] -> [b]
map (Point
pforall a. Num a => a -> a -> a
+) (LayoutRequest -> [Point]
refpoints LayoutRequest
r)) (forall a b. [a] -> [b] -> [(a, b)]
zip [LayoutRequest]
requests [Point]
cellps)
where cellps :: [Point]
cellps = [Int -> Int -> Point
Point Int
x Int
y | Int
y<-forall {t :: * -> *} {b}.
(Traversable t, Num b) =>
b -> b -> t b -> t b
place Int
0 Int
sep [Int]
rowhs,Int
x<-forall {t :: * -> *} {b}.
(Traversable t, Num b) =>
b -> b -> t b -> t b
place Int
0 Int
sep [Int]
colws]
table2 :: Rect -> [Rect]
table2 (Rect (Point Int
x0 Int
y0) got :: Point
got@(Point Int
width Int
height)) =
let
#if 0
rowhs' = arowhs height
colws' = acolws width
#else
(([Int]
colws',[Int]
rowhs'),(Int
w',Int
h')) =
if Int
widthforall a. Ord a => a -> a -> Bool
<=Int
totw
then (Int -> ([Int], [Int])
adjrowhs Int
width,(Int
width,forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
rowhs'forall a. Num a => a -> a -> a
+Int
vsep))
else (Int -> ([Int], [Int])
adjcolws Int
height,(forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
colws'forall a. Num a => a -> a -> a
+Int
hsep,Int
height))
#endif
colws'' :: [Int]
colws'' = forall {t}. Integral t => t -> [t] -> [Bool] -> [t]
adjsizes (forall {a2}. Show a2 => a2 -> a2
tr (Int
widthforall a. Num a => a -> a -> a
-Int
w')) [Int]
colws' [Bool]
colfixws
rowhs'' :: [Int]
rowhs'' = forall {t}. Integral t => t -> [t] -> [Bool] -> [t]
adjsizes (forall {a2}. Show a2 => a2 -> a2
tr (Int
heightforall a. Num a => a -> a -> a
-Int
h')) [Int]
rowhs' [Bool]
rowfixhs
xs :: [Int]
xs = forall {t :: * -> *} {b}.
(Traversable t, Num b) =>
b -> b -> t b -> t b
place Int
x0 Int
sep [Int]
colws''
ys :: [Int]
ys = forall {t :: * -> *} {b}.
(Traversable t, Num b) =>
b -> b -> t b -> t b
place Int
y0 Int
sep [Int]
rowhs''
placedrows :: [[Rect]]
placedrows =
[[Int -> Int -> Int -> Int -> Rect
rR Int
x Int
y Int
w Int
h|(Int
x,Int
w)<-forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
xs [Int]
colws'']|(Int
y,Int
h)<-forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
ys [Int]
rowhs'']
rectss :: [[Rect]]
rectss =
case LayoutDir
ld of
LayoutDir
Horizontal -> [[Rect]]
placedrows
LayoutDir
Vertical -> forall a. [[a]] -> [[a]]
transpose [[Rect]]
placedrows
rects :: [Rect]
rects = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Rect]]
rectss
in (if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rect]
rectsforall a. Ord a => a -> a -> Bool
<forall (t :: * -> *) a. Foldable t => t a -> Int
length [LayoutRequest]
requests
then forall {a1} {a2}. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"tableP" (forall (t :: * -> *) a. Foldable t => t a -> Int
length [LayoutRequest]
requests,forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rect]
rects)
else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
forall {a1} {a2}. [a1] -> [a2] -> [a2]
lhead [LayoutRequest]
requests [Rect]
rects
acolws :: Int -> [Int]
acolws Int
aw = forall {t}. Integral t => t -> [t] -> [Bool] -> [t]
adjsizes (Int
awforall a. Num a => a -> a -> a
-Int
totw) [Int]
colws [Bool]
colfixws
arowhs :: Int -> [Int]
arowhs Int
ah = forall {t}. Integral t => t -> [t] -> [Bool] -> [t]
adjsizes (Int
ahforall a. Num a => a -> a -> a
-Int
toth) [Int]
rowhs [Bool]
rowfixhs
adjsizes :: t -> [t] -> [Bool] -> [t]
adjsizes t
extra [t]
ss [Bool]
fixs = forall {t}. Integral t => t -> t -> [t] -> [Bool] -> [t]
pad t
flex t
extra [t]
ss [Bool]
fixs
where
flex :: t
flex = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [t
s | (t
s,Bool
fixed) <-forall a b. [a] -> [b] -> [(a, b)]
zip [t]
ss [Bool]
fixs, Bool -> Bool
not Bool
fixed]
pad :: t -> t -> [t] -> [Bool] -> [t]
pad t
_ t
0 [t]
ws [Bool]
_ = [t]
ws
pad t
0 t
extra [t]
ws [Bool]
_ = [t]
ws
pad t
flex t
extra (t
w:[t]
ws) (Bool
fixed:[Bool]
fs) =
if Bool
fixed
then t
wforall a. a -> [a] -> [a]
:t -> t -> [t] -> [Bool] -> [t]
pad t
flex t
extra [t]
ws [Bool]
fs
else let e :: t
e = (t
extraforall a. Num a => a -> a -> a
*t
w forall a. Integral a => a -> a -> a
`quot` t
flex) forall a. Ord a => a -> a -> a
`max` (-t
w)
in t
wforall a. Num a => a -> a -> a
+t
eforall a. a -> [a] -> [a]
:t -> t -> [t] -> [Bool] -> [t]
pad (t
flexforall a. Num a => a -> a -> a
-t
w) (t
extraforall a. Num a => a -> a -> a
-t
e) [t]
ws [Bool]
fs
pad t
_ t
_ [t]
_ [Bool]
_ = []
adjrowhs :: Int -> ([Int], [Int])
adjrowhs = forall a. (Int -> a) -> Int -> a
memoInt Int -> ([Int], [Int])
adjrowhs'
adjrowhs' :: Int -> ([Int], [Int])
adjrowhs' Int
w = ([Int]
colws,forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a. [[a]] -> [[a]]
transpose [[Int]]
colhs))
where colhs :: [[Int]]
colhs = [forall a b. (a -> b) -> [a] -> [b]
map (Point -> Int
ycoord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip LayoutRequest -> Int -> Point
wAdj Int
colw) [LayoutRequest]
column |
(Int
colw,[LayoutRequest]
column) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
colws [[LayoutRequest]]
columns]
colws :: [Int]
colws = Int -> [Int]
acolws Int
w
adjcolws :: Int -> ([Int], [Int])
adjcolws = forall a. (Int -> a) -> Int -> a
memoInt Int -> ([Int], [Int])
adjcolws'
adjcolws' :: Int -> ([Int], [Int])
adjcolws' Int
h = (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a. [[a]] -> [[a]]
transpose [[Int]]
rowws),[Int]
rowhs)
where rowws :: [[Int]]
rowws = [forall a b. (a -> b) -> [a] -> [b]
map (Point -> Int
xcoord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip LayoutRequest -> Int -> Point
hAdj Int
rowh) [LayoutRequest]
row |
(Int
rowh,[LayoutRequest]
row) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
rowhs [[LayoutRequest]]
rows]
rowhs :: [Int]
rowhs = Int -> [Int]
arowhs Int
h
wa :: Int -> Point
wa Int
w = forall {a1} {a2}. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"tablePwa" Point
s Point
s
where s :: Point
s = Int -> Int -> Point
Point Int
w (Int
vsepforall a. Num a => a -> a -> a
+Int
h)
h :: Int
h = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a, b) -> b
snd (Int -> ([Int], [Int])
adjrowhs Int
w))
ha :: Int -> Point
ha Int
h = Int -> Int -> Point
Point (Int
hsepforall a. Num a => a -> a -> a
+Int
w) Int
h
where w :: Int
w = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a, b) -> a
fst (Int -> ([Int], [Int])
adjcolws Int
h))
in ((Point -> Bool -> Bool -> [Point] -> LayoutRequest
refpLayout Point
tot Bool
totfw Bool
totfh [Point]
rps){wAdj :: Int -> Point
wAdj=forall a. (Int -> a) -> Int -> a
memoInt Int -> Point
wa,hAdj :: Int -> Point
hAdj=forall a. (Int -> a) -> Int -> a
memoInt Int -> Point
ha}, Rect -> [Rect]
table2)
place :: b -> b -> t b -> t b
place b
pos0 b
sep = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL b -> b -> (b, b)
f b
pos0
where f :: b -> b -> (b, b)
f b
pos b
size = (b
posforall a. Num a => a -> a -> a
+b
sizeforall a. Num a => a -> a -> a
+b
sep,b
pos)
#ifdef __NHC__
fromInt = fromIntegral
#endif