File: ColorButton.chs

package info (click to toggle)
haskell-gtk 0.11.0-5
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 2,920 kB
  • ctags: 82
  • sloc: haskell: 1,929; ansic: 714; sh: 5; makefile: 3
file content (252 lines) | stat: -rw-r--r-- 7,210 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
{-# LANGUAGE CPP #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget ColorButton
--
--  Author : Duncan Coutts
--
--  Created: 5 April 2005
--
--  Copyright (C) 2005 Duncan Coutts
--
--  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 button to launch a color selection dialog
--
-- * Module available since Gtk+ version 2.4
--
module Graphics.UI.Gtk.Selectors.ColorButton (
-- * Detail
-- 
-- | The 'ColorButton' is a button which displays the currently selected color
-- an allows to open a color selection dialog to change the color. It is
-- suitable widget for selecting a color in a preference dialog.

-- * Class Hierarchy
-- |
-- @
-- |  'GObject'
-- |   +----'Object'
-- |         +----'Widget'
-- |               +----'Container'
-- |                     +----'Bin'
-- |                           +----'Button'
-- |                                 +----ColorButton
-- @

#if GTK_CHECK_VERSION(2,4,0)
-- * Types
  ColorButton,
  ColorButtonClass,
  castToColorButton, gTypeColorButton,
  toColorButton,

-- * Constructors
  colorButtonNew,
  colorButtonNewWithColor,

-- * Methods
  colorButtonSetColor,
  colorButtonGetColor,
  colorButtonSetAlpha,
  colorButtonGetAlpha,
  colorButtonSetUseAlpha,
  colorButtonGetUseAlpha,
  colorButtonSetTitle,
  colorButtonGetTitle,

-- * Attributes
  colorButtonUseAlpha,
  colorButtonTitle,
  colorButtonAlpha,

-- * Signals
  onColorSet,
  afterColorSet,
#endif
  ) where

import Control.Monad	(liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Structs	(Color)

{# context lib="gtk" prefix="gtk" #}

#if GTK_CHECK_VERSION(2,4,0)
--------------------
-- Constructors

-- | Creates a new color button. This returns a widget in the form of a small
-- button containing a swatch representing the current selected color. When the
-- button is clicked, a color-selection dialog will open, allowing the user to
-- select a color. The swatch will be updated to reflect the new color when the
-- user finishes.
--
colorButtonNew :: IO ColorButton
colorButtonNew =
  makeNewObject mkColorButton $
  liftM (castPtr :: Ptr Widget -> Ptr ColorButton) $
  {# call gtk_color_button_new #}

-- | Creates a new color button.
--
colorButtonNewWithColor :: 
    Color          -- ^ @color@ - A 'Color' to set the current color with.
 -> IO ColorButton
colorButtonNewWithColor color =
  makeNewObject mkColorButton $
  liftM (castPtr :: Ptr Widget -> Ptr ColorButton) $
  with color $ \colorPtr ->
  {# call gtk_color_button_new_with_color #}
    (castPtr colorPtr)

--------------------
-- Methods

-- | Sets the current color to be @color@.
--
colorButtonSetColor :: ColorButtonClass self => self
 -> Color -- ^ @color@ - A 'Color' to set the current color with.
 -> IO ()
colorButtonSetColor self color =
  with color $ \colorPtr ->
  {# call gtk_color_button_set_color #}
    (toColorButton self)
    (castPtr colorPtr)

-- | Returns the current color value.
--
colorButtonGetColor :: ColorButtonClass self => self -> IO Color
colorButtonGetColor self =
  alloca $ \colorPtr ->
  {# call gtk_color_button_get_color #}
    (toColorButton self)
    (castPtr colorPtr)
  >> peek colorPtr >>= \color ->
  return color

-- | Sets the current opacity to be @alpha@.
--
colorButtonSetAlpha :: ColorButtonClass self => self
 -> Word16 -- ^ @alpha@ - an integer between 0 and 65535.
 -> IO ()
colorButtonSetAlpha self alpha =
  {# call gtk_color_button_set_alpha #}
    (toColorButton self)
    (fromIntegral alpha)

-- | Returns the current alpha value.
--
colorButtonGetAlpha :: ColorButtonClass self => self
 -> IO Word16 -- ^ returns an integer between 0 and 65535.
colorButtonGetAlpha self =
  liftM fromIntegral $
  {# call gtk_color_button_get_alpha #}
    (toColorButton self)

-- | Sets whether or not the color button should use the alpha channel.
--
colorButtonSetUseAlpha :: ColorButtonClass self => self
 -> Bool  -- ^ @useAlpha@ - @True@ if color button should use alpha channel,
          -- @False@ if not.
 -> IO ()
colorButtonSetUseAlpha self useAlpha =
  {# call gtk_color_button_set_use_alpha #}
    (toColorButton self)
    (fromBool useAlpha)

-- | Does the color selection dialog use the alpha channel?
--
colorButtonGetUseAlpha :: ColorButtonClass self => self
 -> IO Bool -- ^ returns @True@ if the color sample uses alpha channel,
            -- @False@ if not.
colorButtonGetUseAlpha self =
  liftM toBool $
  {# call gtk_color_button_get_use_alpha #}
    (toColorButton self)

-- | Sets the title for the color selection dialog.
--
colorButtonSetTitle :: ColorButtonClass self => self
 -> String -- ^ @title@ - String containing new window title.
 -> IO ()
colorButtonSetTitle self title =
  withUTFString title $ \titlePtr ->
  {# call gtk_color_button_set_title #}
    (toColorButton self)
    titlePtr

-- | Gets the title of the color selection dialog.
--
colorButtonGetTitle :: ColorButtonClass self => self
 -> IO String -- ^ returns An internal string, do not free the return value
colorButtonGetTitle self =
  {# call gtk_color_button_get_title #}
    (toColorButton self)
  >>= peekUTFString

--------------------
-- Attributes

-- | If this property is set to @True@, the color swatch on the button is
-- rendered against a checkerboard background to show its opacity and the
-- opacity slider is displayed in the color selection dialog.
--
-- Default value: @False@
--
colorButtonUseAlpha :: ColorButtonClass self => Attr self Bool
colorButtonUseAlpha = newAttr
  colorButtonGetUseAlpha
  colorButtonSetUseAlpha

-- | The title of the color selection dialog
--
-- Default value: \"Pick a Color\"
--
colorButtonTitle :: ColorButtonClass self => Attr self String
colorButtonTitle = newAttr
  colorButtonGetTitle
  colorButtonSetTitle

-- | The selected opacity value (0 fully transparent, 65535 fully opaque).
--
-- Allowed values: \<= 65535
--
-- Default value: 65535
--
colorButtonAlpha :: ColorButtonClass self => Attr self Word16
colorButtonAlpha = newAttr
  colorButtonGetAlpha
  colorButtonSetAlpha

--------------------
-- Signals

-- | The ::color-set signal is emitted when the user selects a color. When
-- handling this signal, use 'colorButtonGetColor' and 'colorButtonGetAlpha' to
-- find out which color was just selected.
--
onColorSet, afterColorSet :: ColorButtonClass self => self
 -> IO ()
 -> IO (ConnectId self)
onColorSet = connect_NONE__NONE "color_set" False
afterColorSet = connect_NONE__NONE "color_set" True
#endif