aboutsummaryrefslogtreecommitdiffstats
path: root/FlexibleManipulate.hs
blob: c85706aa04be64c0d3b096487192a2c2bd9c1a73 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonadContrib.FlexibleManipulate
-- Copyright   :  (c) Michael Sloan
-- License     :  BSD3-style (see LICENSE)
-- 
-- Maintainer  :  <mgsloan@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Lets you move and resize floating windows without warping the mouse.
--
-----------------------------------------------------------------------------

-- Based on the FlexibleResize code by Lukas Mai (Mauke)

module XMonadContrib.FlexibleManipulate (
	-- * Usage
	-- $usage
	mouseWindow, discrete, linear, resize, position
) where

import XMonad
import Operations
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras

-- $usage
-- Add this import to your Config.hs file:
--
-- > import qualified XMonadContrib.FlexibleManipulate as Flex
--
-- Set one of the mouse button bindings up like this:
--
-- > mouseBindings = M.fromList
-- >     [ ((modMask, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w)) ], ...
--
-- Flex.linear indicates that positions between the edges and the middle
--    indicate a combination scale\/position.
-- Flex.discrete indicates that there are discrete pick regions. (window
--    is divided by thirds for each axis)
-- Flex.resize performs only resize of the window, based on which quadrant
--    the mouse is in
-- Flex.position is similar to the built-in mouseMoveWindow
--
-- You can also write your own function for this parameter. It should take
-- a value between 0 and 1 indicating position, and return a value indicating
-- the corresponding position if plain Flex.linear was used.

-- %import qualified XMonadContrib.FlexibleManipulate as Flex
-- %mousebind , ((modMask, button1), (\\w -> focus w >> Flex.mouseWindow Flex.linear w))

discrete, linear, resize, position :: Double -> Double

discrete x | x < 0.33 = 0
           | x > 0.66 = 1
           | otherwise = 0.5

linear = id

resize x = if x < 0.5 then 0 else 1
position = const 0.5

mouseWindow :: (Double -> Double) -> Window -> X ()
mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
    io $ raiseWindow d w
    [wpos, wsize] <- io $ getWindowAttributes d w >>= return . winAttrs
    sh <- io $ getWMNormalHints d w
    pointer <- io $ queryPointer d w >>= return . pointerPos

    let uv = (pointer - wpos) / wsize
        fc = mapP f uv
        mul = mapP (\x -> 2 - 2 * abs(x - 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle
        atl = ((1, 1) - fc) * mul
        abr = fc * mul
    mouseDrag (\ex ey -> io $ do
        let offset = (fromIntegral ex, fromIntegral ey) - pointer
            npos = wpos + offset * atl
            nbr = (wpos + wsize) + offset * abr
            ntl = minP (nbr - (32, 32)) npos    --minimum size
            nwidth = applySizeHints sh $ mapP (round :: Double -> Integer) (nbr - ntl)
        moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth
        return ())
        (float w)

    float w
    
  where
    pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt
    winAttrs :: WindowAttributes -> [Pnt]
    winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height]


-- I'd rather I didn't have to do this, but I hate writing component 2d math
type Pnt = (Double, Double)

pairUp :: [a] -> [(a,a)]
pairUp [] = []
pairUp [_] = []
pairUp (x:y:xs) = (x, y) : (pairUp xs)

mapP :: (a -> b) -> (a, a) -> (b, b)
mapP f (x, y) = (f x, f y)
zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c) 
zipP f (ax,ay) (bx,by) = (f ax bx, f ay by)

minP :: Ord a => (a,a) -> (a,a) -> (a,a)
minP = zipP min

instance Num Pnt where
    (+) = zipP (+)
    (-) = zipP (-)
    (*) = zipP (*)
    abs = mapP abs
    signum = mapP signum
    fromInteger = const undefined

instance Fractional Pnt where
    fromRational = const undefined
    recip = mapP recip