diff --git a/Graphics/UI/Gtk.chs b/Graphics/UI/Gtk.chs --- a/Graphics/UI/Gtk.chs +++ b/Graphics/UI/Gtk.chs @@ -217,6 +217,9 @@ module Graphics.UI.Gtk.Layout.HPaned, module Graphics.UI.Gtk.Layout.Layout, module Graphics.UI.Gtk.Layout.Notebook, +#if GTK_MAJOR_VERSION >= 3 + module Graphics.UI.Gtk.Layout.Overlay, +#endif module Graphics.UI.Gtk.Layout.Expander, module Graphics.UI.Gtk.Layout.Table, module Graphics.UI.Gtk.Layout.VBox, @@ -474,6 +477,9 @@ import Graphics.UI.Gtk.Layout.VPaned import Graphics.UI.Gtk.Layout.Layout import Graphics.UI.Gtk.Layout.Notebook +#if GTK_MAJOR_VERSION >= 3 +import Graphics.UI.Gtk.Layout.Overlay +#endif import Graphics.UI.Gtk.Layout.Expander import Graphics.UI.Gtk.Layout.Table -- ornaments diff --git a/Graphics/UI/Gtk/Abstract/Widget.chs b/Graphics/UI/Gtk/Abstract/Widget.chs --- a/Graphics/UI/Gtk/Abstract/Widget.chs +++ b/Graphics/UI/Gtk/Abstract/Widget.chs @@ -248,7 +248,12 @@ widgetParent, widgetWidthRequest, widgetHeightRequest, + widgetMarginLeft, + widgetMarginRight, + widgetMarginTop, + widgetMarginBottom, widgetVisible, + widgetOpacity, widgetSensitive, widgetAppPaintable, widgetCanFocus, @@ -2364,6 +2369,18 @@ widgetName :: WidgetClass self => Attr self (Maybe String) widgetName = newAttrFromMaybeStringProperty "name" +widgetMarginLeft :: WidgetClass self => Attr self Int +widgetMarginLeft = newAttrFromIntProperty "margin-left" + +widgetMarginRight :: WidgetClass self => Attr self Int +widgetMarginRight = newAttrFromIntProperty "margin-right" + +widgetMarginTop :: WidgetClass self => Attr self Int +widgetMarginTop = newAttrFromIntProperty "margin-top" + +widgetMarginBottom :: WidgetClass self => Attr self Int +widgetMarginBottom = newAttrFromIntProperty "margin-bottom" + -- %hash c:1533 d:3213 -- | The parent widget of this widget. Must be a Container widget. -- @@ -2399,6 +2416,13 @@ -- widgetVisible :: WidgetClass self => Attr self Bool widgetVisible = newAttrFromBoolProperty "visible" + +-- | The opacity of the widget +-- +-- Default value: @1.0@ +-- +widgetOpacity :: WidgetClass self => Attr self Double +widgetOpacity = newAttrFromDoubleProperty "opacity" -- %hash c:4dd4 d:594e -- | Whether the widget responds to input. diff --git a/Graphics/UI/Gtk/Gdk/EventM.hsc b/Graphics/UI/Gtk/Gdk/EventM.hsc --- a/Graphics/UI/Gtk/Gdk/EventM.hsc +++ b/Graphics/UI/Gtk/Gdk/EventM.hsc @@ -123,6 +123,7 @@ eventRootCoordinates, eventModifier, eventModifierAll, + eventModifierMouse, eventTime, eventKeyVal, eventKeyName, @@ -359,23 +360,35 @@ -- | Query the modifier keys that were depressed when the event happened. -- Sticky modifiers such as CapsLock are omitted in the return value. -- Use 'eventModifierAll' your application requires all modifiers. +-- Use 'eventModifierMouse' if you just need the mouse buttons. -- eventModifier :: HasModifier t => EventM t [Modifier] -eventModifier = eM False +eventModifier = eM defModMask -- | Query the modifier keys that were depressed when the event happened. -- The result includes sticky modifiers such as CapsLock. Normally, -- 'eventModifier' is more appropriate in applications. -- eventModifierAll :: HasModifier t => EventM t [Modifier] -eventModifierAll = eM True +eventModifierAll = eM allModMask +-- | Query the mouse buttons that were depressed when the event happened. +-- +eventModifierMouse :: HasModifier t => EventM t [Modifier] +eventModifierMouse = eM mouseModMask + +allModMask = -1 + foreign import ccall safe "gtk_accelerator_get_default_mod_mask" defModMask :: #gtk2hs_type guint -eM allModifs = do - let mask | allModifs = -1 - | otherwise = defModMask +mouseModMask = #{const GDK_BUTTON1_MASK} + .|. #{const GDK_BUTTON2_MASK} + .|. #{const GDK_BUTTON3_MASK} + .|. #{const GDK_BUTTON4_MASK} + .|. #{const GDK_BUTTON5_MASK} + +eM mask = do ptr <- ask liftIO $ do (ty :: #{gtk2hs_type GdkEventType}) <- peek (castPtr ptr) diff --git a/Graphics/UI/Gtk/Gdk/Pixbuf.chs b/Graphics/UI/Gtk/Gdk/Pixbuf.chs --- a/Graphics/UI/Gtk/Gdk/Pixbuf.chs +++ b/Graphics/UI/Gtk/Gdk/Pixbuf.chs @@ -77,6 +77,9 @@ #if GTK_CHECK_VERSION(2,6,0) pixbufNewFromFileAtScale, #endif +#if GTK_CHECK_VERSION(3,0,0) + pixbufNewFromSurface, +#endif pixbufNewFromInline, InlineImage, pixbufNewSubpixbuf, @@ -133,6 +136,8 @@ #if GTK_MAJOR_VERSION < 3 import Graphics.UI.Gtk.Gdk.Pixmap (Bitmap, Pixmap) #endif +import Graphics.Rendering.Cairo +import Graphics.Rendering.Cairo.Types {# context prefix="gdk" #} @@ -345,6 +350,23 @@ (fromIntegral height) (fromBool preserveAspectRatio) errPtrPtr +#endif + +#if GTK_CHECK_VERSION(3,0,0) +-- | Creates a new pixbuf from a cairo Surface. +-- +-- Transfers image data from a cairo Surface and converts it to an RGB(A) representation inside a Pixbuf. This allows you to efficiently read individual pixels from cairo surfaces. For GdkWindows, use gdk_pixbuf_get_from_window() instead. +-- +-- This function will create an RGB pixbuf with 8 bits per channel. The pixbuf will contain an alpha channel if the surface contains one. +pixbufNewFromSurface :: Surface -> Int -> Int -> Int -> Int -> IO Pixbuf +pixbufNewFromSurface surface srcX srcY width height = + withSurface surface $ \ss -> wrapNewGObject mkPixbuf $ + {# call gdk_pixbuf_get_from_surface #} + (castPtr ss) + (fromIntegral srcX) + (fromIntegral srcY) + (fromIntegral width) + (fromIntegral height) #endif -- | A string representing an image file format. diff --git a/Graphics/UI/Gtk/Layout/Overlay.chs b/Graphics/UI/Gtk/Layout/Overlay.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Layout/Overlay.chs @@ -0,0 +1,81 @@ +{-# LANGUAGE CPP #-} +-- -*-haskell-*- +-- GTK3 Widget Overlay +-- +-- Author : Vincent Hanquez +-- +-- Created: 15 May 2014 +-- +-- Copyright (C) 2014 Vincent Hanquez +-- Copyright (C) 1999-2005 Axel Simon +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk2hs-users@lists.sourceforge.net +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +-- A simple container that can display overlayed widgets +-- +module Graphics.UI.Gtk.Layout.Overlay ( +-- * Detail +-- +-- | The Overlay widget is a Bin widget where widgets can be added as overlay of the bin widget. + +-- * Class Hierarchy +-- | +-- @ +-- | 'GObject' +-- | +----'Object' +-- | +----'Widget' +-- | +----'Container' +-- | +----'Bin' +-- | +----Overlay +-- @ + +-- * Types + Overlay, + OverlayClass, + castToOverlay, gTypeOverlay, + toOverlay, + +-- * Constructors + overlayNew, + overlayAdd + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +{#import Graphics.UI.Gtk.Types#} + +{# context lib="gtk" prefix="gtk" #} + +-------------------- +-- Constructors + +-- | Create a new 'Overlay' +-- +overlayNew :: IO Overlay +overlayNew = + makeNewObject mkOverlay $ + liftM (castPtr :: Ptr Widget -> Ptr Overlay) $ + {# call unsafe overlay_new #} + +overlayAdd :: (OverlayClass self, WidgetClass widget) => self + -> widget -- ^ @widget@ - a widget to be placed as overlay + -> IO () +overlayAdd self widget = + {# call unsafe overlay_add_overlay #} + (toOverlay self) + (toWidget widget) diff --git a/Graphics/UI/Gtk/Types.chs b/Graphics/UI/Gtk/Types.chs --- a/Graphics/UI/Gtk/Types.chs +++ b/Graphics/UI/Gtk/Types.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} -- -*-haskell-*- -- -------------------- automatically generated file - do not edit ---------- @@ -276,6 +277,10 @@ toSeparatorMenuItem, mkSeparatorMenuItem, unSeparatorMenuItem, castToSeparatorMenuItem, gTypeSeparatorMenuItem, + Overlay(Overlay), OverlayClass, + toOverlay, + mkOverlay, unOverlay, + castToOverlay, gTypeOverlay, Window(Window), WindowClass, toWindow, mkWindow, unWindow, @@ -2232,6 +2237,32 @@ gTypeSeparatorMenuItem :: GType gTypeSeparatorMenuItem = {# call fun unsafe gtk_separator_menu_item_get_type #} + +-- ******************************************************************** Overlay + +{#pointer *GtkOverlay as Overlay foreign newtype #} deriving (Eq,Ord) + +mkOverlay = (Overlay, objectUnrefFromMainloop) +unOverlay (Overlay o) = o + +class BinClass o => OverlayClass o +toOverlay :: OverlayClass o => o -> Overlay +toOverlay = unsafeCastGObject . toGObject + +instance OverlayClass Overlay +instance BinClass Overlay +instance ContainerClass Overlay +instance WidgetClass Overlay +instance GObjectClass Overlay where + toGObject = GObject . castForeignPtr . unOverlay + unsafeCastGObject = Overlay . castForeignPtr . unGObject + +castToOverlay :: GObjectClass obj => obj -> Overlay +castToOverlay = castTo gTypeOverlay "Overlay" + +gTypeOverlay :: GType +gTypeOverlay = + {# call fun unsafe gtk_overlay_get_type #} -- ********************************************************************* Window diff --git a/demo/overlay/Overlay.hs b/demo/overlay/Overlay.hs new file mode 100644 --- /dev/null +++ b/demo/overlay/Overlay.hs @@ -0,0 +1,63 @@ +module Main (main) where + +import Graphics.UI.Gtk +import Control.Monad.IO.Class (liftIO) + +main :: IO () +main = do + initGUI + + -- Create a new window + window <- windowNew + + -- Here we connect the "destroy" event to a signal handler. + on window objectDestroy mainQuit + + -- Sets the border width of the window. + set window [ containerBorderWidth := 10 ] + + overlay <- overlayNew + + set window [ containerChild := overlay ] + + vbox <- vBoxNew True 3 + label1 <- labelNew (Just "This is an overlayed label") + button <- buttonNewWithLabel ("another one") + label3 <- labelNew (Just "and a final one") + boxPackStart vbox label1 PackNatural 3 + boxPackStart vbox button PackNatural 3 + boxPackStart vbox label3 PackNatural 3 + + set vbox [ widgetMarginLeft := 150, widgetMarginBottom := 50 ] + + overlayAdd overlay vbox + + hbuttonbox <- hButtonBoxNew + + containerAdd overlay hbuttonbox + + button1 <- buttonNewWithLabel "One" + button2 <- buttonNewWithLabel "Two" + button3 <- buttonNewWithLabel "Three" + + -- Add each button to the button box with the default packing and padding + set hbuttonbox [ containerChild := button + | button <- [button1, button2, button3] ] + + -- This sets button3 to be a so called 'secondary child'. When the layout + -- stlye is ButtonboxStart or ButtonboxEnd, the secondary children are + -- grouped seperately from the others. Resize the window to see the effect. + -- + -- This is not interesting in itself but shows how to set child attributes. + -- Note that the child attribute 'buttonBoxChildSecondary' takes the + -- button box container child 'button3' as a parameter. + set hbuttonbox [ buttonBoxLayoutStyle := ButtonboxStart ] + --, buttonBoxChildSecondary button3 := True ] + + -- The final step is to display everything (the window and all the widgets + -- contained within it) + widgetShowAll window + + -- All Gtk+ applications must run the main event loop. Control ends here and + -- waits for an event to occur (like a key press or mouse event). + mainGUI diff --git a/gtk3.cabal b/gtk3.cabal --- a/gtk3.cabal +++ b/gtk3.cabal @@ -1,5 +1,5 @@ Name: gtk3 -Version: 0.12.5.6 +Version: 0.12.5.7 License: LGPL-2.1 License-file: COPYING Copyright: (c) 2001-2010 The Gtk2Hs Team @@ -136,7 +136,7 @@ Library build-depends: base >= 4 && < 5, array, containers, mtl, bytestring, - glib >= 0.12.5.3 && < 0.13, + glib >= 0.12.5.4 && < 0.13, pango >= 0.12.5.3 && < 0.13, cairo >= 0.12.5.3 && < 0.13 if flag(have-gio) @@ -231,6 +231,7 @@ Graphics.UI.Gtk.Layout.HPaned Graphics.UI.Gtk.Layout.Layout Graphics.UI.Gtk.Layout.Notebook + Graphics.UI.Gtk.Layout.Overlay Graphics.UI.Gtk.Layout.Table Graphics.UI.Gtk.Layout.VBox Graphics.UI.Gtk.Layout.VButtonBox @@ -391,35 +392,35 @@ main-is: ActionMenu.hs if flag(build-demos) buildable: True - build-depends: gtk3==0.12.5.6, base, transformers + build-depends: gtk3==0.12.5.7, base, transformers Executable gtk2hs-demo-buttonBox hs-source-dirs: demo/buttonbox main-is: ButtonBox.hs if flag(build-demos) buildable: True - build-depends: gtk3==0.12.5.6, base, transformers + build-depends: gtk3==0.12.5.7, base, transformers Executable gtk2hs-demo-carsim hs-source-dirs: demo/carsim main-is: CarSim.hs if flag(build-demos) buildable: True - build-depends: gtk3==0.12.5.6, base, transformers, time, cairo + build-depends: gtk3==0.12.5.7, base, transformers, time, cairo Executable gtk2hs-demo-progress hs-source-dirs: demo/concurrent main-is: Progress.hs if flag(build-demos) buildable: True - build-depends: gtk3==0.12.5.6, base, transformers + build-depends: gtk3==0.12.5.7, base, transformers Executable gtk2hs-demo-progressThreadedRTS hs-source-dirs: demo/concurrent main-is: ProgressThreadedRTS.hs if flag(build-demos) buildable: True - build-depends: gtk3==0.12.5.6, base, transformers + build-depends: gtk3==0.12.5.7, base, transformers ghc-options: -threaded Executable gtk2hs-demo-fastDraw @@ -427,68 +428,74 @@ main-is: FastDraw.hs if flag(build-demos) buildable: True - build-depends: gtk3==0.12.5.6, base, transformers, array, cairo + build-depends: gtk3==0.12.5.7, base, transformers, array, cairo Executable gtk2hs-demo-fonts hs-source-dirs: demo/fonts main-is: Fonts.hs if flag(build-demos) buildable: True - build-depends: gtk3==0.12.5.6, base + build-depends: gtk3==0.12.5.7, base Executable gtk2hs-demo-builder hs-source-dirs: demo/gtkbuilder main-is: GtkBuilderTest.hs if flag(build-demos) buildable: True - build-depends: gtk3==0.12.5.6, base, transformers + build-depends: gtk3==0.12.5.7, base, transformers Executable gtk2hs-demo-helloworld hs-source-dirs: demo/hello main-is: World.hs if flag(build-demos) buildable: True - build-depends: gtk3==0.12.5.6, base, transformers + build-depends: gtk3==0.12.5.7, base, transformers Executable gtk2hs-demo-layout hs-source-dirs: demo/inputmethod main-is: Layout.hs if flag(build-demos) buildable: True - build-depends: gtk3==0.12.5.6, base, transformers, cairo + build-depends: gtk3==0.12.5.7, base, transformers, cairo Executable gtk2hs-demo-menudemo hs-source-dirs: demo/menu main-is: MenuDemo.hs if flag(build-demos) buildable: True - build-depends: gtk3==0.12.5.6, base, transformers + build-depends: gtk3==0.12.5.7, base, transformers Executable gtk2hs-demo-combodemo hs-source-dirs: demo/menu main-is: ComboDemo.hs if flag(build-demos) buildable: True - build-depends: gtk3==0.12.5.6, base, transformers + build-depends: gtk3==0.12.5.7, base, transformers Executable gtk2hs-demo-notebook hs-source-dirs: demo/notebook main-is: Notebook.hs if flag(build-demos) buildable: True - build-depends: gtk3==0.12.5.6, base, transformers + build-depends: gtk3==0.12.5.7, base, transformers Executable gtk2hs-demo-statusIcon hs-source-dirs: demo/statusicon main-is: StatusIcon.hs if flag(build-demos) buildable: True - build-depends: gtk3==0.12.5.6, base, transformers + build-depends: gtk3==0.12.5.7, base, transformers Executable gtk2hs-demo-arabic hs-source-dirs: demo/unicode main-is: Arabic.hs if flag(build-demos) buildable: True - build-depends: gtk3==0.12.5.6, base, transformers + build-depends: gtk3==0.12.5.7, base, transformers +Executable gtk2hs-demo-overlay + hs-source-dirs: demo/overlay + main-is: Overlay.hs + if flag(build-demos) + buildable: True + build-depends: gtk3==0.12.5.7, base, transformers diff --git a/hierarchy3.list b/hierarchy3.list --- a/hierarchy3.list +++ b/hierarchy3.list @@ -91,6 +91,7 @@ GtkTearoffMenuItem GtkImageMenuItem GtkSeparatorMenuItem + GtkOverlay GtkWindow GtkAssistant GtkOffscreenWindow