module HorizontalAlignP where
import Data.List(mapAccumL)
import LayoutRequest
import Geometry
import Spacers(Distance(..),layoutModifierS,idS)
import Defaults(defaultSep)

-- Better names:
alignP :: Placer
alignP = Placer
horizontalAlignP
alignP' :: Distance -> Placer
alignP' = Distance -> Placer
horizontalAlignP'

horizontalAlignP :: Placer
horizontalAlignP = Distance -> Placer
horizontalAlignP' Distance
forall a. Num a => a
defaultSep

horizontalAlignP' :: Distance -> Placer
horizontalAlignP' :: Distance -> Placer
horizontalAlignP' Distance
sep = Placer1 -> Placer
P Placer1
haP
  where
    haP :: Placer1
haP [LayoutRequest]
reqs = (LayoutRequest
req,Rect -> [Rect]
placer2)
      where
	sepp :: Point
sepp = Distance -> Distance -> Point
pP Distance
sep Distance
0
	req :: LayoutRequest
req = Point -> Bool -> Bool -> [Point] -> LayoutRequest
refpLayout Point
rsize Bool
fh Bool
fv [Point
ref1,Point
ref2]
	fh :: Bool
fh = (LayoutRequest -> Bool) -> [LayoutRequest] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LayoutRequest -> Bool
fixedh [LayoutRequest]
reqs
	fv :: Bool
fv = Bool
False -- any fixedv reqs
	reqrects0 :: [((Rect, (Bool, Bool)), (Point, Point))]
reqrects0 = (Point, [((Rect, (Bool, Bool)), (Point, Point))])
-> [((Rect, (Bool, Bool)), (Point, Point))]
forall a b. (a, b) -> b
snd ((Point, [((Rect, (Bool, Bool)), (Point, Point))])
 -> [((Rect, (Bool, Bool)), (Point, Point))])
-> (Point, [((Rect, (Bool, Bool)), (Point, Point))])
-> [((Rect, (Bool, Bool)), (Point, Point))]
forall a b. (a -> b) -> a -> b
$ (Point
 -> LayoutRequest
 -> (Point, ((Rect, (Bool, Bool)), (Point, Point))))
-> Point
-> [LayoutRequest]
-> (Point, [((Rect, (Bool, Bool)), (Point, Point))])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Point
-> LayoutRequest -> (Point, ((Rect, (Bool, Bool)), (Point, Point)))
reqrect (-Point
sepp) [LayoutRequest]
reqs
	  where
	    reqrect :: Point
