module DragF(containerGroupF,hPotF,hPotF',vPotF,vPotF',PotRequest(..),PotState(..)) where
import Command
import CompOps((>=^<), (>^=<))
import CompFfun(prepostMapHigh)
import Cursor
import Dlayout(groupF,groupF')
import Sizing(Sizing(..))
import Event
import Fudget
import FRequest
import NullF
import Geometry
import GreyBgF
import Border3dF(border3dF)
import LayoutRequest(LayoutResponse(..))
import LayoutF(holeF')
import Spacers(hvMarginS)
import DynSpacerF(dynSpacerF)
import Spacer(noStretchF)
import Alignment
import Loops(loopCompThroughRightF,loopLeftF)
import EitherUtils(stripEither)
import Data.Maybe(fromMaybe)
import CmdLineEnv(argReadKey)
import Xtypes
data PotRequest = ResizePot Int Int
| MovePot Int
| PotMkVisible Int Int (Maybe Alignment)
| PotInput (ModState, KeySym)
type PotState = (Int,Int,Int)
knobS :: Rect -> Rect -> Spacer
knobS knob :: Rect
knob@(Rect Size
kp Size
ks) box :: Rect
box@(Rect Size
bp Size
bs) =
Size -> Size -> Spacer
hvMarginS (Size
kpforall a. Num a => a -> a -> a
+Size
margin) (Size
bsforall a. Num a => a -> a -> a
+Size
marginforall a. Num a => a -> a -> a
-Size
kpforall a. Num a => a -> a -> a
-Size
ks)
knobK :: Rect -> Rect -> Size -> K (Rect, Rect) (Either Spacer Rect)
knobK Rect
box Rect
knob Size
pabs =
let cont :: Rect -> Size -> K (Rect, Rect) (Either Spacer Rect)
cont Rect
knob' Size
pabs' = Rect -> Rect -> Size -> K (Rect, Rect) (Either Spacer Rect)
knobK Rect
box Rect
knob' Size
pabs'
newbox :: Rect -> Rect -> K (Rect, Rect) (Either Spacer Rect)
newbox Rect
box' Rect
knob' = Rect -> Rect -> Size -> K (Rect, Rect) (Either Spacer Rect)
knobK Rect
box' Rect
knob' Size
pabs
same :: K (Rect, Rect) (Either Spacer Rect)
same = Rect -> Size -> K (Rect, Rect) (Either Spacer Rect)
cont Rect
knob Size
pabs
output :: b -> K hi (Either a b) -> K hi (Either a b)
output b
knob = forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall a b. b -> Message a b
High (forall a b. b -> Either a b
Right b
knob))
repos :: Rect -> Rect -> K hi (Either Spacer b) -> K hi (Either Spacer b)
repos Rect
knob Rect
box = forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall a b. b -> Message a b
High (forall a b. a -> Either a b
Left (Rect -> Rect -> Spacer
knobS Rect
knob Rect
box)))
in forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ \KEvent (Rect, Rect)
msg ->
case KEvent (Rect, Rect)
msg of
Low (XEvt (MotionNotify {rootPos :: XEvent -> Size
rootPos=Size
pabs',state :: XEvent -> ModState
state=ModState
mods})) ->
let knob' :: Rect
knob' = Rect -> Size -> Rect
moverect Rect
knob (Size -> Size -> Size
psub Size
pabs' Size
pabs)
knob'' :: Rect
knob'' = Rect -> Rect -> Rect
confine Rect
box Rect
knob'
pabs'' :: Size
pabs'' = Size -> Size -> Size
padd Size
pabs' (Rect -> Rect -> Size
rsub Rect
knob'' Rect
knob')
in forall {hi} {b}.
Rect -> Rect -> K hi (Either Spacer b) -> K hi (Either Spacer b)
repos Rect
knob'' Rect
box forall a b. (a -> b) -> a -> b
$
(if Modifiers
Shift forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ModState
mods then forall a. a -> a
id else forall {b} {hi} {a}. b -> K hi (Either a b) -> K hi (Either a b)
output Rect
knob'') forall a b. (a -> b) -> a -> b
$
Rect -> Size -> K (Rect, Rect) (Either Spacer Rect)
cont Rect
knob'' Size
pabs''
Low (XEvt (ButtonEvent {rootPos :: XEvent -> Size
rootPos=Size
pabs',type' :: XEvent -> Pressed
type'=Pressed
Pressed})) -> Rect -> Size -> K (Rect, Rect) (Either Spacer Rect)
cont Rect
knob Size
pabs'
Low (XEvt (ButtonEvent {type' :: XEvent -> Pressed
type'=Pressed
Released})) -> forall {b} {hi} {a}. b -> K hi (Either a b) -> K hi (Either a b)
output Rect
knob forall a b. (a -> b) -> a -> b
$ K (Rect, Rect) (Either Spacer Rect)
same
High (Rect
newknob, Rect
box') ->
let knob' :: Rect
knob' = Rect -> Rect -> Rect
confine Rect
box' Rect
newknob
msgs :: K hi (Either Spacer Rect) -> K hi (Either Spacer Rect)
msgs = (if Rect
knob'forall a. Eq a => a -> a -> Bool
/=Rect
knob Bool -> Bool -> Bool
|| Rect
box'forall a. Eq a => a -> a -> Bool
/=Rect
box
then forall {hi} {b}.
Rect -> Rect -> K hi (Either Spacer b) -> K hi (Either Spacer b)
repos Rect
knob' Rect
box'
else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Rect
knob'forall a. Eq a => a -> a -> Bool
/=Rect
knob
then forall {b} {hi} {a}. b -> K hi (Either a b) -> K hi (Either a b)
output Rect
knob'
else forall a. a -> a
id)
in forall {hi}. K hi (Either Spacer Rect) -> K hi (Either Spacer Rect)
msgs forall a b. (a -> b) -> a -> b
$
Rect -> Rect -> K (Rect, Rect) (Either Spacer Rect)
newbox Rect
box' Rect
knob'
KEvent (Rect, Rect)
_ -> K (Rect, Rect) (Either Spacer Rect)
same
containerGroupF :: Rect
-> Rect
-> Int
-> Button
-> ModState
-> F c b
-> F (Either (Rect, Rect) c) (Either Rect b)
containerGroupF Rect
knob Rect
box Int
cursorshape Button
buttons ModState
modifiers F c b
fudget =
forall a b c. F (Either a b) (Either a c) -> F b c
loopLeftF forall a b. (a -> b) -> a -> b
$
forall {hi} {b} {c} {ho}.
(hi -> b) -> (c -> ho) -> F b c -> F hi ho
prepostMapHigh forall a. a -> a
pre forall {a} {b} {b}. Either (Either a b) b -> Either a (Either b b)
post forall a b. (a -> b) -> a -> b
$
forall {c} {ho}. F c ho -> F (Either Spacer c) ho
dynSpacerF forall a b. (a -> b) -> a -> b
$
forall {a} {b} {c} {d}.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF [FRequest]
initcmds
(forall a b. Int -> K a b -> K a b
setFontCursor Int
cursorshape (Rect -> Rect -> Size -> K (Rect, Rect) (Either Spacer Rect)
knobK Rect
box Rect
knob Size
origin))
F c b
fudget
where attrs :: [WindowAttributes]
attrs = [[EventMask] -> WindowAttributes
CWEventMask []]
initcmds :: [FRequest]
initcmds = forall a b. (a -> b) -> [a] -> [b]
map XCommand -> FRequest
XCmd
[[WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
attrs,
Bool -> Button -> ModState -> [EventMask] -> XCommand
GrabButton Bool
False Button
buttons ModState
modifiers
[EventMask
PointerMotionMask, EventMask
ButtonReleaseMask]]
pre :: a -> a
pre = forall a. a -> a
id
post :: Either (Either a b) b -> Either a (Either b b)
post = 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)
knobF :: Int -> Rect -> Rect -> F (Rect, Rect) Rect
knobF Int
cursor Rect
box Rect
knob =
(forall {a}. Either a a -> a
stripEither forall a b e. (a -> b) -> F e a -> F e b
>^=< forall {c} {b}.
Rect
-> Rect
-> Int
-> Button
-> ModState
-> F c b
-> F (Either (Rect, Rect) c) (Either Rect b)
containerGroupF Rect
knob Rect
box Int
cursor (Int -> Button
Button Int
1) [] forall {a} {d}. F a d
vF ) forall c d e. F c d -> (e -> c) -> F e d
>=^<
forall a b. a -> Either a b
Left
where vF :: F a d
vF = forall {a} {d}. F a d -> F a d
raisedF (forall {hi} {ho}. Size -> F hi ho
holeF' Size
s)
s :: Size
s = Rect -> Size
rectsize Rect
knob
staticBorder3dF :: Bool -> F a d -> F a d
staticBorder3dF Bool
down F a d
fud = forall {a} {b}. Bool -> Int -> F a b -> F (Either Bool a) b
border3dF Bool
down Int
2 F a d
fud forall c d e. F c d -> (e -> c) -> F e d
>=^< forall a b. b -> Either a b
Right
raisedF :: F a d -> F a d
raisedF = forall {a} {d}. Bool -> F a d -> F a d
staticBorder3dF Bool
False
loweredF :: F a d -> F a d
loweredF = forall {a} {d}. Bool -> F a d -> F a d
staticBorder3dF Bool
True
topleft :: Size
topleft = Int -> Size
diag Int
0
margin :: Size
margin = Int -> Size
diag (forall {p}. (Read p, Show p) => [Char] -> p -> p
argReadKey [Char]
"potmargin" Int
0)
absknobpos :: a -> (a, a, a) -> (a, a)
absknobpos a
size (a
pos, a
frame, a
tot) =
if a
tot forall a. Eq a => a -> a -> Bool
== a
0
then (a
0, forall a. Ord a => a -> a -> a
max a
1 a
size)
else ((a
pos forall a. Num a => a -> a -> a
* a
size forall a. Num a => a -> a -> a
+ a
tot forall a. Integral a => a -> a -> a
`div` a
2) forall a. Integral a => a -> a -> a
`quot` a
tot, forall a. Ord a => a -> a -> a
max a
1 (a
frame forall a. Num a => a -> a -> a
* a
size forall a. Integral a => a -> a -> a
`quot` a
tot))
newkpos :: PotState -> (Int,Int) -> PotState
newkpos :: PotState -> (Int, Int) -> PotState
newkpos (Int
_, Int
frame, Int
tot) (Int
pos, Int
size) = (Int
pos forall a. Num a => a -> a -> a
* Int
tot forall a. Integral a => a -> a -> a
`quot` Int
size, Int
frame, Int
tot)
knobup :: a -> (a, b, c) -> (a, b, c)
knobup a
d (a
pos, b
frame, c
tot) = (a
0 forall a. Ord a => a -> a -> a
`max` (a
pos forall a. Num a => a -> a -> a
- a
d), b
frame, c
tot)
knobdown :: c -> (c, c, c) -> (c, c, c)
knobdown c
d (c
pos, c
frame, c
tot) = ((c
tot forall a. Num a => a -> a -> a
- c
frame) forall a. Ord a => a -> a -> a
`min` (c
pos forall a. Num a => a -> a -> a
+ c
d), c
frame, c
tot)
pageup :: (b, b, c) -> (b, b, c)
pageup knob :: (b, b, c)
knob@(b
_, b
frame, c
_) = forall {a} {b} {c}. (Ord a, Num a) => a -> (a, b, c) -> (a, b, c)
knobup b
frame (b, b, c)
knob
pagedown :: (c, c, c) -> (c, c, c)
pagedown knob :: (c, c, c)
knob@(c
_, c
frame, c
_) = forall {c}. (Ord c, Num c) => c -> (c, c, c) -> (c, c, c)
knobdown c
frame (c, c, c)
knob
stepup :: c -> (c, b, c) -> (c, b, c)
stepup c
len (c, b, c)
knob = forall {a} {b} {c}. (Ord a, Num a) => a -> (a, b, c) -> (a, b, c)
knobup (forall {a} {a} {b}. Integral a => a -> (a, b, a) -> a
stepsize c
len (c, b, c)
knob) (c, b, c)
knob
stepdown :: c -> (c, c, c) -> (c, c, c)
stepdown c
len (c, c, c)
knob = forall {c}. (Ord c, Num c) => c -> (c, c, c) -> (c, c, c)
knobdown (forall {a} {a} {b}. Integral a => a -> (a, b, a) -> a
stepsize c
len (c, c, c)
knob) (c, c, c)
knob
stepsize :: a -> (a, b, a) -> a
stepsize a
size (a
_,b
_,a
tot) = (a
totforall a. Num a => a -> a -> a
+a
sizeforall a. Num a => a -> a -> a
-a
1) forall a. Integral a => a -> a -> a
`quot` a
size
knobhome :: (a, b, c) -> (a, b, c)
knobhome (a
_, b
frame, c
tot) = (a
0, b
frame, c
tot)
knobend :: (a, c, c) -> (c, c, c)
knobend (a
_, c
frame, c
tot) = (c
tot forall a. Num a => a -> a -> a
- c
frame, c
frame, c
tot)
resizePot :: (a, b, c) -> b -> c -> (a, b, c)
resizePot (a
pos,b
_,c
_) b
frame c
tot = (a
pos,b
frame,c
tot)
movePot :: (a, b, c) -> a -> (a, b, c)
movePot (a
_,b
frame,c
tot) a
pos = (a
pos,b
frame,c
tot)
keyAction :: t Modifiers -> [Char] -> c -> Maybe ((c, c, c) -> (c, c, c))
keyAction t Modifiers
mods [Char]
s c
len =
case [Char]
s of
[Char]
s | [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"space" Bool -> Bool -> Bool
|| [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"Next" -> forall a. a -> Maybe a
Just (forall {a}. a -> a -> a
shift forall {c} {a}. Num c => (a, c, c) -> (c, c, c)
knobend forall {c}. (Ord c, Num c) => (c, c, c) -> (c, c, c)
pagedown)
[Char]
s | [Char]
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
pageupKeys -> forall a. a -> Maybe a
Just (forall {a}. a -> a -> a
shift forall {a} {a} {b} {c}. Num a => (a, b, c) -> (a, b, c)
knobhome forall {b} {c}. (Ord b, Num b) => (b, b, c) -> (b, b, c)
pageup)
[Char]
s | [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"Home" -> forall a. a -> Maybe a
Just forall {a} {a} {b} {c}. Num a => (a, b, c) -> (a, b, c)
knobhome
[Char]
s | [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"End" -> forall a. a -> Maybe a
Just forall {c} {a}. Num c => (a, c, c) -> (c, c, c)
knobend
[Char]
s | [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"Down" Bool -> Bool -> Bool
|| [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"Right" -> forall a. a -> Maybe a
Just (forall {c}. Integral c => c -> (c, c, c) -> (c, c, c)
stepdown c
len)
[Char]
s | [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"Up" Bool -> Bool -> Bool
|| [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"Left" -> forall a. a -> Maybe a
Just (forall {c} {b}. Integral c => c -> (c, b, c) -> (c, b, c)
stepup c
len)
[Char]
_ -> forall a. Maybe a
Nothing
where
shift :: a -> a -> a
shift = if Modifiers
Shift forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Modifiers
mods then forall a b. a -> b -> a
const else forall a b. a -> b -> a
const forall a. a -> a
id
pageupKeys :: [[Char]]
pageupKeys = [[Char]
"Delete",[Char]
"BackSpace",[Char]
"Prior"]
mkVisible :: (a, a, a) -> a -> a -> Maybe a -> Maybe (a, a, a)
mkVisible (a
pos,a
frame,a
tot) a
first a
last Maybe a
optAlign =
case Maybe a
optAlign of
Just a
a -> forall a. a -> Maybe a
Just (forall a. Ord a => a -> a -> a
max a
0 (forall a. Ord a => a -> a -> a
min (a
totforall a. Num a => a -> a -> a
-a
frame) a
pos'),a
frame,a
tot)
where pos' :: a
pos' = a
firstforall a. Num a => a -> a -> a
+forall a b. (RealFrac a, Integral b) => a -> b
truncate (a
aforall a. Num a => a -> a -> a
*forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
lastforall a. Num a => a -> a -> a
-a
firstforall a. Num a => a -> a -> a
-a
frame))
Maybe a
_ ->
if a
firstforall a. Ord a => a -> a -> Bool
<a
pos Bool -> Bool -> Bool
|| a
lastforall a. Num a => a -> a -> a
-a
firstforall a. Ord a => a -> a -> Bool
>a
frame
then forall a. a -> Maybe a
Just (a
first,a
frame,a
tot)
else if a
lastforall a. Ord a => a -> a -> Bool
>a
posforall a. Num a => a -> a -> a
+a
frame
then forall a. a -> Maybe a
Just (a
lastforall a. Num a => a -> a -> a
-a
frame,a
frame,a
tot)
else forall a. Maybe a
Nothing
potF :: Bool
-> (Size -> Int)
-> (Size -> t)
-> (Int -> t -> Size)
-> Int
-> p
-> Bool
-> Maybe Size
-> F PotRequest PotState
potF Bool
hori Size -> Int
par Size -> t
ort Int -> t -> Size
vect Int
shape p
grav Bool
acceptFocus Maybe Size
optsize =
forall a b c d.
F (Either (Either a b) c) (Either (Either c d) a) -> F b d
loopCompThroughRightF F (Either (Either Rect PotRequest) (Rect, Rect))
(Either (Either (Rect, Rect) PotState) Rect)
potGroupF
where
potGroupF :: F (Either (Either Rect PotRequest) (Rect, Rect))
(Either (Either (Rect, Rect) PotState) Rect)
potGroupF =
forall {a} {b}. Bool -> Bool -> F a b -> F a b
noStretchF (Bool -> Bool
not Bool
hori) Bool
hori forall a b. (a -> b) -> a -> b
$
forall {a} {d}. F a d -> F a d
loweredF forall a b. (a -> b) -> a -> b
$
forall {a} {b} {c} {d}.
Sizing
-> [FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF' Sizing
Static [FRequest]
startcmds
(forall {hi} {ho}. K hi ho -> K hi ho
darkGreyBgK K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
potK0)
(Int -> Rect -> Rect -> F (Rect, Rect) Rect
knobF Int
shape Rect
box0 (Int -> PotState -> Rect
knob Int
length0 PotState
kpos0))
where wattrs :: [WindowAttributes]
wattrs = [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
eventmask]
alwayseventmask :: [EventMask]
alwayseventmask = [EventMask
ButtonPressMask,EventMask
Button2MotionMask]
focuseventmask :: [EventMask]
focuseventmask = [EventMask
EnterWindowMask, EventMask
LeaveWindowMask, EventMask
KeyPressMask]
eventmask :: [EventMask]
eventmask = [EventMask]
alwayseventmask forall a. [a] -> [a] -> [a]
++
if Bool
acceptFocus then [EventMask]
focuseventmask else []
startcmds :: [FRequest]
startcmds = [
XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wattrs]
wsize :: Size
wsize = forall a. a -> Maybe a -> a
fromMaybe (Int -> t -> Size
vect Int
50 t
11) Maybe Size
optsize
boxsize0 :: Size
boxsize0 = Size -> Size -> Size
psub Size
wsize Size
margin
length0 :: Int
length0 = Size -> Int
par Size
boxsize0
boxwidth :: t
boxwidth = Size -> t
ort Size
boxsize0
knob :: Int -> PotState -> Rect
knob Int
length' PotState
kpos' =
let (Int
pos, Int
size) = forall {a}. Integral a => a -> (a, a, a) -> (a, a)
absknobpos Int
length' PotState
kpos'
in Size -> Size -> Rect
Rect (Size -> Size -> Size
padd Size
topleft (Int -> t -> Size
vect Int
pos t
0)) (Int -> t -> Size
vect Int
size t
boxwidth)
box0 :: Rect
box0 = Size -> Size -> Rect
Rect Size
topleft Size
boxsize0
potK0 :: K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
potK0 = K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
potK1
potK1 :: K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
potK1 = PotState
-> Int -> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
potK PotState
kpos0 Int
length0 where
potK :: PotState
-> Int -> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
potK PotState
kpos Int
len =
let cont :: PotState
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
cont PotState
kpos' = PotState
-> Int -> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
potK PotState
kpos' Int
len
newlen :: PotState
-> Int -> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
newlen PotState
kpos' Int
len' = PotState
-> Int -> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
potK PotState
kpos' Int
len'
same :: K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
same = PotState
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
cont PotState
kpos
report :: b -> Message a (Either a b)
report b
kpos' =
forall a b. b -> Message a b
High (forall a b. b -> Either a b
Right b
kpos')
changeknob :: Int -> PotState -> Message a (Either (Rect, Rect) b)
changeknob Int
len' PotState
kpos' =
forall a b. b -> Message a b
High (forall a b. a -> Either a b
Left (Int -> PotState -> Rect
knob Int
len' PotState
kpos',
Size -> Size -> Rect
Rect Size
topleft (Int -> t -> Size
vect Int
len' t
boxwidth)))
moveknob :: PotState
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
moveknob PotState
kpos' =
forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK [forall {a} {b}.
Int -> PotState -> Message a (Either (Rect, Rect) b)
changeknob Int
len PotState
kpos'] forall a b. (a -> b) -> a -> b
$
K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
same
keyInput :: t Modifiers
-> [Char]
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
keyInput t Modifiers
mods [Char]
key = forall b a. b -> (a -> b) -> Maybe a -> b
maybe K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
same (PotState -> PotState)
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
act (forall {c} {t :: * -> *}.
(Integral c, Foldable t) =>
t Modifiers -> [Char] -> c -> Maybe ((c, c, c) -> (c, c, c))
keyAction t Modifiers
mods [Char]
key Int
len)
where act :: (PotState -> PotState)
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
act PotState -> PotState
action = PotState
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
moveknob (PotState -> PotState
action PotState
kpos)
button2Action :: Size -> PotState
button2Action Size
p = PotState -> (Int, Int) -> PotState
newkpos PotState
kpos (Size -> Int
par Size
p, Int
len)
buttonAction :: Button -> t Modifiers -> Size -> PotState
buttonAction (Button Int
2) t Modifiers
mods Size
p = Size -> PotState
button2Action Size
p
buttonAction Button
b t Modifiers
mods Size
p =
case (Size -> Int
par Size
p forall a. Ord a => a -> a -> Bool
< Size -> Int
par (Rect -> Size
rectpos (Int -> PotState -> Rect
knob Int
len PotState
kpos)),
Modifiers
Shift forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Modifiers
mods Bool -> Bool -> Bool
|| Modifiers
Control forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Modifiers
mods) of
(Bool
True, Bool
False) -> forall {b} {c}. (Ord b, Num b) => (b, b, c) -> (b, b, c)
pageup PotState
kpos
(Bool
True, Bool
True ) -> forall {a} {a} {b} {c}. Num a => (a, b, c) -> (a, b, c)
knobhome PotState
kpos
(Bool
False,Bool
False) -> forall {c}. (Ord c, Num c) => (c, c, c) -> (c, c, c)
pagedown PotState
kpos
(Bool
False,Bool
True ) -> forall {c} {a}. Num c => (a, c, c) -> (c, c, c)
knobend PotState
kpos
in forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ \KEvent (Either Rect PotRequest)
msg ->
case KEvent (Either Rect PotRequest)
msg of
Low (XEvt (ButtonEvent {button :: XEvent -> Button
button=Button
b,pos :: XEvent -> Size
pos=Size
p,state :: XEvent -> ModState
state=ModState
mods,type' :: XEvent -> Pressed
type'=Pressed
Pressed})) ->
PotState
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
moveknob (forall {t :: * -> *}.
Foldable t =>
Button -> t Modifiers -> Size -> PotState
buttonAction Button
b ModState
mods Size
p)
Low (XEvt (MotionNotify {pos :: XEvent -> Size
pos=Size
p,state :: XEvent -> ModState
state=ModState
mods})) | Modifiers
Button2 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ModState
mods ->
PotState
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
moveknob (Size -> PotState
button2Action Size
p)
Low (LEvt (LayoutSize Size
size')) ->
let len' :: Int
len' = Size -> Int
par Size
size' forall a. Num a => a -> a -> a
- Size -> Int
par Size
margin
in if Int
len'forall a. Eq a => a -> a -> Bool
/=Int
len
then forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK [forall {a} {b}.
Int -> PotState -> Message a (Either (Rect, Rect) b)
changeknob Int
len' PotState
kpos] (PotState
-> Int -> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
newlen PotState
kpos Int
len')
else K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
same
Low (XEvt (KeyEvent Int
_ Size
_ Size
_ ModState
mods Pressed
Pressed KeyCode
_ [Char]
key [Char]
_)) ->
forall {t :: * -> *}.
Foldable t =>
t Modifiers
-> [Char]
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
keyInput ModState
mods [Char]
key
Low (XEvt (FocusIn {detail :: XEvent -> Detail
detail=Detail
d})) | Detail
d forall a. Eq a => a -> a -> Bool
/= Detail
NotifyInferior ->
forall {hi} {ho}. K hi ho -> K hi ho
lightGreyBgK K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
same
Low (XEvt (FocusOut {detail :: XEvent -> Detail
detail=Detail
d})) | Detail
d forall a. Eq a => a -> a -> Bool
/= Detail
NotifyInferior ->
forall {hi} {ho}. K hi ho -> K hi ho
darkGreyBgK K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
same
High (Right (PotInput (ModState
mods,[Char]
key))) -> forall {t :: * -> *}.
Foldable t =>
t Modifiers
-> [Char]
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
keyInput ModState
mods [Char]
key
High (Right (ResizePot Int
frame Int
tot)) ->
let kpos' :: PotState
kpos' = forall {a} {b} {c} {b} {c}. (a, b, c) -> b -> c -> (a, b, c)
resizePot PotState
kpos Int
frame Int
tot
in forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {b}.
Int -> PotState -> Message a (Either (Rect, Rect) b)
changeknob Int
len PotState
kpos') (PotState
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
cont PotState
kpos')
High (Right (MovePot Int
pos)) ->
let kpos' :: PotState
kpos' = forall {a} {b} {c} {a}. (a, b, c) -> a -> (a, b, c)
movePot PotState
kpos Int
pos
in forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {a} {b}.
Int -> PotState -> Message a (Either (Rect, Rect) b)
changeknob Int
len PotState
kpos') (PotState
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
cont PotState
kpos')
High (Right (PotMkVisible Int
pos Int
size Maybe Alignment
optAlign)) ->
case forall {a} {a}.
(RealFrac a, Integral a) =>
(a, a, a) -> a -> a -> Maybe a -> Maybe (a, a, a)
mkVisible PotState
kpos Int
pos (Int
posforall a. Num a => a -> a -> a
+Int
size) Maybe Alignment
optAlign of
Just PotState
kpos' -> PotState
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
moveknob PotState
kpos'
Maybe PotState
Nothing -> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
same
High (Left Rect
newknob) ->
let kpos' :: PotState
kpos' = PotState -> (Int, Int) -> PotState
newkpos PotState
kpos (Size -> Int
par (Rect -> Rect -> Size
rsub Rect
newknob Rect
box0), Int
len)
in if PotState
kpos'forall a. Eq a => a -> a -> Bool
==PotState
kpos
then K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
same
else forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall {b} {a} {a}. b -> Message a (Either a b)
report PotState
kpos') (PotState
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
cont PotState
kpos')
KEvent (Either Rect PotRequest)
_ -> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
same
kpos0 :: PotState
kpos0 = (Int
0,Int
1,Int
1)
vPotF' :: Bool -> Maybe Size -> F PotRequest PotState
vPotF' = forall {t} {p}.
Num t =>
Bool
-> (Size -> Int)
-> (Size -> t)
-> (Int -> t -> Size)
-> Int
-> p
-> Bool
-> Maybe Size
-> F PotRequest PotState
potF Bool
False Size -> Int
ycoord Size -> Int
xcoord (\Int
x -> \Int
y -> Int -> Int -> Size
Point Int
y Int
x) Int
116 Gravity
NorthEastGravity
hPotF' :: Bool -> Maybe Size -> F PotRequest PotState
hPotF' = forall {t} {p}.
Num t =>
Bool
-> (Size -> Int)
-> (Size -> t)
-> (Int -> t -> Size)
-> Int
-> p
-> Bool
-> Maybe Size
-> F PotRequest PotState
potF Bool
True Size -> Int
xcoord Size -> Int
ycoord Int -> Int -> Size
Point Int
108 Gravity
SouthWestGravity
vPotF :: F PotRequest PotState
vPotF = Bool -> Maybe Size -> F PotRequest PotState
vPotF' Bool
True forall a. Maybe a
Nothing
hPotF :: F PotRequest PotState
hPotF = Bool -> Maybe Size -> F PotRequest PotState
hPotF' Bool
True forall a. Maybe a
Nothing