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 Point
kp Point
ks) box :: Rect
box@(Rect Point
bp Point
bs) =
  --ctrace "knobS" (knob,box) $
  Point -> Point -> Spacer
hvMarginS (Point
kpPoint -> Point -> Point
forall a. Num a => a -> a -> a
+Point
margin) (Point
bsPoint -> Point -> Point
forall a. Num a => a -> a -> a
+Point
marginPoint -> Point -> Point
forall a. Num a => a -> a -> a
-Point
kpPoint -> Point -> Point
forall a. Num a => a -> a -> a
-Point
ks)

knobK :: Rect -> Rect -> Point -> K (Rect, Rect) (Either Spacer Rect)
knobK Rect
box Rect
knob Point
pabs =
    let cont :: Rect -> Point -> K (Rect, Rect) (Either Spacer Rect)
cont Rect
knob' Point
pabs' = Rect -> Rect -> Point -> K (Rect, Rect) (Either Spacer Rect)
knobK Rect
box Rect
knob' Point
pabs'
        newbox :: Rect -> Rect -> K (Rect, Rect) (Either Spacer Rect)
newbox Rect
box' Rect
knob' = Rect -> Rect -> Point -> K (Rect, Rect) (Either Spacer Rect)
knobK Rect
box' Rect
knob' Point
pabs
        same :: K (Rect, Rect) (Either Spacer Rect)
same = Rect -> Point -> K (Rect, Rect) (Either Spacer Rect)
cont Rect
knob Point
pabs
	output :: b -> K hi (Either a b) -> K hi (Either a b)
