module LinearSplitP where
import AllFudgets
--import ListUtil(chopList)
import HbcUtils(apFst,chopList)
import Data.Maybe(isJust,listToMaybe)

horizontalSplitP :: Placer
horizontalSplitP = Int -> Placer
horizontalSplitP' Int
forall a. Num a => a
defaultSep
verticalSplitP :: Placer
verticalSplitP = Int -> Placer
verticalSplitP' Int
forall a. Num a => a
defaultSep

horizontalSplitP' :: Int -> Placer
horizontalSplitP' = LayoutDir -> Int -> Placer
linearSplitP LayoutDir
Horizontal
verticalSplitP' :: Int -> Placer
verticalSplitP' = LayoutDir -> Int -> Placer
linearSplitP LayoutDir
Vertical

linearSplitP :: LayoutDir -> Int -> Placer
linearSplitP LayoutDir
dir Int
sep = Placer1 -> Placer
P Placer1
linearSplitP'
  where
    linearSplitP' :: Placer1
linearSplitP' [] = Placer1
linearP' []
    linearSplitP' [LayoutRequest
r] = Placer1
linearP' [LayoutRequest
r]
    linearSplitP' [LayoutRequest]
reqs0 = (LayoutRequest
req,Rect -> [Rect]
placer2)
      where
        reqss :: [[LayoutRequest]]
reqss = [LayoutRequest] -> [[LayoutRequest]]
chopReqs [LayoutRequest]
reqs0
        ([LayoutRequest]
reqs1,[Rect -> [Rect]]
placers2) = [(LayoutRequest, Rect -> [Rect])]
-> ([LayoutRequest], [Rect -> [Rect]])
forall a b. [(a, b)] -> ([a], [b])
unzip (Placer1 -> [[LayoutRequest]] -> [(LayoutRequest, Rect -> [Rect])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Placer1
linearP' [[LayoutRequest]]
reqss)
	--reqs2 = zipWith adjSize (sizes reqss) reqs1
	(LayoutRequest
req,Rect -> [Rect]
placer2a) = Placer1
linearP' [LayoutRequest]
reqs1
	positions :: [Maybe (Point, Point, Alignment)]
positions = ([LayoutRequest] -> Maybe (Point, Point, Alignment))
-> [[LayoutRequest]] -> [Maybe (Point, Point, Alignment)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( \ [LayoutRequest]
r->[LayoutRequest] -> Maybe LayoutRequest
forall a. [a] -> Maybe a
listToMaybe [LayoutRequest]
r Maybe LayoutRequest
-> (LayoutRequest -> Maybe (Point, Point, Alignment))
-> Maybe (Point, Point, Alignment)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LayoutRequest -> Maybe (Point, Point, Alignment)
wantedPos) [[LayoutRequest]]
reqss
	placer2 :: Rect -> [Rect]
placer2 r :: Rect
r@(Rect Point
_ Point
s) =
 	  [[Rect]] -> [Rect]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Rect]] -> [Rect]) -> (Rect -> [[Rect]]) -> Rect -> [Rect]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rect -> [Rect]) -> Rect -> [Rect])
-> [Rect -> [Rect]] -> [Rect] -> [[Rect]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Rect -> [Rect]) -> Rect -> [Rect]
forall a. a -> a
id [Rect -> [Rect]]
placers2 ([Rect] -> [[Rect]]) -> (Rect -> [Rect]) -> Rect -> [[Rect]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> [Maybe (Point, Point, Alignment)] -> [Rect] -> [Rect]
forall c.
RealFrac c =>
Point -> [Maybe (Point, Point, c)] -> [Rect] -> [Rect]
adjPlaces Point
s [Maybe (Point, Point, Alignment)]
positions ([Rect] -> [Rect]) -> (Rect -> [Rect]) -> Rect -> [Rect]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect -> [Rect]
placer2a (Rect -> [Rect]) -> Rect -> [Rect]
forall a b. (a -> b) -> a -> b
$ Rect
r

    adjPlaces :: Point -> [Maybe (Point, Point, c)] -> [Rect] -> [Rect]
adjPlaces Point
asize (Maybe (Point, Point, c)
_:[Maybe (Point, Point, c)]
ps) (Rect
r:[Rect]
rs) = [Maybe (Point, Point, c)] -> Rect -> [Rect] -> [Rect]
forall c.
RealFrac c =>
[Maybe (Point, Point, c)] -> Rect -> [Rect] -> [Rect]
adjPlaces' [Maybe (Point, Point, c)]
ps Rect
r [Rect]
rs
      where
	adjPlaces' :: [Maybe (Point, Point, c)] -> Rect -> [Rect] -> [Rect]
adjPlaces' (Maybe (Point, Point, c)
optp:[Maybe (Point, Point, c)]
ps) r1 :: Rect
r1@(Rect Point
p1 Point
s1) (r2 :: Rect
r2@(Rect Point
p2 Point
s2):[Rect]
rs) =
	  case Maybe (Point, Point, c)
