{-# 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
[DwmGeometry a] -> ShowS
DwmGeometry a -> String
(Int -> DwmGeometry a -> ShowS)
-> (DwmGeometry a -> String)
-> ([DwmGeometry a] -> ShowS)
-> Show (DwmGeometry a)
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
$cshowsPrec :: forall a. Int -> DwmGeometry a -> ShowS
showsPrec :: Int -> DwmGeometry a -> ShowS
$cshow :: forall a. DwmGeometry a -> String
show :: DwmGeometry a -> String
$cshowList :: forall a. [DwmGeometry a] -> ShowS
showList :: [DwmGeometry a] -> ShowS
Show, ReadPrec [DwmGeometry a]
ReadPrec (DwmGeometry a)
Int -> ReadS (DwmGeometry a)
ReadS [DwmGeometry a]
(Int -> ReadS (DwmGeometry a))
-> ReadS [DwmGeometry a]
-> ReadPrec (DwmGeometry a)
-> ReadPrec [DwmGeometry a]
-> Read (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
$creadsPrec :: forall a. Int -> ReadS (DwmGeometry a)
readsPrec :: Int -> ReadS (DwmGeometry a)
$creadList :: forall a. ReadS [DwmGeometry a]
readList :: ReadS [DwmGeometry a]
$creadPrec :: forall a. ReadPrec (DwmGeometry a)
readPrec :: ReadPrec (DwmGeometry a)
$creadListPrec :: forall a. ReadPrec [DwmGeometry a]
readListPrec :: ReadPrec [DwmGeometry a]
Read)

instance Default (DwmGeometry a) where
  def :: DwmGeometry a
def = Bool -> Rational -> Dimension -> Dimension -> DwmGeometry a
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
dwmShowForFocused :: forall a. DwmGeometry a -> Bool
dwmHorizontalPosition :: forall a. DwmGeometry a -> Rational
dwmDecoHeight :: forall a. DwmGeometry a -> Dimension
dwmDecoWidth :: forall a. DwmGeometry a -> Dimension
dwmShowForFocused :: Bool
dwmHorizontalPosition :: Rational
dwmDecoHeight :: Dimension
dwmDecoWidth :: Dimension
..}) Rectangle
_ Stack Window
stack [(Window, Rectangle)]
_ (Window
w, Rectangle Position
x Position
y Dimension
windowWidth Dimension
_) =
    let width :: Dimension
width = Dimension -> Dimension -> Dimension
forall a. Ord a => a -> a -> a
min Dimension
windowWidth Dimension
dwmDecoWidth
        halfWidth :: Dimension
halfWidth = Dimension
width Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Dimension
2
        minCenterX :: Position
minCenterX = Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
halfWidth
        maxCenterX :: Position
maxCenterX = Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
windowWidth Position -> Position -> Position
forall a. Num a => a -> a -> a
- Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
halfWidth
        centerX :: Position
centerX = Rational -> Position
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
round ((Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
dwmHorizontalPosition)Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Position -> Rational
forall a b. (Integral a, Num b) => a -> b
fi Position
minCenterX Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
dwmHorizontalPositionRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Position -> Rational
forall a b. (Integral a, Num b) => a -> b
fi Position
maxCenterX) :: Position
        decoX :: Position
decoX = Position
centerX Position -> Position -> Position
forall a. Num a => a -> a -> a
- Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
halfWidth
        focusedWindow :: Window
focusedWindow = Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
stack
        isFocused :: Bool
isFocused = Window
focusedWindow Window -> Window -> Bool
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 (Stack Window -> Window -> Bool
forall a. Eq a => Stack a -> a -> Bool
D.isInStack Stack Window
stack Window
w)
          then Maybe Rectangle
forall a. Maybe a
Nothing
          else Rectangle -> Maybe Rectangle
forall a. a -> Maybe a
Just (Rectangle -> Maybe Rectangle) -> Rectangle -> Maybe Rectangle
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 = shrinker
-> Theme TextDecoration StandardWidget
-> TextDecoration StandardWidget Window
-> DwmGeometry Window
-> l Window
-> ModifiedLayout
     (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker)
     l
     Window
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 TextDecoration StandardWidget
theme TextDecoration StandardWidget Window
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 = shrinker
-> DwmGeometry Window
-> ThemeEx StandardWidget
-> l Window
-> ModifiedLayout
     (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker)
     l
     Window
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
forall a. Default a => a
def