{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.DecorationEx.DwmGeometry
-- Description :  DWM-style window decoration geometry
-- Copyright   :  (c) 2007 Andrea Rossato, 2023 Ilya Portnov
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  portnov84@rambler.ru
-- Stability   :  unstable
-- Portability :  unportable
--
-- This defines window decorations which are shown as a bar of fixed width
-- on top of window.
-----------------------------------------------------------------------------

module XMonad.Layout.DecorationEx.DwmGeometry (
    -- * Usage:
    -- $usage
    DwmGeometry (..),
    dwmStyleDeco, dwmStyleDecoEx
  ) where 

import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import XMonad.Layout.LayoutModifier
import qualified XMonad.Layout.Decoration as D

import XMonad.Layout.DecorationEx.LayoutModifier
import XMonad.Layout.DecorationEx.Common
import XMonad.Layout.DecorationEx.Geometry
import XMonad.Layout.DecorationEx.Widgets
import XMonad.Layout.DecorationEx.TextEngine

-- $usage
-- You can use this module with the following in your
-- @xmonad.hs@:
--
-- > import XMonad.Layout.DecorationEx.DwmStyle
-- Then edit your @layoutHook@ by adding the DwmStyle decoration to
-- your layout:
--
-- > myL = dwmStyleDeco shrinkText (layoutHook def)
-- > main = xmonad def { layoutHook = myL }
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"

-- | Decoration geometry data type
data DwmGeometry a = DwmGeometry {
      forall a. DwmGeometry a -> Bool
dwmShowForFocused :: !Bool         -- ^ Whether to show decorations on focused windows
    , forall a. DwmGeometry a -> Rational
dwmHorizontalPosition :: !Rational -- ^ Horizontal position of decoration rectangle.
                                         -- 0 means place it at left corner, 1 - place it at
                                         -- right corner, @1%2@ - place it at center.
    , forall a. DwmGeometry a -> Dimension
dwmDecoHeight :: !Dimension        -- ^ Height of decoration rectangle
    , forall a. DwmGeometry a -> Dimension
dwmDecoWidth :: !Dimension         -- ^ Width of decoration rectangle
  }
  deriving (Int -> DwmGeometry a -> ShowS
forall a. Int -> DwmGeometry a -> ShowS
forall a. [DwmGeometry a] -> ShowS
forall a. DwmGeometry a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DwmGeometry a] -> ShowS
$cshowList :: forall a. [DwmGeometry a] -> ShowS
show :: DwmGeometry a -> String
$cshow :: forall a. DwmGeometry a -> String
showsPrec :: Int -> DwmGeometry a -> ShowS
$cshowsPrec :: forall a. Int -> DwmGeometry a -> ShowS
Show, ReadPrec [DwmGeometry a]
ReadPrec (DwmGeometry a)
ReadS [DwmGeometry a]
forall a. ReadPrec [DwmGeometry a]
forall a. ReadPrec (DwmGeometry a)
forall a. Int -> ReadS (DwmGeometry a)
forall a. ReadS [DwmGeometry a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DwmGeometry a]
$creadListPrec :: forall a. ReadPrec [DwmGeometry a]
readPrec :: ReadPrec (DwmGeometry a)
$creadPrec :: forall a. ReadPrec (DwmGeometry a)
readList :: ReadS [DwmGeometry a]
$creadList :: forall a. ReadS [DwmGeometry a]
readsPrec :: Int -> ReadS (DwmGeometry a)
$creadsPrec :: forall a. Int -> ReadS (DwmGeometry a)
Read)

instance Default (DwmGeometry a) where
  def :: DwmGeometry a
def = forall a.
Bool -> Rational -> Dimension -> Dimension -> DwmGeometry a
DwmGeometry Bool
False Rational
1 Dimension
20 Dimension
200

instance DecorationGeometry DwmGeometry Window where
  describeGeometry :: DwmGeometry Window -> String
describeGeometry DwmGeometry Window
_ = String
"DwmStyle"

  pureDecoration :: DwmGeometry Window
-> Rectangle
-> Stack Window
-> [(Window, Rectangle)]
-> (Window, Rectangle)
-> Maybe Rectangle
pureDecoration (DwmGeometry {Bool
Rational
Dimension
dwmDecoWidth :: Dimension
dwmDecoHeight :: Dimension
dwmHorizontalPosition :: Rational
dwmShowForFocused :: Bool
dwmDecoWidth :: forall a. DwmGeometry a -> Dimension
dwmDecoHeight :: forall a. DwmGeometry a -> Dimension
dwmHorizontalPosition :: forall a. DwmGeometry a -> Rational
dwmShowForFocused :: forall a. DwmGeometry a -> Bool
..}) Rectangle
_ Stack Window
stack [(Window, Rectangle)]
_ (Window
w, Rectangle Position
x Position
y Dimension
windowWidth Dimension
_) =
    let width :: Dimension
