module Spacers where
import LayoutRequest
import Geometry
import Utils(mapPair)
import Alignment

---- Spacer types

type Distance = Int


---- Primitive Spacers

-- Fixed margins

hMarginS, vMarginS :: Distance -> Distance -> Spacer
hMarginS :: Distance -> Distance -> Spacer
hMarginS Distance
dLeft Distance
dRight = Size -> Size -> Spacer
hvMarginS (Distance -> Distance -> Size
pP Distance
dLeft Distance
0) (Distance -> Distance -> Size
pP Distance
dRight Distance
0)
vMarginS :: Distance -> Distance -> Spacer
vMarginS Distance
dTop Distance
dBottom = Size -> Size -> Spacer
hvMarginS (Distance -> Distance -> Size
pP Distance
0 Distance
dTop) (Distance -> Distance -> Size
pP Distance
0 Distance
dBottom)

hvMarginS :: Size -> Size -> Spacer
hvMarginS :: Size -> Size -> Spacer
hvMarginS Size
dUpperLeft Size
dBottomRight = Spacer1 -> Spacer
S (Spacer1 -> Spacer) -> Spacer1 -> Spacer
forall a b. (a -> b) -> a -> b
$ \ LayoutRequest
req ->
  let growth :: Size
growth = Size
dUpperLeft Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
dBottomRight
  in ((Size -> Size) -> LayoutRequest -> LayoutRequest
mapLayoutRefs (Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
dUpperLeft) (LayoutRequest -> LayoutRequest) -> LayoutRequest -> LayoutRequest
forall a b. (a -> b) -> a -> b
$
        (Size -> Size)
-> (Distance -> Distance)
-> (Distance -> Distance)
-> LayoutRequest
-> LayoutRequest
mapAdjLayoutSize (Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
growth) (Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
+(-Size -> Distance
xcoord Size
growth)) (Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
+(-Size -> Distance
ycoord Size
growth)) LayoutRequest
req,
      Size -> Size -> Rect -> Rect
center' Size
dUpperLeft Size
growth)

center :: Size -> Rect -> Rect
center Size
p (Rect Size
r Size
s) = Size -> Size -> Rect
Rect (Size
rSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
p) (Size
sSize -> Size -> Size
forall a. Num a => a -> a -> a
-(Size
pSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
p))
center' :: Size -> Size -> Rect -> Rect
center' Size
offset Size
shrink (Rect Size
r Size
s) = Size -> Size -> Rect
Rect (Size
rSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
offset) (Size
sSize -> Size -> Size
forall a. Num a => a -> a -> a
-Size
shrink)

sepS :: Size -> Spacer
sepS :: Size -> Spacer
sepS Size
s = Size -> Size -> Spacer
hvMarginS Size
s Size
s

marginS :: Distance -> Spacer
marginS :: Distance -> Spacer
marginS Distance
d = Size -> Spacer
sepS (Distance -> Size
diag Distance
d)

-- Flexible margins

leftS :: Spacer
leftS = Alignment -> Spacer
hAlignS Alignment
aLeft
hCenterS :: Spacer
hCenterS = Alignment -> Spacer
hAlignS Alignment
aCenter
rightS :: Spacer
rightS = Alignment -> Spacer
hAlignS Alignment
aRight

vAlignS :: Alignment -> Spacer
vAlignS = Spacer -> Spacer
flipS (Spacer -> Spacer) -> (Alignment -> Spacer) -> Alignment -> Spacer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Spacer
hAlignS
topS :: Spacer
topS = Spacer -> Spacer
flipS Spacer
leftS
vCenterS :: Spacer
vCenterS = Spacer -> Spacer
flipS Spacer
hCenterS
bottomS :: Spacer
bottomS = Spacer -> Spacer
flipS Spacer
rightS

hvAlignS :: Alignment -> Alignment -> Spacer
hvAlignS Alignment
hpos Alignment
vpos = Alignment -> Spacer
hAlignS Alignment
hpos Spacer -> Spacer -> Spacer
`compS` Alignment -> Spacer
vAlignS Alignment
vpos
centerS :: Spacer
centerS = Spacer
vCenterS Spacer -> Spacer -> Spacer
`compS` Spacer
hCenterS

hAlignS :: Alignment -> Spacer
hAlignS :: Alignment -> Spacer
hAlignS Alignment
hpos = Spacer1 -> Spacer
S (Spacer1 -> Spacer) -> Spacer1 -> Spacer
forall a b. (a -> b) -> a -> b
$ \ (Layout size :: Size
size@(Point Distance
rw Distance
_) Bool
fh Bool
fv Distance -> Size
wa Distance -> Size
ha [Size]
rps Maybe (Size, Size, Alignment)
wanted) ->
  let
    wa' :: Distance -> Size
