[feat] better use of rdectl in xmobar.

6 files changed, 104 insertions, 11 deletions

diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index bbf182f..b6f8737 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -1,4 +1,4 @@
-module Rahm.Desktop.Keys (applyKeys) where
+module Rahm.Desktop.Keys (applyKeys, commandHandler) where
 
 import Control.Applicative
 import Control.Monad
@@ -19,7 +19,7 @@ import Control.Monad.Writer
     lift,
     tell,
   )
-import Data.Char (isAlpha, toLower)
+import Data.Char (isAlpha, isSpace, toLower)
 import Data.IORef
 import Data.List (foldl', isInfixOf)
 import Data.List.Safe ((!!))
@@ -39,6 +39,7 @@ import Graphics.X11.ExtraTypes.XF86
     xF86XK_AudioPrev,
     xF86XK_AudioRaiseVolume,
     xF86XK_Calculator,
+    xF86XK_Display,
     xF86XK_MonBrightnessDown,
     xF86XK_MonBrightnessUp,
   )
@@ -109,6 +110,7 @@ import Rahm.Desktop.RebindKeys
   ( remapKey,
     sendKey,
   )
+import Rahm.Desktop.Server (CommandHandler (..), (<<>>))
 import Rahm.Desktop.StackSet (screens)
 import qualified Rahm.Desktop.StackSet as W
 import Rahm.Desktop.Submap
@@ -118,6 +120,7 @@ import Rahm.Desktop.Submap
     submapButtonsWithKey,
   )
 import Rahm.Desktop.SwapMaster (swapMaster)
+import Rahm.Desktop.TabletMode
 import Rahm.Desktop.Theater
   ( restoreTheater,
   )
@@ -137,6 +140,7 @@ import Rahm.Desktop.XMobarLog.PendingBuffer
   )
 import System.Exit (exitFailure, exitSuccess)
 import Text.Printf (printf)
+import Text.Read (readMaybe)
 import XMonad as X
 import XMonad.Actions.CopyWindow as CopyWindow
 import XMonad.Actions.RotSlaves
@@ -163,6 +167,31 @@ spawnX = spawn
 safeSpawnX :: String -> [String] -> X ()
 safeSpawnX = safeSpawn
 
+parseNumber :: (Read a, Num a) => String -> Maybe a
+parseNumber s
+  | "0x" `isPrefixOf` s || "0X" `isPrefixOf` s = readMaybeHex (drop 2 s)
+  | "0b" `isPrefixOf` s || "0B" `isPrefixOf` s = readMaybeBinary (drop 2 s)
+  | otherwise = readMaybe s
+  where
+    readMaybeHex str =
+      let trimmed = takeWhile (not . isSpace) str
+       in if all isValidHexChar trimmed
+            then readMaybe trimmed
+            else Nothing
+    readMaybeBinary str =
+      let trimmed = takeWhile (not . isSpace) str
+       in if all (`elem` "01") trimmed
+            then readMaybe trimmed
+            else Nothing
+
+isPrefixOf :: (Eq a) => [a] -> [a] -> Bool
+isPrefixOf _ [] = True
+isPrefixOf [] _ = False
+isPrefixOf (x : xs) (y : ys) = x == y && isPrefixOf xs ys
+
+isValidHexChar :: Char -> Bool
+isValidHexChar c = c `elem` "0123456789abcdefABCDEF"
+
 selectedWindowsColor = BorderColor "#00ffff" "#00ffff"
 
 decreaseVolume = do
@@ -1057,6 +1086,10 @@ bindings = do
     justMod $ spawnX "set-backlight.sh 0.01"
     rawMask shiftMask $ spawnX "set-backlight.sh 0"
 
+  bind xF86XK_Display $ do
+    noMod toggleTabletMode
+    justMod toggleTabletMode
+
   -- Button bindings. These are bindings to buttons on my mouse.
   --
   -- I usre a G502 SE HERO Gaming Mouse. This mouse has 13 buttons on it. The
@@ -1109,6 +1142,11 @@ bindings = do
       doc "Media next" $
         noWindow mediaNext
 
+  bind syntheticKeyStartDrag $
+    noMod $
+      subbind $ do
+        bind button1 $ noMod $ noWindow D.dragWindow
+
   let button14Binder = do
         bind button3 $
           noMod $
@@ -1357,6 +1395,47 @@ bindings = do
 
   localKeys
 
