diff options
Diffstat (limited to 'lib/Phi')
| -rw-r--r-- | lib/Phi/Bindings/SystrayErrorHandler.hsc | 17 | ||||
| -rw-r--r-- | lib/Phi/Bindings/Util.hsc | 90 | ||||
| -rw-r--r-- | lib/Phi/Bindings/XCB.hsc | 92 | ||||
| -rw-r--r-- | lib/Phi/Widget.hs | 45 | ||||
| -rw-r--r-- | lib/Phi/X11.hs | 376 | ||||
| -rw-r--r-- | lib/Phi/X11/AtomList.hs | 14 | ||||
| -rw-r--r-- | lib/Phi/X11/Atoms.hs | 32 | ||||
| -rw-r--r-- | lib/Phi/X11/Util.hs | 89 |
8 files changed, 423 insertions, 332 deletions
diff --git a/lib/Phi/Bindings/SystrayErrorHandler.hsc b/lib/Phi/Bindings/SystrayErrorHandler.hsc deleted file mode 100644 index 73fedbb..0000000 --- a/lib/Phi/Bindings/SystrayErrorHandler.hsc +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} - -module Phi.Bindings.SystrayErrorHandler ( setSystrayErrorHandler - , getLastErrorWindow - ) where - -#include <SystrayErrorHandler.h> - - -import Graphics.X11.Xlib - - -foreign import ccall unsafe "SystrayErrorHandler.h setSystrayErrorHandler" - setSystrayErrorHandler :: IO () - -foreign import ccall unsafe "SystrayErrorHandler.h getLastErrorWindow" - getLastErrorWindow :: IO Window diff --git a/lib/Phi/Bindings/Util.hsc b/lib/Phi/Bindings/Util.hsc deleted file mode 100644 index bae6c71..0000000 --- a/lib/Phi/Bindings/Util.hsc +++ /dev/null @@ -1,90 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} - -module Phi.Bindings.Util ( setClassHint - , visualIDFromVisual - , putClientMessage - , Phi.Bindings.Util.getEvent - , createXlibSurface - ) where - - -#include <X11/Xlib.h> -#include <X11/Xutil.h> -#include <cairo.h> -#include <cairo-xlib.h> - - -import Foreign.C.String (withCString) -import Foreign.C.Types -import Foreign.Ptr -import Foreign.Marshal.Alloc (alloca, allocaBytes) -import Foreign.Marshal.Array -import Foreign.Storable - -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras - -import Graphics.Rendering.Cairo.Types - - -foreign import ccall unsafe "X11/Xutil.h XSetClassHint" - xSetClassHint :: Display -> Window -> Ptr ClassHint -> IO () - -setClassHint :: Display -> Window -> ClassHint -> IO () -setClassHint disp wnd hint = allocaBytes (#size XClassHint) $ \p -> - withCString (resName hint) $ \res_name -> - withCString (resClass hint) $ \res_class -> do - (#poke XClassHint, res_name) p res_name - (#poke XClassHint, res_class) p res_class - xSetClassHint disp wnd p - -foreign import ccall unsafe "X11/Xlib.h XVisualIDFromVisual" - visualIDFromVisual :: Visual -> VisualID - -putClientMessage :: XEventPtr -> Window -> Atom -> [CLong] -> IO () -putClientMessage event window message_type messageData = do - setEventType event clientMessage - (#poke XClientMessageEvent, window) event window - (#poke XClientMessageEvent, message_type) event message_type - (#poke XClientMessageEvent, format) event (32 :: CInt) - pokeArray ((#ptr XClientMessageEvent, data.l) event) $ take 5 messageData - -foreign import ccall unsafe "cairo-xlib.h cairo_xlib_surface_create" - xlibSurfaceCreate :: Display -> Drawable -> Visual -> CInt -> CInt -> IO (Ptr Surface) - -getEvent :: Display -> XEventPtr -> IO Event -getEvent display p = do - eventType <- get_EventType p - case True of - _ | eventType == clientMessage -> do - serial <- (#peek XClientMessageEvent, serial) p - send_event <- (#peek XClientMessageEvent, send_event) p - window <- (#peek XClientMessageEvent, window) p - message_type <- (#peek XClientMessageEvent, message_type) p - format <- (#peek XClientMessageEvent, format) p - let datPtr = (#ptr XClientMessageEvent, data) p - dat <- case (format::CInt) of - 8 -> do a <- peekArray 20 datPtr - return $ map fromIntegral (a::[CUChar]) - 16 -> do a <- peekArray 10 datPtr - return $ map fromIntegral (a::[CUShort]) - 32 -> do a <- peekArray 5 datPtr - return $ map fromIntegral (a::[CULong]) - return $ ClientMessageEvent { ev_event_type = eventType - , ev_serial = serial - , ev_send_event = send_event - , ev_event_display = display - , ev_window = window - , ev_message_type = message_type - , ev_data = dat - } - | otherwise -> Graphics.X11.Xlib.Extras.getEvent p - - -createXlibSurface :: Display -> Drawable -> Visual -> CInt -> CInt -> IO Surface -createXlibSurface dpy drawable visual width height = do - surfacePtr <- xlibSurfaceCreate dpy drawable visual width height - surface <- mkSurface surfacePtr - manageSurface surface - return surface - diff --git a/lib/Phi/Bindings/XCB.hsc b/lib/Phi/Bindings/XCB.hsc new file mode 100644 index 0000000..33aff03 --- /dev/null +++ b/lib/Phi/Bindings/XCB.hsc @@ -0,0 +1,92 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +module Phi.Bindings.XCB ( Connection + , connect + , createXCBSurface + , flush + , clearArea + ) where + +import Control.Monad + +import Data.Int +import Data.Word + +import Foreign.C.String +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc +import Foreign.Marshal.Utils +import Foreign.Ptr +import Foreign.Storable + +import Graphics.Rendering.Cairo.Types +import Graphics.XHB (toValue) +import Graphics.XHB.Gen.Xproto (DRAWABLE, WINDOW, VISUALTYPE(..)) + + +#include <xcb/xcb.h> +#include <xcb/xproto.h> +#include <cairo-xcb.h> + + +data Connection = Connection (ForeignPtr Connection) + +foreign import ccall "xcb/xcb.h xcb_connect" xcb_connect :: CString -> Ptr CInt -> IO (Ptr Connection) +foreign import ccall "xcb/xcb.h &xcb_disconnect" p_xcb_disconnect :: FunPtr (Ptr Connection -> IO ()) + +connect :: IO Connection +connect = do + conn <- xcb_connect nullPtr nullPtr + newForeignPtr p_xcb_disconnect conn >>= return . Connection + +foreign import ccall "cairo-xlib.h cairo_xcb_surface_create" + cairo_xcb_surface_create :: Ptr Connection -> DRAWABLE -> Ptr VISUALTYPE -> CInt -> CInt -> IO (Ptr Surface) + +instance Storable VISUALTYPE where + sizeOf _ = (#size xcb_visualtype_t) + alignment _ = alignment (undefined :: CInt) + + peek _ = error "VISUALTYPE: peek not implemented" + + poke vt (MkVISUALTYPE visual_id _class bits_per_rgb_value colormap_entries red_mask green_mask blue_mask) = do + (#poke xcb_visualtype_t, visual_id) vt visual_id + (#poke xcb_visualtype_t, _class) vt (toValue _class :: Word8) + (#poke xcb_visualtype_t, bits_per_rgb_value) vt bits_per_rgb_value + (#poke xcb_visualtype_t, colormap_entries) vt colormap_entries + (#poke xcb_visualtype_t, red_mask) vt red_mask + (#poke xcb_visualtype_t, green_mask) vt green_mask + (#poke xcb_visualtype_t, blue_mask) vt blue_mask + +createXCBSurface :: Connection -> DRAWABLE -> VISUALTYPE -> CInt -> CInt -> IO Surface +createXCBSurface (Connection conn) drawable visual width height = + with visual $ \visualptr -> withForeignPtr conn $ \connptr -> do + surfacePtr <- cairo_xcb_surface_create connptr drawable visualptr width height + surface <- mkSurface surfacePtr + manageSurface surface + return surface + +foreign import ccall "xcb/xcb.h xcb_flush" + xcb_flush :: Ptr Connection -> IO () + +flush :: Connection -> IO () +flush (Connection conn) = withForeignPtr conn xcb_flush + +type VOID_COOKIE = CUInt + +foreign import ccall "xcb/xcb.h xcb_request_check" + xcb_request_check :: Ptr Connection -> VOID_COOKIE -> IO (Ptr ()) + +requestCheck :: Ptr Connection -> VOID_COOKIE -> IO () +requestCheck conn cookie = do + ret <- xcb_request_check conn cookie + when (ret /= nullPtr) $ + free ret + +foreign import ccall "xcb/xproto.h xcb_clear_area" + xcb_clear_area :: Ptr Connection -> Word8 -> WINDOW -> Int16 -> Int16 -> Word16 -> Word16 -> IO VOID_COOKIE + +clearArea :: Connection -> Bool -> WINDOW -> Int16 -> Int16 -> Word16 -> Word16 -> IO () +clearArea (Connection conn) exposures window x y width height = withForeignPtr conn $ \connptr -> do + cookie <- xcb_clear_area connptr (if exposures then 1 else 0) window x y width height + requestCheck connptr cookie diff --git a/lib/Phi/Widget.hs b/lib/Phi/Widget.hs index e3f8388..788abc2 100644 --- a/lib/Phi/Widget.hs +++ b/lib/Phi/Widget.hs @@ -1,6 +1,7 @@ {-# LANGUAGE ExistentialQuantification, StandaloneDeriving, DeriveDataTypeable, MultiParamTypeClasses, FunctionalDependencies, TypeSynonymInstances, FlexibleInstances #-} -module Phi.Widget ( Display(..) +module Phi.Widget ( XEvent(..) + , Display(..) , withDisplay , getAtoms , XMessage(..) @@ -30,36 +31,38 @@ import Control.Monad.IO.Class import Data.Maybe import Data.Typeable -import qualified Graphics.X11.Xlib as Xlib +import Graphics.XHB import Graphics.Rendering.Cairo import Phi.Phi import Phi.X11.Atoms -data Display = Display !(MVar Xlib.Display) !Atoms +data Display = Display !Connection !Atoms -withDisplay :: MonadIO m => Display -> (Xlib.Display -> m a) -> m a -withDisplay (Display dispvar _) f = do - disp <- liftIO $ takeMVar dispvar - a <- f disp - liftIO $ putMVar dispvar disp - return a +newtype XEvent = XEvent SomeEvent deriving Typeable + +instance Show XEvent where + show _ = "XEvent (..)" + + +withDisplay :: MonadIO m => Display -> (Connection -> m a) -> m a +withDisplay (Display conn _) f = f conn getAtoms :: Display -> Atoms getAtoms (Display _ atoms) = atoms -data XMessage = UpdateScreens [(Xlib.Rectangle, Xlib.Window)] deriving (Show, Typeable) +data XMessage = UpdateScreens [(RECTANGLE, WINDOW)] deriving (Show, Typeable) -unionArea :: Xlib.Rectangle -> Xlib.Rectangle -> Int +unionArea :: RECTANGLE -> RECTANGLE -> Int unionArea a b = fromIntegral $ uw*uh where uw = max 0 $ (min ax2 bx2) - (max ax1 bx1) uh = max 0 $ (min ay2 by2) - (max ay1 by1) - Xlib.Rectangle ax1 ay1 aw ah = a - Xlib.Rectangle bx1 by1 bw bh = b + MkRECTANGLE ax1 ay1 aw ah = a + MkRECTANGLE bx1 by1 bw bh = b ax2 = ax1 + fromIntegral aw ay2 = ay1 + fromIntegral ah @@ -71,22 +74,24 @@ unionArea a b = fromIntegral $ uw*uh data SurfaceSlice = SurfaceSlice !Int !Surface class Eq s => Widget w s c | w -> s, w -> c where - initWidget :: w -> Phi -> Display -> [(Xlib.Rectangle, Xlib.Window)] -> IO s + initWidget :: w -> Phi -> Display -> [(RECTANGLE, WINDOW)] -> IO s initCache :: w -> c - minSize :: w -> s -> Int -> Xlib.Rectangle -> Int + minSize :: w -> s -> Int -> RECTANGLE -> Int weight :: w -> Float weight _ = 0 - render :: w -> s -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> StateT c IO [(Bool, SurfaceSlice)] + render :: w -> s -> Int -> Int -> Int -> Int -> RECTANGLE -> StateT c IO [(Bool, SurfaceSlice)] handleMessage :: w -> s -> Message -> s handleMessage _ priv _ = priv +deriving instance Eq RECTANGLE + type IOCache = CacheArrow (Kleisli IO) -type RenderCache s = IOCache (s, Int, Int, Int, Int, Xlib.Rectangle) Surface +type RenderCache s = IOCache (s, Int, Int, Int, Int, RECTANGLE) Surface createIOCache :: Eq a => (a -> IO b) -> IOCache a b createIOCache = lift . Kleisli @@ -98,8 +103,8 @@ runIOCache a = do put cache' return b -createRenderCache :: (s -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> Render ()) - -> CacheArrow (Kleisli IO) (s, Int, Int, Int, Int, Xlib.Rectangle) Surface +createRenderCache :: (s -> Int -> Int -> Int -> Int -> RECTANGLE -> Render ()) + -> CacheArrow (Kleisli IO) (s, Int, Int, Int, Int, RECTANGLE) Surface createRenderCache f = lift . Kleisli $ \(state, x, y, w, h, screen) -> do surface <- createImageSurface FormatARGB32 w h renderWith surface $ do @@ -109,7 +114,7 @@ createRenderCache f = lift . Kleisli $ \(state, x, y, w, h, screen) -> do f state x y w h screen return surface -renderCached :: Eq s => s -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> StateT (RenderCache s) IO [(Bool, SurfaceSlice)] +renderCached :: Eq s => s -> Int -> Int -> Int -> Int -> RECTANGLE -> StateT (RenderCache s) IO [(Bool, SurfaceSlice)] renderCached state x y w h screen = do cache <- get (surf, updated, cache') <- liftIO $ runKleisli (runCache' cache) (state, x, y, w, h, screen) diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs index 82809f2..cc53cea 100644 --- a/lib/Phi/X11.hs +++ b/lib/Phi/X11.hs @@ -5,16 +5,19 @@ module Phi.X11 ( XConfig(..) , runPhi ) where -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras -import Graphics.X11.Xinerama +import Graphics.XHB +import Graphics.XHB.Gen.Xinerama +import Graphics.XHB.Gen.Xproto import Graphics.Rendering.Cairo import Control.Monad -import Data.Maybe import Data.Bits import Data.Char +import Data.List +import Data.Maybe +import Data.Typeable +import Data.Word import Control.Arrow ((&&&)) import Control.Concurrent @@ -27,16 +30,18 @@ import System.Exit import System.Posix.Signals import System.Posix.Types +import qualified Phi.Bindings.XCB as XCB + import Phi.Phi +import Phi.X11.Util import qualified Phi.Types as Phi import qualified Phi.Panel as Panel import qualified Phi.Widget as Widget import Phi.Widget hiding (Display, handleMessage) import Phi.X11.Atoms -import qualified Phi.Bindings.Util as Util -data XConfig = XConfig { phiXScreenInfo :: !(Display -> IO [Rectangle]) +data XConfig = XConfig { phiXScreenInfo :: !(Connection -> IO [RECTANGLE]) } data PhiState w s c = (Widget.Widget w s c) => PhiState { phiRootImage :: !Surface @@ -47,10 +52,10 @@ data PhiState w s c = (Widget.Widget w s c) => PhiState { phiRootImage :: !Su , phiWidgetState :: !s } -data PanelState w s c = (Widget.Widget w s c) => PanelState { panelWindow :: !Window - , panelPixmap :: !Pixmap - , panelArea :: !Rectangle - , panelScreenArea :: !Rectangle +data PanelState w s c = (Widget.Widget w s c) => PanelState { panelWindow :: !WINDOW + , panelPixmap :: !PIXMAP + , panelArea :: !RECTANGLE + , panelScreenArea :: !RECTANGLE , panelWidgetCache :: !c } @@ -76,27 +81,35 @@ runPhiX config st (PhiX a) = runPhiReader config $ runStateT a st defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo } +getScreenInfo :: Connection -> IO [RECTANGLE] +getScreenInfo conn = do + exs <- queryScreens conn >>= getReply + case exs of + Right xs -> return . map screenInfoToRect $ screen_info_QueryScreensReply xs + Left _ -> getGeometry conn (fromXid . toXid $ getRoot conn) >>= getReply' "getScreenInfo: getGeometry failed" >>= + return . (\(MkGetGeometryReply _ _ x y w h _) -> [MkRECTANGLE x y w h]) + where + screenInfoToRect (MkScreenInfo x y w h) = MkRECTANGLE x y w h + runPhi :: (Widget.Widget w s c) => XConfig -> Panel.PanelConfig -> w -> IO () runPhi xconfig config widget = do - xSetErrorHandler - phi <- initPhi installHandler sigTERM (termHandler phi) Nothing installHandler sigINT (termHandler phi) Nothing installHandler sigQUIT (termHandler phi) Nothing - disp <- openDisplay [] + conn <- liftM fromJust connect + xcb <- XCB.connect - atoms <- initAtoms disp - selectInput disp (defaultRootWindow disp) $ propertyChangeMask.|.structureNotifyMask + atoms <- initAtoms conn + changeWindowAttributes conn (getRoot conn) $ toValueParam [(CWEventMask, toMask [EventMaskPropertyChange, EventMaskStructureNotify])] bg <- createImageSurface FormatRGB24 1 1 - dispmvar <- newMVar disp - screens <- liftIO $ phiXScreenInfo xconfig disp - panelWindows <- mapM (createPanelWindow disp config) screens - let dispvar = Widget.Display dispmvar atoms + screens <- liftIO $ phiXScreenInfo xconfig conn + panelWindows <- mapM (createPanelWindow conn config) screens + let dispvar = Widget.Display conn atoms widget' = widget <~> separator 0 (if weight widget > 0 then 0 else 1) screenPanels = zip screens panelWindows @@ -116,29 +129,28 @@ runPhi xconfig config widget = do , phiShutdownHold = 0 , phiWidgetState = initialState } $ do - updateRootImage disp + updateRootImage conn xcb + + panels <- mapM (\(screen, window) -> createPanel conn window screen) screenPanels + + forM_ panels $ \panel -> do + setPanelProperties conn panel + liftIO $ mapWindow conn (panelWindow panel) + + modify $ \state -> state { phiPanels = panels } + + liftIO $ forkIO $ receiveEvents phi conn - Widget.withDisplay dispvar $ \disp -> do - panels <- mapM (\(screen, window) -> createPanel disp window screen) screenPanels - - forM_ panels $ \panel -> do - setPanelProperties disp panel - liftIO $ mapWindow disp (panelWindow panel) - - modify $ \state -> state { phiPanels = panels } - - liftIO $ forkIO $ receiveEvents phi dispvar - forever $ do available <- messageAvailable phi unless available $ do repaint <- gets phiRepaint when repaint $ do - updatePanels dispvar + updatePanels conn xcb modify $ \state -> state {phiRepaint = False} message <- receiveMessage phi - handleMessage dispvar message + handleMessage conn xcb message case (fromMessage message) of Just Shutdown -> @@ -163,8 +175,8 @@ termHandler :: Phi -> Handler termHandler phi = Catch $ sendMessage phi Shutdown -handleMessage :: (Widget w s c) => Widget.Display -> Message -> PhiX w s c () -handleMessage dispvar m = do +handleMessage :: (Widget w s c) => Connection -> XCB.Connection -> Message -> PhiX w s c () +handleMessage conn xcb m = do w <- asks phiWidget modify $ \state -> state {phiWidgetState = Widget.handleMessage w (phiWidgetState state) m} @@ -173,34 +185,43 @@ handleMessage dispvar m = do modify $ \state -> state {phiRepaint = True} _ -> case (fromMessage m) of - Just event -> - Widget.withDisplay dispvar $ flip handleEvent event + Just (XEvent event) -> + handleEvent conn xcb event _ -> return () -handleEvent :: (Widget w s c) => Display -> Event -> PhiX w s c () -handleEvent disp PropertyEvent { ev_atom = atom } = do +handleEvent :: (Widget w s c) => Connection -> XCB.Connection -> SomeEvent -> PhiX w s c () +handleEvent conn xcb event = do + case (fromEvent event) of + Just e -> handlePropertyNotifyEvent conn xcb e + Nothing -> case (fromEvent event) of + Just e -> handleConfigureNotifyEvent conn e + Nothing -> return () + +handlePropertyNotifyEvent :: (Widget w s c) => Connection -> XCB.Connection -> PropertyNotifyEvent -> PhiX w s c () +handlePropertyNotifyEvent conn xcb MkPropertyNotifyEvent { atom_PropertyNotifyEvent = atom } = do phi <- asks phiPhi atoms <- asks phiAtoms panels <- gets phiPanels when (atom == atom_XROOTPMAP_ID atoms || atom == atom_XROOTMAP_ID atoms) $ do - updateRootImage disp + updateRootImage conn xcb sendMessage phi ResetBackground sendMessage phi Repaint -handleEvent disp ConfigureEvent { ev_window = window } | window == defaultRootWindow disp = do +handleConfigureNotifyEvent :: (Widget w s c) => Connection -> ConfigureNotifyEvent -> PhiX w s c () +handleConfigureNotifyEvent conn MkConfigureNotifyEvent { window_ConfigureNotifyEvent = window } | window == getRoot conn = do phi <- asks phiPhi xconfig <- asks phiXConfig config <- asks phiPanelConfig panels <- gets phiPanels let screens = map panelScreenArea panels - screens' <- liftIO $ phiXScreenInfo xconfig disp + screens' <- liftIO $ phiXScreenInfo xconfig conn when (screens /= screens') $ do liftIO $ do - mapM (freePixmap disp . panelPixmap) panels - mapM_ (destroyWindow disp . panelWindow) $ drop (length screens') panels + mapM_ (freePixmap conn . panelPixmap) panels + mapM_ (destroyWindow conn . panelWindow) $ drop (length screens') panels let panelsScreens = zip screens' $ map Just panels ++ repeat Nothing @@ -210,17 +231,21 @@ handleEvent disp ConfigureEvent { ev_window = window } | window == defaultRootWi let rect = panelBounds config screen win = panelWindow panel - liftIO $ withRectangle rect $ moveResizeWindow disp win + liftIO $ configureWindow conn win $ toValueParam [ (ConfigWindowX, fromIntegral $ x_RECTANGLE rect) + , (ConfigWindowY, fromIntegral $ y_RECTANGLE rect) + , (ConfigWindowWidth, fromIntegral $ width_RECTANGLE rect) + , (ConfigWindowHeight, fromIntegral $ height_RECTANGLE rect) + ] - panel' <- createPanel disp win screen - setPanelProperties disp panel' + panel' <- createPanel conn win screen + setPanelProperties conn panel' return panel' Nothing -> do - win <- liftIO $ createPanelWindow disp config screen - panel <- createPanel disp win screen - setPanelProperties disp panel - liftIO $ mapWindow disp $ panelWindow panel + win <- liftIO $ createPanelWindow conn config screen + panel <- createPanel conn win screen + setPanelProperties conn panel + liftIO $ mapWindow conn $ panelWindow panel return panel modify $ \state -> state { phiPanels = panels' } @@ -228,30 +253,13 @@ handleEvent disp ConfigureEvent { ev_window = window } | window == defaultRootWi sendMessage phi $ UpdateScreens $ map (panelScreenArea &&& panelWindow) panels' sendMessage phi Repaint -handleEvent _ _ = return () +receiveEvents :: Phi -> Connection -> IO () +receiveEvents phi conn = do + forever $ waitForEvent conn >>= sendMessage phi . XEvent -receiveEvents :: Phi -> Widget.Display -> IO () -receiveEvents phi dispvar = do - connection <- Widget.withDisplay dispvar $ return . Fd . connectionNumber - - allocaXEvent $ \xevent -> forever $ do - handled <- Widget.withDisplay dispvar $ \disp -> do - pend <- pending disp - if pend /= 0 then - do - liftIO $ nextEvent disp xevent - event <- liftIO $ Util.getEvent disp xevent - sendMessage phi event - - return True - else return False - - --when (not handled) $ threadWaitRead connection - when (not handled) $ threadDelay 40000 - -updatePanels :: (Widget w s c) => Widget.Display -> PhiX w s c () -updatePanels dispvar = do +updatePanels :: (Widget w s c) => Connection -> XCB.Connection -> PhiX w s c () +updatePanels conn xcb = do w <- asks phiWidget s <- gets phiWidgetState rootImage <- gets phiRootImage @@ -264,60 +272,56 @@ updatePanels dispvar = do (panelSurfaces, cache') <- liftIO $ flip runStateT (panelWidgetCache panel) $ (withDimension area $ Widget.render w s 0 0) (panelScreenArea panel) - Widget.withDisplay dispvar $ \disp -> do - let screen = defaultScreen disp - visual = defaultVisual disp screen - - xbuffer <- liftIO $ withDimension area $ Util.createXlibSurface disp pixmap visual - - liftIO $ (withDimension area $ withSimilarSurface xbuffer ContentColor) $ \buffer -> do - renderWith buffer $ do + let screen = head . roots_Setup . connectionSetup $ conn + visualtype = fromJust $ findVisualtype screen (root_visual_SCREEN screen) + + xbuffer <- liftIO $ withDimension area $ XCB.createXCBSurface xcb (fromXid . toXid $ pixmap) visualtype + + liftIO $ (withDimension area $ withSimilarSurface xbuffer ContentColor) $ \buffer -> do + renderWith buffer $ do + save + translate (-(fromIntegral $ x_RECTANGLE area)) (-(fromIntegral $ y_RECTANGLE area)) + withPatternForSurface rootImage $ \pattern -> do + patternSetExtend pattern ExtendRepeat + setSource pattern + paint + restore + + forM_ panelSurfaces $ \(updated, SurfaceSlice x surface) -> do save - translate (-(fromIntegral $ rect_x area)) (-(fromIntegral $ rect_y area)) - withPatternForSurface rootImage $ \pattern -> do - patternSetExtend pattern ExtendRepeat - setSource pattern + translate (fromIntegral x) 0 + withPatternForSurface surface setSource paint restore - - forM_ panelSurfaces $ \(updated, SurfaceSlice x surface) -> do - save - translate (fromIntegral x) 0 - withPatternForSurface surface setSource - paint - restore - - renderWith xbuffer $ do - withPatternForSurface buffer setSource - paint - - surfaceFinish xbuffer - -- update window - liftIO $ do - (withDimension area $ clearArea disp (panelWindow panel) 0 0) True - sync disp False + renderWith xbuffer $ do + withPatternForSurface buffer setSource + paint + + surfaceFinish xbuffer + -- update window + liftIO $ withDimension area $ XCB.clearArea xcb True (panelWindow panel) 0 0 + return $ panel { panelWidgetCache = cache' } modify $ \state -> state { phiPanels = panels' } -updateRootImage :: Display -> PhiX w s c () -updateRootImage disp = do +updateRootImage :: Connection -> XCB.Connection -> PhiX w s c () +updateRootImage conn xcb = do atoms <- asks phiAtoms - let screen = defaultScreen disp - visual = defaultVisual disp screen - rootwin = defaultRootWindow disp - pixmap <- liftM (fromIntegral . fromMaybe 0 . listToMaybe . join . catMaybes) $ forM [atom_XROOTPMAP_ID atoms, atom_XROOTMAP_ID atoms] $ - \atom -> liftIO $ getWindowProperty32 disp atom rootwin + let screen = head . roots_Setup . connectionSetup $ conn + visualtype = fromJust $ findVisualtype screen (root_visual_SCREEN screen) + rootwin = root_SCREEN screen - (pixmapWidth, pixmapHeight) <- case pixmap of + pixmap <- liftM (fromXid . toXid . fromMaybe 0 . listToMaybe . join . catMaybes) $ forM [atom_XROOTPMAP_ID atoms, atom_XROOTMAP_ID atoms] $ + \atom -> liftIO $ getProperty32 conn rootwin atom + + (pixmapWidth, pixmapHeight) <- case (fromXid . toXid $ (pixmap :: PIXMAP) :: Word32) of 0 -> return (1, 1) - _ -> do - (_, _, _, pixmapWidth, pixmapHeight, _, _) <- liftIO $ getGeometry disp pixmap - return (pixmapWidth, pixmapHeight) + _ -> liftIO $ getGeometry conn (fromXid . toXid $ pixmap) >>= getReply' "updateRootImage: getGeometry failed" >>= return . (width_GetGeometryReply &&& height_GetGeometryReply) -- update surface size oldBg <- gets phiRootImage @@ -330,31 +334,33 @@ updateRootImage disp = do bg <- gets phiRootImage - case pixmap of + case (fromXid . toXid $ pixmap :: Word32) of 0 -> do renderWith bg $ do setSourceRGB 0 0 0 paint _ -> do - rootSurface <- liftIO $ Util.createXlibSurface disp pixmap visual (fromIntegral pixmapWidth) (fromIntegral pixmapHeight) + rootSurface <- liftIO $ XCB.createXCBSurface xcb (fromXid . toXid $ pixmap) visualtype (fromIntegral pixmapWidth) (fromIntegral pixmapHeight) renderWith bg $ withPatternForSurface rootSurface $ \pattern -> do setSource pattern paint surfaceFinish rootSurface + return () -createPanel :: (Widget w s c) => Display -> Window -> Rectangle -> PhiX w s c (PanelState w s c) -createPanel disp win screenRect = do +createPanel :: (Widget w s c) => Connection -> WINDOW -> RECTANGLE -> PhiX w s c (PanelState w s c) +createPanel conn win screenRect = do config <- asks phiPanelConfig w <- asks phiWidget let rect = panelBounds config screenRect - screen = defaultScreen disp - depth = defaultDepth disp screen + screen = head . roots_Setup . connectionSetup $ conn + depth = root_depth_SCREEN screen - pixmap <- liftIO $ (withDimension rect $ createPixmap disp win) depth - liftIO $ setWindowBackgroundPixmap disp win pixmap + pixmap <- liftIO $ newResource conn + liftIO $ createPixmap conn $ withDimension rect $ MkCreatePixmap depth pixmap (fromXid . toXid $ win) + liftIO $ changeWindowAttributes conn win $ toValueParam [(CWBackPixmap, fromXid . toXid $ pixmap)] return PanelState { panelWindow = win , panelPixmap = pixmap @@ -363,96 +369,84 @@ createPanel disp win screenRect = do , panelWidgetCache = initCache w } -createPanelWindow :: Display -> Panel.PanelConfig -> Rectangle -> IO Window -createPanelWindow disp config screenRect = do +createPanelWindow :: Connection -> Panel.PanelConfig -> RECTANGLE -> IO WINDOW +createPanelWindow conn config screenRect = do let rect = panelBounds config screenRect - screen = defaultScreen disp - depth = defaultDepth disp screen - visual = defaultVisual disp screen - colormap = defaultColormap disp screen - rootwin = defaultRootWindow disp - mask = cWEventMask.|.cWColormap.|.cWBackPixel.|.cWBorderPixel - - allocaSetWindowAttributes $ \attr -> do - set_colormap attr colormap - set_background_pixel attr 0 - set_border_pixel attr 0 - set_event_mask attr exposureMask - withRectangle rect (createWindow disp rootwin) 0 depth inputOutput visual mask attr - - -setPanelProperties :: Display -> PanelState w s c -> PhiX w s c () -setPanelProperties disp panel = do + screen = head . roots_Setup . connectionSetup $ conn + depth = root_depth_SCREEN screen + rootwin = root_SCREEN screen + visual = root_visual_SCREEN screen + win <- liftIO $ newResource conn + createWindow conn $ (withRectangle rect $ MkCreateWindow depth win rootwin) 0 WindowClassInputOutput visual $ + toValueParam [(CWEventMask, toMask [EventMaskExposure]), (CWBackPixel, 0), (CWBorderPixel, 0)] + return win + + +setPanelProperties :: Connection -> PanelState w s c -> PhiX w s c () +setPanelProperties conn panel = do atoms <- asks phiAtoms liftIO $ do - storeName disp (panelWindow panel) "Phi" - changeProperty8 disp (panelWindow panel) (atom_NET_WM_NAME atoms) (atomUTF8_STRING atoms) propModeReplace $ map (fromIntegral . ord) "Phi" + let name = map (fromIntegral . ord) "Phi" + changeProperty8 conn PropModeReplace (panelWindow panel) (atomWM_NAME atoms) (atomSTRING atoms) name + changeProperty8 conn PropModeReplace (panelWindow panel) (atom_NET_WM_NAME atoms) (atomUTF8_STRING atoms) name - changeProperty32 disp (panelWindow panel) (atom_NET_WM_WINDOW_TYPE atoms) aTOM propModeReplace [fromIntegral (atom_NET_WM_WINDOW_TYPE_DOCK atoms)] - changeProperty32 disp (panelWindow panel) (atom_NET_WM_DESKTOP atoms) cARDINAL propModeReplace [0xFFFFFFFF] - changeProperty32 disp (panelWindow panel) (atom_NET_WM_STATE atoms) aTOM propModeReplace [ fromIntegral (atom_NET_WM_STATE_SKIP_PAGER atoms) - , fromIntegral (atom_NET_WM_STATE_SKIP_TASKBAR atoms) - , fromIntegral (atom_NET_WM_STATE_STICKY atoms) - , fromIntegral (atom_NET_WM_STATE_BELOW atoms) - ] - setWMHints disp (panelWindow panel) WMHints { wmh_flags = fromIntegral inputHintBit - , wmh_input = False - , wmh_initial_state = 0 - , wmh_icon_pixmap = 0 - , wmh_icon_window = 0 - , wmh_icon_x = 0 - , wmh_icon_y = 0 - , wmh_icon_mask = 0 - , wmh_window_group = 0 - } - changeProperty32 disp (panelWindow panel) (atom_MOTIF_WM_HINTS atoms) (atom_MOTIF_WM_HINTS atoms) propModeReplace [ 2, 0, 0, 0, 0 ] + changeProperty32 conn PropModeReplace (panelWindow panel) (atom_NET_WM_WINDOW_TYPE atoms) (atomATOM atoms) [fromXid . toXid $ atom_NET_WM_WINDOW_TYPE_DOCK atoms] + changeProperty32 conn PropModeReplace (panelWindow panel) (atom_NET_WM_DESKTOP atoms) (atomCARDINAL atoms) [0xFFFFFFFF] + changeProperty32 conn PropModeReplace (panelWindow panel) (atom_NET_WM_STATE atoms) (atomATOM atoms) $ + map (fromXid . toXid) [ atom_NET_WM_STATE_SKIP_PAGER atoms + , atom_NET_WM_STATE_SKIP_TASKBAR atoms + , atom_NET_WM_STATE_STICKY atoms + , atom_NET_WM_STATE_BELOW atoms + ] - Util.setClassHint disp (panelWindow panel) ClassHint { resName = "phi", resClass = "Phi" } + changeProperty32 conn PropModeReplace (panelWindow panel) (atom_MOTIF_WM_HINTS atoms) (atom_MOTIF_WM_HINTS atoms) [ 2, 0, 0, 0, 0 ] - setStruts disp panel + changeProperty8 conn PropModeReplace (panelWindow panel) (atomWM_CLASS atoms) (atomSTRING atoms) $ map (fromIntegral . ord) "phi\0Phi" + + setStruts conn panel -setStruts :: Display -> PanelState w s c -> PhiX w s c () -setStruts disp panel = do +setStruts :: Connection -> PanelState w s c -> PhiX w s c () +setStruts conn panel = do atoms <- asks phiAtoms config <- asks phiPanelConfig - let rootwin = defaultRootWindow disp + let rootwin = getRoot conn position = Panel.panelPosition config area = panelArea panel - (_, _, _, _, rootHeight, _, _) <- liftIO $ getGeometry disp rootwin + rootHeight <- liftIO $ getGeometry conn (fromXid . toXid $ rootwin) >>= getReply' "setStruts: getGeometry failed" >>= return . height_GetGeometryReply let struts = [makeStruts i | i <- [0..11]] - where - makeTopStruts 2 = (fromIntegral $ rect_y area) + (fromIntegral $ rect_height area) - makeTopStruts 8 = (fromIntegral $ rect_x area) - makeTopStruts 9 = (fromIntegral $ rect_x area) + (fromIntegral $ rect_width area) - 1 - makeTopStruts _ = 0 - - makeBottomStruts 3 = (fromIntegral rootHeight) - (fromIntegral $ rect_y area) - makeBottomStruts 10 = (fromIntegral $ rect_x area) - makeBottomStruts 11 = (fromIntegral $ rect_x area) + (fromIntegral $ rect_width area) - 1 - makeBottomStruts _ = 0 - - makeStruts = case position of - Phi.Top -> makeTopStruts - Phi.Bottom -> makeBottomStruts + where + makeTopStruts 2 = (fromIntegral $ y_RECTANGLE area) + (fromIntegral $ height_RECTANGLE area) + makeTopStruts 8 = (fromIntegral $ x_RECTANGLE area) + makeTopStruts 9 = (fromIntegral $ x_RECTANGLE area) + (fromIntegral $ width_RECTANGLE area) - 1 + makeTopStruts _ = 0 + + makeBottomStruts 3 = (fromIntegral rootHeight) - (fromIntegral $ y_RECTANGLE area) + makeBottomStruts 10 = (fromIntegral $ x_RECTANGLE area) + makeBottomStruts 11 = (fromIntegral $ x_RECTANGLE area) + (fromIntegral $ width_RECTANGLE area) - 1 + makeBottomStruts _ = 0 + + makeStruts = case position of + Phi.Top -> makeTopStruts + Phi.Bottom -> makeBottomStruts liftIO $ do - changeProperty32 disp (panelWindow panel) (atom_NET_WM_STRUT atoms) cARDINAL propModeReplace $ take 4 struts - changeProperty32 disp (panelWindow panel) (atom_NET_WM_STRUT_PARTIAL atoms) cARDINAL propModeReplace struts + changeProperty32 conn PropModeReplace (panelWindow panel) (atom_NET_WM_STRUT atoms) (atomCARDINAL atoms) $ take 4 struts + changeProperty32 conn PropModeReplace (panelWindow panel) (atom_NET_WM_STRUT_PARTIAL atoms) (atomCARDINAL atoms) struts -panelBounds :: Panel.PanelConfig -> Rectangle -> Rectangle +panelBounds :: Panel.PanelConfig -> RECTANGLE -> RECTANGLE panelBounds config screenBounds = case Panel.panelPosition config of - Phi.Top -> screenBounds { rect_height = fromIntegral $ Panel.panelSize config } - Phi.Bottom -> screenBounds { rect_height = fromIntegral $ Panel.panelSize config, - rect_y = (rect_y screenBounds) + (fromIntegral $ rect_height screenBounds) - (fromIntegral $ Panel.panelSize config) } + Phi.Top -> screenBounds { height_RECTANGLE = fromIntegral $ Panel.panelSize config } + Phi.Bottom -> screenBounds { height_RECTANGLE = fromIntegral $ Panel.panelSize config, + y_RECTANGLE = (y_RECTANGLE screenBounds) + (fromIntegral $ height_RECTANGLE screenBounds) - (fromIntegral $ Panel.panelSize config) } -withRectangle :: (Num x, Num y, Num w, Num h) => Rectangle -> (x -> y -> w -> h -> a) -> a +withRectangle :: (Num x, Num y, Num w, Num h) => RECTANGLE -> (x -> y -> w -> h -> a) -> a withRectangle r = withDimension r . withPosition r -withPosition :: (Num x, Num y) => Rectangle -> (x -> y -> a) -> a -withPosition r f = f (fromIntegral $ rect_x r) (fromIntegral $ rect_y r) +withPosition :: (Num x, Num y) => RECTANGLE -> (x -> y -> a) -> a +withPosition r f = f (fromIntegral $ x_RECTANGLE r) (fromIntegral $ y_RECTANGLE r) -withDimension :: (Num w, Num h) => Rectangle -> (w -> h -> a) -> a -withDimension r f = f (fromIntegral $ rect_width r) (fromIntegral $ rect_height r) +withDimension :: (Num w, Num h) => RECTANGLE -> (w -> h -> a) -> a +withDimension r f = f (fromIntegral $ width_RECTANGLE r) (fromIntegral $ height_RECTANGLE r) diff --git a/lib/Phi/X11/AtomList.hs b/lib/Phi/X11/AtomList.hs index dbd6fc5..d05bad2 100644 --- a/lib/Phi/X11/AtomList.hs +++ b/lib/Phi/X11/AtomList.hs @@ -6,10 +6,16 @@ module Phi.X11.AtomList ( atoms import Language.Haskell.TH -import Graphics.X11.Xlib +import Graphics.XHB +import Graphics.XHB.Connection.Open atoms :: [String] -atoms = [ "UTF8_STRING" +atoms = [ "ATOM" + , "CARDINAL" + , "STRING" + , "UTF8_STRING" + , "WM_NAME" + , "WM_CLASS" , "MANAGER" , "_NET_WM_NAME" , "_NET_WM_WINDOW_TYPE" @@ -43,7 +49,7 @@ atoms = [ "UTF8_STRING" , "_XROOTMAP_ID" ] --- the expression must have the type (Display -> String) +-- the expression must have the type (Connection -> String) specialAtoms :: [(String, Q Exp)] -specialAtoms = [ ("_NET_SYSTEM_TRAY_SCREEN", [|("_NET_SYSTEM_TRAY_S" ++) . show . defaultScreen|]) +specialAtoms = [ ("_NET_SYSTEM_TRAY_SCREEN", [|("_NET_SYSTEM_TRAY_S" ++) . show . screen . displayInfo|]) ]
\ No newline at end of file diff --git a/lib/Phi/X11/Atoms.hs b/lib/Phi/X11/Atoms.hs index acbae64..0a8f66a 100644 --- a/lib/Phi/X11/Atoms.hs +++ b/lib/Phi/X11/Atoms.hs @@ -5,36 +5,48 @@ module Phi.X11.Atoms ( Atoms(..) ) where import Control.Monad +import Data.Char +import Data.List + import Language.Haskell.TH -import Graphics.X11 +import Graphics.XHB +import Graphics.XHB.Gen.Xproto import Phi.X11.AtomList $(let atomsName = mkName "Atoms" atomNames = map (\atom -> (atom, mkName ("atom" ++ atom))) $ atoms ++ (map fst specialAtoms) - fields = map (\(_, name) -> (name, IsStrict, ConT ''Atom)) atomNames + fields = map (\(_, name) -> (name, IsStrict, ConT ''ATOM)) atomNames in return [DataD [] atomsName [] [RecC atomsName fields] []] ) -initAtoms :: Display -> IO Atoms -initAtoms display = +initAtoms :: Connection -> IO Atoms +initAtoms conn = $(do normalAtomNames <- mapM (\atom -> do + receiptName <- newName ('_':atom) varName <- newName ('_':atom) - return ([|const atom|], mkName ("atom" ++ atom), varName) + return ([|const atom|], mkName ("atom" ++ atom), receiptName, varName) ) atoms specialAtomNames <- mapM (\(name, atomgen) -> do + receiptName <- newName ('_':name) varName <- newName ('_':name) - return (atomgen, mkName ("atom" ++ name), varName) + return (atomgen, mkName ("atom" ++ name), receiptName, varName) ) specialAtoms let atomNames = normalAtomNames ++ specialAtomNames + atomReceipts <- forM atomNames $ + \(atomgen, _, receiptName, _) -> liftM (BindS (VarP receiptName)) + [|let name = ($atomgen conn) + in internAtom conn $ MkInternAtom False (genericLength name) $ map (fromIntegral . ord) name|] atomInitializers <- forM atomNames $ - \(atomgen, _, varName) -> liftM (BindS (VarP varName)) [| internAtom display ($atomgen display) False |] - - let atomFieldExps = map (\(_, atomName, varName) -> (atomName, VarE varName)) atomNames + \(_, _, receiptName, varName) -> liftM (BindS (VarP varName)) + [|liftM (\(Right a) -> a) $ getReply $(return $ VarE receiptName)|] + + + let atomFieldExps = map (\(_, atomName, _, varName) -> (atomName, VarE varName)) atomNames atomsName = mkName "Atoms" atomsContruction = NoBindS $ AppE (VarE 'return) $ RecConE atomsName atomFieldExps - return $ DoE $ atomInitializers ++ [atomsContruction] + return $ DoE $ atomReceipts ++ atomInitializers ++ [atomsContruction] ) diff --git a/lib/Phi/X11/Util.hs b/lib/Phi/X11/Util.hs new file mode 100644 index 0000000..cadceeb --- /dev/null +++ b/lib/Phi/X11/Util.hs @@ -0,0 +1,89 @@ +module Phi.X11.Util ( getReply' + , changeProperty8 + , changeProperty16 + , changeProperty32 + , getProperty8 + , getProperty16 + , getProperty32 + , findVisualtype + ) where + +import Control.Monad + +import Data.Int +import Data.List +import Data.Maybe +import Data.Word + +import Foreign.Marshal.Array +import Foreign.Ptr + +import Graphics.XHB +import Graphics.XHB.Gen.Xproto + +import System.IO.Unsafe + + +getReply' :: String -> Receipt a -> IO a +getReply' m = getReply >=> return . fromRight + where + fromRight (Left _) = error m + fromRight (Right a) = a + +castWord16to8 :: [Word16] -> [Word8] +castWord16to8 input = unsafePerformIO $ + withArray input $ \ptr -> + peekArray (2 * length input) (castPtr ptr) + +castWord32to8 :: [Word32] -> [Word8] +castWord32to8 input = unsafePerformIO $ + withArray input $ \ptr -> + peekArray (4 * length input) (castPtr ptr) + +castWord8to16 :: [Word8] -> [Word16] +castWord8to16 input = unsafePerformIO $ + withArray input $ \ptr -> + peekArray (length input `div` 2) (castPtr ptr) + +castWord8to32 :: [Word8] -> [Word32] +castWord8to32 input = unsafePerformIO $ + withArray input $ \ptr -> + peekArray (length input `div` 4) (castPtr ptr) + + +changeProperty8 :: Connection -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word8] -> IO () +changeProperty8 conn mode win prop proptype propdata = changeProperty conn $ MkChangeProperty mode win prop proptype 8 (genericLength propdata) propdata + +changeProperty16 :: Connection -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word16] -> IO () +changeProperty16 conn mode win prop proptype propdata = changeProperty conn $ MkChangeProperty mode win prop proptype 16 (genericLength propdata) (castWord16to8 propdata) + +changeProperty32 :: Connection -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word32] -> IO () +changeProperty32 conn mode win prop proptype propdata = changeProperty conn $ MkChangeProperty mode win prop proptype 32 (genericLength propdata) (castWord32to8 propdata) + + +getProperty' :: Word8 -> Connection -> WINDOW -> ATOM -> IO (Maybe [Word8]) +getProperty' format conn win prop = do + reply <- getProperty conn (MkGetProperty False win prop (fromXid xidNone) 0 4) >>= getReply + case reply of + Left _ -> return Nothing + Right (MkGetPropertyReply {format_GetPropertyReply = format'}) | format' /= format -> return Nothing + Right (MkGetPropertyReply {bytes_after_GetPropertyReply = 0, value_GetPropertyReply = value}) -> return $ Just value + Right (MkGetPropertyReply {bytes_after_GetPropertyReply = bytes_after}) -> do + reply' <- getProperty conn (MkGetProperty False win prop (fromXid xidNone) 0 (4+bytes_after)) >>= getReply + case reply' of + Left _ -> return Nothing + Right (MkGetPropertyReply {format_GetPropertyReply = format'}) | format' /= format -> return Nothing + Right (MkGetPropertyReply {value_GetPropertyReply = value}) -> return $ Just value + +getProperty8 :: Connection -> WINDOW -> ATOM -> IO (Maybe [Word8]) +getProperty8 = getProperty' 8 + +getProperty16 :: Connection -> WINDOW -> ATOM -> IO (Maybe [Word16]) +getProperty16 conn win prop = getProperty' 16 conn win prop >>= return . fmap castWord8to16 + +getProperty32 :: Connection -> WINDOW -> ATOM -> IO (Maybe [Word32]) +getProperty32 conn win prop = getProperty' 32 conn win prop >>= return . fmap castWord8to32 + + +findVisualtype :: SCREEN -> VISUALID -> Maybe VISUALTYPE +findVisualtype screen id = listToMaybe . filter ((== id) . visual_id_VISUALTYPE) . join . map visuals_DEPTH . allowed_depths_SCREEN $ screen
\ No newline at end of file |