-> LayoutRequest -> (Point, ((Rect, (Bool, Bool)), (Point, Point)))
reqrect Point
ref0 (Layout {minsize :: LayoutRequest -> Point
minsize=Point
s,fixedh :: LayoutRequest -> Bool
fixedh=Bool
fh,fixedv :: LayoutRequest -> Bool
fixedv=Bool
fv,refpoints :: LayoutRequest -> [Point]
refpoints=[Point]
rps}) =
		(Point
ref2',((Point -> Point -> Rect
Rect Point
d Point
s,(Bool
fh,Bool
fv)),(Point
dPoint -> Point -> Point
forall a. Num a => a -> a -> a
+Point
ref1,Point
ref2')))
	      where d :: Point
d = Point
ref0Point -> Point -> Point
forall a. Num a => a -> a -> a
-Point
ref1Point -> Point -> Point
forall a. Num a => a -> a -> a
+Point
sepp
		    ref2' :: Point
ref2' = Point
dPoint -> Point -> Point
forall a. Num a => a -> a -> a
+Point
ref2
		    (Point
ref1,Point
ref2) = case [Point]
rps of
				    [] -> Point -> (Point, Point)
middleRefs Point
s
				    [Point]
_  -> ([Point] -> Point
forall a. [a] -> a
head [Point]
rps,[Point] -> Point
forall a. [a] -> a
last [Point]
rps)

	reqrects :: [((Rect, (Bool, Bool)), (Point, Point))]
reqrects = (((Rect, (Bool, Bool)), (Point, Point))
 -> ((Rect, (Bool, Bool)), (Point, Point)))
-> [((Rect, (Bool, Bool)), (Point, Point))]
-> [((Rect, (Bool, Bool)), (Point, Point))]
forall a b. (a -> b) -> [a] -> [b]
map ((Rect, (Bool, Bool)), (Point, Point))
-> ((Rect, (Bool, Bool)), (Point, Point))
forall b.
((Rect, b), (Point, Point)) -> ((Rect, b), (Point, Point))
adj [((Rect, (Bool, Bool)), (Point, Point))]
reqrects0
	  where adj :: ((Rect, b), (Point, Point)) -> ((Rect, b), (Point, Point))
adj ((Rect
r,b
f),(Point
ref1,Point
ref2)) =
		  ((Rect -> Point -> Rect
moverect Rect
r (-Point
minp),b
f),(Point
ref1Point -> Point -> Point
forall a. Num a => a -> a -> a
-Point
minp,Point
ref2Point -> Point -> Point
forall a. Num a => a -> a -> a
-Point
minp))
		minp :: Point
minp = [Point] -> Point
pMin (Point
0Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
:[Point
d | ((Rect Point
d Point
_,(Bool, Bool)
_),(Point, Point)
_) <- [((Rect, (Bool, Bool)), (Point, Point))]
reqrects0])

	rsize :: Point
rsize = [Point] -> Point
pMax (Point
1Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
:[Point
pPoint -> Point -> Point
forall a. Num a => a -> a -> a
+Point
s | ((Rect Point
p Point
s,(Bool, Bool)
_),(Point, Point)
_) <- [((Rect, (Bool, Bool)), (Point, Point))]
reqrects])
	(Point
ref1,Point
ref2) =
	  case [((Rect, (Bool, Bool)), (Point, Point))]
reqrects of
	    [] -> Point -> (Point, Point)
middleRefs Point
rsize
	    [((Rect, (Bool, Bool)), (Point, Point))]
_ -> ((Point, Point) -> Point
forall a b. (a, b) -> a
fst ((Point, Point) -> Point)
-> ([((Rect, (Bool, Bool)), (Point, Point))] -> (Point, Point))
-> [((Rect, (Bool, Bool)), (Point, Point))]
-> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rect, (Bool, Bool)), (Point, Point)) -> (Point, Point)
forall a b. (a, b) -> b
snd (((Rect, (Bool, Bool)), (Point, Point)) -> (Point, Point))
-> ([((Rect, (Bool, Bool)), (Point, Point))]
    -> ((Rect, (Bool, Bool)), (Point, Point)))
-> [((Rect, (Bool, Bool)), (Point, Point))]
-> (Point, Point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [((Rect, (Bool, Bool)), (Point, Point))]
-> ((Rect, (Bool, Bool)), (Point, Point))
forall a. [a] -> a
head ([((Rect, (Bool, Bool)), (Point, Point))] -> Point)
-> [((Rect, (Bool, Bool)), (Point, Point))] -> Point
forall a b. (a -> b) -> a -> b
$ [((Rect, (Bool, Bool)), (Point, Point))]
reqrects,(Point, Point) -> Point
forall a b. (a, b) -> b
snd ((Point, Point) -> Point)
-> ([((Rect, (Bool, Bool)), (Point, Point))] -> (Point, Point))
-> [((Rect, (Bool, Bool)), (Point, Point))]
-> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rect, (Bool, Bool)), (Point, Point)) -> (Point, Point)
forall a b. (a, b) -> b
snd (((Rect, (Bool, Bool)), (Point, Point)) -> (Point, Point))
-> ([((Rect, (Bool, Bool)), (Point, Point))]
    -> ((Rect, (Bool, Bool)), (Point, Point)))
-> [((Rect, (Bool, Bool)), (Point, Point))]
-> (Point, Point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [((Rect, (Bool, Bool)), (Point, Point))]
-> ((Rect, (Bool, Bool)), (Point, Point))
forall a. [a] -> a
last ([((Rect, (Bool, Bool)), (Point, Point))] -> Point)
-> [((Rect, (Bool, Bool)), (Point, Point))] -> Point
forall a b. (a -> b) -> a -> b
$ [((Rect, (Bool, Bool)), (Point, Point))]
reqrects)

	placer2 :: Rect -> [Rect]
