module ScrollF(scrollShellF,
               scrollF,oldScrollF,
               vScrollF,oldVscrollF,
	       hScrollF,oldHscrollF,
	       grabScrollKeys) where
import Fudget
import EitherUtils
import CmdLineEnv(argFlag)
import Utils(remove)
import LayoutRequest
import Geometry
import Command
import FRequest
import Event
import Xtypes

import FreeGroupF
import Dlayout(groupF)
import DShellF(shellF)
import Spops
import NullF(nullF)
import Cont(waitForSP)
import SpEither(mapFilterSP)
import DragF(hPotF',vPotF',PotRequest(..))
import Placer(tableF,hBoxF,vBoxF)
import SerCompF(absF)
import Loops(loopThroughRightF)
import CompOps
--import Maptrace(ctrace)

scrollShellF :: String -> (Point, Point) -> F c d -> F c d
scrollShellF String
name (Point, Point)
initlimits = forall {c} {d}. String -> F c d -> F c d
shellF String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b} {d}. Bool -> (Point, Point) -> F b d -> F b d
oldScrollF Bool
True (Point, Point)
initlimits

grabScrollKeys :: Bool
grabScrollKeys = String -> Bool -> Bool
argFlag String
"grabscrollkeys" Bool
False
 -- True is not good if there are two or more scrollFs in the same shell window.

-- Std versions with arbirarily chosen limits...
scrollF :: F b d -> F b d
scrollF = forall {b} {d}. Bool -> (Point, Point) -> F b d -> F b d
oldScrollF Bool
grabScrollKeys (Int -> Int -> Point
pP Int
50 Int
30,Int -> Int -> Point
pP Int
550 Int
700)
vScrollF :: F b d -> F b d
vScrollF = forall {b} {d}. Bool -> (Point, Point) -> F b d -> F b d
oldVscrollF Bool
grabScrollKeys (Int -> Int -> Point
pP Int
50 Int
30,Int -> Int -> Point
pP Int
550 Int
700)
hScrollF :: F b d -> F b d
hScrollF = forall {b} {d}. Bool -> (Point, Point) -> F b d -> F b d
oldHscrollF Bool
grabScrollKeys (Int -> Int -> Point
pP Int
50 Int
10,Int -> Int -> Point
pP Int
550 Int
700)

scroll :: Bool
-> (a -> b -> a, LayoutRequest -> Point -> Point, F a b -> F a b,
    F (Either PotRequest PotRequest) (Either PotState PotState))
scroll Bool
foc = (forall a b. a -> b -> a
const,LayoutRequest -> Point -> Point
plainAdjLayout,forall {a} {b}. Int -> F a b -> F a b
tableF Int
2,Bool -> Maybe Point -> F PotRequest PotState
vPotF' Bool
foc forall a. Maybe a
Nothing forall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
>+< Bool -> Maybe Point -> F PotRequest PotState
hPotF' Bool
foc forall a. Maybe a
Nothing)
vscroll :: Bool
-> (a -> b -> a, LayoutRequest -> Point -> Point, F a b -> F a b,
    F (Either PotRequest c) (Either PotState d))
vscroll Bool
foc = (forall a b. a -> b -> a
const,LayoutRequest -> Point -> Point
wAdjLayout,forall {a} {b}. F a b -> F a b
hBoxF,Bool -> Maybe Point -> F PotRequest PotState
vPotF' Bool
foc forall a. Maybe a
Nothing forall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
>+< forall {hi} {ho}. F hi ho
nullF)
hscroll :: Bool
-> (a -> b -> a, LayoutRequest -> Point -> Point, F a b -> F a b,
    F (Either a PotRequest) (Either b PotState))
hscroll Bool
foc = (forall a b. a -> b -> a
const,LayoutRequest -> Point -> Point
hAdjLayout,forall {a} {b}. F a b -> F a b
vBoxF,forall {hi} {ho}. F hi ho
nullFforall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
>+<Bool -> Maybe Point -> F PotRequest PotState
hPotF' Bool
foc forall a. Maybe a
Nothing)

