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 :: Int -> Int -> Spacer
hMarginS Int
dLeft Int
dRight = Size -> Size -> Spacer
hvMarginS (Int -> Int -> Size
pP Int
dLeft Int
0) (Int -> Int -> Size
pP Int
dRight Int
0)
vMarginS :: Int -> Int -> Spacer
vMarginS Int
dTop Int
dBottom = Size -> Size -> Spacer
hvMarginS (Int -> Int -> Size
pP Int
0 Int
dTop) (Int -> Int -> Size
pP Int
0 Int
dBottom)

hvMarginS :: Size -> Size -> Spacer
hvMarginS :: Size -> Size -> Spacer
hvMarginS Size
dUpperLeft Size
dBottomRight = Spacer1 -> Spacer
S forall a b. (a -> b) -> a -> b
$ \ LayoutRequest
req ->
  let growth :: Size
growth = Size
dUpperLeft forall a. Num a => a -> a -> a
+ Size
dBottomRight
  in ((Size -> Size) -> LayoutRequest -> LayoutRequest
mapLayoutRefs (forall a. Num a => a -> a -> a
+Size
dUpperLeft) forall a b. (a -> b) -> a -> b
$
        (Size -> Size)
-> (Int -> Int) -> (Int -> Int) -> LayoutRequest -> LayoutRequest
mapAdjLayoutSize (forall a. Num a => a -> a -> a
+Size
growth) (forall a. Num a => a -> a -> a
+(-Size -> Int
xcoord Size
growth)) (forall a. Num a => a -> a -> a
+(-Size -> Int
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
rforall a. Num a => a -> a -> a
+Size
p) (Size
sforall a. Num a => a -> a -> a
-(Size
pforall 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
rforall a. Num a => a -> a -> a
+Size
offset) (Size
sforall 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 :: Int -> Spacer
marginS Int
d = Size -> Spacer
sepS (Int -> Size
diag Int
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 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 forall a b. (a -> b) -> a -> b
$ \ (Layout size :: Size
size@(Point Int
rw Int
_) Bool
fh Bool
fv Int -> Size
wa Int -> Size
ha [Size]
rps Maybe (Size, Size, Alignment)
wanted) ->
  let
    wa' :: Int -> Size
wa' Int
w = Int -> Size
wa (forall a. Ord a => a -> a -> a
min Int
rw Int
w)
    hAlignR :: Rect -> Rect
hAlignR (Rect p :: Size
p@(Point Int
x Int
y) s :: Size
s@(Point Int
aw Int
ah)) =
	Size -> Size -> Rect
Rect (Int -> Int -> Size
pP (Int
xforall a. Num a => a -> a -> a
+Int
spaceLeft) Int
y) (Int -> Int -> Size
pP Int
rw' Int
ah)
      where
	space :: Int
space = Int
awforall a. Num a => a -> a -> a
-Int
rw'
	spaceLeft :: Int
spaceLeft = forall {a1} {b} {a2}.
(RealFrac a1, Integral b, Integral a2) =>
a1 -> a2 -> b
scale Alignment
hpos Int
space
	rw' :: Int
rw' = forall a. Ord a => a -> a -> a
min Int
rw Int
aw
	rw :: Int
rw = Size -> Int
xcoord (Int -> Size
ha Int
ah)
  in (Size
-> Bool
-> Bool
-> (Int -> Size)
-> (Int -> Size)
-> [Size]
-> Maybe (Size, Size, Alignment)
-> LayoutRequest
Layout Size
size Bool
False{-fh-} Bool
fv Int -> Size
wa' Int -> Size
ha [Size]
rps Maybe (Size, Size, Alignment)
wanted,Rect -> Rect
hAlignR)

marginHVAlignS :: Int -> Alignment -> Alignment -> Spacer
marginHVAlignS Int
sep Alignment
halign Alignment
valign = Int -> Spacer
marginS Int
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 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]
placer2forall 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 = forall {t1} {a} {t2} {b}. (t1 -> a, t2 -> b) -> (t1, t2) -> (a, b)
mapPair (LayoutRequest -> LayoutRequest
flipReq,(Rect -> Rect) -> Rect -> Rect
flipS2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spacer1
spacer forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutRequest -> LayoutRequest
flipReq
    flipS2 :: (Rect -> Rect) -> Rect -> Rect
flipS2 Rect -> Rect
spacer2 = Rect -> Rect
flipRectforall b c a. (b -> c) -> (a -> b) -> a -> c
.Rect -> Rect
spacer2forall 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 forall a b. (a -> b) -> a -> b
$ \ LayoutRequest
req -> (LayoutRequest
req,forall a. a -> a
id)

compS :: Spacer -> Spacer -> Spacer
compS :: Spacer -> Spacer -> Spacer
compS (S Spacer1
spa) (S Spacer1
spb) = Spacer1 -> Spacer
S 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
spb2forall 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
maxSizeS :: Size -> Spacer
maxSizeS = (Size -> Size) -> Spacer
resizeS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Size -> Size -> Size
pmin
minSizeS :: Size -> Spacer
minSizeS = (Size -> Size) -> Spacer
resizeS 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 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
 -> (Int -> Size)
 -> (Int -> Size)
 -> [Size]
 -> Maybe (Size, Size, Alignment)
 -> t)
-> LayoutRequest -> t
mapLayout Size
-> Bool
-> Bool
-> (Int -> Size)
-> (Int -> Size)
-> [Size]
-> Maybe (Size, Size, Alignment)
-> t
f LayoutRequest
req =
  case LayoutRequest
req of
    Layout Size
size Bool
fh Bool
fv Int -> Size
wa Int -> Size
ha [Size]
rps Maybe (Size, Size, Alignment)
wanted -> Size
-> Bool
-> Bool
-> (Int -> Size)
-> (Int -> Size)
-> [Size]
-> Maybe (Size, Size, Alignment)
-> t
f Size
size Bool
fh Bool
fv Int -> Size
wa Int -> Size
ha [Size]
rps Maybe (Size, Size, Alignment)
wanted

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