width = forall a. Ord a => a -> a -> a
min Dimension
windowWidth Dimension
dwmDecoWidth
        halfWidth :: Dimension
halfWidth = Dimension
width forall a. Integral a => a -> a -> a
`div` Dimension
2
        minCenterX :: Position
minCenterX = Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
halfWidth
        maxCenterX :: Position
maxCenterX = Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
windowWidth forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
halfWidth
        centerX :: Position
centerX = forall a b. (RealFrac a, Integral b) => a -> b
round ((Rational
1 forall a. Num a => a -> a -> a
- Rational
dwmHorizontalPosition)forall a. Num a => a -> a -> a
*forall a b. (Integral a, Num b) => a -> b
fi Position
minCenterX forall a. Num a => a -> a -> a
+ Rational
dwmHorizontalPositionforall a. Num a => a -> a -> a
*forall a b. (Integral a, Num b) => a -> b
fi Position
maxCenterX) :: Position
        decoX :: Position
decoX = Position
centerX forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
halfWidth
        focusedWindow :: Window
focusedWindow = forall a. Stack a -> a
W.focus Stack Window
stack
        isFocused :: Bool
isFocused = Window
focusedWindow forall a. Eq a => a -> a -> Bool
== Window
w
    in  if (Bool -> Bool
not Bool
dwmShowForFocused Bool -> Bool -> Bool
&& Bool
isFocused) Bool -> Bool -> Bool
|| Bool -> Bool
not (forall a. Eq a => Stack a -> a -> Bool
D.isInStack Stack Window
stack Window
w)
          then forall a. Maybe a
Nothing
          else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
decoX Position
y Dimension
width Dimension
dwmDecoHeight

  shrinkWindow :: DwmGeometry Window -> Rectangle -> Rectangle -> Rectangle
shrinkWindow DwmGeometry Window
_ Rectangle
_ Rectangle
windowRect = Rectangle
windowRect

-- | Add a decoration to window layout. Widgets are indicated with text fragments using TextDecoration;
-- decoration placement can be adjusted.
dwmStyleDecoEx :: D.Shrinker shrinker    
             => shrinker               -- ^ Strings shrinker, for example @shrinkText@
             -> DwmGeometry Window
             -> ThemeEx StandardWidget -- ^ Decoration theme (font, colors, widgets, etc)
             -> l Window               -- ^ Layout to be decorated
             -> ModifiedLayout (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker) l Window
dwmStyleDecoEx :: forall shrinker (l :: * -> *).
Shrinker shrinker =>
shrinker
-> DwmGeometry Window
-> ThemeEx StandardWidget
-> l Window
-> ModifiedLayout
     (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker)
     l
     Window
dwmStyleDecoEx shrinker
shrinker DwmGeometry Window
geom ThemeEx StandardWidget
theme = forall (engine :: * -> * -> *) widget a (geom :: * -> *) shrinker
       (l :: * -> *).
(DecorationEngine engine widget a, DecorationGeometry geom a,
 Shrinker shrinker) =>
shrinker
-> Theme engine widget
-> engine widget a
-> geom a
-> l a
-> ModifiedLayout (DecorationEx engine widget geom shrinker) l a
decorationEx shrinker
shrinker ThemeEx StandardWidget
theme forall widget a. TextDecoration widget a
TextDecoration DwmGeometry Window
geom

-- | Add a decoration to window layout. Widgets are indicated with text fragments using TextDecoration;
-- decoration placement is similar to DWM.
dwmStyleDeco :: D.Shrinker shrinker    
             => shrinker               -- ^ Strings shrinker, for example @shrinkText@
             -> ThemeEx StandardWidget -- ^ Decoration theme (font, colors, widgets, etc)
             -> l Window               -- ^ Layout to be decorated
             -> ModifiedLayout (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker) l Window
dwmStyleDeco :: forall shrinker (l :: * -> *).
Shrinker shrinker =>
shrinker
-> ThemeEx StandardWidget
-> l Window
-> ModifiedLayout
     (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker)
     l
     Window
dwmStyleDeco shrinker
shrinker = forall shrinker (l :: * -> *).
Shrinker shrinker =>
shrinker
-> DwmGeometry Window
-> ThemeEx StandardWidget
-> l Window
-> ModifiedLayout
     (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker)
     l
     Window
dwmStyleDecoEx shrinker
shrinker forall a. Default a => a
def