oldScrollF :: Bool -> (Point, Point) -> F b d -> F b d
oldScrollF Bool
grabKeys  = forall {a} {c} {inr} {b} {b} {b} {b} {c} {b} {c} {d}.
(a, LayoutRequest -> Point -> Point,
 F (Either (Either (Either Point (Either Point Point)) c) inr)
   (Either
      (Either (Either (Either (ModState, String) Point) LayoutMessage) b)
      b)
 -> F (Either
         (Either
            (Either Point (Either Point Point)) (Either PotRequest PotRequest))
         b)
      (Either
         (Either
            (Either (Either (ModState, String) Point) LayoutMessage)
            (Either (Int, b, c) (Int, b, c)))
         d),
 F c b)
-> Bool -> (Point, Point) -> F inr b -> F b d
gScrollF (forall {a} {b} {a} {b}.
Bool
-> (a -> b -> a, LayoutRequest -> Point -> Point, F a b -> F a b,
    F (Either PotRequest PotRequest) (Either PotState PotState))
scroll  (Bool -> Bool
not Bool
grabKeys)) Bool
grabKeys
oldVscrollF :: Bool -> (Point, Point) -> F b d -> F b d
oldVscrollF Bool
grabKeys = forall {a} {c} {inr} {b} {b} {b} {b} {c} {b} {c} {d}.
(a, LayoutRequest -> Point -> Point,
 F (Either (Either (Either Point (Either Point Point)) c) inr)
   (Either
      (Either (Either (Either (ModState, String) Point) LayoutMessage) b)
      b)
 -> F (Either
         (Either
            (Either Point (Either Point Point)) (Either PotRequest PotRequest))
         b)
      (Either
         (Either
            (Either (Either (ModState, String) Point) LayoutMessage)
            (Either (Int, b, c) (Int, b, c)))
         d),
 F c b)
-> Bool -> (Point, Point) -> F inr b -> F b d
gScrollF (forall {a} {b} {a} {b} {c} {d}.
Bool
-> (a -> b -> a, LayoutRequest -> Point -> Point, F a b -> F a b,
    F (Either PotRequest c) (Either PotState d))
vscroll (Bool -> Bool
not Bool
grabKeys)) Bool
grabKeys
oldHscrollF :: Bool -> (Point, Point) -> F b d -> F b d
oldHscrollF Bool
grabKeys = forall {a} {c} {inr} {b} {b} {b} {b} {c} {b} {c} {d}.
(a, LayoutRequest -> Point -> Point,
 F (Either (Either (Either Point (Either Point Point)) c) inr)
   (Either
      (Either (Either (Either (ModState, String) Point) LayoutMessage) b)
      b)
 -> F (Either
         (Either
            (Either Point (Either Point Point)) (Either PotRequest PotRequest))
         b)
      (Either
         (Either
            (Either (Either (ModState, String) Point) LayoutMessage)
            (Either (Int, b, c) (Int, b, c)))
         d),
 F c b)
-> Bool -> (Point, Point) -> F inr b -> F b d
gScrollF (forall {a} {b} {a} {b} {a} {b}.
Bool
-> (a -> b -> a, LayoutRequest -> Point -> Point, F a b -> F a b,
    F (Either a PotRequest) (Either b PotState))
hscroll (Bool -> Bool
not Bool
grabKeys)) Bool
grabKeys

gScrollF :: (a, LayoutRequest -> Point -> Point,
 F (Either (Either (Either Point (Either Point Point)) c) inr)
   (Either
      (Either (Either (Either (ModState, String) Point) LayoutMessage) b)
      b)
 -> F (Either
         (Either
            (Either Point (Either Point Point)) (Either PotRequest PotRequest))
         b)
      (Either
         (Either
            (Either (Either (ModState, String) Point) LayoutMessage)
            (Either (Int, b, c) (Int, b, c)))
         d),
 F c b)
-> Bool -> (Point, Point) -> F inr b -> F b d
gScrollF (a
outCoupling,LayoutRequest -> Point -> Point
inCoupling,F (Either (Either (Either Point (Either Point Point)) c) inr)
  (Either
     (Either (Either (Either (ModState, String) Point) LayoutMessage) b)
     b)
-> F (Either
        (Either
           (Either Point (Either Point Point)) (Either PotRequest PotRequest))
        b)
     (Either
        (Either
           (Either (Either (ModState, String) Point) LayoutMessage)
           (Either (Int, b, c) (Int, b, c)))
        d)
placer,F c b
scrollbarsF) Bool
grabKeys (Point, Point)
initlimits F inr b
fud =
    forall a b c d. F (Either a b) (Either c d) -> F c a -> F b d