output b
knob = KCommand (Either a b) -> K hi (Either a b) -> K hi (Either a b)
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (Either a b -> KCommand (Either a b)
forall a b. b -> Message a b
High (b -> Either a b
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 = KCommand (Either Spacer b)
-> K hi (Either Spacer b) -> K hi (Either Spacer b)
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (Either Spacer b -> KCommand (Either Spacer b)
forall a b. b -> Message a b
High (Spacer -> Either Spacer b
forall a b. a -> Either a b
Left (Rect -> Rect -> Spacer
knobS Rect
knob Rect
box)))
    in  Cont (K (Rect, Rect) (Either Spacer Rect)) (KEvent (Rect, Rect))
forall hi ho. Cont (K hi ho) (KEvent hi)
getK Cont (K (Rect, Rect) (Either Spacer Rect)) (KEvent (Rect, Rect))
-> Cont (K (Rect, Rect) (Either Spacer Rect)) (KEvent (Rect, Rect))
forall a b. (a -> b) -> a -> b
$ \KEvent (Rect, Rect)
msg ->
        case KEvent (Rect, Rect)
msg of
          Low (XEvt (MotionNotify {rootPos :: XEvent -> Point
rootPos=Point
pabs',state :: XEvent -> ModState
state=ModState
mods})) ->
	    let knob' :: Rect
knob' = Rect -> Point -> Rect
moverect Rect
knob (Point -> Point -> Point
psub Point
pabs' Point
pabs)
	        knob'' :: Rect
knob'' = Rect -> Rect -> Rect
confine Rect
box Rect
knob'
		pabs'' :: Point
pabs'' = Point -> Point -> Point
padd Point
pabs' (Rect -> Rect -> Point
rsub Rect
knob'' Rect
knob')
            in  Rect
-> Rect
-> K (Rect, Rect) (Either Spacer Rect)
-> K (Rect, Rect) (Either Spacer Rect)
forall hi b.
Rect -> Rect -> K hi (Either Spacer b) -> K hi (Either Spacer b)
repos Rect
knob'' Rect
box (K (Rect, Rect) (Either Spacer Rect)
 -> K (Rect, Rect) (Either Spacer Rect))
-> K (Rect, Rect) (Either Spacer Rect)
-> K (Rect, Rect) (Either Spacer Rect)
forall a b. (a -> b) -> a -> b
$
                (if Modifiers
Shift Modifiers -> ModState -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ModState
mods then K (Rect, Rect) (Either Spacer Rect)
-> K (Rect, Rect) (Either Spacer Rect)
forall a. a -> a
id else Rect
-> K (Rect, Rect) (Either Spacer Rect)
-> K (Rect, Rect) (Either Spacer Rect)
forall b hi a. b -> K hi (Either a b) -> K hi (Either a b)
output Rect
knob'') (K (Rect, Rect) (Either Spacer Rect)
 -> K (Rect, Rect) (Either Spacer Rect))
-> K (Rect, Rect) (Either Spacer Rect)
-> K (Rect, Rect) (Either Spacer Rect)
forall a b. (a -> b) -> a -> b
$
	        Rect -> Point -> K (Rect, Rect) (Either Spacer Rect)
cont Rect
knob'' Point
pabs''
          Low (XEvt (ButtonEvent {rootPos :: XEvent -> Point
rootPos=Point
pabs',type' :: XEvent -> Pressed
type'=Pressed
Pressed})) -> Rect -> Point -> K (Rect, Rect) (Either Spacer Rect)
cont Rect
knob Point
pabs'
          Low (XEvt (ButtonEvent {type' :: XEvent -> Pressed
type'=Pressed
Released})) -> Rect
-> K (Rect, Rect) (Either Spacer Rect)
-> K (Rect, Rect) (Either Spacer Rect)
forall b hi a. b -> K hi (Either a b) -> K hi (Either a b)
output Rect
knob (K (Rect, Rect) (Either Spacer Rect)
 -> K (Rect, Rect) (Either Spacer Rect))
-> K (Rect, Rect) (Either Spacer Rect)
-> K (Rect, Rect) (Either Spacer Rect)
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'Rect -> Rect -> Bool
forall a. Eq a => a -> a -> Bool
/=Rect
knob Bool -> Bool -> Bool
|| Rect
box'Rect -> Rect -> Bool
forall a. Eq a => a -> a -> Bool
/=Rect
box
                        then Rect
-> Rect -> K hi (Either Spacer Rect) -> K hi (Either Spacer Rect)
forall hi b.
Rect -> Rect -> K hi (Either Spacer b) -> K hi (Either Spacer b)
repos Rect
knob' Rect
box'
			else K hi (Either Spacer Rect) -> K hi (Either Spacer Rect)
forall a. a -> a
id) (K hi (Either Spacer Rect) -> K hi (Either Spacer Rect))
-> (K hi (Either Spacer Rect) -> K hi (Either Spacer Rect))
-> K hi (Either Spacer Rect)
-> K hi (Either Spacer Rect)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		       (if Rect
knob'Rect -> Rect -> Bool
forall a. Eq a => a -> a -> Bool
/=Rect
knob -- was: knob/=newknob
		        then Rect -> K hi (Either Spacer Rect) -> K hi (Either Spacer Rect)
forall b hi a. b -> K hi (Either a b) -> K hi (Either a b)
output Rect
knob'
			else K hi (Either Spacer Rect) -> K hi (Either Spacer Rect)
forall a. a -> a
id)
            in K (Rect, Rect) (Either Spacer Rect)
-> K (Rect, Rect) (Either Spacer Rect)
forall hi. K hi (Either Spacer Rect) -> K hi (Either Spacer Rect)
msgs (K (Rect, Rect) (Either Spacer Rect)
 -> K (Rect, Rect) (Either Spacer Rect))
-> K (Rect, Rect) (Either Spacer Rect)
-> K (Rect, Rect) (Either Spacer Rect)
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 =
    F (Either Spacer (Either (Rect, Rect) c))
  (Either Spacer (Either Rect b))
-> F (Either (Rect, Rect) c) (Either Rect b)
forall a b c. F (Either a b) (Either a c) -> F b c
loopLeftF (F (Either Spacer (Either (Rect, Rect) c))
   (Either Spacer (Either Rect b))
 -> F (Either (Rect, Rect) c) (Either Rect b))
-> F (Either Spacer (Either (Rect, Rect) c))
     (Either Spacer (Either Rect b))
-> F (Either (Rect, Rect) c) (Either Rect b)
forall a b. (a -> b) -> a -> b
$
    (Either Spacer (Either (Rect, Rect) c)
 -> Either Spacer (Either (Rect, Rect) c))
-> (Either (Either Spacer Rect) b -> Either Spacer (Either Rect b))
-> F (Either Spacer (Either (Rect, Rect) c))
     (Either (Either Spacer Rect) b)
-> F (Either Spacer (Either (Rect, Rect) c))
     (Either Spacer (Either Rect b))
forall hi b c ho. (hi -> b) -> (c -> ho) -> F b c -> F hi ho
prepostMapHigh Either Spacer (Either (Rect, Rect) c)
-> Either Spacer (Either (Rect, Rect) c)
forall a. a -> a
pre Either (Either Spacer Rect) b -> Either Spacer (Either Rect b)
forall a a b. Either (Either a a) b -> Either a (Either a b)
post (F (Either Spacer (Either (Rect, Rect) c))
   (Either (Either Spacer Rect) b)
 -> F (Either Spacer (Either (Rect, Rect) c))
      (Either Spacer (Either Rect b)))
-> F (Either Spacer (Either (Rect, Rect) c))
     (Either (Either Spacer Rect) b)
-> F (Either Spacer (Either (Rect, Rect) c))
     (Either Spacer (Either Rect b))
forall a b. (a -> b) -> a -> b
$
    F (Either (Rect, Rect) c) (Either (Either Spacer Rect) b)
-> F (Either Spacer (Either (Rect, Rect) c))
     (Either (Either Spacer Rect) b)
forall c ho. F c ho -> F (Either Spacer c) ho
dynSpacerF (F (Either (Rect, Rect) c) (Either (Either Spacer Rect) b)
 -> F (Either Spacer (Either (Rect, Rect) c))
      (Either (Either Spacer Rect) b))
-> F (Either (Rect, Rect) c) (Either (Either Spacer Rect) b)
-> F (Either Spacer (Either (Rect, Rect) c))
     (Either (Either Spacer Rect) b)
forall a b. (a -> b) -> a -> b
$
    [FRequest]
-> K (Rect, Rect) (Either Spacer Rect)
-> F c b
-> F (Either (Rect, Rect) c) (Either (Either Spacer Rect) b)
forall a b c d.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF [FRequest]
initcmds
           (Int
-> K (Rect, Rect) (Either Spacer Rect)
-> K (Rect, Rect) (Either Spacer Rect)
forall a b. Int -> K a b -> K a b
setFontCursor Int
cursorshape (Rect -> Rect -> Point -> K (Rect, Rect) (Either Spacer Rect)
knobK Rect
box Rect
knob Point
origin))
           F c b
fudget
  where attrs :: [WindowAttributes]
attrs = [[EventMask] -> WindowAttributes
CWEventMask []]
        initcmds :: [FRequest]
initcmds = (XCommand -> FRequest) -> [XCommand] -> [FRequest]
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 = a -> a
forall a. a -> a
id
	post :: Either (Either a a) b -> Either a (Either a b)
post = (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)

knobF :: Int -> Rect -> Rect -> F (Rect, Rect) Rect
knobF Int
cursor Rect
box Rect
knob =
    (Either Rect Rect -> Rect
forall p. Either p p -> p
stripEither (Either Rect Rect -> Rect)
-> F (Either (Rect, Rect) Any) (Either Rect Rect)
-> F (Either (Rect, Rect) Any) Rect
forall a b e. (a -> b) -> F e a -> F e b
>^=< Rect
-> Rect
-> Int
-> Button
-> ModState
-> F Any Rect
-> F (Either (Rect, Rect) Any) (Either Rect Rect)
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) [] F Any Rect
forall a d. F a d
vF ) F (Either (Rect, Rect) Any) Rect
-> ((Rect, Rect) -> Either (Rect, Rect) Any) -> F (Rect, Rect) Rect
forall c d e. F c d -> (e -> c) -> F e d
>=^<
    (Rect, Rect) -> Either (Rect, Rect) Any