placer2 rect :: Rect
rect@(Rect Point
p Point
asize) = [Rect -> Point -> Rect
moverect Rect
r Point
d | ((Rect
r,(Bool, Bool)
_),(Point, Point)
_)<-[((Rect, (Bool, Bool)), (Point, Point))]
reqrects]
	  where d :: Point
d = Point
p -- + scalePoint 0.5 (pmax 0 (asize-rsize))

--refMiddleS :: Spacer
refMiddleS :: Spacer
refMiddleS = Spacer1 -> Spacer
S Spacer1
forall a. LayoutRequest -> (LayoutRequest, a -> a)
refMiddleS'

refMiddleS' :: LayoutRequest -> (LayoutRequest, a -> a)
refMiddleS' LayoutRequest
req =
 let (Point
ref1,Point
ref2) = Point -> (Point, Point)
middleRefs (LayoutRequest -> Point
minsize LayoutRequest
req)
 in (LayoutRequest
req{refpoints :: [Point]
refpoints=[Point
ref1,Point
ref2]},a -> a
forall a. a -> a
id)
-- in (Layout s fh fv wa ha [ref1,ref2] wanted,id)

--refEdgesS :: Spacer
refEdgesS :: Spacer
refEdgesS = Spacer1 -> Spacer
S Spacer1
forall a. LayoutRequest -> (LayoutRequest, a -> a)
refEdgesS'
  where
    refEdgesS' :: LayoutRequest -> (LayoutRequest, a -> a)
refEdgesS' req :: LayoutRequest
req@(Layout {refpoints :: LayoutRequest -> [Point]
refpoints=[]}) = LayoutRequest -> (LayoutRequest, a -> a)
forall a. LayoutRequest -> (LayoutRequest, a -> a)
refMiddleS' LayoutRequest
req
    refEdgesS' req :: LayoutRequest
req@(Layout {minsize :: LayoutRequest -> Point
minsize=Point Distance
w Distance
_,refpoints :: LayoutRequest -> [Point]
refpoints=[Point]
rps}) =
        (LayoutRequest
req {refpoints :: [Point]
refpoints=[Point
ref1,Point
ref2]},a -> a
forall a. a -> a
id)
      where
        ref1 :: Point
ref1 = ([Point] -> Point
forall a. [a] -> a
head [Point]
rps){xcoord :: Distance
xcoord=Distance
0}
	ref2 :: Point
ref2 = ([Point] -> Point
forall a. [a] -> a
last [Point]
rps){xcoord :: Distance
xcoord=Distance
w}

middleRefs :: Point -> (Point, Point)
middleRefs (Point Distance
w Distance
h) = (Distance -> Distance -> Point
pP Distance
0 Distance
h2,Distance -> Distance -> Point
pP Distance
w Distance
h2)
  where h2 :: Distance
h2 = Distance
h Distance -> Distance -> Distance
forall a. Integral a => a -> a -> a
`div` Distance
2

noRefsS :: Spacer
noRefsS :: Spacer
noRefsS = Spacer1 -> Spacer
S (Spacer1 -> Spacer) -> Spacer1 -> Spacer
forall a b. (a -> b) -> a -> b
$ \ LayoutRequest
req -> (LayoutRequest
req {refpoints :: [Point]
refpoints=[]},Rect -> Rect
forall a. a -> a
id)

moveRefsS :: Point -> Spacer
moveRefsS :: Point -> Spacer
moveRefsS Point
d = (LayoutRequest -> LayoutRequest) -> Spacer
layoutModifierS ((Point -> Point) -> LayoutRequest -> LayoutRequest
mapLayoutRefs (Point
dPoint -> Point -> Point
forall a. Num a => a -> a -> a
+))

---