loopThroughRightF (F (Either (Either (Either Point (Either Point Point)) c) inr)
  (Either
     (Either (Either (Either (ModState, String) Point) LayoutMessage) b)
     b)
-> F (Either
        (Either
           (Either Point (Either Point Point)) (Either PotRequest PotRequest))
        b)
     (Either
        (Either
           (Either (Either (ModState, String) Point) LayoutMessage)
           (Either (Int, b, c) (Int, b, c)))
        d)
placer F (Either (Either (Either Point (Either Point Point)) c) inr)
  (Either
     (Either (Either (Either (ModState, String) Point) LayoutMessage) b)
     b)
mainF) (forall a b. SP a b -> F a b
absF (forall {a} {b} {b} {b}.
(Point
 -> Point
 -> (Point -> Point)
 -> SP
      (Either (Either a LayoutMessage) b) (Either (Either Point b) b))
-> SP
     (Either (Either a LayoutMessage) b) (Either (Either Point b) b)
initSP forall {b} {c} {b} {c} {a}.
Point
-> Point
-> (Point -> Point)
-> SP
     (Either
        (Either (Either (ModState, String) Point) LayoutMessage)
        (Either (Int, b, c) (Int, b, c)))
     (Either
        (Either a (Either Point Point)) (Either PotRequest PotRequest))
ctrlSP))
  where
    mainF :: F (Either (Either (Either Point (Either Point Point)) c) inr)
  (Either
     (Either (Either (Either (ModState, String) Point) LayoutMessage) b)
     b)
mainF =
        forall {a} {b} {b} {b}.
Either (Either a (Either b b)) b
-> Either (Either (Either a b) b) b
postforall a b e. (a -> b) -> F e a -> F e b
>^=<
	(forall {a} {b} {c} {d}.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF [FRequest]
start K Point (Either (ModState, String) Point)
visibleK (forall {inr} {outr}.
F inr outr
-> F (Either (Either Point Point) inr) (Either LayoutMessage outr)
freeGroupF F inr b
fud)forall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
>+<F c b
scrollbarsF)
	forall c d e. F c d -> (e -> c) -> F e d
>=^<forall {a} {b} {b} {b}.
Either (Either (Either a b) b) b
-> Either (Either a (Either b b)) b
pre
      where
        post :: Either (Either a (Either b b)) b
-> Either (Either (Either a b) b) b
post = forall {a} {b} {b}. Either (Either a b) b -> Either (Either a b) b
swapRightforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall {t1} {a} {t2} {b}.
(t1 -> a) -> (t2 -> b) -> Either t1 t2 -> Either a b
mapEither forall {a} {b} {b}. Either a (Either b b) -> Either (Either a b) b
assocLeft forall a. a -> a
id -- (KV+(T+a))+S -> ((KV+T)+S)+a
	pre :: Either (Either (Either a b) b) b
-> Either (Either a (Either b b)) b
pre = forall {t1} {a} {t2} {b}.
(t1 -> a) -> (t2 -> b) -> Either t1 t2 -> Either a b
mapEither forall {a} {b} {b}. Either (Either a b) b -> Either a (Either b b)
assocRight forall a. a -> a
idforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall {a} {b} {b}. Either (Either a b) b -> Either (Either a b) b
swapRight -- converse

        start :: [FRequest]
start = forall a b. (a -> b) -> [a] -> [b]
map XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$
	        [XCommand]
transinitforall a. [a] -> [a] -> [a]
++
	        [[WindowAttributes] -> XCommand
ChangeWindowAttributes [PixmapId -> WindowAttributes
CWBackPixmap PixmapId
parentRelative],
		 [WindowChanges] -> XCommand
ConfigureWindow [Int -> WindowChanges
CWBorderWidth Int
1]]

	transinit :: [XCommand]
transinit =
	    if Bool
