aosd 0.2.1 → 0.2.2
raw patch · 8 files changed
+71/−65 lines, 8 files
Files
- Graphics/Aosd.hs +9/−9
- Graphics/Aosd/AOSD_H.hsc +3/−3
- Graphics/Aosd/CallbackUtil.hs +9/−9
- Graphics/Aosd/Pango.hs +32/−31
- Graphics/Aosd/Renderer.hs +1/−1
- Graphics/Aosd/Util.hs +8/−8
- aosd.cabal +5/−4
- changelog.markdown +4/−0
Graphics/Aosd.hs view
@@ -112,7 +112,7 @@ -- | Must *NOT* access the aosdStructOwnedDataVar of the AosdPtr argument (-> deadlock). reconfigure0 :: (AosdRenderer renderer) => AosdOptions -> renderer -> AosdPtr -> IO AosdStructOwnedData-reconfigure0 AosdOptions{..} renderer aosd@AosdPtr {unAosdPtr=ptr, display} = +reconfigure0 AosdOptions{..} renderer aosd@AosdPtr {unAosdPtr=ptr, display} = do GeneralRenderer{..} <- toGeneralRenderer renderer @@ -142,7 +142,7 @@ maybeDo (setClassHint ptr) classHint maybeDo (setHideUponMouseEvent ptr) hideUponMouseEvent- + rendererPtr <- setRenderer ptr finalRenderer handlerPtr <- traverseMaybe (setMouseEventCB aosd) mouseEventCB @@ -212,7 +212,7 @@ aosdNew :: (AosdRenderer renderer) => AosdOptions -> renderer -> IO AosdPtr aosdNew opts r = do- aosd <- aosdNew0 + aosd <- aosdNew0 z <- reconfigure0 opts r aosd modifyMVar_ (aosdStructOwnedDataVar aosd) (\x -> assert (isNothing x) $ return (Just z)) @@ -234,7 +234,7 @@ return (Just zNew)) wrapAosd :: (Ptr C'Aosd -> c) -> AosdPtr -> c-wrapAosd f = f . unAosdPtr +wrapAosd f = f . unAosdPtr aosdRender :: AosdPtr -> IO () aosdRender = wrapAosd c'aosd_render@@ -255,9 +255,9 @@ aosdLoopFor a millis = wrapAosd (flip c'aosd_loop_for millis) a -data AosdStructOwnedData = - AosdStructOwnedData - !(StablePtr (Cairo -> IO ())) +data AosdStructOwnedData =+ AosdStructOwnedData+ !(StablePtr (Cairo -> IO ())) !(Maybe (StablePtr (Ptr C'AosdMouseEvent -> IO()))) @@ -268,7 +268,7 @@ maybeDo (freeStablePtrDebug cxt "mouse event handler") sp_h aosdDestroy :: AosdPtr -> IO ()-aosdDestroy AosdPtr {unAosdPtr, aosdStructOwnedDataVar, display} = +aosdDestroy AosdPtr {unAosdPtr, aosdStructOwnedDataVar, display} = modifyMVar_ aosdStructOwnedDataVar $ \z -> do c'aosd_destroy_debug "aosdDestroy" unAosdPtr maybeDo (freeAosdStructOwnedData "aosdDestroy") z@@ -276,6 +276,6 @@ return Nothing --- | 'aosdNew'/'aosdDestroy' bracket. Leaking the 'AosdPtr' out of the third argument leads to undefined behaviour. +-- | 'aosdNew'/'aosdDestroy' bracket. Leaking the 'AosdPtr' out of the third argument leads to undefined behaviour. withAosd :: AosdRenderer renderer => AosdOptions -> renderer -> (AosdPtr -> IO c) -> IO c withAosd opts ren = bracket (aosdNew opts ren) aosdDestroy
Graphics/Aosd/AOSD_H.hsc view
@@ -11,7 +11,7 @@ #opaque_t Aosd -#integral_t AosdCoordinate +#integral_t AosdCoordinate #num COORDINATE_MINIMUM #num COORDINATE_CENTER #num COORDINATE_MAXIMUM@@ -38,9 +38,9 @@ #field res_class, CString #stoptype -#ccall aosd_new, IO (Ptr <Aosd>) +#ccall aosd_new, IO (Ptr <Aosd>) #ccall aosd_destroy, Ptr <Aosd> -> IO ()- + -- * object configurators #ccall aosd_set_name, Ptr <Aosd> -> Ptr <XClassHint> -> IO ()
Graphics/Aosd/CallbackUtil.hs view
@@ -15,22 +15,22 @@ -- delegates the @a@ to that @a -> IO ()@. newtype UniversalCallback a = UniversalCallback (FunPtr (Callback a)) -mkUniversalCallback :: forall a. - (Callback a -> IO (FunPtr (Callback a))) - -- ^ Should be something obtained from a @foreign import ccall \"wrapper\" ...@ declaration +mkUniversalCallback :: forall a.+ (Callback a -> IO (FunPtr (Callback a)))+ -- ^ Should be something obtained from a @foreign import ccall \"wrapper\" ...@ declaration -> IO (UniversalCallback a)-mkUniversalCallback foreignImportWrapper = +mkUniversalCallback foreignImportWrapper = UniversalCallback `fmap` foreignImportWrapper universalCallback universalCallback :: a -> Ptr () -> IO () universalCallback a userData = do- handler <- deRefStablePtr (castPtrToStablePtr userData) :: IO (a -> IO ()) + handler <- deRefStablePtr (castPtrToStablePtr userData) :: IO (a -> IO ()) handler a -tunnelCallback :: - UniversalCallback a - -> (FunPtr (Callback a) -> UserData -> IO ()) -- ^ The C-imported callback setter function - -> (a -> IO ()) -- ^ The haskell function you want to be called back +tunnelCallback ::+ UniversalCallback a+ -> (FunPtr (Callback a) -> UserData -> IO ()) -- ^ The C-imported callback setter function+ -> (a -> IO ()) -- ^ The haskell function you want to be called back -> IO (StablePtr (a -> IO ())) -- ^ Returns a StablePtr which needs to be freed once the callback is no longer used tunnelCallback (UniversalCallback u) setCallback haskellCallback = do
Graphics/Aosd/Pango.hs view
@@ -26,8 +26,8 @@ module Data.Monoid, module Data.Colour.Names - - ++ ) where import Graphics.Aosd hiding(width)@@ -69,7 +69,7 @@ } 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 + | Width Double -- ^ The layout will be wrapped (according to 'wrapMode') to the given width in Pango units deriving(Show,Eq) unsup :: String -> t@@ -110,7 +110,7 @@ -- | Plain text or some Pango markup. Suggestion: Use {-\# LANGUAGE OverloadedStrings \#-}. data PangoText = PlainText ShowS- | PangoMarkup ShowS + | PangoMarkup ShowS | Empty toMarkup :: PangoText -> ShowS@@ -118,15 +118,18 @@ toMarkup (PangoMarkup s) = s toMarkup Empty = mempty --- | Uses 'pText' (not 'pRaw'). +-- | Uses 'pText' (not 'pRaw'). instance IsString PangoText where fromString = pText +instance Semigroup PangoText where+ (<>) = mappend+ instance Monoid PangoText where mempty = Empty mappend Empty x2 = x2 mappend x1 Empty = x1- mappend (PlainText s1) (PlainText s2) = PlainText (s1 . s2) + mappend (PlainText s1) (PlainText s2) = PlainText (s1 . s2) mappend x1 x2 = PangoMarkup (toMarkup x1 . toMarkup x2) instance Show PangoText where@@ -172,10 +175,10 @@ pTag :: String -- ^ Tag name -> PangoText -> PangoText-pTag tagName inner = PangoMarkup $ - showChar '<' . showString tagName . showChar '>' . - toMarkup inner . - showString "</" . showString tagName . showChar '>' +pTag tagName inner = PangoMarkup $+ showChar '<' . showString tagName . showChar '>' .+ toMarkup inner .+ showString "</" . showString tagName . showChar '>' pBold :: PangoText -> PangoText pBold = pTag "b"@@ -194,32 +197,30 @@ -- | Superscript pSup :: PangoText -> PangoText pSup = pTag "sup"- + pSmall :: PangoText -> PangoText pSmall = pTag "small"- + -- | Monospace font pMono :: PangoText -> PangoText pMono = pTag "tt"- --- | Underline ++-- | 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@@ -229,13 +230,13 @@ case tcText of Empty -> return ()- PlainText s -> layoutSetText layout (s "") - PangoMarkup s -> void (layoutSetMarkup layout (s ""))+ PlainText s -> layoutSetText layout (s "")+ PangoMarkup s -> void (layoutSetMarkup layout (s "") :: IO String) - let go :: (PangoLayout -> a -> IO ()) -> Maybe a -> IO () + let go :: (PangoLayout -> a -> IO ()) -> Maybe a -> IO () go f = maybeDo (f layout)- + go layoutSetWidth' width go layoutSetWrap wrapMode go layoutSetJustify justify@@ -252,7 +253,7 @@ showLayout layout - return GeneralRenderer { grInkExtent, grPositioningExtent, grRender = render } + return GeneralRenderer { grInkExtent, grPositioningExtent, grRender = render } @@ -261,17 +262,17 @@ -- 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/Renderer.hs view
@@ -23,7 +23,7 @@ -- (Likewise for the /y/ axis) grPositioningExtent :: Rectangle }- + instance AosdRenderer GeneralRenderer where toGeneralRenderer = return
Graphics/Aosd/Util.hs view
@@ -32,13 +32,13 @@ fi = fromIntegral rectLeft :: Rectangle -> Int-rectLeft (Rectangle a _ _ _) = a +rectLeft (Rectangle a _ _ _) = a rectTop :: Rectangle -> Int-rectTop (Rectangle _ a _ _) = a +rectTop (Rectangle _ a _ _) = a rectWidth :: Rectangle -> Int-rectWidth (Rectangle _ _ a _) = a +rectWidth (Rectangle _ _ a _) = a rectHeight :: Rectangle -> Int-rectHeight (Rectangle _ _ _ a) = a +rectHeight (Rectangle _ _ _ a) = a rectRight :: Rectangle -> Int rectRight r = rectLeft r + rectWidth r@@ -94,19 +94,19 @@ newStablePtrDebug :: String -> String -> a -> IO (StablePtr a) newStablePtrDebug cxt descr a = do sp <- newStablePtr a- putDebugMemory cxt ("Created "++descr++" StablePtr: "++showStablePtr sp) + putDebugMemory cxt ("Created "++descr++" StablePtr: "++showStablePtr sp) return sp freeStablePtrDebug :: String -> String -> StablePtr a -> IO () freeStablePtrDebug cxt descr sp = do- putDebugMemory cxt ("Freeing "++descr++" StablePtr: "++showStablePtr sp) + putDebugMemory cxt ("Freeing "++descr++" StablePtr: "++showStablePtr sp) freeStablePtr sp newForeignPtrDebug :: String -> String -> IO () -> Ptr a -> IO (ForeignPtr a) newForeignPtrDebug cxt descr finalizer p = do- fp <- newForeignPtr p + fp <- newForeignPtr p (do- putDebugMemory "ForeignPtr finalizer" ("Finalizing "++descr++" ForeignPtr made in "++cxt) + putDebugMemory "ForeignPtr finalizer" ("Finalizing "++descr++" ForeignPtr made in "++cxt) finalizer) putDebugMemory cxt ("Created "++descr++" ForeignPtr: "++show fp) return fp
aosd.cabal view
@@ -2,7 +2,7 @@ -- see -- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. Name: aosd-Version: 0.2.1+Version: 0.2.2 Synopsis: Bindings to libaosd, a library for Cairo-based on-screen displays Description: <http://www.atheme.org/project/libaosd>@@ -23,7 +23,7 @@ . main = do \ withAosd- \ defaultOpts + \ defaultOpts \ (textRenderer markup) { alignment = Just AlignCenter, colour = orange } \ (\a -> aosdFlash a (symDurations 3000 3000)) @@@ -39,10 +39,11 @@ Build-type: Simple Extra-source-files: test/test.hs Cabal-version: >=1.10+extra-source-files: changelog.markdown source-repository head- type: hg- location: https://dschuessler@bitbucket.org/dschuessler/haskell-aosd+ type: git+ location: https://github.com/DanielSchuessler/haskell-aosd Flag DebugMemory Default: False
+ changelog.markdown view
@@ -0,0 +1,4 @@+## 0.2.2++* Fixed build with GHC 8.6.5 (Thanks to Allen Haim)+* Converted Repository to git and migrated project to Github