neocturne/phi
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Correctly render tiled background pixmaps

Browse source
This commit is contained in:
Matthias Schiffer 2011-08-29 09:32:31 +02:00
parent 7ed869fcf1
commit e48e3a6fe0
1 changed files with 8 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
lib/Phi/X11.hs
View file

@ -218,7 +218,9 @@ updatePanels dispvar = do
renderWith buffer $ do renderWith buffer $ do
save save
translate (-(fromIntegral $ rect_x area)) (-(fromIntegral $ rect_y area)) translate (-(fromIntegral $ rect_x area)) (-(fromIntegral $ rect_y area))
withPatternForSurface rootImage setSource withPatternForSurface rootImage $ \pattern -> do
patternSetExtend pattern ExtendRepeat
setSource pattern
paint paint
restore restore
@ -238,6 +240,7 @@ updatePanels dispvar = do
-- copy buffer to window -- copy buffer to window
liftIO $ do liftIO $ do
(withDimension area $ clearArea disp (panelWindow panel) 0 0) True (withDimension area $ clearArea disp (panelWindow panel) 0 0) True
--(withDimension area $ copyArea disp (panelPixmap panel) (panelWindow panel) (defaultGC disp $ defaultScreen disp) 0 0) 0 0
sync disp False sync disp False
return $ panel { panelWidgetState = layoutedWidget, panelWidgetCache = cache' } return $ panel { panelWidgetState = layoutedWidget, panelWidgetCache = cache' }
@ -268,15 +271,15 @@ updateRootImage disp = do
pixmap <- liftM (fromIntegral . fromMaybe 0 . listToMaybe . join . catMaybes) $ forM [atom_XROOTPMAP_ID atoms, atom_XROOTMAP_ID atoms] $ pixmap <- liftM (fromIntegral . fromMaybe 0 . listToMaybe . join . catMaybes) $ forM [atom_XROOTPMAP_ID atoms, atom_XROOTMAP_ID atoms] $
\atom -> liftIO $ getWindowProperty32 disp atom rootwin \atom -> liftIO $ getWindowProperty32 disp atom rootwin
(_, _, _, rootWidth, rootHeight, _, _) <- liftIO $ getGeometry disp rootwin (_, _, _, pixmapWidth, pixmapHeight, _, _) <- liftIO $ getGeometry disp pixmap
-- update surface size -- update surface size
oldBg <- gets phiRootImage oldBg <- gets phiRootImage
imageWidth <- liftM fromIntegral $ imageSurfaceGetWidth oldBg imageWidth <- liftM fromIntegral $ imageSurfaceGetWidth oldBg
imageHeight <- liftM fromIntegral $ imageSurfaceGetHeight oldBg imageHeight <- liftM fromIntegral $ imageSurfaceGetHeight oldBg
when (imageWidth /= rootWidth || imageHeight /= rootHeight) $ do when (imageWidth /= pixmapWidth || imageHeight /= pixmapHeight) $ do
surfaceFinish oldBg surfaceFinish oldBg
newBg <- liftIO $ createImageSurface FormatRGB24 (fromIntegral rootWidth) (fromIntegral rootHeight) newBg <- liftIO $ createImageSurface FormatRGB24 (fromIntegral pixmapWidth) (fromIntegral pixmapHeight)
modify $ \state -> state { phiRootImage = newBg } modify $ \state -> state { phiRootImage = newBg }
bg <- gets phiRootImage bg <- gets phiRootImage
@ -287,7 +290,7 @@ updateRootImage disp = do
setSourceRGB 0 0 0 setSourceRGB 0 0 0
paint paint
_ -> do _ -> do
rootSurface <- liftIO $ Util.createXlibSurface disp pixmap visual (fromIntegral rootWidth) (fromIntegral rootHeight) rootSurface <- liftIO $ Util.createXlibSurface disp pixmap visual (fromIntegral pixmapWidth) (fromIntegral pixmapHeight)
renderWith bg $ withPatternForSurface rootSurface $ \pattern -> do renderWith bg $ withPatternForSurface rootSurface $ \pattern -> do
setSource pattern setSource pattern