grabKeys
	    then [(XEvent -> Maybe XEvent) -> [EventMask] -> XCommand
TranslateEvent XEvent -> Maybe XEvent
tobutton [EventMask
KeyPressMask]]
	    else []

      --tobutton k@(KeyEvent t p1 p2 s Pressed _ ks _) | (s, ks) `elem` keys =
	tobutton :: XEvent -> Maybe XEvent
tobutton e :: XEvent
e@(KeyEvent {state :: XEvent -> ModState
state=ModState
s,type' :: XEvent -> Pressed
type'=Pressed
Pressed,keySym :: XEvent -> String
keySym=String
ks})
	           | (ModState
s, String
ks) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(ModState, String)]
keys =
	    forall a. a -> Maybe a
Just XEvent
e
        -- Mouse Wheel support:
	tobutton e :: XEvent
e@(ButtonEvent {button :: XEvent -> Button
button=Button Int
4,type' :: XEvent -> Pressed
type'=Pressed
Pressed}) = forall a. a -> Maybe a
Just XEvent
e
	tobutton e :: XEvent
e@(ButtonEvent {button :: XEvent -> Button
button=Button Int
5,type' :: XEvent -> Pressed
type'=Pressed
Pressed}) = forall a. a -> Maybe a
Just XEvent
e
	tobutton XEvent
_ = forall a. Maybe a
Nothing

        keys :: [(ModState, String)]
keys = forall a b. (a -> b) -> [a] -> [b]
map ((,) []) [String]
keys' forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map ((,) [Modifiers
Shift]) [String]
keys'
	  where keys' :: [String]
keys' = [String
"Prior",String
"Next",String
"Home",String
"End"]

    -- visibleK reports the current visible size and grabbed keys
    visibleK :: K Point (Either (ModState, String) Point)
visibleK = forall hi ho. KSP hi ho -> K hi ho
K{-kk-} forall a b. (a -> b) -> a -> b
$ forall {t} {b}. (t -> Maybe b) -> SP t b
mapFilterSP Message FResponse Point
-> Maybe (Message FRequest (Either (ModState, String) Point))
visible
      where
	visible :: Message FResponse Point
-> Maybe (Message FRequest (Either (ModState, String) Point))
visible (Low (LEvt (LayoutSize Point
vissize))) = forall a. a -> Maybe a
Just (forall a b. b -> Message a b
High (forall a b. b -> Either a b
Right Point
vissize))
	visible (Low (XEvt (KeyEvent{state :: XEvent -> ModState
state=ModState
mods,type' :: XEvent -> Pressed
type'=Pressed
Pressed,keySym :: XEvent -> String
keySym=String
key}))) =
	    forall a. a -> Maybe a
Just (forall a b. b -> Message a b
High (forall a b. a -> Either a b
Left (ModState
mods,String
key)))
	visible (Low (XEvt (ButtonEvent{button :: XEvent -> Button
button=Button Int
4,type' :: XEvent -> Pressed
type'=Pressed
Pressed,state :: XEvent -> ModState
state=ModState
mods}))) =
	    forall a. a -> Maybe a
Just (forall a b. b -> Message a b
High (forall a b. a -> Either a b
Left (ModState
mods,String
"Prior")))
	visible (Low (XEvt (ButtonEvent{button :: XEvent -> Button
button=Button Int
5,type' :: XEvent -> Pressed
type'=Pressed
Pressed,state :: XEvent -> ModState
state=ModState
mods}))) =
	    forall a. a -> Maybe a
Just (forall a b. b -> Message a b
High (forall a b. a -> Either a b
Left (ModState
mods,String
"Next")))
	visible (High Point
vissize) =
	    forall a. a -> Maybe a
Just (forall a b. a -> Message a b
Low (LayoutRequest -> FRequest
layoutRequestCmd (Point -> Bool -> Bool -> LayoutRequest
plainLayout Point
vissize Bool
False Bool
False)))
	visible Message FResponse Point
_ = forall a. Maybe a
Nothing

    initSP :: (Point
 -> Point
 -> (Point -> Point)
 -> SP
      (Either (Either a LayoutMessage) b) (Either (Either Point b) b))
