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
scrollShellF :: [Char] -> (Point, Point) -> F c d -> F c d
scrollShellF [Char]
name (Point, Point)
initlimits = [Char] -> F c d -> F c d
forall c d. [Char] -> F c d -> F c d
shellF [Char]
name (F c d -> F c d) -> (F c d -> F c d) -> F c d -> F c d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> (Point, Point) -> F c d -> F c d
forall b d. Bool -> (Point, Point) -> F b d -> F b d
oldScrollF Bool
True (Point, Point)
initlimits
grabScrollKeys :: Bool
grabScrollKeys = [Char] -> Bool -> Bool
argFlag [Char]
"grabscrollkeys" Bool
False
scrollF :: F b d -> F b d
scrollF = Bool -> (Point, Point) -> F b d -> F b d
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 = Bool -> (Point, Point) -> F b d -> F b d
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 = Bool -> (Point, Point) -> F b d -> F b d
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 = (a -> b -> a
forall a b. a -> b -> a
const,LayoutRequest -> Point -> Point
plainAdjLayout,Int -> F a b -> F a b
forall a b. Int -> F a b -> F a b
tableF Int
2,Bool -> Maybe Point -> F PotRequest PotState
vPotF' Bool
foc Maybe Point
forall a. Maybe a
Nothing F PotRequest PotState
-> F PotRequest PotState
-> F (Either PotRequest PotRequest) (Either PotState PotState)
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 Maybe Point
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 = (a -> b -> a
forall a b. a -> b -> a
const,LayoutRequest -> Point -> Point
wAdjLayout,F a b -> F a b
forall a b. F a b -> F a b
hBoxF,Bool -> Maybe Point -> F PotRequest PotState
vPotF' Bool
foc Maybe Point
forall a. Maybe a
Nothing F PotRequest PotState
-> F c d -> F (Either PotRequest c) (Either PotState d)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+< F c 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 = (a -> b -> a
forall a b. a -> b -> a
const,LayoutRequest -> Point -> Point
hAdjLayout,F a b -> F a b
forall a b. F a b -> F a b
vBoxF,F a b
forall hi ho. F hi ho
nullFF a b
-> F PotRequest PotState
-> F (Either a PotRequest) (Either b PotState)
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 Maybe Point
forall a. Maybe a
Nothing)
oldScrollF :: Bool -> (Point, Point) -> F b d -> F b d
oldScrollF Bool
grabKeys = (Any -> Any -> Any, LayoutRequest -> Point -> Point,
F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either PotState PotState))
d)
-> F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either PotState PotState))
d),
F (Either PotRequest PotRequest) (Either PotState PotState))
-> Bool -> (Point, Point) -> F b d -> F b d
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, [Char]) Point) LayoutMessage) b)
b)
-> F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, b, c) (Int, b, c)))
d),
F c b)
-> Bool -> (Point, Point) -> F inr b -> F b d
gScrollF (Bool
-> (Any -> Any -> Any, LayoutRequest -> Point -> Point,
F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either PotState PotState))
d)
-> F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either PotState PotState))
d),
F (Either PotRequest PotRequest) (Either PotState PotState))
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 = (Any -> Any -> Any, LayoutRequest -> Point -> Point,
F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either PotState (Int, Any, Any)))
d)
-> F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either PotState (Int, Any, Any)))
d),
F (Either PotRequest PotRequest) (Either PotState (Int, Any, Any)))
-> Bool -> (Point, Point) -> F b d -> F b d
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, [Char]) Point) LayoutMessage) b)
b)
-> F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, b, c) (Int, b, c)))
d),
F c b)
-> Bool -> (Point, Point) -> F inr b -> F b d
gScrollF (Bool
-> (Any -> Any -> Any, LayoutRequest -> Point -> Point,
F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either PotState (Int, Any, Any)))
d)
-> F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either PotState (Int, Any, Any)))
d),
F (Either PotRequest PotRequest) (Either PotState (Int, Any, Any)))
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 = (Any -> Any -> Any, LayoutRequest -> Point -> Point,
F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, Any, Any) PotState))
d)
-> F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, Any, Any) PotState))
d),
F (Either PotRequest PotRequest) (Either (Int, Any, Any) PotState))
-> Bool -> (Point, Point) -> F b d -> F b d
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, [Char]) Point) LayoutMessage) b)
b)
-> F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, b, c) (Int, b, c)))
d),
F c b)
-> Bool -> (Point, Point) -> F inr b -> F b d
gScrollF (Bool
-> (Any -> Any -> Any, LayoutRequest -> Point -> Point,
F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, Any, Any) PotState))
d)
-> F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, Any, Any) PotState))
d),
F (Either PotRequest PotRequest) (Either (Int, Any, Any) PotState))
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, [Char]) Point) LayoutMessage) b)
b)
-> F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) 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, [Char]) Point) LayoutMessage) b)
b)
-> F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, b, c) (Int, b, c)))
d)
placer,F c b
scrollbarsF) Bool
grabKeys (Point, Point)
initlimits F inr b
fud =
F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, b, c) (Int, b, c)))
d)
-> F (Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, b, c) (Int, b, c)))
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
-> F b d
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, [Char]) Point) LayoutMessage) b)
b)
-> F (Either
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
b)
(Either
(Either
(Either (Either (ModState, [Char]) 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, [Char]) Point) LayoutMessage) b)
b)
mainF) (SP
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, b, c) (Int, b, c)))
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
-> F (Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, b, c) (Int, b, c)))
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
forall a b. SP a b -> F a b
absF ((Point
-> Point
-> (Point -> Point)
-> SP
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, b, c) (Int, b, c)))
(Either
(Either Point (Either Point Point))
(Either PotRequest PotRequest)))
-> SP
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, b, c) (Int, b, c)))
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
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 Point
-> Point
-> (Point -> Point)
-> SP
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, b, c) (Int, b, c)))
(Either
(Either Point (Either Point Point)) (Either PotRequest PotRequest))
forall b c b c a.
Point
-> Point
-> (Point -> Point)
-> SP
(Either
(Either (Either (ModState, [Char]) 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, [Char]) Point) LayoutMessage) b)
b)
mainF =
Either
(Either (Either (ModState, [Char]) Point) (Either LayoutMessage b))
b
-> Either
(Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
b
forall a b b b.
Either (Either a (Either b b)) b
-> Either (Either (Either a b) b) b
post(Either
(Either (Either (ModState, [Char]) Point) (Either LayoutMessage b))
b
-> Either
(Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
b)
-> F (Either (Either Point (Either (Either Point Point) inr)) c)
(Either
(Either (Either (ModState, [Char]) Point) (Either LayoutMessage b))
b)
-> F (Either (Either Point (Either (Either Point Point) inr)) c)
(Either
(Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
b)
forall a b e. (a -> b) -> F e a -> F e b
>^=<
([FRequest]
-> K Point (Either (ModState, [Char]) Point)
-> F (Either (Either Point Point) inr) (Either LayoutMessage b)
-> F (Either Point (Either (Either Point Point) inr))
(Either (Either (ModState, [Char]) Point) (Either LayoutMessage 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, [Char]) Point)
visibleK (F inr b
-> F (Either (Either Point Point) inr) (Either LayoutMessage b)
forall inr outr.
F inr outr
-> F (Either (Either Point Point) inr) (Either LayoutMessage outr)
freeGroupF F inr b
fud)F (Either Point (Either (Either Point Point) inr))
(Either (Either (ModState, [Char]) Point) (Either LayoutMessage b))
-> F c b
-> F (Either (Either Point (Either (Either Point Point) inr)) c)
(Either
(Either (Either (ModState, [Char]) Point) (Either LayoutMessage b))
b)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+<F c b
scrollbarsF)
F (Either (Either Point (Either (Either Point Point) inr)) c)
(Either
(Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
b)
-> (Either (Either (Either Point (Either Point Point)) c) inr
-> Either (Either Point (Either (Either Point Point) inr)) c)
-> F (Either (Either (Either Point (Either Point Point)) c) inr)
(Either
(Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
b)
forall c d e. F c d -> (e -> c) -> F e d
>=^<Either (Either (Either Point (Either Point Point)) c) inr
-> Either (Either Point (Either (Either Point Point) inr)) c
forall a a b b.
Either (Either (Either a a) b) b
-> Either (Either a (Either a b)) b
pre
where
post :: Either (Either a (Either b b)) b
-> Either (Either (Either a b) b) b
post = Either (Either (Either a b) b) b
-> Either (Either (Either a b) b) b
forall a b b. Either (Either a b) b -> Either (Either a b) b
swapRight(Either (Either (Either a b) b) b
-> Either (Either (Either a b) b) b)
-> (Either (Either a (Either b b)) b
-> Either (Either (Either a b) b) b)
-> Either (Either a (Either b b)) b
-> Either (Either (Either a b) b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Either a (Either b b) -> Either (Either a b) b)
-> (b -> b)
-> Either (Either a (Either b b)) b
-> Either (Either (Either a b) b) b
forall t1 a t2 b.
(t1 -> a) -> (t2 -> b) -> Either t1 t2 -> Either a b
mapEither Either a (Either b b) -> Either (Either a b) b
forall a b b. Either a (Either b b) -> Either (Either a b) b
assocLeft b -> b
forall a. a -> a
id
pre :: Either (Either (Either a a) b) b
-> Either (Either a (Either a b)) b
pre = (Either (Either a a) b -> Either a (Either a b))
-> (b -> b)
-> Either (Either (Either a a) b) b
-> Either (Either a (Either a b)) b
forall t1 a t2 b.
(t1 -> a) -> (t2 -> b) -> Either t1 t2 -> Either a b
mapEither Either (Either a a) b -> Either a (Either a b)
forall a a b. Either (Either a a) b -> Either a (Either a b)
assocRight b -> b
forall a. a -> a
id(Either (Either (Either a a) b) b
-> Either (Either a (Either a b)) b)
-> (Either (Either (Either a a) b) b
-> Either (Either (Either a a) b) b)
-> Either (Either (Either a a) b) b
-> Either (Either a (Either a b)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Either (Either (Either a a) b) b
-> Either (Either (Either a a) b) b
forall a b b. Either (Either a b) b -> Either (Either a b) b
swapRight
start :: [FRequest]
start = (XCommand -> FRequest) -> [XCommand] -> [FRequest]
forall a b. (a -> b) -> [a] -> [b]
map XCommand -> FRequest
XCmd ([XCommand] -> [FRequest]) -> [XCommand] -> [FRequest]
forall a b. (a -> b) -> a -> b
$
[XCommand]
transinit[XCommand] -> [XCommand] -> [XCommand]
forall 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 :: XEvent -> Maybe XEvent
tobutton e :: XEvent
e@(KeyEvent {state :: XEvent -> ModState
state=ModState
s,type' :: XEvent -> Pressed
type'=Pressed
Pressed,keySym :: XEvent -> [Char]
keySym=[Char]
ks})
| (ModState
s, [Char]
ks) (ModState, [Char]) -> [(ModState, [Char])] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(ModState, [Char])]
keys =
XEvent -> Maybe XEvent
forall a. a -> Maybe a
Just XEvent
e
tobutton e :: XEvent
e@(ButtonEvent {button :: XEvent -> Button
button=Button Int
4,type' :: XEvent -> Pressed
type'=Pressed
Pressed}) = XEvent -> Maybe XEvent
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}) = XEvent -> Maybe XEvent
forall a. a -> Maybe a
Just XEvent
e
tobutton XEvent
_ = Maybe XEvent
forall a. Maybe a
Nothing
keys :: [(ModState, [Char])]
keys = ([Char] -> (ModState, [Char])) -> [[Char]] -> [(ModState, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map ((,) []) [[Char]]
keys' [(ModState, [Char])]
-> [(ModState, [Char])] -> [(ModState, [Char])]
forall a. [a] -> [a] -> [a]
++ ([Char] -> (ModState, [Char])) -> [[Char]] -> [(ModState, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map ((,) [Modifiers
Shift]) [[Char]]
keys'
where keys' :: [[Char]]
keys' = [[Char]
"Prior",[Char]
"Next",[Char]
"Home",[Char]
"End"]
visibleK :: K Point (Either (ModState, [Char]) Point)
visibleK = KSP Point (Either (ModState, [Char]) Point)
-> K Point (Either (ModState, [Char]) Point)
forall hi ho. KSP hi ho -> K hi ho
K (KSP Point (Either (ModState, [Char]) Point)
-> K Point (Either (ModState, [Char]) Point))
-> KSP Point (Either (ModState, [Char]) Point)
-> K Point (Either (ModState, [Char]) Point)
forall a b. (a -> b) -> a -> b
$ (Message FResponse Point
-> Maybe (Message FRequest (Either (ModState, [Char]) Point)))
-> KSP Point (Either (ModState, [Char]) Point)
forall t b. (t -> Maybe b) -> SP t b
mapFilterSP Message FResponse Point
-> Maybe (Message FRequest (Either (ModState, [Char]) Point))
visible
where
visible :: Message FResponse Point
-> Maybe (Message FRequest (Either (ModState, [Char]) Point))
visible (Low (LEvt (LayoutSize Point
vissize))) = Message FRequest (Either (ModState, [Char]) Point)
-> Maybe (Message FRequest (Either (ModState, [Char]) Point))
forall a. a -> Maybe a
Just (Either (ModState, [Char]) Point
-> Message FRequest (Either (ModState, [Char]) Point)
forall a b. b -> Message a b
High (Point -> Either (ModState, [Char]) Point
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 -> [Char]
keySym=[Char]
key}))) =
Message FRequest (Either (ModState, [Char]) Point)
-> Maybe (Message FRequest (Either (ModState, [Char]) Point))
forall a. a -> Maybe a
Just (Either (ModState, [Char]) Point
-> Message FRequest (Either (ModState, [Char]) Point)
forall a b. b -> Message a b
High ((ModState, [Char]) -> Either (ModState, [Char]) Point
forall a b. a -> Either a b
Left (ModState
mods,[Char]
key)))
visible (Low (XEvt (ButtonEvent{button :: XEvent -> Button
button=Button Int
4,type' :: XEvent -> Pressed
type'=Pressed
Pressed,state :: XEvent -> ModState
state=ModState
mods}))) =
Message FRequest (Either (ModState, [Char]) Point)
-> Maybe (Message FRequest (Either (ModState, [Char]) Point))
forall a. a -> Maybe a
Just (Either (ModState, [Char]) Point
-> Message FRequest (Either (ModState, [Char]) Point)
forall a b. b -> Message a b
High ((ModState, [Char]) -> Either (ModState, [Char]) Point
forall a b. a -> Either a b
Left (ModState
mods,[Char]
"Prior")))
visible (Low (XEvt (ButtonEvent{button :: XEvent -> Button
button=Button Int
5,type' :: XEvent -> Pressed
type'=Pressed
Pressed,state :: XEvent -> ModState
state=ModState
mods}))) =
Message FRequest (Either (ModState, [Char]) Point)
-> Maybe (Message FRequest (Either (ModState, [Char]) Point))
forall a. a -> Maybe a
Just (Either (ModState, [Char]) Point
-> Message FRequest (Either (ModState, [Char]) Point)
forall a b. b -> Message a b
High ((ModState, [Char]) -> Either (ModState, [Char]) Point
forall a b. a -> Either a b
Left (ModState
mods,[Char]
"Next")))
visible (High Point
vissize) =
Message FRequest (Either (ModState, [Char]) Point)
-> Maybe (Message FRequest (Either (ModState, [Char]) Point))
forall a. a -> Maybe a
Just (FRequest -> Message FRequest (Either (ModState, [Char]) Point)
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
_ = Maybe (Message FRequest (Either (ModState, [Char]) 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 =
(Either (Either a LayoutMessage) b -> Maybe LayoutRequest)
-> (LayoutRequest
-> SP
(Either (Either a LayoutMessage) b) (Either (Either Point b) b))
-> SP
(Either (Either a LayoutMessage) b) (Either (Either Point b) b)
forall a t b. (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP Either (Either a LayoutMessage) b -> Maybe LayoutRequest
forall a b.
Either (Either a LayoutMessage) b -> Maybe LayoutRequest
initreq ((LayoutRequest
-> SP
(Either (Either a LayoutMessage) b) (Either (Either Point b) b))
-> SP
(Either (Either a LayoutMessage) b) (Either (Either Point b) b))
-> (LayoutRequest
-> SP
(Either (Either a LayoutMessage) b) (Either (Either Point b) b))
-> SP
(Either (Either a LayoutMessage) b) (Either (Either Point b) b)
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 Either (Either Point b) b
-> SP
(Either (Either a LayoutMessage) b) (Either (Either Point b) b)
-> SP
(Either (Either a LayoutMessage) b) (Either (Either Point b) b)
forall b a. b -> SP a b -> SP a b
putSP (Either Point b -> Either (Either Point b) b
forall a b. a -> Either a b
Left (Point -> Either Point b
forall a b. a -> Either a b
Left Point
vissize)) (SP (Either (Either a LayoutMessage) b) (Either (Either Point b) b)
-> SP
(Either (Either a LayoutMessage) b) (Either (Either Point b) b))
-> SP
(Either (Either a LayoutMessage) b) (Either (Either Point b) b)
-> SP
(Either (Either a LayoutMessage) b) (Either (Either Point b) b)
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))) = LayoutRequest -> Maybe LayoutRequest
forall a. a -> Maybe a
Just LayoutRequest
req
initreq Either (Either a LayoutMessage) b
_ = Maybe LayoutRequest
forall a. Maybe a
Nothing
ctrlSP :: Point
-> Point
-> (Point -> Point)
-> SP
(Either
(Either (Either (ModState, [Char]) 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 =
((Point, Point, Point, Point -> Point)
-> Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, b, c) (Int, b, c))
-> ((Point, Point, Point, Point -> Point),
[Either
(Either a (Either Point Point)) (Either PotRequest PotRequest)]))
-> (Point, Point, Point, Point -> Point)
-> SP
(Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, b, c) (Int, b, c)))
(Either
(Either a (Either Point Point)) (Either PotRequest PotRequest))
forall t a b. (t -> a -> (t, [b])) -> t -> SP a b
concatMapAccumlSP (Point, Point, Point, Point -> Point)
-> Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, b, c) (Int, b, c))
-> ((Point, Point, Point, Point -> Point),
[Either
(Either a (Either Point Point)) (Either PotRequest PotRequest)])
forall b c b c a.
(Point, Point, Point, Point -> Point)
-> Either
(Either (Either (ModState, [Char]) 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)
where
ctrlT :: (Point, Point, Point, Point -> Point)
-> Either
(Either (Either (ModState, [Char]) 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, [Char]) Point) LayoutMessage)
(Either (Int, b, c) (Int, b, c))
msg =
case Either
(Either (Either (ModState, [Char]) Point) LayoutMessage)
(Either (Int, b, c) (Int, b, c))
msg of
Left (Left (Left (ModState, [Char])
key)) -> ((Point, Point, Point, Point -> Point)
s,(ModState, [Char])
-> [Either
(Either a (Either Point Point)) (Either PotRequest PotRequest)]
forall a.
(ModState, [Char]) -> [Either a (Either PotRequest PotRequest)]
potKeyInput (ModState, [Char])
key)
Left (Left (Right Point
visible')) -> Point
-> (Point -> Point)
-> ((Point, Point, Point, Point -> Point),
[Either
(Either a (Either Point Point)) (Either PotRequest PotRequest)])
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 -> Point
-> (Point -> Point)
-> ((Point, Point, Point, Point -> Point),
[Either
(Either a (Either Point Point)) (Either PotRequest PotRequest)])
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, Rect
-> (Maybe Alignment, Maybe Alignment)
-> [Either
(Either a (Either Point Point)) (Either PotRequest PotRequest)]
forall a.
Rect
-> (Maybe Alignment, Maybe Alignment)
-> [Either a (Either PotRequest PotRequest)]
mkvisible Rect
rect (Maybe Alignment, Maybe Alignment)
align)
LayoutMessage
_ -> ((Point, Point, Point, Point -> Point)
s, [])
Right (Left (Int
y,b
_,c
_)) -> Point
-> Int
-> ((Point, Point, Point, Point -> Point),
[Either
(Either a (Either Point Point)) (Either PotRequest PotRequest)])
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
_)) -> Point
-> Int
-> ((Point, Point, Point, Point -> Point),
[Either
(Either a (Either Point Point)) (Either PotRequest PotRequest)])
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, [Char]) -> [Either a (Either PotRequest PotRequest)]
potKeyInput key :: (ModState, [Char])
key@(ModState
mods,[Char]
k) =
if Modifiers
Shift Modifiers -> ModState -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ModState
mods
then [Either PotRequest PotRequest
-> Either a (Either PotRequest PotRequest)
forall a b. b -> Either a b
Right (PotRequest -> Either PotRequest PotRequest
forall a b. b -> Either a b
Right ((ModState, [Char]) -> PotRequest
PotInput (Modifiers -> ModState -> ModState
forall t. Eq t => t -> [t] -> [t]
remove Modifiers
Shift ModState
mods,[Char]
k)))]
else [Either PotRequest PotRequest
-> Either a (Either PotRequest PotRequest)
forall a b. b -> Either a b
Right (PotRequest -> Either PotRequest PotRequest
forall a b. a -> Either a b
Left ((ModState, [Char]) -> PotRequest
PotInput (ModState, [Char])
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'),
Either a (Either Point b)
-> Either
(Either a (Either Point b)) (Either PotRequest PotRequest)
forall a b. a -> Either a b
Left (Either Point b -> Either a (Either Point b)
forall a b. b -> Either a b
Right (Point -> Either Point b
forall a b. a -> Either a b
Left Point
total'))Either (Either a (Either Point b)) (Either PotRequest PotRequest)
-> [Either
(Either a (Either Point b)) (Either PotRequest PotRequest)]
-> [Either
(Either a (Either Point b)) (Either PotRequest PotRequest)]
forall a. a -> [a] -> [a]
:
Point
-> Point
-> [Either
(Either a (Either Point b)) (Either PotRequest PotRequest)]
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) =
[Either PotRequest PotRequest
-> Either a (Either PotRequest PotRequest)
forall a b. b -> Either a b
Right (PotRequest -> Either PotRequest PotRequest
forall a b. b -> Either a b
Right (Int -> Int -> PotRequest
ResizePot Int
visw Int
totw)),
Either PotRequest PotRequest
-> Either a (Either PotRequest PotRequest)
forall a b. b -> Either a b
Right (PotRequest -> Either PotRequest PotRequest
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) =
[Either PotRequest PotRequest
-> Either a (Either PotRequest PotRequest)
forall a b. b -> Either a b
Right (PotRequest -> Either PotRequest PotRequest
forall a b. b -> Either a b
Right (Int -> Int -> Maybe Alignment -> PotRequest
PotMkVisible Int
x Int
w Maybe Alignment
halign)),
Either PotRequest PotRequest
-> Either a (Either PotRequest PotRequest)
forall a b. b -> Either a b
Right (PotRequest -> Either PotRequest PotRequest
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 =
((Point
visible,Point
total,Point
pos',Point -> Point
adj),[Either a (Either a Point) -> Either (Either a (Either a Point)) b
forall a b. a -> Either a b
Left (Either a Point -> Either a (Either a Point)
forall a b. b -> Either a b
Right (Point -> Either a Point
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 =
((Point
visible,Point
total,Point
pos',Point -> Point
adj),[Either a (Either a Point) -> Either (Either a (Either a Point)) b
forall a b. a -> Either a b
Left (Either a Point -> Either a (Either a Point)
forall a b. b -> Either a b
Right (Point -> Either a Point
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
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 (Int -> Int -> Int
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 (Int -> Int -> Int
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}) = (Point -> Point -> Point) -> (Point -> Point) -> Point -> Point
forall t t t. (t -> t -> t) -> (t -> t) -> t -> t
s ((Point -> Point -> Point) -> Point -> Point -> Point
forall a b c. (a -> b -> c) -> b -> a -> c
flip Point -> Point -> Point
vCoupling) (Int -> Point
wa (Int -> Point) -> (Point -> Int) -> Point -> Point
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}) = (Point -> Point -> Point) -> (Point -> Point) -> Point -> Point
forall t t t. (t -> t -> t) -> (t -> t) -> t -> t
s ((Point -> Point -> Point) -> Point -> Point -> Point
forall a b c. (a -> b -> c) -> b -> a -> c
flip Point -> Point -> Point
hCoupling) (Int -> Point
ha (Int -> Point) -> (Point -> Int) -> Point -> Point
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 :: Either a (Either b b) -> Either (Either a b) b
assocLeft = (a -> Either (Either a b) b)
-> (Either b b -> Either (Either a b) b)
-> Either a (Either b b)
-> Either (Either a b) b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either a b -> Either (Either a b) b
forall a b. a -> Either a b
Left(Either a b -> Either (Either a b) b)
-> (a -> Either a b) -> a -> Either (Either a b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left) ((b -> Either (Either a b) b)
-> (b -> Either (Either a b) b)
-> Either b b
-> Either (Either a b) b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either a b -> Either (Either a b) b
forall a b. a -> Either a b
Left(Either a b -> Either (Either a b) b)
-> (b -> Either a b) -> b -> Either (Either a b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right) b -> Either (Either a b) b
forall a b. b -> Either a b
Right)
assocRight :: Either (Either a a) b -> Either a (Either a b)
assocRight = (Either a a -> Either a (Either a b))
-> (b -> Either a (Either a b))
-> Either (Either a a) b
-> Either a (Either a b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((a -> Either a (Either a b))
-> (a -> Either a (Either a b))
-> Either a a
-> Either a (Either a b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Either a (Either a b)
forall a b. a -> Either a b
Left (Either a b -> Either a (Either a b)
forall a b. b -> Either a b
Right(Either a b -> Either a (Either a b))
-> (a -> Either a b) -> a -> Either a (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left)) (Either a b -> Either a (Either a b)
forall a b. b -> Either a b
Right(Either a b -> Either a (Either a b))
-> (b -> Either a b) -> b -> Either a (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right)
swapRight :: Either (Either a b) b -> Either (Either a b) b
swapRight = (Either a b -> Either (Either a b) b)
-> (b -> Either (Either a b) b)
-> Either (Either a b) b
-> Either (Either a b) b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((a -> Either (Either a b) b)
-> (b -> Either (Either a b) b)
-> Either a b
-> Either (Either a b) b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either a b -> Either (Either a b) b
forall a b. a -> Either a b
Left(Either a b -> Either (Either a b) b)
-> (a -> Either a b) -> a -> Either (Either a b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left) b -> Either (Either a b) b
forall a b. b -> Either a b
Right) (Either a b -> Either (Either a b) b
forall a b. a -> Either a b
Left(Either a b -> Either (Either a b) b)
-> (b -> Either a b) -> b -> Either (Either a b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right)