optp of
	    Maybe (Point, Point, c)
Nothing -> Rect
r1Rect -> [Rect] -> [Rect]
forall a. a -> [a] -> [a]
:[Maybe (Point, Point, c)] -> Rect -> [Rect] -> [Rect]
adjPlaces' [Maybe (Point, Point, c)]
ps Rect
r2 [Rect]
rs -- shouldn't happen
	    Just (Point
p0,Point
s,c
a) -> Rect
r1' Rect -> [Rect] -> [Rect]
forall a. a -> [a] -> [a]
: [Maybe (Point, Point, c)] -> Rect -> [Rect] -> [Rect]
adjPlaces' [Maybe (Point, Point, c)]
ps Rect
r2' [Rect]
rs
	      where v :: Point
v = LayoutDir -> Int -> Int -> Point
mkp LayoutDir
dir Int
d Int
0
	             where
		       d :: Int
d = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
d0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d1)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
d1 -- try to avoid sizes <= 0
		       d0 :: Int
d0 = LayoutDir -> Point -> Int
xc LayoutDir
dir Point
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-LayoutDir -> Point -> Int
xc LayoutDir
dir (Rect -> Point
rectpos Rect
r2)
		       d1 :: Int
d1 = LayoutDir -> Point -> Int
xc LayoutDir
dir Point
s1
		    p :: Point
p = Point
p0 Point -> Point -> Point
forall a. Num a => a -> a -> a
+ c -> Point -> Point
forall a. RealFrac a => a -> Point -> Point
scalePoint c
a (Point
asizePoint -> Point -> Point
forall a. Num a => a -> a -> a
-Point
s)
		    r1' :: Rect
r1' = Point -> Point -> Rect
Rect Point
p1 (Point
s1Point -> Point -> Point
forall a. Num a => a -> a -> a
+Point
v)
		    r2' :: Rect
r2' = Point -> Point -> Rect
Rect (Point
p2Point -> Point -> Point
forall a. Num a => a -> a -> a
+Point
v) (Point
s2Point -> Point -> Point
forall a. Num a => a -> a -> a
-Point
v)
	adjPlaces' [] Rect
r [] = [Rect
r]


    chopReqs :: [LayoutRequest] -> [[LayoutRequest]]
chopReqs = ([LayoutRequest] -> ([LayoutRequest], [LayoutRequest]))
-> [LayoutRequest] -> [[LayoutRequest]]
forall a b. ([a] -> (b, [a])) -> [a] -> [b]
chopList [LayoutRequest] -> ([LayoutRequest], [LayoutRequest])
splitReqs

    splitReqs :: [LayoutRequest] -> ([LayoutRequest], [LayoutRequest])
splitReqs (LayoutRequest
r:[LayoutRequest]
rs) = ([LayoutRequest] -> [LayoutRequest])
-> ([LayoutRequest], [LayoutRequest])
-> ([LayoutRequest], [LayoutRequest])
forall t a b. (t -> a) -> (t, b) -> (a, b)
apFst (LayoutRequest
rLayoutRequest -> [LayoutRequest] -> [LayoutRequest]
forall a. a -> [a] -> [a]
:) ((LayoutRequest -> Bool)
-> [LayoutRequest] -> ([LayoutRequest], [LayoutRequest])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break LayoutRequest -> Bool
wantPos [LayoutRequest]
rs)
    splitReqs [] = ([],[])

    wantPos :: LayoutRequest -> Bool
wantPos = Maybe (Point, Point, Alignment) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Point, Point, Alignment) -> Bool)
-> (LayoutRequest -> Maybe (Point, Point, Alignment))
-> LayoutRequest
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutRequest -> Maybe (Point, Point, Alignment)
wantedPos

    linearP' :: Placer1
linearP' = Placer -> Placer1
unP (LayoutDir -> Int -> Placer
linearP LayoutDir
dir Int
sep)

    {-
    adjSize Nothing req = req
    adjSize (Just s1) req@(Layout{minsize=s2}) =
        req{minsize=size, wAdj=const size, hAdj=const size}
      where size = mkp dir (xc dir s1) (yc dir s2)

    sizes = sizes' . (Just 0:) . tail . positions
    sizes' ps = zipWith size ps (tail ps++[Nothing])
      where size optp1 optp2 = do p1 <- optp1
                                  p2 <- optp2
				  return (p2-p1-mkp dir sep 0)
    -}