{-# LANGUAGE CPP #-}
module MatrixP(matrixP,matrixP') where
import Geometry
import LayoutRequest
import LayoutDir(LayoutDir(..),xc,yc,mkp)
import Spacers(Distance)
import Defaults(defaultSep)
import Data.List(mapAccumL)

#ifndef __HBC__
#define fromInt fromIntegral
#endif

matrixP :: Int -> Placer
matrixP Int
n = Int -> LayoutDir -> Int -> Placer
matrixP' Int
n LayoutDir
Horizontal Int
forall a. Num a => a
defaultSep

matrixP' :: Int -> LayoutDir -> Distance -> Placer
matrixP' :: Int -> LayoutDir -> Int -> Placer
matrixP' Int
count' LayoutDir
ld Int
sep = Placer1 -> Placer
P (Placer1 -> Placer) -> Placer1 -> Placer
forall a b. (a -> b) -> a -> b
$ \ [LayoutRequest]
requests ->
    let n :: Int
n = [LayoutRequest] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LayoutRequest]
requests
        maxsize :: Point
maxsize = ([Point] -> Point
pMax ([Point] -> Point)
-> ([LayoutRequest] -> [Point]) -> [LayoutRequest] -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point
originPoint -> [Point] -> [Point]
forall a. a -> [a] -> [a]
:) ([Point] -> [Point])
-> ([LayoutRequest] -> [Point]) -> [LayoutRequest] -> [Point]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayoutRequest -> Point) -> [LayoutRequest] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map LayoutRequest -> Point
minsize) [LayoutRequest]
requests
	rps' :: [Point]
rps' = (LayoutRequest -> [Point]) -> [LayoutRequest] -> [Point]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LayoutRequest -> [Point]
refpoints [LayoutRequest]
requests
        maxh :: Int
maxh = LayoutDir -> Point -> Int
xc LayoutDir
ld Point
maxsize
        maxv :: Int
maxv = LayoutDir -> Point -> Int
yc LayoutDir
ld Point
maxsize
        ncols :: Int
ncols = Int
count' Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
n
        nrows :: Int
nrows = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
count' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        his :: Int
his = Int
sep Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
ncols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        vis :: Int
vis = Int
sep Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
nrows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        h :: Int
h = Int
his Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxh Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ncols
        v :: Int
v = Int
vis Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxv Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
nrows
        mat2 :: Rect -> [Rect]
mat2 (Rect Point
gotpos Point
gotsize) =
            let x0 :: Int
x0 = LayoutDir -> Point -> Int
xc LayoutDir
ld Point
gotpos
	        y0 :: Int
y0 = LayoutDir -> Point -> Int
yc LayoutDir
ld Point
gotpos
		width :: Int
width = LayoutDir -> Point -> Int
xc LayoutDir
ld Point
gotsize
		height :: Int
height = LayoutDir -> Point -> Int
yc LayoutDir
ld Point
gotsize
                goth,gotv :: Double
                goth :: Double
goth = fromInt (width - his) / fromInt ncols
                gotv :: Double
gotv = fromInt (height - vis) / fromInt nrows
                pl :: Int -> p -> (Int, Rect)
pl Int
i p
_ =
		  let (Int
x, Int
y) = (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
count', Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
count')
		  in (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Point -> Point -> Rect
Rect
		   (LayoutDir -> Int -> Int -> Point
mkp LayoutDir
ld (Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (fromInt x * (goth + fromInt sep)))
			   (Int
y0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (fromInt y * (gotv + fromInt sep))))
		   (LayoutDir -> Int -> Int -> Point
mkp LayoutDir
ld (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
goth)
			   (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
gotv)))
            in  (Int, [Rect]) -> [Rect]
forall a b. (a, b) -> b
snd ((Int -> LayoutRequest -> (Int, Rect))
-> Int -> [LayoutRequest] -> (Int, [Rect])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Int -> LayoutRequest -> (Int, Rect)
forall p. Int -> p -> (Int, Rect)
pl Int
0 [LayoutRequest]
requests)
    in  (Point -> Bool -> Bool -> [Point] -> LayoutRequest
refpLayout (LayoutDir -> Int -> Int -> Point
mkp LayoutDir
ld Int
h Int
v) Bool
False Bool
False [Point]
rps', Rect -> [Rect]
mat2)

#ifdef __NHC__
fromInt = fromIntegral
#endif