{-# LANGUAGE FlexibleInstances #-} -- | Tablet mode support for pen displays -- -- This module provides tablet mode functionality including: -- - Screen rotation (0°, 90°, 180°, 270°) -- - Coordinate transformation for pen/finger devices -- - Keyboard disable/enable in tablet mode -- - State management via XMonad ExtensibleState module Rahm.Desktop.TabletMode ( -- * Configuration TabletModeConfig (..), defaultConfig, setTabletConfig, -- * State TabletModeState (..), -- * Operations setTabletMode, toggleTabletMode, getTabletMode, setRotation, -- * Convenience enableTabletMode, disableTabletMode, -- * Types RotationAngle (..), tabletModeXMobarString, tabletModeCommandHandler, syntheticKeyStartDrag, syntheticKeyStartResize, ) where import Control.Concurrent (forkIO) import Control.Monad (forM_, unless, when) import Data.Char (toLower) import Data.List (intercalate, isInfixOf) import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (fromMaybe, isJust) import Data.Typeable (Typeable) import Graphics.X11.Xlib hiding (hWaitReady) import qualified Graphics.X11.Xlib.Extras import Rahm.Desktop.Logger (LogLevel (Debug, Info, Warn), logs) import Rahm.Desktop.Server import System.Directory (createDirectoryIfMissing) import System.Environment (lookupEnv) import System.FilePath (()) import qualified System.IO as IO import System.Process (callProcess, readProcessWithExitCode) import XMonad ( Atom, Display, ExtensionClass (..), StateExtension (PersistentExtension), Window, X, ask, io, spawn, ) import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.Run (runProcessWithInput) syntheticKeyStartDrag :: KeySym syntheticKeyStartDrag = 0x1100000000000011 syntheticKeyStartResize :: KeySym syntheticKeyStartResize = 0x1100000000000111 -- | Rotation angle for the display data RotationAngle = -- | Normal orientation (0°) Rot0 | -- | Rotated 90° clockwise Rot90 | -- | Rotated 180° (inverted) Rot180 | -- | Rotated 270° clockwise (90° counter-clockwise) Rot270 deriving (Eq, Show, Typeable, Enum, Bounded, Read) circularSucc :: (Bounded a, Enum a) => a -> a circularSucc x = toEnum $ (fromEnum x + 1) `mod` (fromEnum (maxBound `asTypeOf` x) + 1) -- | Configuration for tablet mode data TabletModeConfig = TabletModeConfig { -- | Display name (e.g., "eDP-1") configDisplay :: String, -- | Keyboard device name (Nothing to disable keyboard control) configKeyboard :: Maybe String } deriving (Eq, Show, Typeable, Read) -- | Default configuration matching the user's hardware defaultConfig :: TabletModeConfig defaultConfig = TabletModeConfig { configDisplay = "eDP-1", configKeyboard = Just "AT Translated Set 2 keyboard" } -- | Tablet mode state data TabletModeState = TabletModeState { stateConfig :: TabletModeConfig, tabletModeEnabled :: Bool, tabletRotation :: RotationAngle, lazyHasTabletMode :: Maybe Bool } deriving (Eq, Show, Read) instance ExtensionClass TabletModeState where initialValue = TabletModeState { stateConfig = defaultConfig, tabletModeEnabled = False, tabletRotation = Rot0, lazyHasTabletMode = Nothing } extensionType = PersistentExtension hasTabletMode :: X Bool hasTabletMode = do cached <- lazyHasTabletMode <$> XS.get case cached of Just b -> return b Nothing -> do hasTouch <- io $ do output <- runProcessWithInput "xinput" ["list"] "" let hasTouchDevice = any (isInfixOf "touch" . map toLower) (lines output) return hasTouchDevice XS.modify (\st -> st {lazyHasTabletMode = Just hasTouch}) return hasTouch -- | Update the tablet mode configuration setTabletConfig :: TabletModeConfig -> X () setTabletConfig config = XS.modify (\s -> s {stateConfig = config}) -- | Check if tablet mode is currently enabled getTabletMode :: X Bool getTabletMode = tabletModeEnabled <$> XS.get -- | Enable or disable tablet mode setTabletMode :: Bool -> X () setTabletMode enable = do state <- XS.get let config = stateConfig state when enable $ spawn "on-tablet-mode.sh 1" if enable then do logs Info "Enabling tablet mode" setRotation Rot180 maybeDisableKeyboard config XS.put state {tabletModeEnabled = True, tabletRotation = Rot180} else do logs Info "Disabling tablet mode" setRotation Rot0 maybeEnableKeyboard config XS.put state {tabletModeEnabled = False, tabletRotation = Rot0} unless enable $ spawn "on-tablet-mode.sh 0" -- | Toggle tablet mode on/off toggleTabletMode :: X () toggleTabletMode = do enabled <- getTabletMode setTabletMode (not enabled) -- | Rotation flags for xrandr rotationFlags :: RotationAngle -> String rotationFlags Rot0 = "normal" rotationFlags Rot90 = "right" rotationFlags Rot180 = "inverted" rotationFlags Rot270 = "left" -- | Coordinate transformation matrices for each rotation -- Format: [a, b, tx, c, d, ty, p, q, r] for matrix: -- | a b tx | -- | c d ty | -- | p q r | rotationMatrix :: RotationAngle -> String rotationMatrix Rot0 = "1 0 0 0 1 0 0 0 1" rotationMatrix Rot90 = "0 1 0 -1 0 1 0 0 1" rotationMatrix Rot180 = "-1 0 1 0 -1 1 0 0 1" rotationMatrix Rot270 = "0 -1 1 1 0 0 0 0 1" rotationNext :: X () rotationNext = do curRotation <- tabletRotation <$> XS.get setRotation (circularSucc curRotation) -- | Set the display rotation and device transformations setRotation :: RotationAngle -> X () setRotation angle = do state <- XS.get let config = stateConfig state display = configDisplay config matrix = rotationMatrix angle xrandrFlag = rotationFlags angle logs Info "Setting rotation to %s" (show angle) -- Rotate display io $ spawn $ unwords ["xrandr", "--output", display, "--rotate", xrandrFlag] -- Apply coordinate transformations to devices let devices = [ "Wacom HID 527E Pen stylus", "Wacom HID 527E Pen eraser", "Wacom HID 527E Finger touch" ] forM_ devices $ \dev -> do let matrixStr = unwords (map show matrix) logs Debug "Setting %s matrix: %s" dev matrix io $ spawn $ unwords [ "xinput", "set-prop", "\"" ++ dev ++ "\"", "\"Coordinate Transformation Matrix\"", matrix ] -- Update state XS.put state {tabletRotation = angle} -- | Disable keyboard if configured maybeDisableKeyboard :: TabletModeConfig -> X () maybeDisableKeyboard config = do when (isJust (configKeyboard config)) $ do let keyboard = fromMaybe "" (configKeyboard config) logs Info "Disabling keyboard: %s" keyboard io $ spawn $ unwords ["xinput", "disable", "\"" ++ keyboard ++ "\""] -- | Enable keyboard if configured maybeEnableKeyboard :: TabletModeConfig -> X () maybeEnableKeyboard config = do when (isJust (configKeyboard config)) $ do let keyboard = fromMaybe "" (configKeyboard config) logs Info "Enabling keyboard: %s" keyboard io $ spawn $ unwords ["xinput", "enable", "\"" ++ keyboard ++ "\""] tabletModeXMobarString :: X String tabletModeXMobarString = do doesHaveTabletMode <- hasTabletMode if doesHaveTabletMode then do tabletMode <- getTabletMode return $ ( if tabletMode then concat [ " \61706 ", " \61724 ", " \11096 ", " ✗ ", "\61728 ", " \58183 ", " \983486 ", " \985704 " ] else " \61705 " ) ++ " " else return "" data TabletModeCommand where SetTabletMode :: Bool -> TabletModeCommand NextRotation :: TabletModeCommand tabletModeCommandHandler :: CommandHandler TabletModeCommand tabletModeCommandHandler = CommandHandler ( \s -> case words s of ["tablet-mode", "on"] -> Just $ SetTabletMode True ["tablet-mode", "off"] -> Just $ SetTabletMode False ["next-rotation"] -> Just NextRotation _ -> Nothing ) ( \case SetTabletMode mode -> setTabletMode mode NextRotation -> rotationNext ) -- | Enable tablet mode (rotate 180°, disable keyboard) enableTabletMode :: X () enableTabletMode = setTabletMode True -- | Disable tablet mode (rotate 0°, enable keyboard) disableTabletMode :: X () disableTabletMode = setTabletMode False