{-# 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 --sizes = map minsize requests
        ([[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
	--rowfixws = map (and . map fixedh) rows
	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
	--colfixhs = map (and . map fixedv) 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]
--	  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
widthforall a. Ord a => a -> a -> Bool
<=Int
totw -- hmm...
		  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'']
{- 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 -> 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))
{- --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
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))
{- --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=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