twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-19 11:30:22 -07:00
Code Issues Packages Projects Releases Wiki Activity

Aesthetics on Flexiblemanipulate

Browse Source 
Based on Adam Vogts recommendation on the mailing list. I had to give explicit
type signatures to get rid of warnings, but nearly verbatim to his version.
This commit is contained in:
Mats Rauhala 2011-05-06 09:44:31 +00:00
parent d9c9e0c10e
commit a4da8cd41b
1 changed files with 24 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
XMonad/Actions/FlexibleManipulate.hs
View File

@ -23,6 +23,8 @@ module XMonad.Actions.FlexibleManipulate (
) where ) where
import XMonad import XMonad
import qualified Prelude as P
import Prelude (($), (.), fst, snd, uncurry, const, id, Ord(..), Monad(..), fromIntegral, Double, Integer, map, round, otherwise)
-- $usage -- $usage
-- First, add this import to your @~\/.xmonad\/xmonad.hs@: -- First, add this import to your @~\/.xmonad\/xmonad.hs@:
@ -82,17 +84,17 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
sh <- io $ getWMNormalHints d w sh <- io $ getWMNormalHints d w
pointer <- io $ queryPointer d w >>= return . pointerPos pointer <- io $ queryPointer d w >>= return . pointerPos
let uv = zipP (/) (zipP (-) pointer wpos) wsize let uv = (pointer - wpos) / wsize
fc = mapP f uv 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 mul = mapP (\x -> 2 P.- 2 P.* P.abs(x P.- 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle
atl = zipP (*) (zipP (-) (1, 1) fc) mul atl = ((1, 1) - fc) * mul
abr = zipP (*) fc mul abr = fc * mul
mouseDrag (\ex ey -> io $ do mouseDrag (\ex ey -> io $ do
let offset = zipP (-) (fromIntegral ex, fromIntegral ey) pointer let offset = (fromIntegral ex, fromIntegral ey) - pointer
npos = zipP (*) wpos $ zipP (*) offset atl npos = wpos + offset * atl
nbr = zipP (+) (zipP (+) wpos wsize) (zipP (*) offset abr) nbr = (wpos + wsize) + offset * abr
ntl = minP (zipP (-) nbr (32, 32)) npos --minimum size ntl = minP (nbr - (32, 32)) npos --minimum size
nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (zipP (-) nbr ntl) nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (nbr - ntl)
moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth
return ()) return ())
(float w) (float w)
@ -100,14 +102,14 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
float w float w
where where
pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt
winAttrs :: WindowAttributes -> [(Double, Double)] winAttrs :: WindowAttributes -> [Pnt]
winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height] winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height]
-- Changed the type = Pnt implementation to use the zipP functionality
-- because (on ghc7) the previous implementation caused Orphan Instances
-- warnings
-- 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 :: [a] -> [(a,a)]
pairUp [] = [] pairUp [] = []
pairUp [_] = [] pairUp [_] = []
@ -120,3 +122,11 @@ zipP f (ax,ay) (bx,by) = (f ax bx, f ay by)
minP :: Ord a => (a,a) -> (a,a) -> (a,a) minP :: Ord a => (a,a) -> (a,a) -> (a,a)
minP = zipP min minP = zipP min
(+), (-), (*) :: (P.Num a) => (a,a) -> (a,a) -> (a,a)
(+) = zipP (P.+)
(-) = zipP (P.-)
(*) = zipP (P.*)
(/) :: (P.Fractional a) => (a,a) -> (a,a) -> (a,a)
(/) = zipP (P./)