module LayoutRequest where
import Geometry(Point(..), Size(..),Rect(..){-,padd,psub,pmax,pP-})
--import EitherUtils(mapMaybe)
--import HO(apFst)
--import Maptrace(ctrace) -- debugging
import Alignment
import ShowFun()

data LayoutRequest
  = Layout { LayoutRequest -> Size
minsize :: Size,
	     LayoutRequest -> Bool
fixedh, LayoutRequest -> Bool
fixedv :: Bool,
	     LayoutRequest -> Int -> Size
wAdj, LayoutRequest -> Int -> Size
hAdj :: Int -> Size,
		-- If the available width is w
		-- then the size of this box should be wAdj w.
		-- Analogously for hAdj.
	     LayoutRequest -> [Size]
refpoints :: [Point], -- used by some placers
	     LayoutRequest -> Maybe (Size, Size, Alignment)
wantedPos :: Maybe (Point,Size,Alignment)
           }
  deriving (Int -> LayoutRequest -> ShowS
[LayoutRequest] -> ShowS
LayoutRequest -> String
(Int -> LayoutRequest -> ShowS)
-> (LayoutRequest -> String)
-> ([LayoutRequest] -> ShowS)
-> Show LayoutRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayoutRequest] -> ShowS
$cshowList :: [LayoutRequest] -> ShowS
show :: LayoutRequest -> String
$cshow :: LayoutRequest -> String
showsPrec :: Int -> LayoutRequest -> ShowS
$cshowsPrec :: Int -> LayoutRequest -> ShowS
Show)

plainLayout :: Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
s Bool
fh Bool
fv = Size -> Bool -> Bool -> [Size] -> LayoutRequest
refpLayout Size
s Bool
fh Bool
fv []
refpLayout :: Size -> Bool -> Bool -> [Size] -> LayoutRequest
refpLayout Size
s Bool
fh Bool
fv [Size]
rps = Size
-> Bool
-> Bool
-> (Int -> Size)
-> (Int -> Size)
-> [Size]
-> Maybe (Size, Size, Alignment)
-> LayoutRequest
Layout Size
s Bool
fh Bool
fv Int -> Size
forall p. p -> Size
wa Int -> Size
forall p. p -> Size
ha [Size]
rps Maybe (Size, Size, Alignment)
forall a. Maybe a
Nothing
  where
    wa :: p -> Size
wa p
w = {-ctrace "wa" (show (w::Int,s)) $-} Size
s
    ha :: p -> Size
ha p
h = {-ctrace "ha" (show (h::Int,s)) $-} Size
s
    --wa = if fh then const s else \ w -> pmax s (pP w 0)
    --ha = if fv then const s else \ h -> pmax s (pP 0 h)

data LayoutMessage
  = LayoutRequest LayoutRequest
  | LayoutMakeVisible Rect (Maybe Alignment,Maybe Alignment)
  | LayoutScrollStep Int
  | LayoutName String
  | LayoutPlacer Placer
  | LayoutSpacer Spacer
  | LayoutHint LayoutHint
  | LayoutDoNow
  | LayoutDestroy
  | LayoutReplaceSpacer Spacer  -- for use by dynSpacerF
  | LayoutReplacePlacer Placer  -- for use by dynPlacerF
  deriving (Int -> LayoutMessage -> ShowS
[LayoutMessage] -> ShowS
LayoutMessage -> String
(Int -> LayoutMessage -> ShowS)
-> (LayoutMessage -> String)
-> ([LayoutMessage] -> ShowS)
-> Show LayoutMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayoutMessage] -> ShowS
$cshowList :: [LayoutMessage] -> ShowS
show :: LayoutMessage -> String
$cshow :: LayoutMessage -> String
showsPrec :: Int -> LayoutMessage -> ShowS
$cshowsPrec :: Int -> LayoutMessage -> ShowS
Show)

data LayoutResponse
  = LayoutPlace Rect
  | LayoutSize Size
  | LayoutPos Point -- Position in parent window. Occationally useful.
  deriving Int -> LayoutResponse -> ShowS
[LayoutResponse] -> ShowS
LayoutResponse -> String
(Int -> LayoutResponse -> ShowS)
-> (LayoutResponse -> String)
-> ([LayoutResponse] -> ShowS)
-> Show LayoutResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayoutResponse] -> ShowS
$cshowList :: [LayoutResponse] -> ShowS
show :: LayoutResponse -> String
$cshow :: LayoutResponse -> String
showsPrec :: Int -> LayoutResponse -> ShowS
$cshowsPrec :: Int -> LayoutResponse -> ShowS
Show

layoutMakeVisible :: Rect -> LayoutMessage
layoutMakeVisible Rect
r = Rect -> (Maybe Alignment, Maybe Alignment) -> LayoutMessage
LayoutMakeVisible Rect
r (Maybe Alignment
forall a. Maybe a
Nothing,Maybe Alignment
forall a. Maybe a
Nothing)

