{-# LINE 1 "src/Xmobar/X11/CairoSurface.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}

------------------------------------------------------------------------------
-- |
-- Module: Xmobar.X11.Cairo
-- Copyright: (c) 2022 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
-- Stability: unstable
-- Portability: unportable
-- Created: Thu Sep 08, 2022 01:25
--
--
-- Xlib Cairo Surface creation
--
------------------------------------------------------------------------------

module Xmobar.X11.CairoSurface (withXlibSurface
                               , withBitmapSurface
                               , setSurfaceDrawable) where

import Graphics.X11.Xlib.Types
import Graphics.X11.Types
import Graphics.X11.Xlib (defaultScreenOfDisplay)
import Graphics.Rendering.Cairo.Types
import qualified Graphics.Rendering.Cairo.Internal as Internal

import Foreign
import Foreign.C



foreign import ccall "cairo_xlib_surface_create"
   cSurfaceCreate :: Display -> Drawable -> Visual -> CInt -> CInt -> Ptr Surface

foreign import ccall "cairo_xlib_surface_create_for_bitmap"
   cBitmapCreate :: Display -> Pixmap -> Screen -> CInt -> CInt -> Ptr Surface

foreign import ccall "cairo_xlib_surface_set_drawable"
   cSetDrawable :: Ptr Surface -> Drawable -> CInt -> CInt -> ()

createXlibSurface :: Display -> Drawable -> Visual -> Int -> Int -> IO Surface
createXlibSurface :: Display -> Drawable -> Visual -> Int -> Int -> IO Surface
createXlibSurface Display
d Drawable
dr Visual
v Int
w Int
h =
  Ptr Surface -> IO Surface
mkSurface (Ptr Surface -> IO Surface) -> Ptr Surface -> IO Surface
forall a b. (a -> b) -> a -> b
$ Display -> Drawable -> Visual -> CInt -> CInt -> Ptr Surface
cSurfaceCreate Display
d Drawable
dr Visual
v (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)

withXlibSurface ::
  Display -> Drawable -> Visual -> Int -> Int -> (Surface -> IO a) -> IO a
withXlibSurface :: forall a.
Display
-> Drawable -> Visual -> Int -> Int -> (Surface -> IO a) -> IO a
withXlibSurface Display
d Drawable
dr Visual
v Int
w Int
h Surface -> IO a
f = do
  surface <- Display -> Drawable -> Visual -> Int -> Int -> IO Surface
createXlibSurface Display
d Drawable
dr Visual
v Int
w Int
h
  ret <- f surface
  Internal.surfaceDestroy surface
  return ret

createBitmapSurface :: Display -> Pixmap -> Screen -> Int -> Int -> IO Surface
createBitmapSurface :: Display -> Drawable -> Screen -> Int -> Int -> IO Surface
createBitmapSurface Display
d Drawable
p Screen
s Int
w Int
h =
  Ptr Surface -> IO Surface
mkSurface (Ptr Surface -> IO Surface) -> Ptr Surface -> IO Surface
forall a b. (a -> b) -> a -> b
$ Display -> Drawable -> Screen -> CInt -> CInt -> Ptr Surface
cBitmapCreate Display
d Drawable
p Screen
s (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)

withBitmapSurface :: Display -> Pixmap -> Int -> Int -> (Surface -> IO a) -> IO a
withBitmapSurface :: forall a.
Display -> Drawable -> Int -> Int -> (Surface -> IO a) -> IO a
withBitmapSurface Display
d Drawable
p Int
w Int
h Surface -> IO a
f = do
  surface <- Display -> Drawable -> Screen -> Int -> Int -> IO Surface
createBitmapSurface Display
d Drawable
p (Display -> Screen
defaultScreenOfDisplay Display
d) Int
w Int
h
  ret <- f surface
  Internal.surfaceDestroy surface
  return ret

setSurfaceDrawable :: Surface -> Drawable -> Int -> Int -> IO ()
setSurfaceDrawable :: Surface -> Drawable -> Int -> Int -> IO ()
setSurfaceDrawable Surface
surface Drawable
dr Int
w Int
h =
  Surface -> (Ptr Surface -> IO ()) -> IO ()
forall {b}. Surface -> (Ptr Surface -> IO b) -> IO b
withSurface Surface
surface ((Ptr Surface -> IO ()) -> IO ())
-> (Ptr Surface -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    \Ptr Surface
s -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Surface -> Drawable -> CInt -> CInt -> ()
cSetDrawable Ptr Surface
s Drawable
dr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)