{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.ImageButtonDecoration
-- Description :  Decoration that includes image buttons, executing actions when clicked on.
-- Copyright   :  (c) Jan Vornberger 2009
--                    Alejandro Serrano 2010
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  trupill@gmail.com
-- Stability   :  unstable
-- Portability :  not portable
--
-- A decoration that includes small image buttons on both ends which invoke
-- various actions when clicked on: Show a window menu (see
-- "XMonad.Actions.WindowMenu"), minimize, maximize or close the window.
--
-- Note: For maximizing and minimizing to actually work, you will need
-- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your
-- setup.  See the documentation of those modules for more information.
--
-----------------------------------------------------------------------------

-- This module is mostly derived from "XMonad.Layout.DecorationAddons"
-- and "XMonad.Layout.ButtonDecoration"

module XMonad.Layout.ImageButtonDecoration
    ( -- * Usage:
      -- $usage
      imageButtonDeco
    , defaultThemeWithImageButtons
    , shrinkText
    , CustomShrink(CustomShrink)
    , Shrinker
    , imageTitleBarButtonHandler
    , ImageButtonDecoration
    ) where

import XMonad
import XMonad.Layout.Decoration
import XMonad.Layout.DecorationAddons
import XMonad.Util.Image

import XMonad.Actions.WindowMenu
import XMonad.Actions.Minimize
import XMonad.Layout.Maximize

-- $usage
-- You can use this module with the following in your
-- @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.ImageButtonDecoration
--
-- Then edit your @layoutHook@ by adding the ImageButtonDecoration to
-- your layout:
--
-- > myL = imageButtonDeco shrinkText defaultThemeWithImageButtons (layoutHook def)
-- > main = xmonad def { layoutHook = myL }
--

-- The buttons' dimension and placements

buttonSize :: Int
buttonSize :: Int
buttonSize = Int
10

menuButtonOffset :: Int
menuButtonOffset :: Int
menuButtonOffset = Int
4

minimizeButtonOffset :: Int
minimizeButtonOffset :: Int
minimizeButtonOffset = Int
32

maximizeButtonOffset :: Int
maximizeButtonOffset :: Int
maximizeButtonOffset = Int
18

closeButtonOffset :: Int
closeButtonOffset :: Int
closeButtonOffset = Int
4


-- The images in a 0-1 scale to make
-- it easier to visualize

convertToBool' :: [Int] -> [Bool]
convertToBool' :: [Int] -> [Bool]
convertToBool' = (Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1)

convertToBool :: [[Int]] -> [[Bool]]
convertToBool :: [[Int]] -> [[Bool]]
convertToBool = ([Int] -> [Bool]) -> [[Int]] -> [[Bool]]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> [Bool]
convertToBool'

menuButton' :: [[Int]]
menuButton' :: [[Int]]
menuButton' = [[Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
               [Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
               [Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
               [Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
               [Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
               [Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
               [Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
               [Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
               [Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
               [Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1]]

menuButton :: [[Bool]]
menuButton :: [[Bool]]
menuButton = [[Int]] -> [[Bool]]
convertToBool [[Int]]
menuButton'

miniButton' :: [[Int]]
miniButton' :: [[Int]]
miniButton' = [[Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0],
               [Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0],
               [Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0],
               [Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0],
               [Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0],
               [Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0],
               [Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0],
               [Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0],
               [Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
               [Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1]]

miniButton :: [[Bool]]
miniButton :: [[Bool]]
miniButton = [[Int]] -> [[Bool]]
convertToBool [[Int]]
miniButton'

maxiButton' :: [[Int]]
maxiButton' :: [[Int]]
maxiButton' = [[Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
               [Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
               [Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
               [Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
               [Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
               [Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
               [Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
               [Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
               [Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1],
               [Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1]]

maxiButton :: [[Bool]]
maxiButton :: [[Bool]]
maxiButton = [[Int]] -> [[Bool]]
convertToBool [[Int]]
maxiButton'

closeButton' :: [[Int]]
closeButton' :: [[Int]]
closeButton' = [[Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1],
                [Int
1,Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1,Int
1],
                [Int
0,Int
1,Int
1,Int
1,Int
0,Int
0,Int
1,Int
1,Int
1,Int
0],
                [Int
0,Int
0,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
0,Int
0],
                [Int
0,Int
0,Int
0,Int
1,Int
1,Int
1,Int
1,Int
0,Int
0,Int
0],
                [Int
0,Int
0,Int
0,Int
1,Int
1,Int
1,Int
1,Int
0,Int
0,Int
0],
                [Int
0,Int
0,Int
1,Int
1,Int
1,Int
1,Int
1,Int
1,Int
0,Int
0],
                [Int
0,Int
1,Int
1,Int
1,Int
0,Int
0,Int
1,Int
1,Int
1,Int
0],
                [Int
1,Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1,Int
1],
                [Int
1,Int
1,Int
0,Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
1]]


closeButton :: [[Bool]]
closeButton :: [[Bool]]
closeButton = [[Int]] -> [[Bool]]
convertToBool [[Int]]
closeButton'

-- | A function intended to be plugged into the 'decorationCatchClicksHook' of a decoration.
-- It will intercept clicks on the buttons of the decoration and invoke the associated action.
-- To actually see the buttons, you will need to use a theme that includes them.
-- See 'defaultThemeWithImageButtons' below.
imageTitleBarButtonHandler :: Window -> Int -> Int -> X Bool
imageTitleBarButtonHandler :: Window -> Int -> Int -> X Bool
imageTitleBarButtonHandler Window
mainw Int
distFromLeft Int
distFromRight = do
    let action :: X Bool
action
          | Int -> Int
forall a b. (Integral a, Num b) => a -> b
fi Int
distFromLeft Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
menuButtonOffset Bool -> Bool -> Bool
&&
             Int -> Int
forall a b. (Integral a, Num b) => a -> b
fi Int
distFromLeft Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
menuButtonOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
buttonSize = Window -> X ()
focus Window
mainw X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> X ()
windowMenu X () -> X Bool -> X Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          | Int -> Int
forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
closeButtonOffset Bool -> Bool -> Bool
&&
            Int -> Int
forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
closeButtonOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
buttonSize = Window -> X ()
focus Window
mainw X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> X ()
kill X () -> X Bool -> X Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          | Int -> Int
forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maximizeButtonOffset Bool -> Bool -> Bool
&&
            Int -> Int
forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maximizeButtonOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
buttonSize = Window -> X ()
focus Window
mainw X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MaximizeRestore -> X ()
forall a. Message a => a -> X ()
sendMessage (Window -> MaximizeRestore
maximizeRestore Window
mainw) X () -> X Bool -> X Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          | Int -> Int
forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minimizeButtonOffset Bool -> Bool -> Bool
&&
            Int -> Int
forall a b. (Integral a, Num b) => a -> b
fi Int
distFromRight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
minimizeButtonOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
buttonSize = Window -> X ()
focus Window
mainw X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> X ()
minimizeWindow Window
mainw X () -> X Bool -> X Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          | Bool
otherwise = Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    X Bool
action

defaultThemeWithImageButtons :: Theme
defaultThemeWithImageButtons :: Theme
defaultThemeWithImageButtons = Theme
forall a. Default a => a
def {
                                windowTitleIcons :: [([[Bool]], Placement)]
windowTitleIcons = [ ([[Bool]]
menuButton, Int -> Placement
CenterLeft Int
3),
                                                     ([[Bool]]
closeButton, Int -> Placement
CenterRight Int
3),
                                                     ([[Bool]]
maxiButton, Int -> Placement
CenterRight Int
18),
                                                     ([[Bool]]
miniButton, Int -> Placement
CenterRight Int
33) ]
                               }

imageButtonDeco :: (Eq a, Shrinker s) => s -> Theme
                   -> l a -> ModifiedLayout (Decoration ImageButtonDecoration s) l a
imageButtonDeco :: forall a s (l :: * -> *).
(Eq a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration ImageButtonDecoration s) l a
imageButtonDeco s
s Theme
c = s
-> Theme
-> ImageButtonDecoration a
-> l a
-> ModifiedLayout (Decoration ImageButtonDecoration s) l a
forall (ds :: * -> *) a s (l :: * -> *).
(DecorationStyle ds a, Shrinker s) =>
s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a
decoration s
s Theme
c (ImageButtonDecoration a
 -> l a -> ModifiedLayout (Decoration ImageButtonDecoration s) l a)
-> ImageButtonDecoration a
-> l a
-> ModifiedLayout (Decoration ImageButtonDecoration s) l a
forall a b. (a -> b) -> a -> b
$ Bool -> ImageButtonDecoration a
forall a. Bool -> ImageButtonDecoration a
NFD Bool
True

newtype ImageButtonDecoration a = NFD Bool deriving (Int -> ImageButtonDecoration a -> ShowS
[ImageButtonDecoration a] -> ShowS
ImageButtonDecoration a -> String
(Int -> ImageButtonDecoration a -> ShowS)
-> (ImageButtonDecoration a -> String)
-> ([ImageButtonDecoration a] -> ShowS)
-> Show (ImageButtonDecoration a)
forall a. Int -> ImageButtonDecoration a -> ShowS
forall a. [ImageButtonDecoration a] -> ShowS
forall a. ImageButtonDecoration a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageButtonDecoration a] -> ShowS
$cshowList :: forall a. [ImageButtonDecoration a] -> ShowS
show :: ImageButtonDecoration a -> String
$cshow :: forall a. ImageButtonDecoration a -> String
showsPrec :: Int -> ImageButtonDecoration a -> ShowS
$cshowsPrec :: forall a. Int -> ImageButtonDecoration a -> ShowS
Show, ReadPrec [ImageButtonDecoration a]
ReadPrec (ImageButtonDecoration a)
Int -> ReadS (ImageButtonDecoration a)
ReadS [ImageButtonDecoration a]
(Int -> ReadS (ImageButtonDecoration a))
-> ReadS [ImageButtonDecoration a]
-> ReadPrec (ImageButtonDecoration a)
-> ReadPrec [ImageButtonDecoration a]
-> Read (ImageButtonDecoration a)
forall a. ReadPrec [ImageButtonDecoration a]
forall a. ReadPrec (ImageButtonDecoration a)
forall a. Int -> ReadS (ImageButtonDecoration a)
forall a. ReadS [ImageButtonDecoration a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImageButtonDecoration a]
$creadListPrec :: forall a. ReadPrec [ImageButtonDecoration a]
readPrec :: ReadPrec (ImageButtonDecoration a)
$creadPrec :: forall a. ReadPrec (ImageButtonDecoration a)
readList :: ReadS [ImageButtonDecoration a]
$creadList :: forall a. ReadS [ImageButtonDecoration a]
readsPrec :: Int -> ReadS (ImageButtonDecoration a)
$creadsPrec :: forall a. Int -> ReadS (ImageButtonDecoration a)
Read)

instance Eq a => DecorationStyle ImageButtonDecoration a where
    describeDeco :: ImageButtonDecoration a -> String
describeDeco ImageButtonDecoration a
_ = String
"ImageButtonDeco"
    decorationCatchClicksHook :: ImageButtonDecoration a -> Window -> Int -> Int -> X Bool
decorationCatchClicksHook ImageButtonDecoration a
_ = Window -> Int -> Int -> X Bool
imageTitleBarButtonHandler
    decorationAfterDraggingHook :: ImageButtonDecoration a -> (Window, Rectangle) -> Window -> X ()
decorationAfterDraggingHook ImageButtonDecoration a
_ (Window
mainw, Rectangle
_) Window
decoWin = Window -> X ()
focus Window
mainw X () -> X Bool -> X Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> Window -> X Bool
handleScreenCrossing Window
mainw Window
decoWin X Bool -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()