module SizingF(sizingF) where
import LoopLow(loopThroughLowF)
import Spops(mapAccumlSP)
import LayoutRequest
import FRequest
--import Event
--imaport Command
import Geometry(Rect(..))
--import Fudget
import Sizing(newSize)
--import Maptrace(ctrace) -- debugging

sizingF :: Sizing -> F i o -> F i o
sizingF = SP (Either TCommand TEvent) (Either TCommand TEvent)
-> F i o -> F i o
forall i o.
SP (Either TCommand TEvent) (Either TCommand TEvent)
-> F i o -> F i o
loopThroughLowF (SP (Either TCommand TEvent) (Either TCommand TEvent)
 -> F i o -> F i o)
-> (Sizing -> SP (Either TCommand TEvent) (Either TCommand TEvent))
-> Sizing
-> F i o
-> F i o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sizing -> SP (Either TCommand TEvent) (Either TCommand TEvent)
forall a.
Sizing
-> SP
     (Either (a, FRequest) (a, FResponse))
     (Either (a, FRequest) (a, FResponse))
sizingSP

sizingSP :: Sizing
-> SP
     (Either (a, FRequest) (a, FResponse))
     (Either (a, FRequest) (a, FResponse))
sizingSP Sizing
sizing = (Maybe (Maybe Point, Point, Bool, Bool)
 -> Either (a, FRequest) (a, FResponse)
 -> (Maybe (Maybe Point, Point, Bool, Bool),
     Either (a, FRequest) (a, FResponse)))
-> Maybe (Maybe Point, Point, Bool, Bool)
-> SP
     (Either (a, FRequest) (a, FResponse))
     (Either (a, FRequest) (a, FResponse))
forall t a b. (t -> a -> (t, b)) -> t -> SP a b
mapAccumlSP Maybe (Maybe Point, Point, Bool, Bool)
-> Either (a, FRequest) (a, FResponse)
-> (Maybe (Maybe Point, Point, Bool, Bool),
    Either (a, FRequest) (a, FResponse))
forall a.
Maybe (Maybe Point, Point, Bool, Bool)
-> Either (a, FRequest) (a, FResponse)
-> (Maybe (Maybe Point, Point, Bool, Bool),
    Either (a, FRequest) (a, FResponse))
sizingT Maybe (Maybe Point, Point, Bool, Bool)
forall a. Maybe a
state0
  where
    --tr = if sizing==StaticDebug then ctrace "dsizing" else const id
    state0 :: Maybe a
state0 = Maybe a
forall a. Maybe a
Nothing

    sizingT :: Maybe (Maybe Point, Point, Bool, Bool)
-> Either (a, FRequest) (a, FResponse)
-> (Maybe (Maybe Point, Point, Bool, Bool),
    Either (a, FRequest) (a, FResponse))
sizingT Maybe (Maybe Point, Point, Bool, Bool)
Nothing Either (a, FRequest) (a, FResponse)
msg =
      case Either (a, FRequest) (a, FResponse)
msg of
	Left (a
path,LCmd (LayoutRequest (Layout Point
size' Bool
fh' Bool
fv' Int -> Point
wa' Int -> Point
ha' [Point]
rps' Maybe (Point, Point, Alignment)
wanted'))) ->
	  ((Maybe Point, Point, Bool, Bool)
-> Maybe (Maybe Point, Point, Bool, Bool)
forall a. a -> Maybe a
Just (Maybe Point
forall a. Maybe a
Nothing,Point
size',Bool
fh',Bool
fv'{-,rps'-}),Either (a, FRequest) (a, FResponse)
msg)
	Either (a, FRequest) (a, FResponse)
_ -> (Maybe (Maybe Point, Point, Bool, Bool)
forall a. Maybe a
Nothing,Either (a, FRequest) (a, FResponse)
msg)
    sizingT s :: Maybe (Maybe Point, Point, Bool, Bool)
s@(Just state :: (Maybe Point, Point, Bool, Bool)
state@(Maybe Point
optpos,Point
size,Bool
fh,Bool
fv{-,rps-})) Either (a, FRequest) (a, FResponse)
msg =
      case Either (a, FRequest) (a, FResponse)
msg of
	Left (a
path,LCmd (LayoutRequest r :: LayoutRequest
r@(Layout Point
size' Bool
fh' Bool
fv' Int -> Point
wa' Int -> Point
ha' [Point]
rps' Maybe (Point, Point, Alignment)
wanted'))) ->
	    case ((Maybe Point, Point, Bool, Bool)
state' (Maybe Point, Point, Bool, Bool)
-> (Maybe Point, Point, Bool, Bool) -> Bool
forall a. Eq a => a -> a -> Bool
== (Maybe Point, Point, Bool, Bool)
state,Maybe Point
optpos) of
	      (Bool
True,Just Point
pos) -> (Maybe (Maybe Point, Point, Bool, Bool)
s,(a, FResponse) -> Either (a, FRequest) (a, FResponse)
forall a b. b -> Either a b
Right (a
path,LayoutResponse -> FResponse
LEvt (Rect -> LayoutResponse
LayoutPlace (Point -> Point -> Rect
Rect Point
pos Point
size))))
	      (Bool, Maybe Point)
_ -> --tr (show (state,state'))
	            ((Maybe Point, Point, Bool, Bool)
-> Maybe (Maybe Point, Point, Bool, Bool)
forall a. a -> Maybe a
Just (Maybe Point, Point, Bool, Bool)
state',Either (a, FRequest) (a, FResponse)
forall b. Either (a, FRequest) b
msg')
	  where size'' :: Point
size'' = Sizing -> Point -> Point -> Point
newSize Sizing
sizing Point
size Point
size'
	        state' :: (Maybe Point, Point, Bool, Bool)
state' = (Maybe Point
optpos,Point
size'',Bool
fh',Bool
fv'{-,rps'-})
	        msg' :: Either (a, FRequest) b
msg' = (a, FRequest) -> Either (a, FRequest) b
forall a b. a -> Either a b
Left (a
path,LayoutRequest -> FRequest
layoutRequestCmd LayoutRequest
r{minsize :: Point
minsize=Point
size''})
	Right (a
_,LEvt (LayoutPlace rect :: Rect
rect@(Rect Point
pos' Point
size'))) -> ((Maybe Point, Point, Bool, Bool)
-> Maybe (Maybe Point, Point, Bool, Bool)
forall a. a -> Maybe a
Just (Point -> Maybe Point
forall a. a -> Maybe a
Just Point
pos',Point
size',Bool
fh,Bool
fv{-,rps-}),Either (a, FRequest) (a, FResponse)
msg)
	Either (a, FRequest) (a, FResponse)
_ -> (Maybe (Maybe Point, Point, Bool, Bool)
s,Either (a, FRequest) (a, FResponse)
msg)

{-
sizingF prevents a fudget from outputting a layout request that doesn't change
anything. The sizing parameter also restricts what kind of resizing is allowed.

sizingF assumes that the argument fudget has only ONE layout box and will
confuse things if layout requests are received from several different paths.

sizingF is used in autoLayoutF and there is probably no reason to use it in
other places (i.e., use autoLayoutF' if there seems to be a need for sizingF).
-}