module HandleF(hHandleF,vHandleF) where
import AllFudgets

hHandleF :: Alignment -> F Point d
hHandleF = forall {d}. LayoutDir -> Int -> Alignment -> F Point d
handleF' LayoutDir
Horizontal Int
108
vHandleF :: Alignment -> F Point d
vHandleF = forall {d}. LayoutDir -> Int -> Alignment -> F Point d
handleF' LayoutDir
Vertical Int
116

sepSize :: Int
sepSize = forall a. Ord a => a -> a -> a
max Int
2 forall a. Num a => a
defaultSep -- !! see note about layoutreq below
sepD :: LayoutDir -> Drawing lbl Gfx
sepD LayoutDir
dir =
    -- the size of the drawing must be sepSize (in the dir direction)
    forall {lbl} {leaf}. Placer -> Drawing lbl leaf -> Drawing lbl leaf
placedD (Int -> Int -> Spacer
margS Int
d (Int
d2forall a. Num a => a -> a -> a
-Int
d) Spacer -> Placer -> Placer
`spacerP` LayoutDir -> Int -> Placer
linearP LayoutDir
dir Int
0) forall a b. (a -> b) -> a -> b
$
    forall {lbl} {leaf}. [Drawing lbl leaf] -> Drawing lbl leaf
boxD [forall {a} {lbl} {leaf}.
(Show a, ColorGen a) =>
a -> Drawing lbl leaf -> Drawing lbl leaf
fgD [ColorName
shadowColor,ColorName
"black"] forall {lbl}. Drawing lbl Gfx
l,forall {a} {lbl} {leaf}.
(Show a, ColorGen a) =>
a -> Drawing lbl leaf -> Drawing lbl leaf
fgD [ColorName
shineColor,ColorName
"white"] forall {lbl}. Drawing lbl Gfx
l]
  where l :: Drawing lbl Gfx
l = forall {a} {lbl}. Graphic a => a -> Drawing lbl Gfx
g FlexibleDrawing
line
        d2 :: Int
d2 = Int
sepSizeforall a. Num a => a -> a -> a
-Int
2
	d :: Int
d = Int
d2 forall a. Integral a => a -> a -> a
`div` Int
2

	margS :: Int -> Int -> Spacer
margS = forall {p}. LayoutDir -> p -> p -> p
colinear LayoutDir
dir Int -> Int -> Spacer
hMarginS Int -> Int -> Spacer
vMarginS
	line :: FlexibleDrawing
line = forall {p}. LayoutDir -> p -> p -> p
colinear LayoutDir
dir Int -> FlexibleDrawing
vFiller Int -> FlexibleDrawing
hFiller Int
1

handleF' :: LayoutDir -> Int -> Alignment -> F Point d
handleF' LayoutDir
dir Int
cur Alignment
alignment =
    --showCommandF "handleF" $
    forall a b. SP a b
nullSP forall a b e. SP a b -> F e a -> F e b
>^^=<
    forall {hi} {ho}. (TCommand -> TCommand) -> F hi ho -> F hi ho
postMapLow TCommand -> TCommand
post (forall {a} {b} {c} {d}.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF [FRequest]
startcmds forall {b}. K Point b
handleK0 (forall {a1} {a2} {b}. Graphic a1 => a1 -> F a2 b
labelF (forall {lbl}. LayoutDir -> Drawing lbl Gfx
sepD LayoutDir
dir)))
    forall c d e. F c d -> (e -> c) -> F e d
>=^< forall a b. a -> Either a b
Left
    --windowF startcmds handleK0
  where
    -- Hack: all layout requests must come from the same address, otherwise
    -- two boxes will be placed instead of one...
    post :: TCommand -> TCommand
post ([Direction
L],cmd :: FRequest
cmd@(LCmd LayoutMessage
_)) = ([Direction
R,Direction
R],FRequest
cmd)
    post TCommand
tcmd = TCommand
tcmd

    startcmds :: [FRequest]
startcmds =
      [--layoutRequestCmd layoutreq,
       XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
eventmask,
                                      PixmapId -> WindowAttributes
CWBackPixmap PixmapId
parentRelative]]

    eventmask :: [EventMask]
eventmask = [EventMask
ButtonPressMask,EventMask
ButtonReleaseMask,EventMask
ButtonMotionMask]

    -- It's important that the size of sepD and this request agree!!
    layoutreq :: LayoutRequest
layoutreq = Point -> Bool -> Bool -> LayoutRequest
plainLayout (Int -> Point
diag Int
sepSize) Bool
isHoriz (Bool -> Bool
not Bool
isHoriz)
    isHoriz :: Bool
isHoriz = LayoutDir
dirforall a. Eq a => a -> a -> Bool
==LayoutDir
Horizontal
    wantposreq :: Point -> Point -> LayoutRequest
wantposreq Point
size Point
p = LayoutRequest
layoutreq{wantedPos :: Maybe (Point, Point, Alignment)
wantedPos=forall a. a -> Maybe a
Just(Point
p,Point
size,Alignment
alignment)}

    handleK0 :: K Point b
