{-# LINE 2 "./Graphics/UI/Gtk/Abstract/Scale.chs" #-}
module Graphics.UI.Gtk.Abstract.Scale (
Scale,
ScaleClass,
castToScale, gTypeScale,
toScale,
scaleSetDigits,
scaleGetDigits,
scaleSetDrawValue,
scaleGetDrawValue,
PositionType(..),
scaleSetValuePos,
scaleGetValuePos,
scaleDigits,
scaleDrawValue,
scaleValuePos,
) where
import Control.Monad (liftM)
import System.Glib.FFI
import System.Glib.Attributes
import Graphics.UI.Gtk.Types
{-# LINE 82 "./Graphics/UI/Gtk/Abstract/Scale.chs" #-}
import Graphics.UI.Gtk.General.Enums (PositionType(..))
{-# LINE 85 "./Graphics/UI/Gtk/Abstract/Scale.chs" #-}
scaleSetDigits :: ScaleClass self => self
-> Int
-> IO ()
scaleSetDigits :: forall self. ScaleClass self => self -> Int -> IO ()
scaleSetDigits self
self Int
digits =
(\(Scale ForeignPtr Scale
arg1) CInt
arg2 -> ForeignPtr Scale -> (Ptr Scale -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Scale
arg1 ((Ptr Scale -> IO ()) -> IO ()) -> (Ptr Scale -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Scale
argPtr1 ->Ptr Scale -> CInt -> IO ()
gtk_scale_set_digits Ptr Scale
argPtr1 CInt
arg2)
{-# LINE 99 "./Graphics/UI/Gtk/Abstract/Scale.chs" #-}
(toScale self)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
digits)
scaleGetDigits :: ScaleClass self => self
-> IO Int
scaleGetDigits :: forall self. ScaleClass self => self -> IO Int
scaleGetDigits self
self =
(CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
(\(Scale ForeignPtr Scale
arg1) -> ForeignPtr Scale -> (Ptr Scale -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Scale
arg1 ((Ptr Scale -> IO CInt) -> IO CInt)
-> (Ptr Scale -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Scale
argPtr1 ->Ptr Scale -> IO CInt
gtk_scale_get_digits Ptr Scale
argPtr1)
{-# LINE 109 "./Graphics/UI/Gtk/Abstract/Scale.chs" #-}
(toScale self)
scaleSetDrawValue :: ScaleClass self => self
-> Bool
-> IO ()
scaleSetDrawValue :: forall self. ScaleClass self => self -> Bool -> IO ()
scaleSetDrawValue self
self Bool
drawValue =
(\(Scale ForeignPtr Scale
arg1) CInt
arg2 -> ForeignPtr Scale -> (Ptr Scale -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Scale
arg1 ((Ptr Scale -> IO ()) -> IO ()) -> (Ptr Scale -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Scale
argPtr1 ->Ptr Scale -> CInt -> IO ()
gtk_scale_set_draw_value Ptr Scale
argPtr1 CInt
arg2)
{-# LINE 119 "./Graphics/UI/Gtk/Abstract/Scale.chs" #-}
(toScale self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
drawValue)
scaleGetDrawValue :: ScaleClass self => self
-> IO Bool
scaleGetDrawValue :: forall self. ScaleClass self => self -> IO Bool
scaleGetDrawValue self
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Scale ForeignPtr Scale
arg1) -> ForeignPtr Scale -> (Ptr Scale -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Scale
arg1 ((Ptr Scale -> IO CInt) -> IO CInt)
-> (Ptr Scale -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Scale
argPtr1 ->Ptr Scale -> IO CInt
gtk_scale_get_draw_value Ptr Scale
argPtr1)
{-# LINE 130 "./Graphics/UI/Gtk/Abstract/Scale.chs" #-}
(toScale self)
scaleSetValuePos :: ScaleClass self => self
-> PositionType
-> IO ()
scaleSetValuePos :: forall self. ScaleClass self => self -> PositionType -> IO ()
scaleSetValuePos self
self PositionType
pos =
(\(Scale ForeignPtr Scale
arg1) CInt
arg2 -> ForeignPtr Scale -> (Ptr Scale -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Scale
arg1 ((Ptr Scale -> IO ()) -> IO ()) -> (Ptr Scale -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Scale
argPtr1 ->Ptr Scale -> CInt -> IO ()
gtk_scale_set_value_pos Ptr Scale
argPtr1 CInt
arg2)
{-# LINE 140 "./Graphics/UI/Gtk/Abstract/Scale.chs" #-}
(toScale self)
((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (PositionType -> Int) -> PositionType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionType -> Int
forall a. Enum a => a -> Int
fromEnum) PositionType
pos)
scaleGetValuePos :: ScaleClass self => self
-> IO PositionType
scaleGetValuePos :: forall self. ScaleClass self => self -> IO PositionType
scaleGetValuePos self
self =
(CInt -> PositionType) -> IO CInt -> IO PositionType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> PositionType
forall a. Enum a => Int -> a
toEnum (Int -> PositionType) -> (CInt -> Int) -> CInt -> PositionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO PositionType) -> IO CInt -> IO PositionType
forall a b. (a -> b) -> a -> b
$
(\(Scale ForeignPtr Scale
arg1) -> ForeignPtr Scale -> (Ptr Scale -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Scale
arg1 ((Ptr Scale -> IO CInt) -> IO CInt)
-> (Ptr Scale -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Scale
argPtr1 ->Ptr Scale -> IO CInt
gtk_scale_get_value_pos Ptr Scale
argPtr1)
{-# LINE 151 "./Graphics/UI/Gtk/Abstract/Scale.chs" #-}
(toScale self)
scaleDigits :: ScaleClass self => Attr self Int
scaleDigits :: forall self. ScaleClass self => Attr self Int
scaleDigits = (self -> IO Int)
-> (self -> Int -> IO ()) -> ReadWriteAttr self Int Int
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO Int
forall self. ScaleClass self => self -> IO Int
scaleGetDigits
self -> Int -> IO ()
forall self. ScaleClass self => self -> Int -> IO ()
scaleSetDigits
scaleDrawValue :: ScaleClass self => Attr self Bool
scaleDrawValue :: forall self. ScaleClass self => Attr self Bool
scaleDrawValue = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO Bool
forall self. ScaleClass self => self -> IO Bool
scaleGetDrawValue
self -> Bool -> IO ()
forall self. ScaleClass self => self -> Bool -> IO ()
scaleSetDrawValue
scaleValuePos :: ScaleClass self => Attr self PositionType
scaleValuePos :: forall self. ScaleClass self => Attr self PositionType
scaleValuePos = (self -> IO PositionType)
-> (self -> PositionType -> IO ())
-> ReadWriteAttr self PositionType PositionType
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO PositionType
forall self. ScaleClass self => self -> IO PositionType
scaleGetValuePos
self -> PositionType -> IO ()
forall self. ScaleClass self => self -> PositionType -> IO ()
scaleSetValuePos
foreign import ccall safe "gtk_scale_set_digits"
gtk_scale_set_digits :: ((Ptr Scale) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_scale_get_digits"
gtk_scale_get_digits :: ((Ptr Scale) -> (IO CInt))
foreign import ccall safe "gtk_scale_set_draw_value"
gtk_scale_set_draw_value :: ((Ptr Scale) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_scale_get_draw_value"
gtk_scale_get_draw_value :: ((Ptr Scale) -> (IO CInt))
foreign import ccall safe "gtk_scale_set_value_pos"
gtk_scale_set_value_pos :: ((Ptr Scale) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_scale_get_value_pos"
gtk_scale_get_value_pos :: ((Ptr Scale) -> (IO CInt))