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 Color
import Fudget
--import FudgetIO
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 Message(Message(..))
import EitherUtils(stripEither)
import Data.Maybe(fromMaybe)
import CmdLineEnv(argReadKey)
import Xtypes
--import Maptrace(ctrace)

data PotRequest = ResizePot Int Int -- frame size, total size
                | MovePot   Int     -- new position
		| PotMkVisible Int Int (Maybe Alignment) -- pos, length, alignm
		| PotInput (ModState, KeySym) -- remote control

type PotState = (Int,Int,Int)  -- position, frame size, total size

knobS :: Rect -> Rect -> Spacer
knobS knob :: Rect
knob@(Rect Size
kp Size
ks) box :: Rect
box@(Rect Size
bp Size
bs) =
  --ctrace "knobS" (knob,box) $
  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 -- was: knob/=newknob
		        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

-- New version, using new more general containterGroupF
-- containterGroupF should be replaced.
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]]
		    --MapRaised]
        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 = diag 2
--margin = diag 6
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) -- !! should adjust pos if necessary
movePot :: (a, b, c) -> a -> (a, b, c)
movePot (a
_,b
frame,c
tot) a
pos = (a
pos,b
frame,c
tot) -- !! should keep pos within boundaries

--and adjkpos (pos,frame,tot) frame' tot' = (min (tot'-frame') (pos*tot'/tot),frame',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 = [--XCmd $ LayoutMsg (Layout wsize (not hori) hori),
			 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 --allocNamedColorPixel defaultColormap "white" 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' = --ctrace "report" 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' = --ctrace "moveknob" 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'{-,report kpos'-}] forall a b. (a -> b) -> a -> b
$
			       -- Rely on the knob to report the new position,
			       -- after it has been confined to the box. This
			       -- is a fix for button2Action that result in
			       -- positions outside the box...
			       K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
same -- cont kpos'
	      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) ->
                 --ctrace "newknob" 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 -- False
		     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