spacersP :: Placer -> [Spacer] -> Placer
spacersP :: Placer -> [Spacer] -> Placer
spacersP (P Placer1
placer) [Spacer]
spacers = Placer1 -> Placer
P (Placer1 -> Placer) -> Placer1 -> Placer
forall a b. (a -> b) -> a -> b
$ \ [LayoutRequest]
reqs ->
  let
    ([LayoutRequest]
reqs',[Rect -> Rect]
spacers2) = [(LayoutRequest, Rect -> Rect)]
-> ([LayoutRequest], [Rect -> Rect])
forall a b. [(a, b)] -> ([a], [b])
unzip ((Spacer -> Spacer1)
-> [Spacer] -> [LayoutRequest] -> [(LayoutRequest, Rect -> Rect)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Spacer -> Spacer1
unS ([Spacer]
spacers[Spacer] -> [Spacer] -> [Spacer]
forall a. [a] -> [a] -> [a]
++Spacer -> [Spacer]
forall a. a -> [a]
repeat Spacer
idS) [LayoutRequest]
reqs)
    (LayoutRequest
req,Rect -> [Rect]
placer2) = Placer1
placer [LayoutRequest]
reqs'
    placer2' :: Rect -> [Rect]
placer2' = ((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]
spacers2 ([Rect] -> [Rect]) -> (Rect -> [Rect]) -> Rect -> [Rect]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect -> [Rect]
placer2
  in  (LayoutRequest
req,Rect -> [Rect]
placer2')

---
overlayAlignP :: Placer
overlayAlignP :: Placer
overlayAlignP = Placer1 -> Placer
P (Placer1 -> Placer) -> Placer1 -> Placer
forall a b. (a -> b) -> a -> b
$ \ [LayoutRequest]
ls ->
  let maxrp :: Point
maxrp = [Point] -> Point
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [[Point] -> Point
forall a. [a] -> a
head (LayoutRequest -> [Point]
refpoints LayoutRequest
l) | LayoutRequest
l<-[LayoutRequest]
ls, Bool -> Bool
not ([Point] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (LayoutRequest -> [Point]
refpoints LayoutRequest
l))]
      ss :: [Point]
ss = [Point -> [Point] -> Point
f Point
ms [Point]
rps | Layout { minsize :: LayoutRequest -> Point
minsize=Point
ms,refpoints :: LayoutRequest -> [Point]
refpoints=[Point]
rps}<-[LayoutRequest]
ls ]
	where f :: Point -> [Point] -> Point
f Point
s [] = Point
s
	      f Point
s (Point
rp:[Point]
_) = Point
sPoint -> Point -> Point
forall a. Num a => a -> a -> a
+Point
maxrpPoint -> Point -> Point
forall a. Num a => a -> a -> a
-Point
rp
      req :: LayoutRequest
req = Point -> Bool -> Bool -> [Point] -> LayoutRequest
refpLayout ([Point] -> Point
pMax [Point]
ss) ((LayoutRequest -> Bool) -> [LayoutRequest] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LayoutRequest -> Bool
fixedh [LayoutRequest]
ls) ((LayoutRequest -> Bool) -> [LayoutRequest] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LayoutRequest -> Bool
fixedv [LayoutRequest]
ls) [Point
maxrp]
      placer2 :: Rect -> [Rect]
placer2 Rect
r = [Rect -> [Point] -> Rect
f Rect
r [Point]
rps | Layout {refpoints :: LayoutRequest -> [Point]
refpoints=[Point]
rps} <- [LayoutRequest]
ls]
	where f :: Rect -> [Point] -> Rect
f Rect
r [] = Rect
r
	      f (Rect Point
p Point
s) (Point
rp:[Point]
_) = Point -> Point -> Rect
Rect (Point
pPoint -> Point -> Point
forall a. Num a => a -> a -> a
+Point
d) (Point
sPoint -> Point -> Point
forall a. Num a => a -> a -> a
-Point
d)
		where d :: Point
d=Point
maxrpPoint -> Point -> Point
forall a. Num a => a -> a -> a
-Point
rp
  in (LayoutRequest
req,Rect -> [Rect]
placer2)