packages feed

aosd (empty) → 0.1

raw patch · 8 files changed

+977/−0 lines, 8 filesdep +X11dep +aosddep +basesetup-changed

Dependencies added: X11, aosd, base, bindings-DSL, cairo, colour, language-haskell-extract, pango, template-haskell, transformers

Files

+ Graphics/Aosd.hs view
@@ -0,0 +1,334 @@+{-# LANGUAGE ExistentialQuantification, NamedFieldPuns, RecordWildCards #-}+{-# OPTIONS -Wall #-}+-- | For a higher-level API for textual OSDs using /Pango/, use "Graphics.Aosd.Pango".+module Graphics.Aosd(+    -- * Renderers+    AosdRenderer(..), GeneralRenderer(..), +--     -- ** Simple combinators+--     HCatRenderer(..), VCatRenderer(..),+    -- * Options+    AosdOptions(..), Transparency(..), Position(..), XClassHint(..), defaultOpts,+    -- * Displaying+    aosdFlash,+    FlashDurations(..), symDurations,+    -- ** Low-level operations+    AosdPtr(..),aosdNew,reconfigure,+    aosdRender, aosdShow, aosdHide, aosdLoopOnce, aosdLoopFor,++    -- * Reexports+    module Graphics.Rendering.Cairo,+    Rectangle(..),+    CInt, CUInt++    +    +    ) where++import Control.Exception+import Control.Monad.IO.Class+import Control.Monad.Trans.Reader+import Foreign+import Foreign.C+import Graphics.Aosd.AOSD_H+import Graphics.Aosd.Util+import Graphics.Rendering.Cairo+import Graphics.Rendering.Cairo.Internal(runRender)+import Data.Functor+import Graphics.Rendering.Pango.Enums+import Graphics.X11.Xlib(openDisplay,displayHeight,displayWidth,defaultScreen)++class AosdRenderer a where+    toGeneralRenderer :: a -> IO GeneralRenderer+++data XClassHint = XClassHint { resName, resClass :: String }+    deriving(Show)++data Transparency = None | Fake | Composite+    deriving(Show)++data Position = Min -- ^ Left/top+              | Center +              | Max -- ^ Right/bottom+    deriving(Show,Enum,Bounded)++data AosdOptions = AosdOptions {+    -- | 'Nothing' = use /libaosd/ default.+    classHint :: Maybe XClassHint,+    -- | 'Nothing' = use /libaosd/ default.+    transparency :: Maybe Transparency,+    xPos :: Position,+    yPos :: Position,+    -- | Positive values denote a rightwards respectively downwards offset (in pixels).+    offset :: (CInt,CInt),+    -- | 'Nothing' = use /libaosd/ default.+    hideUponMouseEvent :: Maybe Bool,+    -- | Mouse-click event handler.+    mouseEventCB :: Maybe (C'AosdMouseEvent -> IO ())+}++data GeneralRenderer = GeneralRenderer {+    grRender :: Render (),+    -- | Part of the surface that the renderer actually draws on (determines the window size).+    grInkExtent :: Rectangle,+    -- | Part of the surface whose...+    --+    -- * ... left edge is aligned to the left edge of the screen, if 'xPos' is 'Min'+    --+    -- * ... center is aligned to the center of the screen, if 'xPos' is 'Center'+    --+    -- * ... right edge is aligned to the right edge of the screen, if 'xPos' is 'Max'+    --+    -- (Likewise for the /y/ axis)+    grPositioningExtent :: Rectangle+}+++-- -- | Horizontal concatenation+-- data HCatRenderer = forall r1 r2. (AosdRenderer r1, AosdRenderer r2) => HCat r1 r2+-- +-- +-- -- | Vertical concatenation+-- data VCatRenderer = forall r1 r2. (AosdRenderer r1, AosdRenderer r2) => VCat r1 r2+++instance AosdRenderer GeneralRenderer where+    toGeneralRenderer = return++-- instance AosdRenderer HCatRenderer where+--     toGeneralRenderer (HCat r1 r2) = do+--         gr1 <- toGeneralRenderer r1+--         gr2 <- toGeneralRenderer r2+--         return GeneralRenderer {+--                     grWidth = ((+) `on` grWidth) gr1 gr2,+--                     grHeight = (max `on` grHeight) gr1 gr2,+--                     grRender = do+--                         grRender gr1+--                         translate (fromIntegral $ grWidth gr1) 0+--                         grRender gr2+--                }+-- +-- instance AosdRenderer VCatRenderer where+--     toGeneralRenderer (VCat r1 r2) = do+--         gr1 <- toGeneralRenderer r1+--         gr2 <- toGeneralRenderer r2+--         return GeneralRenderer {+--                     grWidth = (max `on` grWidth) gr1 gr2,+--                     grHeight = ((+) `on` grHeight) gr1 gr2,+--                     grRender = do+--                         grRender gr1+--                         translate 0 (fromIntegral $ grHeight gr1)+--                         grRender gr2+--                }++toC'AosdRenderer :: Render () -> IO C'AosdRenderer+toC'AosdRenderer r = mk'AosdRenderer f+    where+        f cairo _ = runReaderT (runRender r) cairo+++toAosdTransparency :: Transparency -> C'AosdTransparency+toAosdTransparency None = c'TRANSPARENCY_NONE+toAosdTransparency Fake = c'TRANSPARENCY_FAKE+toAosdTransparency Composite = c'TRANSPARENCY_COMPOSITE+++-- toAosdCoordinate :: Position -> C'AosdCoordinate+-- toAosdCoordinate Min = c'COORDINATE_MINIMUM+-- toAosdCoordinate Center = c'COORDINATE_CENTER+-- toAosdCoordinate Max = c'COORDINATE_MAXIMUM+++withAosd :: (Ptr C'Aosd -> IO a) -> IO a+withAosd k = do+    a <- c'aosd_new +    finally (k a) (c'aosd_destroy a)++++withConfiguredAosd :: AosdRenderer a => AosdOptions -> a -> (Ptr C'Aosd -> IO r) -> IO r+withConfiguredAosd opts x k = +    withAosd (\a -> do+        reconfigure0 opts x a +        k a+    )++++reconfigure0 :: AosdRenderer a => AosdOptions -> a -> Ptr C'Aosd -> IO ()+reconfigure0 AosdOptions{..} renderer a = do+        GeneralRenderer{..} <- toGeneralRenderer renderer +        maybeDo (setClassHint a) classHint+        +        maybeDo (c'aosd_set_transparency a . toAosdTransparency) transparency++        display <- openDisplay ""+        let screen = defaultScreen display+            screenWidth = fromIntegral $ displayWidth display screen+            screenHeight = fromIntegral $ displayHeight display screen++++        let -- l=Left, t=Top, w=Width, h=Height +            Rectangle li ti wi hi = grInkExtent+            Rectangle lp tp wp hp = grPositioningExtent++{- +(These comments only look at the x dimension; the other is analogous) ++Consider the mapping "screenx" from grRender x coordinates to screen x coordinates++Since we translate grRender by -(li,ti), we have:++        screenx x = windowLeft + x - li ++If xPos is Min, we want: ++        screenx lp = 0+        <=>+        windowLeft + lp - li = 0+        <=>+        windowLeft = li - lp++If xPos is Center, we want:++        screenx (lp + wp/2) = screenWidth/2+        <=>+        windowLeft + (lp + wp/2) - li = screenWidth/2+        <=>+        windowLeft = li - lp + (screenWidth - wp)/2 ++If xPos is Max, we want:++        screenx (lp+wp) = screenWidth+        <=>+        windowLeft + (lp+wp) - li = screenWidth+        <=>+        windowLeft = li - lp + screenWidth - wp++-}+            calculateOffsetAdjustment pos min_ink min_positioning size_positioning size_screen  = fromIntegral $ +                        case pos of+                              Min -> min_ink - min_positioning+                              Center -> min_ink - min_positioning + div (size_screen - size_positioning) 2+                              Max -> min_ink - min_positioning + size_screen - size_positioning ++                      ++            windowLeft = calculateOffsetAdjustment xPos li lp wp screenWidth  + fst offset+            windowTop  = calculateOffsetAdjustment yPos ti tp hp screenHeight + snd offset++            windowWidth = fromIntegral wi+            windowHeight = fromIntegral hi++            finalRenderer = do+                translate (fi . negate $ li) (fi . negate $ ti)+                grRender++++        c'aosd_set_geometry a windowLeft windowTop windowWidth windowHeight+            ++        rendererPtr <- toC'AosdRenderer finalRenderer+        c'aosd_set_renderer a rendererPtr nullPtr ++        maybeDo (setHideUponMouseEvent a) hideUponMouseEvent++        maybeDo (setMouseEventCB a) mouseEventCB++setClassHint :: Ptr C'Aosd -> XClassHint -> IO ()+setClassHint a XClassHint{ resName, resClass } = +    withCString resName (\resName' ->+        withCString resClass (\resClass' ->+            c'aosd_set_names a resName' resClass'))++setHideUponMouseEvent :: Ptr C'Aosd -> Bool -> IO ()+setHideUponMouseEvent a b = c'aosd_set_hide_upon_mouse_event a (if b then 1 else 0)++setMouseEventCB :: Ptr C'Aosd -> (C'AosdMouseEvent -> IO ()) -> IO ()+setMouseEventCB a f = do+    fptr <- mk'AosdMouseEventCb f'+    c'aosd_set_mouse_event_cb a fptr nullPtr+  where+    f' :: Ptr C'AosdMouseEvent -> Ptr () -> IO () +    f' p _ = do +        mouseEvent <- peek p +        f mouseEvent++-- | Non-'Nothing' defaults:+--+-- *       transparency = Just Composite,+--+-- *       xPos = Center, +--+-- *       yPos = Center,+-- +-- *       offset = (0,0),+--+-- *       hideUponMouseEvent = Just True+defaultOpts :: AosdOptions+defaultOpts =+    AosdOptions { +        classHint = Nothing,+        transparency = Just Composite,+        xPos = Center, +        yPos = Center,+        offset = (0,0),+        hideUponMouseEvent = Just True,+        mouseEventCB = Nothing+    }++data FlashDurations = FlashDurations {+    inMillis :: CUInt -- ^ Fade-in time in milliseconds +  , fullMillis :: CUInt -- ^ Full display time in milliseconds+  , outMillis :: CUInt -- ^ Fade-out time in milliseconds+}+    deriving(Show)++-- | Construct a 'FlashDurations' with equal 'inMillis' and 'outMillis'.+symDurations :: +        CUInt -- ^ 'inMillis' and 'outMillis'. +     -> CUInt -- ^ 'fullMillis'.+     -> FlashDurations+symDurations fadeMillis fullMillis = FlashDurations fadeMillis fullMillis fadeMillis++-- | Main high-level displayer. Blocks. +aosdFlash :: AosdRenderer a => AosdOptions -> a -> FlashDurations -> IO ()+aosdFlash opts renderer FlashDurations{..} = +    withConfiguredAosd opts renderer (\p -> c'aosd_flash p inMillis fullMillis outMillis)++                               ++++newtype AosdPtr = AosdPtr { unAosdPtr :: ForeignPtr C'Aosd }++-- | Create an /Aosd/ object managed by the garbage collector.+aosdNew :: AosdRenderer a => AosdOptions -> a -> IO AosdPtr+aosdNew opts r = do+    p <- c'aosd_new+    reconfigure0 opts r p+    AosdPtr <$> Foreign.newForeignPtr p'aosd_destroy p+++reconfigure :: AosdRenderer a => AosdOptions -> a -> AosdPtr -> IO ()+reconfigure opts r = (`withForeignPtr` reconfigure0 opts r) . unAosdPtr++aosdRender :: AosdPtr -> IO ()+aosdRender = (`withForeignPtr` c'aosd_render) . unAosdPtr++aosdShow :: AosdPtr -> IO ()+aosdShow = (`withForeignPtr` c'aosd_show) . unAosdPtr++aosdHide :: AosdPtr -> IO ()+aosdHide = (`withForeignPtr` c'aosd_hide) . unAosdPtr++aosdLoopOnce :: AosdPtr -> IO ()+aosdLoopOnce = (`withForeignPtr` c'aosd_loop_once) . unAosdPtr++aosdLoopFor :: AosdPtr +            -> CUInt -- ^ Time in milliseconds.+            -> IO ()+aosdLoopFor (AosdPtr fp) millis = (fp `withForeignPtr` (`c'aosd_loop_for` millis)) +
+ Graphics/Aosd/AOSD_H.hsc view
@@ -0,0 +1,74 @@+#include <bindings.dsl.h>+#include <aosd.h>++-- | Raw bindings.+--+-- Note: The 'Cairo' type (C @cairo_t*@) is from "Graphics.Rendering.Cairo.Types", whose haddock is (as of writing) hidden+module Graphics.Aosd.AOSD_H where+#strict_import+import Graphics.Rendering.Cairo.Types+++#opaque_t Aosd++#integral_t AosdCoordinate +#num COORDINATE_MINIMUM+#num COORDINATE_CENTER+#num COORDINATE_MAXIMUM++#starttype AosdMouseEvent+#field x, CInt+#field y, CInt+#field x_root, CInt+#field y_root, CInt+#field button, CUInt+#field time, CULong+#stoptype++#callback AosdRenderer, Cairo -> Ptr () -> IO ()+#callback AosdMouseEventCb, Ptr <AosdMouseEvent> -> Ptr () -> IO ()++#integral_t AosdTransparency+#num TRANSPARENCY_NONE+#num TRANSPARENCY_FAKE+#num TRANSPARENCY_COMPOSITE++#starttype XClassHint+#field res_name, CString+#field res_class, CString+#stoptype++#ccall aosd_new, IO (Ptr <Aosd>) +#ccall aosd_destroy, Ptr <Aosd> -> IO ()+ +-- * object configurators++#ccall aosd_set_name, Ptr <Aosd> -> Ptr <XClassHint> -> IO ()+#ccall aosd_set_names, Ptr <Aosd> -> CString -> CString -> IO ()+#ccall aosd_set_transparency, Ptr <Aosd> -> <AosdTransparency> -> IO ()+#ccall aosd_set_geometry, Ptr <Aosd> -> CInt -> CInt -> CInt -> CInt -> IO ()+#ccall aosd_set_position, Ptr <Aosd> -> CUInt -> CInt -> CInt -> IO ()+#ccall aosd_set_position_offset, Ptr <Aosd> -> CInt -> CInt -> IO ()+#ccall aosd_set_position_with_offset, Ptr <Aosd> -> <AosdCoordinate> -> <AosdCoordinate> -> CInt -> CInt -> CInt -> CInt -> IO ()+#ccall aosd_set_renderer, Ptr <Aosd> -> <AosdRenderer> -> Ptr () -> IO ()+#ccall aosd_set_mouse_event_cb, Ptr <Aosd> -> <AosdMouseEventCb> -> Ptr () -> IO ()+#ccall aosd_set_hide_upon_mouse_event, Ptr <Aosd> -> CInt -> IO ()+++-- * object manipulators++#ccall aosd_render, Ptr <Aosd> -> IO ()+#ccall aosd_show, Ptr <Aosd> -> IO ()+#ccall aosd_hide, Ptr <Aosd> -> IO ()+++-- * X main loop processing++#ccall aosd_loop_once, Ptr <Aosd> -> IO ()+#ccall aosd_loop_for, Ptr <Aosd> -> CUInt -> IO ()+++-- * automatic object manipulator++#ccall aosd_flash, Ptr <Aosd> -> CUInt -> CUInt -> CUInt -> IO ()+
+ Graphics/Aosd/Pango.hs view
@@ -0,0 +1,279 @@+{-# LANGUAGE ViewPatterns, NoMonomorphismRestriction, ScopedTypeVariables, GeneralizedNewtypeDeriving, TypeSynonymInstances, NamedFieldPuns, RecordWildCards #-}+{-# OPTIONS -Wall #-}++module Graphics.Aosd.Pango(++    -- * Base+    TextRenderer(..),Width(..),textRenderer,+    -- * PangoText+    PangoText,pText,pRaw,pEmpty,pTag,+    -- ** Markup tags+    pSpan,pBold,pBig,pItalic,pStrikethrough,pSmall,pSub,pSup,pUnderline,pMono,+    -- *** Span shorthands+    pSized,+    -- ** Standard text combinators+    pIntercalate,pUnlines,pUnwords,pShow,+++    -- * Reexports+    SpanAttribute(..),+    LayoutAlignment(..),+    LayoutWrapMode(..),+    TabPosition,+    Size(..),+    sRGB,+    module Graphics.Aosd,+    module Data.Monoid,+    module Data.Colour.Names++    +    +    ) where++import Control.Monad.IO.Class+import Foreign.C+import Graphics.Aosd+import Graphics.Aosd.Util+import Graphics.Rendering.Pango.Cairo+import Graphics.Rendering.Pango.Enums+import Graphics.Rendering.Pango.Layout+import Control.Monad(void)+import Graphics.Rendering.Pango.Markup+import Data.Monoid+import Data.String+import Data.List(intersperse)+import Data.Colour+import Data.Colour.SRGB+import Data.Colour.Names+++data TextRenderer = TextRenderer {+    -- | Hint: Use 'sRGB' or "Data.Colour.Names".+    colour :: Colour Double,+    -- | 0: Transparent, 1: Opaque.+    opacity :: Double,+    -- | Uses 'layoutSetWidth' if set.+    width :: Maybe Width,+    -- | Uses 'layoutSetWrap' if set.+    wrapMode :: Maybe LayoutWrapMode,+    -- | Uses 'layoutSetJustify' if set.+    justify :: Maybe Bool,+    -- | Uses 'layoutSetAlignment' if set.+    alignment :: Maybe LayoutAlignment,+    -- | Uses 'layoutSetSpacing' if set.+    lineSpacing :: Maybe Double,+    -- | Uses 'layoutSetTabs' if set.+    tabs :: Maybe [TabPosition],+    -- | Uses 'layoutSetSingleParagraphMode' if set.+    singleParagraphMode :: Maybe Bool,+    -- | The actual text+    tcText :: PangoText+}++data Width = Unlimited -- ^ The layout will be as wide as necessary to hold all the lines without wrapping+           | Width Double -- ^ The layout will be wrapped (according to 'wrapMode') to the given width in Pango units +    deriving(Show,Eq)++unsup :: String -> t+unsup s = error (s ++ " unsupported for Graphics.Aosd.Pango.Width")++-- | Supports only 'fromInteger'.+instance Num Width where+    fromInteger = Width . fromIntegral+    (+) = unsup "(+)"+    (*) = unsup "(*)"+    abs = unsup "abs"+    signum = unsup "signum"+    (-) = unsup "(-)"+    negate = unsup "negate"++-- | Supports only 'fromRational'.+instance Fractional Width where+    fromRational = Width . fromRational+    (/) = unsup "/"+    recip = unsup "recip"++++-- | Construct a 'TextConf' with most fields set to 'Nothing'+textRenderer :: PangoText -> TextRenderer+textRenderer t = TextRenderer {+    colour = green,+    opacity = 1,+    width = Nothing,+    wrapMode = Nothing,+    justify = Nothing,+    alignment = Nothing,+    lineSpacing = Nothing,+    tabs = Nothing,+    singleParagraphMode = Nothing,+    tcText = t+ }++-- | Plain text or some Pango markup. Suggestion: Use &#123;-\# LANGUAGE OverloadedStrings \#-&#125;.+data PangoText = PlainText ShowS+               | PangoMarkup ShowS +               | Empty++toMarkup :: PangoText -> ShowS+toMarkup (PlainText s) = showString (escapeMarkup (s ""))+toMarkup (PangoMarkup s) = s+toMarkup Empty = mempty++-- | Uses 'pText' (not 'pRaw'). +instance IsString PangoText where+    fromString = pText++instance Monoid PangoText where+    mempty = Empty+    mappend Empty x2 = x2+    mappend x1 Empty = x1+    mappend (PlainText s1) (PlainText s2) = PlainText (s1 . s2) +    mappend x1 x2 = PangoMarkup (toMarkup x1 . toMarkup x2)++instance Show PangoText where+    showsPrec _ Empty = showString "pEmpty"+    showsPrec prec (PlainText s) = showParen (prec >= 11) (showString "pText " . shows (s ""))+    showsPrec prec (PangoMarkup s) = showParen (prec >= 11) (showString "pRaw " . shows (s ""))++pEmpty :: PangoText+pEmpty = Empty++-- | Raw Pango markup, see <http://developer.gnome.org/pango/stable/PangoMarkupFormat.html>.+pRaw :: String -> PangoText+pRaw = PangoMarkup . showString++-- | Plain text.+pText :: String -> PangoText+pText = PlainText . showString++pSpan :: [SpanAttribute] -> PangoText -> PangoText+pSpan (attrs :: [SpanAttribute]) inner = PangoMarkup it+     where+       it = -- adapted from 'Graphics.Rendering.Pango.Markup.markSpan'+            showString "<span" .+                    foldr (.) (showChar '>') (map shows attrs) .+                    toMarkup inner .+                    showString "</span>"++pIntercalate :: PangoText -> [PangoText] -> PangoText+pIntercalate x = mconcat . intersperse x++pUnlines :: [PangoText] -> PangoText+pUnlines = pIntercalate (pText "\n")++pUnwords :: [PangoText] -> PangoText+pUnwords = pIntercalate (pText " ")++pShow :: Show a => a -> PangoText+pShow = pText . show++-- | Set font size in points+pSized :: Double -> PangoText -> PangoText+pSized pt = pSpan [FontSize (SizePoint pt)]++pTag :: String -- ^ Tag name+        -> PangoText -> PangoText+pTag tagName inner = PangoMarkup $ +    showChar '<' . showString tagName . showChar '>' . +    toMarkup inner . +    showString "</" . showString tagName . showChar '>' ++pBold :: PangoText -> PangoText+pBold = pTag "b"+pBig :: PangoText -> PangoText+pBig = pTag "big"+pItalic :: PangoText -> PangoText+pItalic = pTag "i"+pStrikethrough :: PangoText -> PangoText+pStrikethrough = pTag "s"+++-- | Subscript+pSub :: PangoText -> PangoText+pSub = pTag "sub"++-- | Superscript+pSup :: PangoText -> PangoText+pSup = pTag "sup"+	+pSmall :: PangoText -> PangoText+pSmall = pTag "small"+	+-- | Monospace font+pMono :: PangoText -> PangoText+pMono = pTag "tt"+	++-- | Underline +pUnderline :: PangoText -> PangoText+pUnderline = pTag "u"+	+++++    +                                   +layoutSetWidth' :: PangoLayout -> Width -> IO ()+layoutSetWidth' layout w = layoutSetWidth layout (case w of+                                                       Unlimited -> Nothing+                                                       Width x -> Just x)++++instance AosdRenderer TextRenderer where+  toGeneralRenderer TextRenderer{..}  = do+    fm <- cairoFontMapGetDefault+    -- resolution <- cairoFontMapGetResolution fm+    cxt <- cairoCreateContext (Just fm)+    layout <- layoutEmpty cxt++    case tcText of+         Empty -> return ()+         PlainText s -> layoutSetText layout (s "") +         PangoMarkup s -> void (layoutSetMarkup layout (s ""))++    let go :: (PangoLayout -> a -> IO ()) -> Maybe a -> IO () +        go f = maybeDo (f layout)+        ++    go layoutSetWidth' width+    go layoutSetWrap wrapMode+    go layoutSetJustify justify+    go layoutSetAlignment alignment+    go layoutSetSpacing lineSpacing+    go layoutSetTabs tabs+    go layoutSetSingleParagraphMode singleParagraphMode+++    (grInkExtent,grPositioningExtent) <- layoutGetPixelExtents layout+    let render = do+            --updateLayout layout -- No idea when this is neccessary+            setSourceColour colour opacity+            showLayout layout+++    return GeneralRenderer { grInkExtent, grPositioningExtent, grRender = render } ++++++-- getSize l = do+--     -- (ink,logical)+--     a@(Rectangle xi yi wi hi, Rectangle xl yl wl hl) <- layoutGetPixelExtents l+-- +--     --     print ("ink",fst a)+--     --     print ("logical",snd a)+-- +--     let w = max (xi+wi) (xl+wl)+--         h = max (yi+hi) (yl+hl)+-- +-- +--     return (fi w, fi h)+-- +--   where+--     fi = fromIntegral+-- +--
+ Graphics/Aosd/Util.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE ViewPatterns, NoMonomorphismRestriction #-}+module Graphics.Aosd.Util where+import Graphics.Rendering.Pango.Enums+import Control.Arrow+import Data.Colour.SRGB+import Graphics.Rendering.Cairo++maybeDo :: Monad m => (a -> m ()) -> Maybe a -> m ()+maybeDo f = maybe (return ()) f++(^+^) ::  (Num t) => (t, t) -> (t, t) -> (t, t)+(x,y) ^+^ (x',y') = (x+x',y+y')++negate2 :: (Num t) => (t, t) -> (t, t)+negate2 (x,y) = (-x,-y)++(^-^) ::  (Num t) => (t, t) -> (t, t) -> (t, t)+v ^-^ w = v ^+^ negate2 w++fi :: (Num b, Integral a) => a -> b+fi = fromIntegral++rectLeft :: Rectangle -> Int+rectLeft (Rectangle a _ _ _) = a +rectTop :: Rectangle -> Int+rectTop (Rectangle _ a _ _) = a +rectWidth :: Rectangle -> Int+rectWidth (Rectangle _ _ a _) = a +rectHeight :: Rectangle -> Int+rectHeight (Rectangle _ _ _ a) = a ++rectRight :: Rectangle -> Int+rectRight r = rectLeft r + rectWidth r+rectBottom :: Rectangle -> Int+rectBottom r = rectTop r + rectHeight r++rectLeftTop :: Rectangle -> (Int, Int)+rectLeftTop = rectLeft &&& rectTop++rectSize :: Rectangle -> (Int, Int)+rectSize = rectWidth &&& rectHeight++max2 :: (Ord t, Ord t1) => (t, t) -> (t1, t1) -> (t, t1)+max2 (x,y) (x',y') = (max x y, max x' y')++min2 :: (Ord t, Ord t1) => (t, t) -> (t1, t1) -> (t, t1)+min2 (x,y) (x',y') = (min x y, min x' y')++rectDiff :: Rectangle -> Rectangle -> Rectangle+rectDiff (Rectangle a b c d) (Rectangle a' b' c' d') = Rectangle (a-a') (b-b') (c-c') (d-d')++scale2 :: Num t => t -> (t, t) -> (t, t)+scale2 s (x,y) = (s*x,s*y)++fi2 :: (Integral a, Num b) => (a,a) -> (b,b)+fi2 = fi *** fi++rectCenterX :: Rectangle -> Rational+rectCenterX r = fi (2 * rectRight r + rectWidth r) / 2+rectCenterY :: Rectangle -> Rational+rectCenterY r = fi (2 * rectTop r + rectHeight r) / 2++setSourceColour :: Colour Double -> Double -> Render ()+setSourceColour (toSRGB -> RGB r g b) a = setSourceRGBA r g b a+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Daniel Schüssler++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Daniel Schüssler nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ aosd.cabal view
@@ -0,0 +1,57 @@+-- aosd.cabal auto-generated by cabal init. For additional options,+-- see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+Name:                aosd+Version:             0.1+Synopsis:            Bindings to libaosd, a library for Cairo-based on-screen displays+Description:         + <http://www.atheme.org/project/libaosd>+ .+ @An advanced on screen display (OSD) library, which uses Cairo to create high quality rendered graphics to be overlaid on top of the screen.@+ .+ Example:+ .+ @+ &#123;-\# LANGUAGE OverloadedStrings \#-&#125;+ import "Graphics.Aosd.Pango"+ .+ markup = pSized 50 (pUnlines [pItalic \"AOSD\",\"Example\"])+ .+ main = aosdFlash + \           defaultOpts + \           (textRenderer markup) &#123; alignment = Just AlignCenter, colour = orange &#125; + \           (symDurations 3000 3000)+ @++License:             BSD3+License-file:        LICENSE+Author:              Daniel Schüssler+Maintainer:          anotheraddress@gmx.de+-- Copyright:           +Category:            Graphics+Build-type:          Simple+Extra-source-files:  test/test.hs+Cabal-version:       >=1.10++Library+  Default-Extensions: ForeignFunctionInterface+  Exposed-modules: +    Graphics.Aosd.AOSD_H +    Graphics.Aosd+    Graphics.Aosd.Pango+  Other-modules:       +    Graphics.Aosd.Util+++  Build-depends:       colour, transformers, X11, base >= 4 && < 5, bindings-DSL >= 1.0.11, cairo >= 0.12, pango >= 0.12 +  Build-tools:         hsc2hs+  Pkgconfig-depends:   libaosd, libaosd-text+  Default-language: Haskell2010++Test-Suite test-aosd+    type:       exitcode-stdio-1.0+    hs-source-dirs: test+    main-is:    test.hs+    Build-depends:       colour, base,aosd,pango,language-haskell-extract,template-haskell+    Default-language: Haskell2010+    ghc-options: -threaded
+ test/test.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE NoMonomorphismRestriction, StandaloneDeriving, OverloadedStrings, NamedFieldPuns, TemplateHaskell, RecordWildCards #-}+import Graphics.Aosd.Pango+import Control.Monad+import Control.Concurrent+import Data.Monoid+import Language.Haskell.TH+import Language.Haskell.Extract+import Data.Functor+import Graphics.Rendering.Pango.Enums++deriving instance Show LayoutAlignment+deriving instance Show LayoutWrapMode++main = mapM_ run ( $(functionExtractor "Test$") :: [(String,IO ())] )+    where+        run :: (String,IO()) -> IO ()+        run (n,a) = do+            putStrLn ("Running "++n)+            header <- aosdNew (defaultOpts { yPos = Min, offset = (0,100) }) (textRenderer (pText n))+            aosdShow header+            aosdRender header+            aosdLoopOnce header+            a+            aosdHide header+            aosdLoopOnce header++go t r = aosdFlash defaultOpts r (symDurations 100 t) +goText t f pm = go t (f (textRenderer pm))++tagsMarkup = pUnlines $(listE [ appE (varE (mkName n)) (litE (stringL n)) | n <- words "pBold pBig pItalic pStrikethrough pSmall pSub pSup pUnderline pMono"]) ++tagsTest = goText 7000 (\x -> x { colour=green }) tagsMarkup +++-- catTest = do+--     go 3000 (HCat (textRenderer "Horizontal") (textRenderer "Cat"))+--     go 3000 (VCat (textRenderer "Vertical") (textRenderer "Cat"))+++alignmentsTest = do+    sequence_ [ goText 2000 (\x -> x { width = Just width, +                                       wrapMode = wrap, +                                       alignment = Just al, +                                       colour = magenta }) ++                    (pSized 14 $ pUnlines [ pText firstLine +                              , pShow width+                              , pShow wrap+                              , pShow al]) ++              | al <- [AlignLeft, AlignRight, AlignCenter], +                firstLine <- flip replicate 'o' <$> [5,80],+                (width,wrap) <- [(Unlimited,Nothing) ,+                                 (100,Just WrapWholeWords) ,+                                 (100,Just WrapAnywhere)+                                 ] +              +              +              ]+++leftOverflowTest =+    sequence_ [ do+                 print ("xPos",xPos)+                 aosdFlash +                    (defaultOpts {xPos}) +                    (textRenderer txt) +                        { alignment = Just AlignRight, width = Just 300, wrapMode = Just WrapWholeWords } +                    (symDurations 100 3000)+               | xPos <- [Center,Min,Max] ]++ where+    txt0 = "LeftOverflow"+    txt = pSized 24 (pBold "LeftEnd" `mappend` +                     pText (concat (replicate 4 txt0)) `mappend`+                     pBold "RightEnd"+                    )+++sizesTest = do+    goText 2000 id $ mconcat [ pSpan [FontSize s] (pText (show s)) | s <- [ SizeSmall, SizeMedium, SizeLarge, SizeHuge, SizeGiant, SizePoint 12 ] ]++singleParagraphModeTest = do+    goText 1000 (\x -> x { singleParagraphMode = Just True }) (pText . unlines . words $ "single paragraph mode")+     +dur = 5000++posTest = forEachPos f+    where+        f xPos yPos = do+                    let tr = (textRenderer (pText $ show (xPos,yPos))) { colour = red } +                    aosdFlash defaultOpts { xPos, yPos } tr (symDurations 500 dur)  ++forEachPos f = do++    sequence [ forkOS $ f xPos yPos ++              | (xPos,yPos) <- join (liftM2 (,)) [minBound..maxBound]+             ]++    threadDelay ((fromIntegral dur+1000)*1000)++    +    --mapM f strings++--f s = flashText defaultTextConf s (symDurations 200 200)++prStatus = liftIO . print =<< status+++circleTest = forEachPos doCircle++doCircle xPos yPos = aosdFlash defaultOpts { xPos, yPos } GeneralRenderer{..} (symDurations 100 2000)+    where+        grInkExtent = Rectangle (-r) (-r) (2*r) (2*r)+        grPositioningExtent = Rectangle (-r_half) (-r_half) r r ++        r_half = 50++        r = 2*r_half++        lw = 10++        grRender = do+            setSourceRGBA 0 1 1 1+            setLineWidth lw+            arc 0 0 (r-lw) 0 (2*pi)+            stroke+            setSourceRGBA 1 0 1 1+            setLineWidth 2+            arc 0 0 (r_half-2) 0 (2*pi)+            stroke+            prStatus++transparencyTest = goText 3000 (\s -> s { colour = lime, opacity = 0.5 }) +                    (pSized 100 "Transparency")