-> SP
     (Either (Either a LayoutMessage) b) (Either (Either Point b) b)
initSP Point
-> Point
-> (Point -> Point)
-> SP
     (Either (Either a LayoutMessage) b) (Either (Either Point b) b)
cont =
        forall {a} {t} {b}. (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP forall {a} {b}.
Either (Either a LayoutMessage) b -> Maybe LayoutRequest
initreq forall a b. (a -> b) -> a -> b
$ \ LayoutRequest
req ->
	let vissize :: Point
vissize = (Point, Point) -> Point -> Point
limit (Point, Point)
initlimits Point
rtotsize
            rtotsize :: Point
rtotsize = LayoutRequest -> Point
minsize LayoutRequest
req
	    adj :: Point -> Point
adj = LayoutRequest -> Point -> Point
inCoupling LayoutRequest
req
	in forall b a. b -> SP a b -> SP a b
putSP (forall a b. a -> Either a b
Left (forall a b. a -> Either a b
Left Point
vissize)) forall a b. (a -> b) -> a -> b
$
	   Point
-> Point
-> (Point -> Point)
-> SP
     (Either (Either a LayoutMessage) b) (Either (Either Point b) b)
cont Point
vissize Point
rtotsize Point -> Point
adj
      where initreq :: Either (Either a LayoutMessage) b -> Maybe LayoutRequest
initreq (Left (Right (LayoutRequest LayoutRequest
req))) = forall a. a -> Maybe a
Just LayoutRequest
req
            initreq Either (Either a LayoutMessage) b
_ = forall a. Maybe a
Nothing

    -- ctrlSP :: SP ((KV+T)+S) ((V+T)+S)
    -- cltrSP implements the scrolling
    -- Input : KV = grabbed keys or visible size (from visibleK)
    --       : T = total size (from freeGroupF)
    --       : S = scroll bar positions
    -- Output: V = requested visible size (to visibleK)
    --         S = scroll bar adjustments on size changes
    --         T = position adjustments on scroll bar changes,
    --             notification of current visible size
    ctrlSP :: Point
-> Point
-> (Point -> Point)
-> SP
     (Either
        (Either (Either (ModState, String) Point) LayoutMessage)
        (Either (Int, b, c) (Int, b, c)))
     (Either
        (Either a (Either Point Point)) (Either PotRequest PotRequest))
ctrlSP Point
visible Point
total Point -> Point
adj =
        forall {t} {a} {b}. (t -> a -> (t, [b])) -> t -> SP a b
concatMapAccumlSP forall {b} {c} {b} {c} {a}.
(Point, Point, Point, Point -> Point)
-> Either
     (Either (Either (ModState, String) Point) LayoutMessage)
     (Either (Int, b, c) (Int, b, c))
-> ((Point, Point, Point, Point -> Point),
    [Either
       (Either a (Either Point Point)) (Either PotRequest PotRequest)])
ctrlT (Point
visible, Point
total, Int -> Int -> Point
pP Int
0 Int
0,Point -> Point
adj) -- limits??
      where
        ctrlT :: (Point, Point, Point, Point -> Point)
-> Either
     (Either (Either (ModState, String) Point) LayoutMessage)
     (Either (Int, b, c) (Int, b, c))
-> ((Point, Point, Point, Point -> Point),
    [Either
       (Either a (Either Point Point)) (Either PotRequest PotRequest)])
ctrlT s :: (Point, Point, Point, Point -> Point)
s@(Point
visible, Point
total, Point
pos, Point -> Point
adj) Either
  (Either (Either (ModState, String) Point) LayoutMessage)
  (Either (Int, b, c) (Int, b, c))
msg =
	    case Either
  (Either (Either (ModState, String) Point) LayoutMessage)
  (Either (Int, b, c) (Int, b, c))
msg of
	      Left (Left (Left (ModState, String)
key)) -> ((Point, Point, Point, Point -> Point)
s,forall {a}.
(ModState, String) -> [Either a (Either PotRequest PotRequest)]
potKeyInput (ModState, String)
key)
	      Left (Left (Right Point
visible')) -> forall {a} {b}.
Point
-> (Point -> Point)
-> ((Point, Point, Point, Point -> Point),
    [Either
       (Either a (Either Point b)) (Either PotRequest PotRequest)])
adjustVisible Point
visible' Point -> Point
adj
	      Left (Right LayoutMessage
req) ->
	        case LayoutMessage
req of
		  LayoutRequest LayoutRequest
req -> forall {a} {b}.
Point
-> (Point -> Point)
-> ((Point, Point, Point, Point -> Point),
    [Either
       (Either a (Either Point b)) (Either PotRequest PotRequest)])
adjustVisible Point
visible Point -> Point
adj'
		     where adj' :: Point -> Point
adj' = LayoutRequest -> Point -> Point
inCoupling LayoutRequest
req
		  LayoutMakeVisible Rect
rect (Maybe Alignment, Maybe Alignment)
align ->
		    ((Point, Point, Point, Point -> Point)
s, forall {a}.
Rect
-> (Maybe Alignment, Maybe Alignment)
-> [Either a (Either PotRequest PotRequest)]
mkvisible Rect
rect (Maybe Alignment, Maybe Alignment)
align)
		  --LayoutScrollStep step -> ...
		  LayoutMessage
_ -> ((Point, Point, Point, Point -> Point)
s, [])
	      Right (Left (Int
y,b
_,c
_)) -> forall {a} {a} {b}.
Point
-> Int
-> ((Point, Point, Point, Point -> Point),
    [Either (Either a (Either a Point)) b])
vmove Point
pos (-Int
y)
	      Right (Right (Int
x,b
_,c
_)) -> forall {a} {a} {b}.
Point
-> Int
-> ((Point, Point, Point, Point -> Point),
    [Either (Either a (Either a Point)) b])
hmove Point
pos (-Int
x)
	  where
	    potKeyInput :: (ModState, String) -> [Either a (Either PotRequest PotRequest)]
potKeyInput key :: (ModState, String)
key@(ModState
mods,String
k) =
	      if Modifiers
Shift forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ModState
mods
	      then [forall a b. b -> Either a b
Right (forall a b. b -> Either a b
Right ((ModState, String) -> PotRequest
PotInput (forall {t}. Eq t => t -> [t] -> [t]
remove Modifiers
Shift ModState
mods,String
k)))]
	      else [forall a b. b -> Either a b
Right (forall a b. a -> Either a b
Left  ((ModState, String) -> PotRequest
PotInput (ModState, String)
key))]
	    adjustVisible :: Point
-> (Point -> Point)
-> ((Point, Point, Point, Point -> Point),
    [Either
       (Either a (Either Point b)) (Either PotRequest PotRequest)])
adjustVisible Point
visible' Point -> Point
adj' =
		((Point
visible', Point
total', Point
pos, Point -> Point
adj'),
		 forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right (forall a b. a -> Either a b
Left Point
total'))forall a. a -> [a] -> [a]
:
		 forall {a}.
Point -> Point -> [Either a (Either PotRequest PotRequest)]
adjustPots Point
visible' Point
total')
	      where total' :: Point
total' = Point -> Point
adj' Point
visible'
	    adjustPots :: Point -> Point -> [Either a (Either PotRequest PotRequest)]
adjustPots (Point Int
visw Int
vish) size :: Point
size@(Point Int
totw Int
toth) =
		    [forall a b. b -> Either a b
Right (forall a b. b -> Either a b
Right (Int -> Int -> PotRequest
ResizePot Int
visw Int
totw)),
		     forall a b. b -> Either a b
Right (forall a b. a -> Either a b
Left (Int -> Int -> PotRequest
ResizePot Int
vish Int
toth))]
	    mkvisible :: Rect
-> (Maybe Alignment, Maybe Alignment)
-> [Either a (Either PotRequest PotRequest)]
mkvisible r :: Rect
r@(Rect (Point Int
x Int
y) (Point Int
w Int
h)) (Maybe Alignment
halign,Maybe Alignment
valign) =
	      --ctrace "mkvisible" r $
		    [forall a b. b -> Either a b
Right (forall a b. b -> Either a b
Right (Int -> Int -> Maybe Alignment -> PotRequest
PotMkVisible Int
x Int
w Maybe Alignment
halign)),
		     forall a b. b -> Either a b
Right (forall a b. a -> Either a b
Left (Int -> Int -> Maybe Alignment -> PotRequest
PotMkVisible Int
y Int
h Maybe Alignment
valign))]
	    vmove :: Point
-> Int
-> ((Point, Point, Point, Point -> Point),
    [Either (Either a (Either a Point)) b])
vmove pos :: Point
pos@(Point Int
x Int
_) Int
y =
	        --ctrace "vmove" (pos,pos') $
	        ((Point
visible,Point
total,Point
pos',Point -> Point
adj),[forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right (forall a b. b -> Either a b
Right Point
pos'))])
	      where pos' :: Point
pos' = Int -> Int -> Point
Point Int
x Int
y
	    hmove :: Point
-> Int
-> ((Point, Point, Point, Point -> Point),
    [Either (Either a (Either a Point)) b])
hmove pos :: Point
pos@(Point Int
_ Int
y) Int
x =
	        --ctrace "hmove" (pos,pos')
	        ((Point
visible,Point
total,Point
pos',Point -> Point
adj),[forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right (forall a b. b -> Either a b
Right Point
pos'))])
	      where pos' :: Point
pos' = Int -> Int -> Point
Point Int
x Int
y


limit :: (Point, Point) -> Point -> Point
limit (Point
min', Point
max') Point
size = Point -> Point -> Point
pmax Point
min' (Point -> Point -> Point
pmin Point
max' Point
size)


type SizeCoupling = Size    -> Size      -> Size
--                  my size    other size   my new size

stdCoupling :: Point -> Point -> Point
stdCoupling = Point -> Point -> Point
pmax
vCoupling :: Point -> Point -> Point
vCoupling (Point Int
tw Int
th) (Point Int
vw Int
vh) = Int -> Int -> Point
Point Int
vw (forall a. Ord a => a -> a -> a
max Int
th Int
vh)
hCoupling :: Point -> Point -> Point
hCoupling (Point Int
tw Int
th) (Point Int
vw Int
vh) = Int -> Int -> Point
Point (forall a. Ord a => a -> a -> a
max Int
tw Int
vw) Int
vh

plainAdjLayout :: LayoutRequest -> Point -> Point
plainAdjLayout (Layout {minsize :: LayoutRequest -> Point
minsize=Point
total'}) = Point -> Point -> Point
stdCoupling Point
total'
wAdjLayout :: LayoutRequest -> Point -> Point
wAdjLayout (Layout {wAdj :: LayoutRequest -> Int -> Point
wAdj=Int -> Point
wa}) = forall {t} {t} {t}. (t -> t -> t) -> (t -> t) -> t -> t
s (forall a b c. (a -> b -> c) -> b -> a -> c
flip Point -> Point -> Point
vCoupling) (Int -> Point
wa forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Int
xcoord)
hAdjLayout :: LayoutRequest -> Point -> Point
hAdjLayout (Layout {hAdj :: LayoutRequest -> Int -> Point
hAdj=Int -> Point
ha}) = forall {t} {t} {t}. (t -> t -> t) -> (t -> t) -> t -> t
s (forall a b c. (a -> b -> c) -> b -> a -> c
flip Point -> Point -> Point
hCoupling) (Int -> Point
ha forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Int
ycoord)

s :: (t -> t -> t) -> (t -> t) -> t -> t
s t -> t -> t
f t -> t
g t
x = t -> t -> t
f t
x (t -> t
g t
x)

-- assocLeft :: a+(b+c) -> (a+b)+c
-- assocRight :: (a+b)+c -> a+(b+c)
assocLeft :: Either a (Either b b) -> Either (Either a b) b
assocLeft = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Leftforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Leftforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) forall a b. b -> Either a b
Right)
assocRight :: Either (Either a b) b -> Either a (Either b b)
assocRight = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Rightforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)) (forall a b. b -> Either a b
Rightforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)

--swapRight :: (a+b)+c -> (a+c)+b
swapRight :: Either (Either a b) b -> Either (Either a b) b
swapRight = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Leftforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) forall a b. b -> Either a b
Right) (forall a b. a -> Either a b
Leftforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)