+data RdeBasicCommand where
+  Goto :: String -> RdeBasicCommand
+  Shift :: String -> String -> RdeBasicCommand
+  Wheel :: RdeBasicCommand
+  ToNextLayout :: RdeBasicCommand
+  SyntheticKeySym :: ButtonMask -> KeySym -> RdeBasicCommand
+
+rdeBasicCommandHandler :: CommandHandler RdeBasicCommand
+rdeBasicCommandHandler =
+  CommandHandler
+    ( \str -> case words str of
+        ["goto", s] -> Just $ Goto s
+        ["shift", s1, s2] -> Just $ Shift s1 s2
+        ["wheel"] -> Just Wheel
+        ["next-layout"] -> Just ToNextLayout
+        ["keysym", w] | Just w' <- parseNumber w -> Just (SyntheticKeySym 0 w')
+        ["keysym", m, w] | Just m' <- parseNumber m, Just w' <- parseNumber w -> Just (SyntheticKeySym m' w')
+        _ -> Nothing
+    )
+    ( \c -> pushPendingBuffer "" $ case c of
+        Wheel -> displayWorkspaceWheelInCenter
+        Goto w -> runMaybeT_ $ do
+          ws <- workspaceForStringT w
+          lift $ do
+            logs Info "Goto Workspace: %s" (fromMaybe "?" $ workspaceName ws)
+            gotoWorkspaceFn ws
+        Shift wins ws -> runMaybeT_ $ do
+          wins <- locationSetForStringT wins
+          workspace <- workspaceForStringT ws
+          lift $ do
+            movement <- moveWindowsToWorkspaceFn workspace (mapMaybe locationWindow wins)
+            windows movement
+        SyntheticKeySym mask keySym -> do
+          logs Info "Got synthetic keysym mask %s %s" (show mask) (show keySym)
+          keyMap <- asks (\c -> keys (config c) (config c))
+          sequence_ $ Map.lookup (mask, keySym) keyMap
+        ToNextLayout -> sendMessage toNextLayout
+    )
+
+commandHandler = rdeBasicCommandHandler <<>> tabletModeCommandHandler
+
 cornersConfig :: Map ScreenCorner (X ())
 cornersConfig =
   Map.fromList
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index e64c6e0..2d4562a 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -41,6 +41,7 @@ module Rahm.Desktop.Keys.Wml
     workspaceForStringT,
     workspaceForString,
     locationSetForKeysT,
+    locationSetForStringT,
     locationSetForKeys,
     readNextWorkspaceName,
     workspaceName,
@@ -459,6 +460,9 @@ workspaceForStringT = workspaceForKeysT . map (\c -> (def, def, [c]))
 workspaceForString :: String -> X (Maybe Workspace)
 workspaceForString = runMaybeT . workspaceForStringT
 
+locationSetForStringT :: String -> MaybeT X [Location]
+locationSetForStringT = locationSetForKeysT . map (\c -> (def, def, [c]))
+
 -- Like the above, but unwrap the MaybeT
 locationSetForKeysT :: KeyString -> MaybeT X [Location]
 locationSetForKeysT s = runKeyFeedWithKeys s readNextLocationSet
diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs
index 46508d7..15166fd 100644
--- a/src/Rahm/Desktop/Submap.hs
+++ b/src/Rahm/Desktop/Submap.hs
@@ -124,6 +124,7 @@ data ButtonOrKeyEvent
         event_keycode :: KeyCode,
         event_string :: String
       }
+  deriving (Show)
 
 nextButtonOrKeyEvent :: MaybeT X ButtonOrKeyEvent
 nextButtonOrKeyEvent = do
diff --git a/src/Rahm/Desktop/TabletMode.hs b/src/Rahm/Desktop/TabletMode.hs
index e0f490a..b13e919 100644
--- a/src/Rahm/Desktop/TabletMode.hs
+++ b/src/Rahm/Desktop/TabletMode.hs
@@ -30,6 +30,7 @@ module Rahm.Desktop.TabletMode
     RotationAngle (..),
     tabletModeXMobarString,
     tabletModeCommandHandler,
+    syntheticKeyStartDrag,
   )
 where
 
@@ -64,6 +65,9 @@ import XMonad
 import qualified XMonad.Util.ExtensibleState as XS
 import XMonad.Util.Run (runProcessWithInput)
 
+syntheticKeyStartDrag :: KeySym
+syntheticKeyStartDrag = 0x1100000000000011
+
 -- | Rotation angle for the display
 data RotationAngle
   = -- | Normal orientation (0°)
@@ -257,7 +261,8 @@ tabletModeXMobarString = do
                   "<fc=#f0f0a0><action=`sleep 0.2 && rdectl wheel`> \11096 </action></fc>",
                   "<fc=#f08080><action=`rdectl shift . _`> ✗ </action></fc>",
                   "<fc=#808080><action=`rofi -monitor -4 -display-run Execute -show run -normal-window`>\61728 </action></fc>",
