tv: lol display-manager

1 files changed, 0 insertions, 172 deletions

diff --git a/tv/2configs/xserver/xmonad-tv/Util/Pager.hs b/tv/2configs/xserver/xmonad-tv/Util/Pager.hs
deleted file mode 100644
index b8168b5b0..000000000
--- a/tv/2configs/xserver/xmonad-tv/Util/Pager.hs
+++ /dev/null
@@ -1,172 +0,0 @@
-module Util.Pager
-    ( defaultPagerConfig
-    , defaultWindowColors
-    , defaultWorkspaceColors
-    , MatchMethod(..)
-    , pager
-    , PagerConfig(..)
-    ) where
-
-import Data.List ( find )
-import Data.Maybe ( catMaybes )
-import Graphics.X11
-import Util.Rhombus
-import XMonad
-import qualified XMonad.StackSet as W
-import XMonad.Hooks.UrgencyHook
-import XMonad.Util.Font ( fi, stringToPixel )
-
-
-data PagerConfig = PagerConfig
-    { pc_font               :: String
-    , pc_cellwidth          :: Dimension
-    , pc_margin             :: Dimension
-    , pc_matchmethod        :: MatchMethod
-    , pc_wrap               :: Bool
-    , pc_workspaceColors    :: Bool -> Bool -> Bool -> (String, String, String)
-    , pc_windowColors       :: Bool -> Bool -> Bool -> Bool -> Bool -> (String, String)
-    }
-
-
-defaultPagerConfig :: PagerConfig
-defaultPagerConfig = PagerConfig "xft:Sans-8" 100 0 MatchInfix True defaultWorkspaceColors defaultWindowColors
-
-
-pager :: PagerConfig -> (String -> X ()) -> [String] -> X ()
-pager pc = rhombus defaultRhombusConfig
-    { rc_font           = pc_font pc
-    , rc_cellwidth      = pc_cellwidth pc
-    , rc_margin         = pc_margin pc
-    , rc_matchmethod    = pc_matchmethod pc
-    , rc_wrap           = pc_wrap pc
-    , rc_colors         = pc_workspaceColors pc
-    , rc_paint          = pagerPaint pc
-    }
-
-
-defaultWorkspaceColors :: Bool -- workspace has focus
-                       -> Bool -- workspace name matches incremental search
-                       -> Bool -- workspace is the current one
-                       -> (String, String, String) -- workspace border, background color, and foreground color
-defaultWorkspaceColors False False False = ("#101010","#050505","#202020")
-defaultWorkspaceColors False False  True = ("#101010","#050505","#202020")
-defaultWorkspaceColors False  True False = ("#404040","#202020","#b0b0b0")
-defaultWorkspaceColors False  True  True = ("#101010","#050505","#505050")
-defaultWorkspaceColors  True     _ False = ("#808020","#404010","#f0f0b0")
-defaultWorkspaceColors  True     _  True = ("#404010","#202005","#909050")
-
-
-defaultWindowColors :: Bool -- window's workspace has focus
-                    -> Bool -- window's workspace name matches incremental search
-                    -> Bool -- window's workspace the current one
-                    -> Bool -- window is urgent
-                    -> Bool -- window has focus
-                    -> (String, String) -- window border and background color
-
-defaultWindowColors   wsf     m     c     u  True = ("#802020", snd $ defaultWindowColors wsf m c u False)
-
-defaultWindowColors False False False False     _ = ("#111111","#060606")
-defaultWindowColors False False False  True     _ = ("#802020","#401010")
-defaultWindowColors False False  True False     _ = ("#101010","#050505")
-defaultWindowColors False False  True  True     _ = ("#401010","#200505")
-defaultWindowColors False  True False False     _ = ("#202080","#101040")
-defaultWindowColors False  True False  True     _ = ("#802080","#401040")
-defaultWindowColors False  True  True False     _ = ("#101040","#100520")
-defaultWindowColors False  True  True  True     _ = ("#401040","#200520")
-
-defaultWindowColors  True False False False     _ = ("#208020","#104010")
-defaultWindowColors  True False False  True     _ = ("#808020","#404010")
-defaultWindowColors  True False  True False     _ = ("#104010","#052005")
-defaultWindowColors  True False  True  True     _ = ("#404010","#202005")
-defaultWindowColors  True  True False False     _ = ("#208080","#104040")
-defaultWindowColors  True  True False  True     _ = ("#808080","#404040")
-defaultWindowColors  True  True  True False     _ = ("#104040","#102020")
-defaultWindowColors  True  True  True  True     _ = ("#404040","#202020")
-
-
-pagerPaint ::
-  PagerConfig
-  -> RhombusConfig
-  -> Display
-  -> Drawable
-  -> GC
-  -> WorkspaceId
-  -> Rectangle
-  -> Bool
-  -> Bool
-  -> Bool
-  -> X ()
-pagerPaint pc rc d p gc t r focus match current = do
-    ss <- gets windowset
-
-    let x = rect_x r
-        y = rect_y r
-
-    urgents <- readUrgents
-    let foci = map W.focus $ catMaybes $ map W.stack $ W.workspaces ss
-
-    let color = pc_windowColors pc focus match current -- :: Bool -> (String, String)
-        (_, _, _fg_color) = pc_workspaceColors pc focus match current
-
-    fg_color <- stringToPixel d _fg_color
-
-    let r = screenRect $ W.screenDetail $ W.current ss
-    let a = fi (rect_width r) / fi (rect_height r)
-    let scale = fi (rc_cellwidth rc) / fi (rect_width r)
-
-    -- TODO whenNothing print error
-    whenJust (findWorkspace t ss) $ \ ws -> do
-        whenJust (W.stack ws) $ \ s ->
-            withDisplay $ \ d -> io $ do
-
-                let color' w = color (w `elem` urgents) (w `elem` foci)
-
-                -- TODO painting of floating windows is broken
-                mapM_ (drawMiniWindow d p gc x y color' scale) (W.down s)
-                drawMiniWindow d p gc x y color' scale (W.focus s)
-                mapM_ (drawMiniWindow d p gc x y color' scale) (W.up s)
-
-drawMiniWindow
-    :: RealFrac a
-    => Display
-    -> Drawable
-    -> GC
-    -> Position
-    -> Position
-    -> (Window -> (String, String))
-    -> a
-    -> Window
-    -> IO ()
-drawMiniWindow d p gc ox oy color s win = do
-    let scale x = round $ fi x * s
-
-    wa <- getWindowAttributes d win
-
-    let x = ox + (scale $ wa_x wa)
-        y = oy + (scale $ wa_y wa)
-        w = (scale $ wa_width wa)
-        h = (scale $ wa_height wa)
-
-    let (fg, bg) = color win
-
-    fg' <- stringToPixel d fg
-    bg' <- stringToPixel d bg
-
-    setForeground d gc bg'
-    fillRectangle d p gc (x + 1) (y + 1) (w - 2) (h - 2)
-
-    setForeground d gc fg'
-    drawLines d p gc
-        [ Point x y
-        , Point (fi w - 1) 0
-        , Point 0 (fi h - 2)
-        , Point (- fi w + 1) 0
-        , Point 0 (- fi h + 2)
-        ]
-        coordModePrevious
-
-
-
--- TODO externalize findWorkspace
-findWorkspace :: (Eq i) => i -> W.StackSet i l a sid sd -> Maybe (W.Workspace i l a)
-findWorkspace t ss = find ((==)t . W.tag) (W.workspaces ss)