handleK0 = 
      forall a b. Int -> K a b -> K a b
setFontCursor Int
cur forall a b. (a -> b) -> a -> b
$
      forall {b}. K Point b
handleK

    handleK :: K Point ho
handleK = forall {ho}. Point -> Point -> K Point ho
idleK Point
0 Point
0
      where
        idleK :: Point -> Point -> K Point ho
idleK Point
parentp Point
size = forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ forall {t1} {t2} {t3}.
(t1 -> t2) -> (t3 -> t2) -> Message t1 t3 -> t2
message FResponse -> K Point ho
low Point -> K Point ho
high
	  where
	    same :: K Point ho
same = Point -> Point -> K Point ho
idleK Point
parentp Point
size
	    high :: Point -> K Point ho
high Point
size' = Point -> Point -> K Point ho
idleK Point
parentp Point
size'
	    low :: FResponse -> K Point ho
low FResponse
event =
	      case FResponse
event of
		XEvt ButtonEvent {type' :: XEvent -> Pressed
type'=Pressed
Pressed,rootPos :: XEvent -> Point
rootPos=Point
pabs} ->
		  Point -> Point -> Point -> Point -> K Point ho
dragK Point
parentp Point
size (Point
pabsforall a. Num a => a -> a -> a
-Point
parentp) Point
pabs
		LEvt (LayoutPos Point
parentp') -> Point -> Point -> K Point ho
idleK Point
parentp' Point
size
		FResponse
_ -> K Point ho
same

	dragK :: Point -> Point -> Point -> Point -> K Point ho
dragK Point
parentp Point
size Point
refp Point
curp = forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ forall {t1} {t2} {t3}.
(t1 -> t2) -> (t3 -> t2) -> Message t1 t3 -> t2
message FResponse -> K Point ho
low Point -> K Point ho
high
	  where
	    moveto :: Point -> K Point ho
moveto = Point -> Point -> Point -> Point -> K Point ho
dragK Point
parentp Point
size Point
refp
	    same :: K Point ho
same = Point -> K Point ho
moveto Point
curp
	    putpos :: Point -> K hi ho -> K hi ho
putpos = forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Message a b
Low forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutRequest -> FRequest
layoutRequestCmd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point -> LayoutRequest
wantposreq Point
size

            high :: Point -> K Point ho
high Point
size' = Point -> Point -> Point -> Point -> K Point ho
dragK Point
parentp Point
size' Point
refp Point
curp

	    low :: FResponse -> K Point ho
low FResponse
event =
	      case FResponse
event of
		LEvt (LayoutPos Point
parentp') -> Point -> Point -> Point -> Point -> K Point ho
dragK Point
parentp' Point
size Point
refp Point
curp
		XEvt ButtonEvent {type' :: XEvent -> Pressed
type'=Pressed
Released,rootPos :: XEvent -> Point
rootPos=Point
curp0'} ->
		    (if Point
curp'forall a. Eq a => a -> a -> Bool
==Point
curp
		    then forall a. a -> a
id
		    else forall {hi} {ho}. Point -> K hi ho -> K hi ho
putpos (Point
curp'forall a. Num a => a -> a -> a
-Point
refp)) forall a b. (a -> b) -> a -> b
$
		    Point -> Point -> K Point ho
idleK Point
parentp Point
size
		  where curp' :: Point
curp' = Point -> Point -> Point
constrain Point
size (Point
curp0'forall a. Num a => a -> a -> a
-Point
refp)forall a. Num a => a -> a -> a
+Point
refp
		XEvt MotionNotify {rootPos :: XEvent -> Point
rootPos=Point
curp0',state :: XEvent -> ModState
state=ModState
mods} ->
		    if Point
curp'forall a. Eq a => a -> a -> Bool
==Point
curp Bool -> Bool -> Bool
|| Modifiers
Shift forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ModState
mods
		    then K Point ho
same
		    else forall {hi} {ho}. Point -> K hi ho -> K hi ho
putpos (Point
curp'forall a. Num a => a -> a -> a
-Point
refp) forall a b. (a -> b) -> a -> b
$
		         Point -> K Point ho
moveto Point
curp'
		  where curp' :: Point
curp' = Point -> Point -> Point
constrain Point
size (Point
curp0'forall a. Num a => a -> a -> a
-Point
refp)forall a. Num a => a -> a -> a
+Point
refp
		FResponse
_ -> K Point ho
same

--constrain _ = id
--{-
-- Try to limit split position to reasonable values:
constrain :: Point -> Point -> Point
constrain Point
size =
  if Point
sizeforall a. Ord a => a -> a -> Bool
>forall a. Num a => a
defaultSep
  then Point -> Point -> Point
pmin (Point
sizeforall a. Num a => a -> a -> a
-forall a. Num a => a
defaultSep) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point -> Point
pmax forall a. Num a => a
defaultSep
  else forall a. a -> a
id
--}