{-# 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 --sizes = map minsize requests
        ([[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
	--rowfixws = map (and . map fixedh) rows
	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
	--colfixhs = map (and . map fixedv) 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]
--	  where	cellps = [Point x y | y<-0:init rowhs,x<-0:init colws] --sep??
        table2 :: Rect -> [Rect]
table2 (Rect (Point Int
x0 Int
y0) got :: Point
got@(Point Int
width Int
height)) =
            let --Point extraw extrah = (got `psub` tot) --`pmax` origin
#if 0
-- old solution
		rowhs' = arowhs height --pad flexh extrah rowhs rowfixhs
		colws' = acolws width --pad flexw extraw colws colfixws
#else
-- new solution
		(([Int]
colws',[Int]
rowhs'),(Int
w',Int
h')) =
		  if Int
widthInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
totw -- hmm...
		  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'']
{- old
		w' = sum colws'
		h' = sum rowhs'
		hscale,vscale :: Double
                hscale = fromInt (width - hsep) / fromInt w'
                vscale = fromInt (height - vsep) / fromInt h'
                placecols x y h' [] = []
                placecols x y h' (w' : ws) =
                    let w'' = scale hscale w'
                    in  rR x y w'' h' : placecols (x + w'' + sep) y h' ws
                placerows y [] = []
                placerows y (h' : hs) =
                    let h'' = scale vscale h'
                    in  placecols x0 y h'' colws' : placerows (y + h'' + sep) hs
                placedrows = placerows y0 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))
{- --old:
		h = sum . map maximum . transpose $ colhs
		colhs =  [map (ycoord . flip wAdj colw) col |
			  (colw,col) <- zip (acolws w) columns]
-}
	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))
{- --old:
		w = sum . map maximum . transpose $ rowws
		rowws =  [map (xcoord . flip hAdj rowh) row |
			  (rowh,row) <- zip (arowhs h) rows]
-}
    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