-                  "<fc=#80f080><action=`rdectl next-rotation`> \58183 </action></fc>"
+                  "<fc=#80f080><action=`rdectl next-rotation`> \58183 </action></fc>",
+                  "<fc=#80f080><action=`sleep 0.2 && rdectl keysym " ++ show syntheticKeyStartDrag ++ "`> \983486 </action></fc>"
                 ]
             else "<action=`rdectl tablet-mode on`><fc=#66cc66> \61705 </fc></action>"
         )
diff --git a/src/Rahm/Desktop/WorkspaceWheel.hs b/src/Rahm/Desktop/WorkspaceWheel.hs
index a89dc6a..b5cba52 100644
--- a/src/Rahm/Desktop/WorkspaceWheel.hs
+++ b/src/Rahm/Desktop/WorkspaceWheel.hs
@@ -31,6 +31,7 @@ import Text.Printf (printf)
 import XMonad
 import qualified XMonad.Operations as X
 import XMonad.Util.Run (spawnPipe)
+import Rahm.Desktop.Logger (logs, LogLevel (Debug))
 
 dzenSize :: (Integral a) => a
 dzenSize = 100
@@ -117,6 +118,8 @@ displayWorkspaceWheelAtPoint wheelType px py = do
         let stop = return ()
         let retry = recur ring
 
+        logs Debug "Workspace Wheel Event: %s" (show evt)
+
         case evt of
           Nothing -> return stop -- timeout
           Just (ButtonPress _ b)
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs
index 980cbe7..b624301 100644
--- a/src/Rahm/Desktop/XMobarLog.hs
+++ b/src/Rahm/Desktop/XMobarLog.hs
@@ -31,6 +31,7 @@ import XMonad (X)
 import qualified XMonad as X (XState (windowset), gets, io)
 import XMonad.Util.NamedWindows (getName)
 import XMonad.Util.Run (runProcessWithInput, spawnPipe)
+import Rahm.Desktop.TabletMode (tabletModeXMobarString)
 
 newtype XMobarLog = XMobarLog Handle
 
@@ -48,10 +49,7 @@ spawnXMobar :: IO XMobarLog
 spawnXMobar = do
   putStrLn "get dpi"
   dpi <- getDPI
-  let scale = dpi / 120
-
-  putStrLn $ "DPI: " ++ show dpi
-  putStrLn $ "scale: " ++ show scale
+  let scale = dpi / 144
 
   pipe <-
     spawnPipe $
@@ -83,6 +81,8 @@ xMobarLogHook = do
 
     uname <- getUname unameRef
 
+    tabletMode <- tabletModeXMobarString
+
     let pendingBufferSize = max 10 $ length uname
 
     let (pendingBufferColor, pendingBuffer') =
@@ -98,7 +98,7 @@ xMobarLogHook = do
 
     let wss = getPopulatedWorkspaces winset
 
-    let log = trunc 80 $
+    let log = trunc 120 $
           execWriter $ do
             tell $ printf "<fc=%s><fn=3> " pendingBufferColor
             tell pendingBuffer
@@ -131,7 +131,8 @@ xMobarLogHook = do
               tell $ toAction $ S.tag ws
               tell "</fc></fn> "
 
-            tell "<fc=#888888>| </fc>"
+            tell tabletMode
+
             tell "<fc=#ff8888><fn=3>"
             tell title
             tell "</fn></fc>"
@@ -143,7 +144,7 @@ xMobarLogHook = do
       | isAsciiUpper ch
           || isAsciiLower ch
           || isDigit ch =
-          printf "<action=`xdotool key 'Super_L+g' '%s'` button=1><action=`xdotool key 'Super_L+Shift_L+g' '%s'` button=3>%s</action></action>" [ch] [ch] [ch]
+          printf "<action=`rdectl goto '%s'` button=1><action=`rdectl shift '.' '%s'` button=3>%s</action></action>" [ch] [ch] [ch]
     toAction ch = ch
 
     toTheaterAction [ch]
@@ -156,7 +157,7 @@ xMobarLogHook = do
     toChangeLayoutAction :: String -> String
     toChangeLayoutAction =
       printf
-        "<action=`xdotool key --delay 50 'Super_L+space' 'Super_L+n'` button=1>\
+        "<action=`rdectl next-layout` button=1>\
         \<action=`xdotool key --delay 50 'Super_L+space' 'Super_L+p'` button=3>\
         \%s</action></action>"