{-# 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 = [Char] -> a2 -> a2 -> a2
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 Int
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 (Placer1 -> Placer) -> Placer1 -> Placer
forall a b. (a -> b) -> a -> b
$ \ [LayoutRequest]
requests ->
let
([[LayoutRequest]]
rows, [[LayoutRequest]]
columns) =
let hmatrix :: [[LayoutRequest]]
hmatrix = ([LayoutRequest] -> ([LayoutRequest], [LayoutRequest]))
-> [LayoutRequest] -> [[LayoutRequest]]
forall a b. ([a] -> (b, [a])) -> [a] -> [b]
chopList (Int -> [LayoutRequest] -> ([LayoutRequest], [LayoutRequest])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
count') [LayoutRequest]
requests
vmatrix :: [[LayoutRequest]]
vmatrix = [[LayoutRequest]] -> [[LayoutRequest]]
forall a. [[a]] -> [[a]]
transpose [[LayoutRequest]]
hmatrix
in LayoutDir
-> ([[LayoutRequest]], [[LayoutRequest]])
-> ([[LayoutRequest]], [[LayoutRequest]])
forall b. LayoutDir -> (b, b) -> (b, b)
vswap LayoutDir
ld ([[LayoutRequest]]
hmatrix, [[LayoutRequest]]
vmatrix)
nrows :: Int
nrows = [[LayoutRequest]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[LayoutRequest]]
rows
ncols :: Int
ncols = [[LayoutRequest]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[LayoutRequest]]
columns
vsep :: Int
vsep = (Int
nrows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sep
hsep :: Int
hsep = (Int
ncols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sep
rowhs :: [Int]
rowhs = ([LayoutRequest] -> Int) -> [[LayoutRequest]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int)
-> ([LayoutRequest] -> [Int]) -> [LayoutRequest] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) ([Int] -> [Int])
-> ([LayoutRequest] -> [Int]) -> [LayoutRequest] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayoutRequest -> Int) -> [LayoutRequest] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Int
ycoord(Point -> Int) -> (LayoutRequest -> Point) -> LayoutRequest -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LayoutRequest -> Point
minsize)) [[LayoutRequest]]
rows
colws :: [Int]
colws = ([LayoutRequest] -> Int) -> [[LayoutRequest]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int)
-> ([LayoutRequest] -> [Int]) -> [LayoutRequest] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) ([Int] -> [Int])
-> ([LayoutRequest] -> [Int]) -> [LayoutRequest] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayoutRequest -> Int) -> [LayoutRequest] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Int
xcoord(Point -> Int) -> (LayoutRequest -> Point) -> LayoutRequest -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LayoutRequest -> Point
minsize)) [[LayoutRequest]]
columns
rowfixhs :: [Bool]
rowfixhs = ([LayoutRequest] -> Bool) -> [[LayoutRequest]] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool)
-> ([LayoutRequest] -> [Bool]) -> [LayoutRequest] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayoutRequest -> Bool) -> [LayoutRequest] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map LayoutRequest -> Bool
fixedv) [[LayoutRequest]]
rows
colfixws :: [Bool]
colfixws = ([LayoutRequest] -> Bool) -> [[LayoutRequest]] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool)
-> ([LayoutRequest] -> [Bool]) -> [LayoutRequest] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayoutRequest -> Bool) -> [LayoutRequest] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map LayoutRequest -> Bool
fixedh) [[LayoutRequest]]
columns
h :: Int
h = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
rowhs
w :: Int
w = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
colws
toth :: Int
toth = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vsep
totw :: Int
totw = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hsep
tot :: Point
tot = Int -> Int -> Point
Point Int
totw Int
toth
totfh :: Bool
totfh = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
rowfixhs
totfw :: Bool
totfw = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
colfixws
rps :: [Point]
rps = ((LayoutRequest, Point) -> [Point])
-> [(LayoutRequest, Point)] -> [Point]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(LayoutRequest
r,Point
p)->(Point -> Point) -> [Point] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point
pPoint -> Point -> Point
forall a. Num a => a -> a -> a
+) (LayoutRequest -> [Point]
refpoints LayoutRequest
r)) ([LayoutRequest] -> [Point] -> [(LayoutRequest, Point)]
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<-Int -> Int -> [Int] -> [Int]
forall (t :: * -> *) a.
(Traversable t, Num a) =>
a -> a -> t a -> t a
place Int
0 Int
sep [Int]
rowhs,Int
x<-Int -> Int -> [Int] -> [Int]
forall (t :: * -> *) a.
(Traversable t, Num a) =>
a -> a -> t a -> t a
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
widthInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
totw
then (Int -> ([Int], [Int])
adjrowhs Int
width,(Int
width,[Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
rowhs'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
vsep))
else (Int -> ([Int], [Int])
adjcolws Int
height,([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
colws'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
hsep,Int
height))
#endif
colws'' :: [Int]
colws'' = Int -> [Int] -> [Bool] -> [Int]
forall a. Integral a => a -> [a] -> [Bool] -> [a]
adjsizes (Int -> Int
forall a2. Show a2 => a2 -> a2
tr (Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
w')) [Int]
colws' [Bool]
colfixws
rowhs'' :: [Int]
rowhs'' = Int -> [Int] -> [Bool] -> [Int]
forall a. Integral a => a -> [a] -> [Bool] -> [a]
adjsizes (Int -> Int
forall a2. Show a2 => a2 -> a2
tr (Int
heightInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
h')) [Int]
rowhs' [Bool]
rowfixhs
xs :: [Int]
xs = Int -> Int -> [Int] -> [Int]
forall (t :: * -> *) a.
(Traversable t, Num a) =>
a -> a -> t a -> t a
place Int
x0 Int
sep [Int]
colws''
ys :: [Int]
ys = Int -> Int -> [Int] -> [Int]
forall (t :: * -> *) a.
(Traversable t, Num a) =>
a -> a -> t a -> t a
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)<-[Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
xs [Int]
colws'']|(Int
y,Int
h)<-[Int] -> [Int] -> [(Int, Int)]
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 -> [[Rect]] -> [[Rect]]
forall a. [[a]] -> [[a]]
transpose [[Rect]]
placedrows
rects :: [Rect]
rects = [[Rect]] -> [Rect]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Rect]]
rectss
in (if [Rect] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rect]
rectsInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<[LayoutRequest] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LayoutRequest]
requests
then [Char] -> (Int, Int) -> [Rect] -> [Rect]
forall a1 a2. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"tableP" ([LayoutRequest] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LayoutRequest]
requests,[Rect] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rect]
rects)
else [Rect] -> [Rect]
forall a. a -> a
id) ([Rect] -> [Rect]) -> [Rect] -> [Rect]
forall a b. (a -> b) -> a -> b
$
[LayoutRequest] -> [Rect] -> [Rect]
forall a1 a2. [a1] -> [a2] -> [a2]
lhead [LayoutRequest]
requests [Rect]
rects
acolws :: Int -> [Int]
acolws Int
aw = Int -> [Int] -> [Bool] -> [Int]
forall a. Integral a => a -> [a] -> [Bool] -> [a]
adjsizes (Int
awInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
totw) [Int]
colws [Bool]
colfixws
arowhs :: Int -> [Int]
arowhs Int
ah = Int -> [Int] -> [Bool] -> [Int]
forall a. Integral a => a -> [a] -> [Bool] -> [a]
adjsizes (Int
ahInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
toth) [Int]
rowhs [Bool]
rowfixhs
adjsizes :: a -> [a] -> [Bool] -> [a]
adjsizes a
extra [a]
ss [Bool]
fixs = a -> a -> [a] -> [Bool] -> [a]
forall a. Integral a => a -> a -> [a] -> [Bool] -> [a]
pad a
flex a
extra [a]
ss [Bool]
fixs
where
flex :: a
flex = [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a
s | (a
s,Bool
fixed) <-[a] -> [Bool] -> [(a, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ss [Bool]
fixs, Bool -> Bool
not Bool
fixed]
pad :: a -> a -> [a] -> [Bool] -> [a]
pad a
_ a
0 [a]
ws [Bool]
_ = [a]
ws
pad a
0 a
extra [a]
ws [Bool]
_ = [a]
ws
pad a
flex a
extra (a
w:[a]
ws) (Bool
fixed:[Bool]
fs) =
if Bool
fixed
then a
wa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a -> a -> [a] -> [Bool] -> [a]
pad a
flex a
extra [a]
ws [Bool]
fs
else let e :: a
e = (a
extraa -> a -> a
forall a. Num a => a -> a -> a
*a
w a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
flex) a -> a -> a
forall a. Ord a => a -> a -> a
`max` (-a
w)
in a
wa -> a -> a
forall a. Num a => a -> a -> a
+a
ea -> [a] -> [a]
forall a. a -> [a] -> [a]
:a -> a -> [a] -> [Bool] -> [a]
pad (a
flexa -> a -> a
forall a. Num a => a -> a -> a
-a
w) (a
extraa -> a -> a
forall a. Num a => a -> a -> a
-a
e) [a]
ws [Bool]
fs
pad a
_ a
_ [a]
_ [Bool]
_ = []
adjrowhs :: Int -> ([Int], [Int])
adjrowhs = (Int -> ([Int], [Int])) -> Int -> ([Int], [Int])
forall a. (Int -> a) -> Int -> a
memoInt Int -> ([Int], [Int])
adjrowhs'
adjrowhs' :: Int -> ([Int], [Int])
adjrowhs' Int
w = ([Int]
colws,([Int] -> Int) -> [[Int]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([[Int]] -> [[Int]]
forall a. [[a]] -> [[a]]
transpose [[Int]]
colhs))
where colhs :: [[Int]]
colhs = [(LayoutRequest -> Int) -> [LayoutRequest] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Int
ycoord (Point -> Int) -> (LayoutRequest -> Point) -> LayoutRequest -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayoutRequest -> Int -> Point) -> Int -> LayoutRequest -> Point
forall a b c. (a -> b -> c) -> b -> a -> c
flip LayoutRequest -> Int -> Point
wAdj Int
colw) [LayoutRequest]
column |
(Int
colw,[LayoutRequest]
column) <- [Int] -> [[LayoutRequest]] -> [(Int, [LayoutRequest])]
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 = (Int -> ([Int], [Int])) -> Int -> ([Int], [Int])
forall a. (Int -> a) -> Int -> a
memoInt Int -> ([Int], [Int])
adjcolws'
adjcolws' :: Int -> ([Int], [Int])
adjcolws' Int
h = (([Int] -> Int) -> [[Int]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([[Int]] -> [[Int]]
forall a. [[a]] -> [[a]]
transpose [[Int]]
rowws),[Int]
rowhs)
where rowws :: [[Int]]
rowws = [(LayoutRequest -> Int) -> [LayoutRequest] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Int
xcoord (Point -> Int) -> (LayoutRequest -> Point) -> LayoutRequest -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayoutRequest -> Int -> Point) -> Int -> LayoutRequest -> Point
forall a b c. (a -> b -> c) -> b -> a -> c
flip LayoutRequest -> Int -> Point
hAdj Int
rowh) [LayoutRequest]
row |
(Int
rowh,[LayoutRequest]
row) <- [Int] -> [[LayoutRequest]] -> [(Int, [LayoutRequest])]
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 = [Char] -> Point -> Point -> Point
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
vsepInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h)
h :: Int
h = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (([Int], [Int]) -> [Int]
forall a b. (a, b) -> b
snd (Int -> ([Int], [Int])
adjrowhs Int
w))
ha :: Int -> Point
ha Int
h = Int -> Int -> Point
Point (Int
hsepInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w) Int
h
where w :: Int
w = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (([Int], [Int]) -> [Int]
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=(Int -> Point) -> Int -> Point
forall a. (Int -> a) -> Int -> a
memoInt Int -> Point
wa,hAdj :: Int -> Point
hAdj=(Int -> Point) -> Int -> Point
forall a. (Int -> a) -> Int -> a
memoInt Int -> Point
ha}, Rect -> [Rect]
table2)
place :: a -> a -> t a -> t a
place a
pos0 a
sep = (a, t a) -> t a
forall a b. (a, b) -> b
snd ((a, t a) -> t a) -> (t a -> (a, t a)) -> t a -> t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> (a, a)) -> a -> t a -> (a, t a)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL a -> a -> (a, a)
f a
pos0
where f :: a -> a -> (a, a)
f a
pos a
size = (a
posa -> a -> a
forall a. Num a => a -> a -> a
+a
sizea -> a -> a
forall a. Num a => a -> a -> a
+a
sep,a
pos)
#ifdef __NHC__
fromInt = fromIntegral
#endif