wa' Distance
w = Distance -> Size
wa (Distance -> Distance -> Distance
forall a. Ord a => a -> a -> a
min Distance
rw Distance
w)
    hAlignR :: Rect -> Rect
hAlignR (Rect p :: Size
p@(Point Distance
x Distance
y) s :: Size
s@(Point Distance
aw Distance
ah)) =
	Size -> Size -> Rect
Rect (Distance -> Distance -> Size
pP (Distance
xDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
+Distance
spaceLeft) Distance
y) (Distance -> Distance -> Size
pP Distance
rw' Distance
ah)
      where
	space :: Distance
space = Distance
awDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
-Distance
rw'
	spaceLeft :: Distance
spaceLeft = Alignment -> Distance -> Distance
forall a1 b a2.
(RealFrac a1, Integral b, Integral a2) =>
a1 -> a2 -> b
scale Alignment
hpos Distance
space
	rw' :: Distance
rw' = Distance -> Distance -> Distance
forall a. Ord a => a -> a -> a
min Distance
rw Distance
aw
	rw :: Distance
rw = Size -> Distance
xcoord (Distance -> Size
ha Distance
ah)
  in (Size
-> Bool
-> Bool
-> (Distance -> Size)
-> (Distance -> Size)
-> [Size]
-> Maybe (Size, Size, Alignment)
-> LayoutRequest
Layout Size
size Bool
False{-fh-} Bool
fv Distance -> Size
wa' Distance -> Size
ha [Size]
rps Maybe (Size, Size, Alignment)
wanted,Rect -> Rect
hAlignR)

marginHVAlignS :: Distance -> Alignment -> Alignment -> Spacer
marginHVAlignS Distance
sep Alignment
halign Alignment
valign = Distance -> Spacer
marginS Distance
sep Spacer -> Spacer -> Spacer
`compS` Alignment -> Alignment -> Spacer
hvAlignS Alignment
halign Alignment
valign

--- Spacer operations

spacerP :: Spacer -> Placer -> Placer
spacerP :: Spacer -> Placer -> Placer
spacerP (S Spacer1
spacer) (P Placer1
placer) = Placer1 -> Placer
P (Placer1 -> Placer) -> Placer1 -> Placer
forall a b. (a -> b) -> a -> b
$ \ [LayoutRequest]
reqs ->
  let   (LayoutRequest
req',Rect -> [Rect]
placer2) = Placer1
placer [LayoutRequest]
reqs
        (LayoutRequest
req'',Rect -> Rect
spacer2) = Spacer1
spacer LayoutRequest
req'
  in (LayoutRequest
req'',Rect -> [Rect]
placer2(Rect -> [Rect]) -> (Rect -> Rect) -> Rect -> [Rect]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Rect -> Rect
spacer2)

--flipS :: Spacer -> Spacer
flipS :: Spacer -> Spacer
flipS = (Spacer1 -> Spacer1) -> Spacer -> Spacer
mapS Spacer1 -> Spacer1
flipS'
  where
    flipS' :: Spacer1 -> Spacer1
flipS' Spacer1
spacer = (LayoutRequest -> LayoutRequest, (Rect -> Rect) -> Rect -> Rect)
-> (LayoutRequest, Rect -> Rect) -> (LayoutRequest, Rect -> Rect)
forall t1 a t2 b. (t1 -> a, t2 -> b) -> (t1, t2) -> (a, b)
mapPair (LayoutRequest -> LayoutRequest
flipReq,(Rect -> Rect) -> Rect -> Rect
flipS2) ((LayoutRequest, Rect -> Rect) -> (LayoutRequest, Rect -> Rect))
-> Spacer1 -> Spacer1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spacer1
spacer Spacer1 -> (LayoutRequest -> LayoutRequest) -> Spacer1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutRequest -> LayoutRequest
flipReq
    flipS2 :: (Rect -> Rect) -> Rect -> Rect
flipS2 Rect -> Rect
spacer2 = Rect -> Rect
flipRect(Rect -> Rect) -> (Rect -> Rect) -> Rect -> Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Rect -> Rect
spacer2(Rect -> Rect) -> (Rect -> Rect) -> Rect -> Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Rect -> Rect
flipRect

mapS :: (Spacer1 -> Spacer1) -> Spacer -> Spacer
mapS Spacer1 -> Spacer1
f (S Spacer1
sp) = Spacer1 -> Spacer
S (Spacer1 -> Spacer1
f Spacer1
sp)

