module HandleF(hHandleF,vHandleF) where
import AllFudgets

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

sepSize :: Int
sepSize = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
2 Int
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)
    Placer -> Drawing lbl Gfx -> Drawing lbl Gfx
forall lbl leaf. Placer -> Drawing lbl leaf -> Drawing lbl leaf
placedD (Int -> Int -> Spacer
margS Int
d (Int
d2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
d) Spacer -> Placer -> Placer
`spacerP` LayoutDir -> Int -> Placer
linearP LayoutDir
dir Int
0) (Drawing lbl Gfx -> Drawing lbl Gfx)
-> Drawing lbl Gfx -> Drawing lbl Gfx
forall a b. (a -> b) -> a -> b
$
    [Drawing lbl Gfx] -> Drawing lbl Gfx
forall lbl leaf. [Drawing lbl leaf] -> Drawing lbl leaf
boxD [[ColorName] -> Drawing lbl Gfx -> Drawing lbl Gfx
forall a lbl leaf.
(Show a, ColorGen a) =>
a -> Drawing lbl leaf -> Drawing lbl leaf
fgD [ColorName
shadowColor,ColorName
"black"] Drawing lbl Gfx
forall lbl. Drawing lbl Gfx
l,[ColorName] -> Drawing lbl Gfx -> Drawing lbl Gfx
forall a lbl leaf.
(Show a, ColorGen a) =>
a -> Drawing lbl leaf -> Drawing lbl leaf
fgD [ColorName
shineColor,ColorName
"white"] Drawing lbl Gfx
forall lbl. Drawing lbl Gfx
l]
  where l :: Drawing lbl Gfx
l = FlexibleDrawing -> Drawing lbl Gfx
forall a lbl. Graphic a => a -> Drawing lbl Gfx
g FlexibleDrawing
line
        d2 :: Int
d2 = Int
sepSizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2
	d :: Int
d = Int
d2 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

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

handleF' :: LayoutDir -> Int -> Double -> F Point d
handleF' LayoutDir
dir Int
cur Double
alignment =
    --showCommandF "handleF" $
    SP (Either Any Any) d
forall a b. SP a b
nullSP SP (Either Any Any) d
-> F (Either Point Any) (Either Any Any) -> F (Either Point Any) d
forall a b e. SP a b -> F e a -> F e b
>^^=<
    (TCommand -> TCommand)
-> F (Either Point Any) (Either Any Any)
-> F (Either Point Any) (Either Any Any)
forall hi ho. (TCommand -> TCommand) -> F hi ho -> F hi ho
postMapLow TCommand -> TCommand
post ([FRequest]
-> K Point Any
-> F Any Any
-> F (Either Point Any) (Either Any Any)
forall a b c d.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF [FRequest]
startcmds K Point Any
forall b. K Point b
handleK0 (Drawing Any Gfx -> F Any Any
forall g a b. Graphic g => g -> F a b
labelF (LayoutDir -> Drawing Any Gfx
forall lbl. LayoutDir -> Drawing lbl Gfx
sepD LayoutDir
dir)))
    F (Either Point Any) d -> (Point -> Either Point Any) -> F Point d
forall c d e. F c d -> (e -> c) -> F e d
>=^< Point -> Either Point Any
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 (XCommand -> FRequest) -> XCommand -> FRequest
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
dirLayoutDir -> LayoutDir -> Bool
forall a. Eq a => a -> a -> Bool
==LayoutDir
Horizontal
    wantposreq :: Point -> Point -> LayoutRequest
wantposreq Point
size Point
p = LayoutRequest
layoutreq{wantedPos :: Maybe (Point, Point, Double)
wantedPos=(Point, Point, Double) -> Maybe (Point, Point, Double)
forall a. a -> Maybe a
Just(Point
p,Point
size,Double
alignment)}

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

    handleK :: K Point ho
handleK = Point -> Point -> K Point ho
forall ho. Point -> Point -> K Point ho
idleK Point
0 Point
0
      where
        idleK :: Point -> Point -> K Point ho
idleK Point
parentp Point
size = Cont (K Point ho) (KEvent Point)
forall hi ho. Cont (K hi ho) (KEvent hi)
getK Cont (K Point ho) (KEvent Point)
-> Cont (K Point ho) (KEvent Point)
forall a b. (a -> b) -> a -> b
$ (FResponse -> K Point ho)
-> (Point -> K Point ho) -> KEvent Point -> K Point ho
forall t1 p t2. (t1 -> p) -> (t2 -> p) -> Message t1 t2 -> p
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
pabsPoint -> Point -> Point
forall 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 = Cont (K Point ho) (KEvent Point)
forall hi ho. Cont (K hi ho) (KEvent hi)
getK Cont (K Point ho) (KEvent Point)
-> Cont (K Point ho) (KEvent Point)
forall a b. (a -> b) -> a -> b
$ (FResponse -> K Point ho)
-> (Point -> K Point ho) -> KEvent Point -> K Point ho
forall t1 p t2. (t1 -> p) -> (t2 -> p) -> Message t1 t2 -> p
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 = KCommand ho -> K hi ho -> K hi ho
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (KCommand ho -> K hi ho -> K hi ho)
-> (Point -> KCommand ho) -> Point -> K hi ho -> K hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FRequest -> KCommand ho
forall a b. a -> Message a b
Low (FRequest -> KCommand ho)
-> (Point -> FRequest) -> Point -> KCommand ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutRequest -> FRequest
layoutRequestCmd (LayoutRequest -> FRequest)
-> (Point -> LayoutRequest) -> Point -> FRequest
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'Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
==Point
curp
		    then K Point ho -> K Point ho
forall a. a -> a
id
		    else Point -> K Point ho -> K Point ho
forall hi ho. Point -> K hi ho -> K hi ho
putpos (Point
curp'Point -> Point -> Point
forall a. Num a => a -> a -> a
-Point
refp)) (K Point ho -> K Point ho) -> K Point ho -> K Point ho
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'Point -> Point -> Point
forall a. Num a => a -> a -> a
-Point
refp)Point -> Point -> Point
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'Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
==Point
curp Bool -> Bool -> Bool
|| Modifiers
Shift Modifiers -> ModState -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ModState
mods
		    then K Point ho
same
		    else Point -> K Point ho -> K Point ho
forall hi ho. Point -> K hi ho -> K hi ho
putpos (Point
curp'Point -> Point -> Point
forall a. Num a => a -> a -> a
-Point
refp) (K Point ho -> K Point ho) -> K Point ho -> K Point ho
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'Point -> Point -> Point
forall a. Num a => a -> a -> a
-Point
refp)Point -> Point -> Point
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
sizePoint -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>Point
forall a. Num a => a
defaultSep
  then Point -> Point -> Point
pmin (Point
sizePoint -> Point -> Point
forall a. Num a => a -> a -> a
-Point
forall a. Num a => a
defaultSep) (Point -> Point) -> (Point -> Point) -> Point -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point -> Point
pmax Point
forall a. Num a => a
defaultSep
  else Point -> Point
forall a. a -> a
id
--}