forall a b. a -> Either a b
Left
  where vF :: F a d
vF = F a d -> F a d
forall a d. F a d -> F a d
raisedF (Point -> F a d
forall hi ho. Point -> F hi ho
holeF' Point
s)
	s :: Point
s = Rect -> Point
rectsize Rect
knob

staticBorder3dF :: Bool -> F a d -> F a d
staticBorder3dF Bool
down F a d
fud = Bool -> Int -> F a d -> F (Either Bool a) d
forall a b. Bool -> Int -> F a b -> F (Either Bool a) b
border3dF Bool
down Int
2 F a d
fud F (Either Bool a) d -> (a -> Either Bool a) -> F a d
forall c d e. F c d -> (e -> c) -> F e d
>=^< a -> Either Bool a
forall a b. b -> Either a b
Right
raisedF :: F a d -> F a d
raisedF = Bool -> F a d -> F a d
forall a d. Bool -> F a d -> F a d
staticBorder3dF Bool
False
loweredF :: F a d -> F a d
loweredF = Bool -> F a d -> F a d
forall a d. Bool -> F a d -> F a d
staticBorder3dF Bool
True

--topleft = diag 2
--margin = diag 6
topleft :: Point
topleft = Int -> Point
diag Int
0
margin :: Point
margin = Int -> Point
diag ([Char] -> Int -> Int
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
    then (a
0, a -> a -> a
forall a. Ord a => a -> a -> a
max a
1 a
size)
    else ((a
pos a -> a -> a
forall a. Num a => a -> a -> a
* a
size a -> a -> a
forall a. Num a => a -> a -> a
+ a
tot a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2) a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
tot, a -> a -> a
forall a. Ord a => a -> a -> a
max a
1 (a
frame a -> a -> a
forall a. Num a => a -> a -> a
* a
size a -> a -> a
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
tot Int -> Int -> Int
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 a -> a -> a
forall a. Ord a => a -> a -> a
`max` (a
pos a -> a -> a
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 c -> c -> c
forall a. Num a => a -> a -> a
- c
frame) c -> c -> c
forall a. Ord a => a -> a -> a
`min` (c
pos c -> c -> c
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
_) = b -> (b, b, c) -> (b, b, 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
_) = c -> (c, c, c) -> (c, c, 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 = c -> (c, b, c) -> (c, b, c)
forall a b c. (Ord a, Num a) => a -> (a, b, c) -> (a, b, c)
knobup (c -> (c, b, c) -> c
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 = c -> (c, c, c) -> (c, c, c)
forall c. (Ord c, Num c) => c -> (c, c, c) -> (c, c, c)
knobdown (c -> (c, c, c) -> c
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
tota -> a -> a
forall a. Num a => a -> a -> a
+a
sizea -> a -> a
forall a. Num a => a -> a -> a
-a
1) a -> a -> a
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 c -> c -> c
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 [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"space"  Bool -> Bool -> Bool
|| [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"Next"  -> ((c, c, c) -> (c, c, c)) -> Maybe ((c, c, c) -> (c, c, c))
forall a. a -> Maybe a
Just (((c, c, c) -> (c, c, c))
-> ((c, c, c) -> (c, c, c)) -> (c, c, c) -> (c, c, c)
forall a. a -> a -> a
shift (c, c, c) -> (c, c, c)
forall c a. Num c => (a, c, c) -> (c, c, c)
knobend (c, c, c) -> (c, c, c)
forall c. (Ord c, Num c) => (c, c, c) -> (c, c, c)
pagedown)
      [Char]
s | [Char]
s [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
pageupKeys           -> ((c, c, c) -> (c, c, c)) -> Maybe ((c, c, c) -> (c, c, c))
forall a. a -> Maybe a
Just (((c, c, c) -> (c, c, c))
-> ((c, c, c) -> (c, c, c)) -> (c, c, c) -> (c, c, c)
forall a. a -> a -> a
shift (c, c, c) -> (c, c, c)
forall a a b c. Num a => (a, b, c) -> (a, b, c)
knobhome (c, c, c) -> (c, c, c)
forall b c. (Ord b, Num b) => (b, b, c) -> (b, b, c)
pageup)
      [Char]
s | [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"Home"                   -> ((c, c, c) -> (c, c, c)) -> Maybe ((c, c, c) -> (c, c, c))
forall a. a -> Maybe a
Just (c, c, c) -> (c, c, c)
forall a a b c. Num a => (a, b, c) -> (a, b, c)
knobhome
      [Char]
s | [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"End"                    -> ((c, c, c) -> (c, c, c)) -> Maybe ((c, c, c) -> (c, c, c))
forall a. a -> Maybe a
Just (c, c, c) -> (c, c, c)
forall c a. Num c => (a, c, c) -> (c, c, c)
knobend
      [Char]
s | [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"Down"   Bool -> Bool -> Bool
|| [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"Right" -> ((c, c, c) -> (c, c, c)) -> Maybe ((c, c, c) -> (c, c, c))
forall a. a -> Maybe a
Just (c -> (c, c, c) -> (c, c, c)
forall c. Integral c => c -> (c, c, c) -> (c, c, c)
stepdown c
len)
      [Char]
s | [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"Up"     Bool -> Bool -> Bool
|| [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"Left"  -> ((c, c, c) -> (c, c, c)) -> Maybe ((c, c, c) -> (c, c, c))
forall a. a -> Maybe a
Just (c -> (c, c, c) -> (c, c, c)
forall c b. Integral c => c -> (c, b, c) -> (c, b, c)
stepup c
len)
      [Char]
_ -> Maybe ((c, c, c) -> (c, c, c))
forall a. Maybe a
Nothing
  where
    shift :: a -> a -> a
shift = if Modifiers
Shift Modifiers -> t Modifiers -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Modifiers
mods then a -> a -> a
forall a b. a -> b -> a
const else (a -> a) -> a -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id
    pageupKeys :: [[Char]]
pageupKeys = [[Char]
"Delete",[Char]
"BackSpace",[Char]
"Prior"]

mkVisible :: (c, c, c) -> c -> c -> Maybe a -> Maybe (c, c, c)
mkVisible (c
pos,c
frame,c
tot) c
first c
last Maybe a
optAlign =
  case Maybe a
optAlign of
    Just a
a -> (c, c, c) -> Maybe (c, c, c)
forall a. a -> Maybe a
Just (c -> c -> c
forall a. Ord a => a -> a -> a
max c
0 (c -> c -> c
forall a. Ord a => a -> a -> a
min (c
totc -> c -> c
forall a. Num a => a -> a -> a
-c
frame) c
pos'),c
frame,c
tot)
      where pos' :: c
pos' = c
firstc -> c -> c
forall a. Num a => a -> a -> a
+a -> c
forall a b. (RealFrac a, Integral b) => a -> b
truncate (a
aa -> a -> a
forall a. Num a => a -> a -> a
*c -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (c
lastc -> c -> c
forall a. Num a => a -> a -> a
-c
firstc -> c -> c
forall a. Num a => a -> a -> a
-c
frame))
    Maybe a
_ ->
      if c
firstc -> c -> Bool
forall a. Ord a => a -> a -> Bool
<c
pos Bool -> Bool -> Bool
|| c
lastc -> c -> c
forall a. Num a => a -> a -> a
-c
firstc -> c -> Bool
forall a. Ord a => a -> a -> Bool
>c
frame
      then (c, c, c) -> Maybe (c, c, c)
forall a. a -> Maybe a
Just (c
first,c
frame,c
tot)
      else if c
lastc -> c -> Bool
forall a. Ord a => a -> a -> Bool
>c
posc -> c -> c
forall a. Num a => a -> a -> a
+c
frame
	   then (c, c, c) -> Maybe (c, c, c)
forall a. a -> Maybe a
Just (c
lastc -> c -> c
forall a. Num a => a -> a -> a
-c
frame,c
frame,c
tot)
	   else Maybe (c, c, c)
forall a. Maybe a
Nothing

potF :: Bool
-> (Point -> Int)
-> (Point -> t)
-> (Int -> t -> Point)
-> Int
-> p
-> Bool
-> Maybe Point
-> F PotRequest PotState
potF Bool
hori Point -> Int
par Point -> t
ort Int -> t -> Point
vect Int
shape p
grav Bool
acceptFocus Maybe Point
optsize =
    F (Either (Either Rect PotRequest) (Rect, Rect))
  (Either (Either (Rect, Rect) PotState) Rect)
-> F PotRequest PotState
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 =
	Bool
-> Bool
-> F (Either (Either Rect PotRequest) (Rect, Rect))
     (Either (Either (Rect, Rect) PotState) Rect)
-> F (Either (Either Rect PotRequest) (Rect, Rect))
     (Either (Either (Rect, Rect) PotState) Rect)
forall a b. Bool -> Bool -> F a b -> F a b
noStretchF (Bool -> Bool
not Bool
hori) Bool
hori (F (Either (Either Rect PotRequest) (Rect, Rect))
   (Either (Either (Rect, Rect) PotState) Rect)
 -> F (Either (Either Rect PotRequest) (Rect, Rect))
      (Either (Either (Rect, Rect) PotState) Rect))
-> F (Either (Either Rect PotRequest) (Rect, Rect))
     (Either (Either (Rect, Rect) PotState) Rect)
-> F (Either (Either Rect PotRequest) (Rect, Rect))
     (Either (Either (Rect, Rect) PotState) Rect)
forall a b. (a -> b) -> a -> b
$
	F (Either (Either Rect PotRequest) (Rect, Rect))
  (Either (Either (Rect, Rect) PotState) Rect)
-> F (Either (Either Rect PotRequest) (Rect, Rect))
     (Either (Either (Rect, Rect) PotState) Rect)
forall a d. F a d -> F a d
loweredF (F (Either (Either Rect PotRequest) (Rect, Rect))
   (Either (Either (Rect, Rect) PotState) Rect)
 -> F (Either (Either Rect PotRequest) (Rect, Rect))
      (Either (Either (Rect, Rect) PotState) Rect))
-> F (Either (Either Rect PotRequest) (Rect, Rect))
     (Either (Either (Rect, Rect) PotState) Rect)
-> F (Either (Either Rect PotRequest) (Rect, Rect))
     (Either (Either (Rect, Rect) PotState) Rect)
forall a b. (a -> b) -> a -> b
$ 
	Sizing
-> [FRequest]
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
-> F (Rect, Rect) Rect
-> F (Either (Either Rect PotRequest) (Rect, Rect))
     (Either (Either (Rect, Rect) PotState) Rect)
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 
	       (K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
forall b ho. K b ho -> K b 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 [EventMask] -> [EventMask] -> [EventMask]
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 (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wattrs]
    wsize :: Point
wsize    = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe (Int -> t -> Point
vect Int
50 t
11) Maybe Point
optsize
    boxsize0 :: Point
boxsize0 = Point -> Point -> Point
psub Point
wsize Point
margin
    length0 :: Int
length0  = Point -> Int
par Point
boxsize0
    boxwidth :: t
boxwidth = Point -> t
ort Point
boxsize0
    knob :: Int -> PotState -> Rect
knob Int
length' PotState
kpos' =
	let (Int
pos, Int
size) = Int -> PotState -> (Int, Int)
forall a. Integral a => a -> (a, a, a) -> (a, a)
absknobpos Int
length' PotState
kpos'
	in  Point -> Point -> Rect
Rect (Point -> Point -> Point
padd Point
topleft (Int -> t -> Point
vect Int
pos t
0)) (Int -> t -> Point
vect Int
size t
boxwidth)
    box0 :: Rect
box0 = Point -> Point -> Rect
Rect Point
topleft Point
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' $
	                     Either a b -> Message a (Either a b)
forall a b. b -> Message a b
High (b -> Either a b
forall a b. b -> Either a b
Right b
kpos')
	      changeknob :: Int -> PotState -> Message a (Either (Rect, Rect) b)
changeknob Int
len' PotState
kpos' =
		  Either (Rect, Rect) b -> Message a (Either (Rect, Rect) b)
forall a b. b -> Message a b
High ((Rect, Rect) -> Either (Rect, Rect) b
forall a b. a -> Either a b
Left (Int -> PotState -> Rect
knob Int
len' PotState
kpos',
			     Point -> Point -> Rect
Rect Point
topleft (Int -> t -> Point
vect Int
len' t
boxwidth)))
	      moveknob :: PotState
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
moveknob PotState
kpos' = --ctrace "moveknob" kpos' $
			       [KCommand (Either (Rect, Rect) PotState)]
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
forall b a. [KCommand b] -> K a b -> K a b
putsK [Int -> PotState -> KCommand (Either (Rect, Rect) PotState)
forall a b. Int -> PotState -> Message a (Either (Rect, Rect) b)
changeknob Int
len PotState
kpos'{-,report kpos'-}] (K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
 -> K (Either Rect PotRequest) (Either (Rect, Rect) PotState))
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
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 = K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
-> ((PotState -> PotState)
    -> K (Either Rect PotRequest) (Either (Rect, Rect) PotState))
-> Maybe (PotState -> PotState)
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
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 (t Modifiers -> [Char] -> Int -> Maybe (PotState -> PotState)
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 :: Point -> PotState
button2Action Point
p = PotState -> (Int, Int) -> PotState
newkpos PotState
kpos (Point -> Int
par Point
p, Int
len)

	      buttonAction :: Button -> t Modifiers -> Point -> PotState
buttonAction (Button Int
2) t Modifiers
mods Point
p = Point -> PotState
button2Action Point
p
	      buttonAction Button
b t Modifiers
mods Point
p =
		case (Point -> Int
par Point
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Point -> Int
par (Rect -> Point
rectpos (Int -> PotState -> Rect
knob Int
len PotState
kpos)),
		      Modifiers
Shift Modifiers -> t Modifiers -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Modifiers
mods Bool -> Bool -> Bool
|| Modifiers
Control Modifiers -> t Modifiers -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Modifiers
mods) of
	          (Bool
True, Bool
False) -> PotState -> PotState
forall b c. (Ord b, Num b) => (b, b, c) -> (b, b, c)
pageup   PotState
kpos
	    	  (Bool
True, Bool
True ) -> PotState -> PotState
forall a a b c. Num a => (a, b, c) -> (a, b, c)
knobhome PotState
kpos
		  (Bool
False,Bool
False) -> PotState -> PotState
forall c. (Ord c, Num c) => (c, c, c) -> (c, c, c)
pagedown PotState
kpos
		  (Bool
False,Bool
True ) -> PotState -> PotState
forall c a. Num c => (a, c, c) -> (c, c, c)
knobend  PotState
kpos

	  in Cont
  (K (Either Rect PotRequest) (Either (Rect, Rect) PotState))
  (KEvent (Either Rect PotRequest))
forall hi ho. Cont (K hi ho) (KEvent hi)
getK Cont
  (K (Either Rect PotRequest) (Either (Rect, Rect) PotState))
  (KEvent (Either Rect PotRequest))
-> Cont
     (K (Either Rect PotRequest) (Either (Rect, Rect) PotState))
     (KEvent (Either Rect PotRequest))
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 -> Point
pos=Point
p,state :: XEvent -> ModState
state=ModState
mods,type' :: XEvent -> Pressed
type'=Pressed
Pressed})) ->
	         PotState
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
moveknob (Button -> ModState -> Point -> PotState
forall (t :: * -> *).
Foldable t =>
Button -> t Modifiers -> Point -> PotState
buttonAction Button
b ModState
mods Point
p)
	       Low (XEvt (MotionNotify {pos :: XEvent -> Point
pos=Point
p,state :: XEvent -> ModState
state=ModState
mods})) | Modifiers
Button2 Modifiers -> ModState -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ModState
mods ->
	         PotState
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
moveknob (Point -> PotState
button2Action Point
p)
	       Low (LEvt (LayoutSize Point
size')) ->
		 let len' :: Int
len' = Point -> Int
par Point
size' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Point -> Int
par Point
margin
		 in if Int
len'Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
len
	            then [KCommand (Either (Rect, Rect) PotState)]
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
forall b a. [KCommand b] -> K a b -> K a b
putsK [Int -> PotState -> KCommand (Either (Rect, Rect) PotState)
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
_ Point
_ Point
_ ModState
mods Pressed
Pressed KeyCode
_ [Char]
key [Char]
_)) ->
	          ModState
-> [Char]
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
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 Detail -> Detail -> Bool
forall a. Eq a => a -> a -> Bool
/= Detail
NotifyInferior -> 
		  K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
forall b ho. K b ho -> K b ho
lightGreyBgK K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
same
	       Low (XEvt (FocusOut {detail :: XEvent -> Detail
detail=Detail
d})) | Detail
d Detail -> Detail -> Bool
forall a. Eq a => a -> a -> Bool
/= Detail
NotifyInferior -> 
		  K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
forall b ho. K b ho -> K b ho
darkGreyBgK K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
same
	       High (Right (PotInput (ModState
mods,[Char]
key))) -> ModState
-> [Char]
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
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' = PotState -> Int -> Int -> PotState
forall a b c b c. (a, b, c) -> b -> c -> (a, b, c)
resizePot PotState
kpos Int
frame Int
tot
		 in KCommand (Either (Rect, Rect) PotState)
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (Int -> PotState -> KCommand (Either (Rect, Rect) PotState)
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' = PotState -> Int -> PotState
forall a b c a. (a, b, c) -> a -> (a, b, c)
movePot PotState
kpos Int
pos
		 in KCommand (Either (Rect, Rect) PotState)
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (Int -> PotState -> KCommand (Either (Rect, Rect) PotState)
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 PotState -> Int -> Int -> Maybe Alignment -> Maybe PotState
forall c a.
(RealFrac a, Integral c) =>
(c, c, c) -> c -> c -> Maybe a -> Maybe (c, c, c)
mkVisible PotState
kpos Int
pos (Int
posInt -> Int -> Int
forall 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 (Point -> Int
par (Rect -> Rect -> Point
rsub Rect
newknob Rect
box0), Int
len)
		 in  if PotState
kpos'PotState -> PotState -> Bool
forall a. Eq a => a -> a -> Bool
==PotState
kpos -- False
		     then K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
same
		     else KCommand (Either (Rect, Rect) PotState)
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
-> K (Either Rect PotRequest) (Either (Rect, Rect) PotState)
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (PotState -> KCommand (Either (Rect, Rect) PotState)
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 Point -> F PotRequest PotState
vPotF' = Bool
-> (Point -> Int)
-> (Point -> Int)
-> (Int -> Int -> Point)
-> Int
-> Gravity
-> Bool
-> Maybe Point
-> F PotRequest PotState
forall t p.
Num t =>
Bool
-> (Point -> Int)
-> (Point -> t)
-> (Int -> t -> Point)
-> Int
-> p
-> Bool
-> Maybe Point
-> F PotRequest PotState
potF Bool
False Point -> Int
ycoord Point -> Int
xcoord (\Int
x -> \Int
y -> Int -> Int -> Point
Point Int
y Int
x) Int
116 Gravity
NorthEastGravity
hPotF' :: Bool -> Maybe Point -> F PotRequest PotState
hPotF' = Bool
-> (Point -> Int)
-> (Point -> Int)
-> (Int -> Int -> Point)
-> Int
-> Gravity
-> Bool
-> Maybe Point
-> F PotRequest PotState
forall t p.
Num t =>
Bool
-> (Point -> Int)
-> (Point -> t)
-> (Int -> t -> Point)
-> Int
-> p
-> Bool
-> Maybe Point
-> F PotRequest PotState
potF Bool
True Point -> Int
xcoord Point -> Int
ycoord Int -> Int -> Point
Point Int
108 Gravity
SouthWestGravity

vPotF :: F PotRequest PotState
vPotF = Bool -> Maybe Point -> F PotRequest PotState
vPotF' Bool
True Maybe Point
forall a. Maybe a
Nothing
hPotF :: F PotRequest PotState
hPotF = Bool -> Maybe Point -> F PotRequest PotState
hPotF' Bool
True Maybe Point
forall a. Maybe a
Nothing