newtype Placer = P Placer1 deriving (Int -> Placer -> ShowS
[Placer] -> ShowS
Placer -> String
(Int -> Placer -> ShowS)
-> (Placer -> String) -> ([Placer] -> ShowS) -> Show Placer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Placer] -> ShowS
$cshowList :: [Placer] -> ShowS
show :: Placer -> String
$cshow :: Placer -> String
showsPrec :: Int -> Placer -> ShowS
$cshowsPrec :: Int -> Placer -> ShowS
Show)

type Placer1 = ([LayoutRequest] -> Placer2)
type Placer2 = (LayoutRequest, Rect -> [Rect])
unP :: Placer -> Placer1
unP (P Placer1
p) = Placer1
p

newtype Spacer = S Spacer1 deriving (Int -> Spacer -> ShowS
[Spacer] -> ShowS
Spacer -> String
(Int -> Spacer -> ShowS)
-> (Spacer -> String) -> ([Spacer] -> ShowS) -> Show Spacer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Spacer] -> ShowS
$cshowList :: [Spacer] -> ShowS
show :: Spacer -> String
$cshow :: Spacer -> String
showsPrec :: Int -> Spacer -> ShowS
$cshowsPrec :: Int -> Spacer -> ShowS
Show)
type Spacer1 = (LayoutRequest -> Spacer2)
type Spacer2 = (LayoutRequest, Rect -> Rect)
unS :: Spacer -> Spacer1
unS (S Spacer1
s) = Spacer1
s

type LayoutHint = String -- ??

--mapLayoutSize f req@(Layout {minsize=s}) = req{minsize=f s}
mapLayoutSize :: (Size -> Size) -> LayoutRequest -> LayoutRequest
mapLayoutSize Size -> Size
f = (Size -> Size)
-> (Int -> Int) -> (Int -> Int) -> LayoutRequest -> LayoutRequest
mapAdjLayoutSize Size -> Size
f Int -> Int
forall a. a -> a
id Int -> Int
forall a. a -> a
id

mapAdjLayoutSize :: (Size -> Size)
-> (Int -> Int) -> (Int -> Int) -> LayoutRequest -> LayoutRequest
mapAdjLayoutSize Size -> Size
f Int -> Int
wf Int -> Int
hf req :: LayoutRequest
req@(Layout {minsize :: LayoutRequest -> Size
minsize=Size
s,wAdj :: LayoutRequest -> Int -> Size
wAdj=Int -> Size
wa,hAdj :: LayoutRequest -> Int -> Size
hAdj=Int -> Size
ha}) =
  LayoutRequest
req{minsize :: Size
minsize=Size -> Size
f Size
s, wAdj :: Int -> Size
wAdj=Size -> Size
f(Size -> Size) -> (Int -> Size) -> Int -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Size
wa(Int -> Size) -> (Int -> Int) -> Int -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Int
wf, hAdj :: Int -> Size
hAdj=Size -> Size
f(Size -> Size) -> (Int -> Size) -> Int -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Size
ha(Int -> Size) -> (Int -> Int) -> Int -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Int
hf}

mapLayoutRefs :: (Size -> Size) -> LayoutRequest -> LayoutRequest
mapLayoutRefs Size -> Size
f req :: LayoutRequest
req@(Layout{refpoints :: LayoutRequest -> [Size]
refpoints=[Size]
rps}) = LayoutRequest
req{refpoints :: [Size]
refpoints=(Size -> Size) -> [Size] -> [Size]
forall a b. (a -> b) -> [a] -> [b]
map Size -> Size
f [Size]
rps}

flipReq :: LayoutRequest -> LayoutRequest
flipReq (Layout Size
p 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)
-> LayoutRequest
Layout (Size -> Size
flipPoint Size
p) Bool
fv Bool
fh
	 (Size -> Size
flipPoint (Size -> Size) -> (Int -> Size) -> Int -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Size
ha) (Size -> Size
flipPoint (Size -> Size) -> (Int -> Size) -> Int -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Size
wa)
	 ((Size -> Size) -> [Size] -> [Size]
forall a b. (a -> b) -> [a] -> [b]
map Size -> Size
flipPoint [Size]
rps)
	 (((Size, Size, Alignment) -> (Size, Size, Alignment))
-> Maybe (Size, Size, Alignment) -> Maybe (Size, Size, Alignment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Size, Size, Alignment) -> (Size, Size, Alignment)
forall c. (Size, Size, c) -> (Size, Size, c)
flipWanted Maybe (Size, Size, Alignment)
wanted)

flipWanted :: (Size, Size, c) -> (Size, Size, c)
flipWanted (Size
p,Size
s,c
a) = (Size -> Size
flipPoint Size
p,Size -> Size
flipPoint Size
s,c
a)

flipRect :: Rect -> Rect
flipRect (Rect Size
p Size
s) = Size -> Size -> Rect
Rect (Size -> Size
flipPoint Size
p) (Size -> Size
flipPoint Size
s)
flipPoint :: Size -> Size
flipPoint (Point Int
x Int
y) = Int -> Int -> Size
Point Int
y Int
x