--idS :: Spacer
idS :: Spacer
idS = Spacer1 -> Spacer
S (Spacer1 -> Spacer) -> Spacer1 -> Spacer
forall a b. (a -> b) -> a -> b
$ \ LayoutRequest
req -> (LayoutRequest
req,Rect -> Rect
forall a. a -> a
id)

compS :: Spacer -> Spacer -> Spacer
compS :: Spacer -> Spacer -> Spacer
compS (S Spacer1
spa) (S Spacer1
spb) = Spacer1 -> Spacer
S (Spacer1 -> Spacer) -> Spacer1 -> Spacer
forall a b. (a -> b) -> a -> b
$ \ LayoutRequest
req ->
  let   (LayoutRequest
req',Rect -> Rect
spb2) = Spacer1
spb LayoutRequest
req
        (LayoutRequest
req'',Rect -> Rect
spa2) = Spacer1
spa LayoutRequest
req'
  in (LayoutRequest
req'',Rect -> Rect
spb2(Rect -> Rect) -> (Rect -> Rect) -> Rect -> Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Rect -> Rect
spa2)


sizeS,maxSizeS,minSizeS :: Size -> Spacer
sizeS :: Size -> Spacer
sizeS    = (Size -> Size) -> Spacer
resizeS ((Size -> Size) -> Spacer)
-> (Size -> Size -> Size) -> Size -> Spacer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Size -> Size
forall a b. a -> b -> a
const
maxSizeS :: Size -> Spacer
maxSizeS = (Size -> Size) -> Spacer
resizeS ((Size -> Size) -> Spacer)
-> (Size -> Size -> Size) -> Size -> Spacer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Size -> Size
pmin
minSizeS :: Size -> Spacer
minSizeS = (Size -> Size) -> Spacer
resizeS ((Size -> Size) -> Spacer)
-> (Size -> Size -> Size) -> Size -> Spacer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Size -> Size
pmax

resizeS :: (Size->Size) -> Spacer
resizeS :: (Size -> Size) -> Spacer
resizeS = (LayoutRequest -> LayoutRequest) -> Spacer
layoutModifierS ((LayoutRequest -> LayoutRequest) -> Spacer)
-> ((Size -> Size) -> LayoutRequest -> LayoutRequest)
-> (Size -> Size)
-> Spacer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Size -> Size) -> LayoutRequest -> LayoutRequest
mapLayoutSize
-- The above and below lines now mean the same
--resizeS f = layoutModifierS (mapAdjLayoutSize f id id)

noStretchS :: Bool -> Bool -> Spacer
noStretchS :: Bool -> Bool -> Spacer
noStretchS Bool
fh Bool
fv = (LayoutRequest -> LayoutRequest) -> Spacer
layoutModifierS LayoutRequest -> LayoutRequest
lf
  where lf :: LayoutRequest -> LayoutRequest
lf LayoutRequest
req = LayoutRequest
req { fixedh :: Bool
fixedh=Bool
fh, fixedv :: Bool
fixedv=Bool
fv }
--noStretchS fh fv req = (mapLayout lf req ,id)
--  where lf size _ _ wa ha rps = Layout size fh fv wa ha rps

mapLayout :: (Size
 -> Bool
 -> Bool
 -> (Distance -> Size)
 -> (Distance -> Size)
 -> [Size]
 -> Maybe (Size, Size, Alignment)
 -> t)
-> LayoutRequest -> t
mapLayout Size
-> Bool
-> Bool
-> (Distance -> Size)
-> (Distance -> Size)
-> [Size]
-> Maybe (Size, Size, Alignment)
-> t
f LayoutRequest
req =
  case LayoutRequest
req of
    Layout Size
size Bool
fh Bool
fv Distance -> Size
wa Distance -> Size
ha [Size]
rps Maybe (Size, Size, Alignment)
wanted -> Size
-> Bool
-> Bool
-> (Distance -> Size)
-> (Distance -> Size)
-> [Size]
-> Maybe (Size, Size, Alignment)
-> t
f Size
size Bool
fh Bool
fv Distance -> Size
wa Distance -> Size
ha [Size]
rps Maybe (Size, Size, Alignment)
wanted

--layoutModifierS :: (LayoutRequest -> LayoutRequest) -> Spacer
layoutModifierS :: (LayoutRequest -> LayoutRequest) -> Spacer
layoutModifierS LayoutRequest -> LayoutRequest
lf = Spacer1 -> Spacer
S (Spacer1 -> Spacer) -> Spacer1 -> Spacer
forall a b. (a -> b) -> a -> b
$ \ LayoutRequest
req -> (LayoutRequest -> LayoutRequest
lf LayoutRequest
req,Rect -> Rect
forall a. a -> a
id)