{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Gtk.Objects.Scale
    ( 

-- * Exported types
    Scale(..)                               ,
    ScaleK                                  ,
    toScale                                 ,
    noScale                                 ,


 -- * Methods
-- ** scaleAddMark
    scaleAddMark                            ,


-- ** scaleClearMarks
    scaleClearMarks                         ,


-- ** scaleGetDigits
    scaleGetDigits                          ,


-- ** scaleGetDrawValue
    scaleGetDrawValue                       ,


-- ** scaleGetHasOrigin
    scaleGetHasOrigin                       ,


-- ** scaleGetLayout
    scaleGetLayout                          ,


-- ** scaleGetLayoutOffsets
    scaleGetLayoutOffsets                   ,


-- ** scaleGetValuePos
    scaleGetValuePos                        ,


-- ** scaleNew
    scaleNew                                ,


-- ** scaleNewWithRange
    scaleNewWithRange                       ,


-- ** scaleSetDigits
    scaleSetDigits                          ,


-- ** scaleSetDrawValue
    scaleSetDrawValue                       ,


-- ** scaleSetHasOrigin
    scaleSetHasOrigin                       ,


-- ** scaleSetValuePos
    scaleSetValuePos                        ,




 -- * Properties
-- ** Digits
    ScaleDigitsPropertyInfo                 ,
    constructScaleDigits                    ,
    getScaleDigits                          ,
    setScaleDigits                          ,


-- ** DrawValue
    ScaleDrawValuePropertyInfo              ,
    constructScaleDrawValue                 ,
    getScaleDrawValue                       ,
    setScaleDrawValue                       ,


-- ** HasOrigin
    ScaleHasOriginPropertyInfo              ,
    constructScaleHasOrigin                 ,
    getScaleHasOrigin                       ,
    setScaleHasOrigin                       ,


-- ** ValuePos
    ScaleValuePosPropertyInfo               ,
    constructScaleValuePos                  ,
    getScaleValuePos                        ,
    setScaleValuePos                        ,




 -- * Signals
-- ** FormatValue
    ScaleFormatValueCallback                ,
    ScaleFormatValueCallbackC               ,
    ScaleFormatValueSignalInfo              ,
    afterScaleFormatValue                   ,
    mkScaleFormatValueCallback              ,
    noScaleFormatValueCallback              ,
    onScaleFormatValue                      ,
    scaleFormatValueCallbackWrapper         ,
    scaleFormatValueClosure                 ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gtk.Types
import GI.Gtk.Callbacks
import qualified GI.Atk as Atk
import qualified GI.GObject as GObject
import qualified GI.Pango as Pango

newtype Scale = Scale (ForeignPtr Scale)
foreign import ccall "gtk_scale_get_type"
    c_gtk_scale_get_type :: IO GType

type instance ParentTypes Scale = ScaleParentTypes
type ScaleParentTypes = '[Range, Widget, GObject.Object, Atk.ImplementorIface, Buildable, Orientable]

instance GObject Scale where
    gobjectIsInitiallyUnowned _ = True
    gobjectType _ = c_gtk_scale_get_type
    

class GObject o => ScaleK o
instance (GObject o, IsDescendantOf Scale o) => ScaleK o

toScale :: ScaleK o => o -> IO Scale
toScale = unsafeCastTo Scale

noScale :: Maybe Scale
noScale = Nothing

-- signal Scale::format-value
type ScaleFormatValueCallback =
    Double ->
    IO T.Text

noScaleFormatValueCallback :: Maybe ScaleFormatValueCallback
noScaleFormatValueCallback = Nothing

type ScaleFormatValueCallbackC =
    Ptr () ->                               -- object
    CDouble ->
    Ptr () ->                               -- user_data
    IO CString

foreign import ccall "wrapper"
    mkScaleFormatValueCallback :: ScaleFormatValueCallbackC -> IO (FunPtr ScaleFormatValueCallbackC)

scaleFormatValueClosure :: ScaleFormatValueCallback -> IO Closure
scaleFormatValueClosure cb = newCClosure =<< mkScaleFormatValueCallback wrapped
    where wrapped = scaleFormatValueCallbackWrapper cb

scaleFormatValueCallbackWrapper ::
    ScaleFormatValueCallback ->
    Ptr () ->
    CDouble ->
    Ptr () ->
    IO CString
scaleFormatValueCallbackWrapper _cb _ value _ = do
    let value' = realToFrac value
    result <- _cb  value'
    result' <- textToCString result
    return result'

onScaleFormatValue :: (GObject a, MonadIO m) => a -> ScaleFormatValueCallback -> m SignalHandlerId
onScaleFormatValue obj cb = liftIO $ connectScaleFormatValue obj cb SignalConnectBefore
afterScaleFormatValue :: (GObject a, MonadIO m) => a -> ScaleFormatValueCallback -> m SignalHandlerId
afterScaleFormatValue obj cb = connectScaleFormatValue obj cb SignalConnectAfter

connectScaleFormatValue :: (GObject a, MonadIO m) =>
                           a -> ScaleFormatValueCallback -> SignalConnectMode -> m SignalHandlerId
connectScaleFormatValue obj cb after = liftIO $ do
    cb' <- mkScaleFormatValueCallback (scaleFormatValueCallbackWrapper cb)
    connectSignalFunPtr obj "format-value" cb' after

-- VVV Prop "digits"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getScaleDigits :: (MonadIO m, ScaleK o) => o -> m Int32
getScaleDigits obj = liftIO $ getObjectPropertyCInt obj "digits"

setScaleDigits :: (MonadIO m, ScaleK o) => o -> Int32 -> m ()
setScaleDigits obj val = liftIO $ setObjectPropertyCInt obj "digits" val

constructScaleDigits :: Int32 -> IO ([Char], GValue)
constructScaleDigits val = constructObjectPropertyCInt "digits" val

data ScaleDigitsPropertyInfo
instance AttrInfo ScaleDigitsPropertyInfo where
    type AttrAllowedOps ScaleDigitsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ScaleDigitsPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint ScaleDigitsPropertyInfo = ScaleK
    type AttrGetType ScaleDigitsPropertyInfo = Int32
    type AttrLabel ScaleDigitsPropertyInfo = "Scale::digits"
    attrGet _ = getScaleDigits
    attrSet _ = setScaleDigits
    attrConstruct _ = constructScaleDigits

-- VVV Prop "draw-value"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getScaleDrawValue :: (MonadIO m, ScaleK o) => o -> m Bool
getScaleDrawValue obj = liftIO $ getObjectPropertyBool obj "draw-value"

setScaleDrawValue :: (MonadIO m, ScaleK o) => o -> Bool -> m ()
setScaleDrawValue obj val = liftIO $ setObjectPropertyBool obj "draw-value" val

constructScaleDrawValue :: Bool -> IO ([Char], GValue)
constructScaleDrawValue val = constructObjectPropertyBool "draw-value" val

data ScaleDrawValuePropertyInfo
instance AttrInfo ScaleDrawValuePropertyInfo where
    type AttrAllowedOps ScaleDrawValuePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ScaleDrawValuePropertyInfo = (~) Bool
    type AttrBaseTypeConstraint ScaleDrawValuePropertyInfo = ScaleK
    type AttrGetType ScaleDrawValuePropertyInfo = Bool
    type AttrLabel ScaleDrawValuePropertyInfo = "Scale::draw-value"
    attrGet _ = getScaleDrawValue
    attrSet _ = setScaleDrawValue
    attrConstruct _ = constructScaleDrawValue

-- VVV Prop "has-origin"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getScaleHasOrigin :: (MonadIO m, ScaleK o) => o -> m Bool
getScaleHasOrigin obj = liftIO $ getObjectPropertyBool obj "has-origin"

setScaleHasOrigin :: (MonadIO m, ScaleK o) => o -> Bool -> m ()
setScaleHasOrigin obj val = liftIO $ setObjectPropertyBool obj "has-origin" val

constructScaleHasOrigin :: Bool -> IO ([Char], GValue)
constructScaleHasOrigin val = constructObjectPropertyBool "has-origin" val

data ScaleHasOriginPropertyInfo
instance AttrInfo ScaleHasOriginPropertyInfo where
    type AttrAllowedOps ScaleHasOriginPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ScaleHasOriginPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint ScaleHasOriginPropertyInfo = ScaleK
    type AttrGetType ScaleHasOriginPropertyInfo = Bool
    type AttrLabel ScaleHasOriginPropertyInfo = "Scale::has-origin"
    attrGet _ = getScaleHasOrigin
    attrSet _ = setScaleHasOrigin
    attrConstruct _ = constructScaleHasOrigin

-- VVV Prop "value-pos"
   -- Type: TInterface "Gtk" "PositionType"
   -- Flags: [PropertyReadable,PropertyWritable]

getScaleValuePos :: (MonadIO m, ScaleK o) => o -> m PositionType
getScaleValuePos obj = liftIO $ getObjectPropertyEnum obj "value-pos"

setScaleValuePos :: (MonadIO m, ScaleK o) => o -> PositionType -> m ()
setScaleValuePos obj val = liftIO $ setObjectPropertyEnum obj "value-pos" val

constructScaleValuePos :: PositionType -> IO ([Char], GValue)
constructScaleValuePos val = constructObjectPropertyEnum "value-pos" val

data ScaleValuePosPropertyInfo
instance AttrInfo ScaleValuePosPropertyInfo where
    type AttrAllowedOps ScaleValuePosPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ScaleValuePosPropertyInfo = (~) PositionType
    type AttrBaseTypeConstraint ScaleValuePosPropertyInfo = ScaleK
    type AttrGetType ScaleValuePosPropertyInfo = PositionType
    type AttrLabel ScaleValuePosPropertyInfo = "Scale::value-pos"
    attrGet _ = getScaleValuePos
    attrSet _ = setScaleValuePos
    attrConstruct _ = constructScaleValuePos

type instance AttributeList Scale = ScaleAttributeList
type ScaleAttributeList = ('[ '("adjustment", RangeAdjustmentPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("digits", ScaleDigitsPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("draw-value", ScaleDrawValuePropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("fill-level", RangeFillLevelPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-origin", ScaleHasOriginPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("inverted", RangeInvertedPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("lower-stepper-sensitivity", RangeLowerStepperSensitivityPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("restrict-to-fill-level", RangeRestrictToFillLevelPropertyInfo), '("round-digits", RangeRoundDigitsPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("show-fill-level", RangeShowFillLevelPropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("upper-stepper-sensitivity", RangeUpperStepperSensitivityPropertyInfo), '("valign", WidgetValignPropertyInfo), '("value-pos", ScaleValuePosPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] :: [(Symbol, *)])

data ScaleFormatValueSignalInfo
instance SignalInfo ScaleFormatValueSignalInfo where
    type HaskellCallbackType ScaleFormatValueSignalInfo = ScaleFormatValueCallback
    connectSignal _ = connectScaleFormatValue

type instance SignalList Scale = ScaleSignalList
type ScaleSignalList = ('[ '("accel-closures-changed", WidgetAccelClosuresChangedSignalInfo), '("adjust-bounds", RangeAdjustBoundsSignalInfo), '("button-press-event", WidgetButtonPressEventSignalInfo), '("button-release-event", WidgetButtonReleaseEventSignalInfo), '("can-activate-accel", WidgetCanActivateAccelSignalInfo), '("change-value", RangeChangeValueSignalInfo), '("child-notify", WidgetChildNotifySignalInfo), '("composited-changed", WidgetCompositedChangedSignalInfo), '("configure-event", WidgetConfigureEventSignalInfo), '("damage-event", WidgetDamageEventSignalInfo), '("delete-event", WidgetDeleteEventSignalInfo), '("destroy", WidgetDestroySignalInfo), '("destroy-event", WidgetDestroyEventSignalInfo), '("direction-changed", WidgetDirectionChangedSignalInfo), '("drag-begin", WidgetDragBeginSignalInfo), '("drag-data-delete", WidgetDragDataDeleteSignalInfo), '("drag-data-get", WidgetDragDataGetSignalInfo), '("drag-data-received", WidgetDragDataReceivedSignalInfo), '("drag-drop", WidgetDragDropSignalInfo), '("drag-end", WidgetDragEndSignalInfo), '("drag-failed", WidgetDragFailedSignalInfo), '("drag-leave", WidgetDragLeaveSignalInfo), '("drag-motion", WidgetDragMotionSignalInfo), '("draw", WidgetDrawSignalInfo), '("enter-notify-event", WidgetEnterNotifyEventSignalInfo), '("event", WidgetEventSignalInfo), '("event-after", WidgetEventAfterSignalInfo), '("focus", WidgetFocusSignalInfo), '("focus-in-event", WidgetFocusInEventSignalInfo), '("focus-out-event", WidgetFocusOutEventSignalInfo), '("format-value", ScaleFormatValueSignalInfo), '("grab-broken-event", WidgetGrabBrokenEventSignalInfo), '("grab-focus", WidgetGrabFocusSignalInfo), '("grab-notify", WidgetGrabNotifySignalInfo), '("hide", WidgetHideSignalInfo), '("hierarchy-changed", WidgetHierarchyChangedSignalInfo), '("key-press-event", WidgetKeyPressEventSignalInfo), '("key-release-event", WidgetKeyReleaseEventSignalInfo), '("keynav-failed", WidgetKeynavFailedSignalInfo), '("leave-notify-event", WidgetLeaveNotifyEventSignalInfo), '("map", WidgetMapSignalInfo), '("map-event", WidgetMapEventSignalInfo), '("mnemonic-activate", WidgetMnemonicActivateSignalInfo), '("motion-notify-event", WidgetMotionNotifyEventSignalInfo), '("move-focus", WidgetMoveFocusSignalInfo), '("move-slider", RangeMoveSliderSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("parent-set", WidgetParentSetSignalInfo), '("popup-menu", WidgetPopupMenuSignalInfo), '("property-notify-event", WidgetPropertyNotifyEventSignalInfo), '("proximity-in-event", WidgetProximityInEventSignalInfo), '("proximity-out-event", WidgetProximityOutEventSignalInfo), '("query-tooltip", WidgetQueryTooltipSignalInfo), '("realize", WidgetRealizeSignalInfo), '("screen-changed", WidgetScreenChangedSignalInfo), '("scroll-event", WidgetScrollEventSignalInfo), '("selection-clear-event", WidgetSelectionClearEventSignalInfo), '("selection-get", WidgetSelectionGetSignalInfo), '("selection-notify-event", WidgetSelectionNotifyEventSignalInfo), '("selection-received", WidgetSelectionReceivedSignalInfo), '("selection-request-event", WidgetSelectionRequestEventSignalInfo), '("show", WidgetShowSignalInfo), '("show-help", WidgetShowHelpSignalInfo), '("size-allocate", WidgetSizeAllocateSignalInfo), '("state-changed", WidgetStateChangedSignalInfo), '("state-flags-changed", WidgetStateFlagsChangedSignalInfo), '("style-set", WidgetStyleSetSignalInfo), '("style-updated", WidgetStyleUpdatedSignalInfo), '("touch-event", WidgetTouchEventSignalInfo), '("unmap", WidgetUnmapSignalInfo), '("unmap-event", WidgetUnmapEventSignalInfo), '("unrealize", WidgetUnrealizeSignalInfo), '("value-changed", RangeValueChangedSignalInfo), '("visibility-notify-event", WidgetVisibilityNotifyEventSignalInfo), '("window-state-event", WidgetWindowStateEventSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method Scale::new
-- method type : Constructor
-- Args : [Arg {argName = "orientation", argType = TInterface "Gtk" "Orientation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "adjustment", argType = TInterface "Gtk" "Adjustment", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "orientation", argType = TInterface "Gtk" "Orientation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "adjustment", argType = TInterface "Gtk" "Adjustment", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Scale"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_new" gtk_scale_new :: 
    CUInt ->                                -- orientation : TInterface "Gtk" "Orientation"
    Ptr Adjustment ->                       -- adjustment : TInterface "Gtk" "Adjustment"
    IO (Ptr Scale)


scaleNew ::
    (MonadIO m, AdjustmentK a) =>
    Orientation ->                          -- orientation
    Maybe (a) ->                            -- adjustment
    m Scale
scaleNew orientation adjustment = liftIO $ do
    let orientation' = (fromIntegral . fromEnum) orientation
    maybeAdjustment <- case adjustment of
        Nothing -> return nullPtr
        Just jAdjustment -> do
            let jAdjustment' = unsafeManagedPtrCastPtr jAdjustment
            return jAdjustment'
    result <- gtk_scale_new orientation' maybeAdjustment
    checkUnexpectedReturnNULL "gtk_scale_new" result
    result' <- (newObject Scale) result
    whenJust adjustment touchManagedPtr
    return result'

-- method Scale::new_with_range
-- method type : Constructor
-- Args : [Arg {argName = "orientation", argType = TInterface "Gtk" "Orientation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "min", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "step", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "orientation", argType = TInterface "Gtk" "Orientation", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "min", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "step", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Scale"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_new_with_range" gtk_scale_new_with_range :: 
    CUInt ->                                -- orientation : TInterface "Gtk" "Orientation"
    CDouble ->                              -- min : TBasicType TDouble
    CDouble ->                              -- max : TBasicType TDouble
    CDouble ->                              -- step : TBasicType TDouble
    IO (Ptr Scale)


scaleNewWithRange ::
    (MonadIO m) =>
    Orientation ->                          -- orientation
    Double ->                               -- min
    Double ->                               -- max
    Double ->                               -- step
    m Scale
scaleNewWithRange orientation min max step = liftIO $ do
    let orientation' = (fromIntegral . fromEnum) orientation
    let min' = realToFrac min
    let max' = realToFrac max
    let step' = realToFrac step
    result <- gtk_scale_new_with_range orientation' min' max' step'
    checkUnexpectedReturnNULL "gtk_scale_new_with_range" result
    result' <- (newObject Scale) result
    return result'

-- method Scale::add_mark
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TInterface "Gtk" "PositionType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "markup", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TInterface "Gtk" "PositionType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "markup", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_add_mark" gtk_scale_add_mark :: 
    Ptr Scale ->                            -- _obj : TInterface "Gtk" "Scale"
    CDouble ->                              -- value : TBasicType TDouble
    CUInt ->                                -- position : TInterface "Gtk" "PositionType"
    CString ->                              -- markup : TBasicType TUTF8
    IO ()


scaleAddMark ::
    (MonadIO m, ScaleK a) =>
    a ->                                    -- _obj
    Double ->                               -- value
    PositionType ->                         -- position
    Maybe (T.Text) ->                       -- markup
    m ()
scaleAddMark _obj value position markup = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let value' = realToFrac value
    let position' = (fromIntegral . fromEnum) position
    maybeMarkup <- case markup of
        Nothing -> return nullPtr
        Just jMarkup -> do
            jMarkup' <- textToCString jMarkup
            return jMarkup'
    gtk_scale_add_mark _obj' value' position' maybeMarkup
    touchManagedPtr _obj
    freeMem maybeMarkup
    return ()

-- method Scale::clear_marks
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_clear_marks" gtk_scale_clear_marks :: 
    Ptr Scale ->                            -- _obj : TInterface "Gtk" "Scale"
    IO ()


scaleClearMarks ::
    (MonadIO m, ScaleK a) =>
    a ->                                    -- _obj
    m ()
scaleClearMarks _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_scale_clear_marks _obj'
    touchManagedPtr _obj
    return ()

-- method Scale::get_digits
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_get_digits" gtk_scale_get_digits :: 
    Ptr Scale ->                            -- _obj : TInterface "Gtk" "Scale"
    IO Int32


scaleGetDigits ::
    (MonadIO m, ScaleK a) =>
    a ->                                    -- _obj
    m Int32
scaleGetDigits _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_scale_get_digits _obj'
    touchManagedPtr _obj
    return result

-- method Scale::get_draw_value
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_get_draw_value" gtk_scale_get_draw_value :: 
    Ptr Scale ->                            -- _obj : TInterface "Gtk" "Scale"
    IO CInt


scaleGetDrawValue ::
    (MonadIO m, ScaleK a) =>
    a ->                                    -- _obj
    m Bool
scaleGetDrawValue _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_scale_get_draw_value _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Scale::get_has_origin
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_get_has_origin" gtk_scale_get_has_origin :: 
    Ptr Scale ->                            -- _obj : TInterface "Gtk" "Scale"
    IO CInt


scaleGetHasOrigin ::
    (MonadIO m, ScaleK a) =>
    a ->                                    -- _obj
    m Bool
scaleGetHasOrigin _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_scale_get_has_origin _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Scale::get_layout
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Pango" "Layout"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_get_layout" gtk_scale_get_layout :: 
    Ptr Scale ->                            -- _obj : TInterface "Gtk" "Scale"
    IO (Ptr Pango.Layout)


scaleGetLayout ::
    (MonadIO m, ScaleK a) =>
    a ->                                    -- _obj
    m Pango.Layout
scaleGetLayout _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_scale_get_layout _obj'
    checkUnexpectedReturnNULL "gtk_scale_get_layout" result
    result' <- (newObject Pango.Layout) result
    touchManagedPtr _obj
    return result'

-- method Scale::get_layout_offsets
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_get_layout_offsets" gtk_scale_get_layout_offsets :: 
    Ptr Scale ->                            -- _obj : TInterface "Gtk" "Scale"
    Ptr Int32 ->                            -- x : TBasicType TInt32
    Ptr Int32 ->                            -- y : TBasicType TInt32
    IO ()


scaleGetLayoutOffsets ::
    (MonadIO m, ScaleK a) =>
    a ->                                    -- _obj
    m (Int32,Int32)
scaleGetLayoutOffsets _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    x <- allocMem :: IO (Ptr Int32)
    y <- allocMem :: IO (Ptr Int32)
    gtk_scale_get_layout_offsets _obj' x y
    x' <- peek x
    y' <- peek y
    touchManagedPtr _obj
    freeMem x
    freeMem y
    return (x', y')

-- method Scale::get_value_pos
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "PositionType"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_get_value_pos" gtk_scale_get_value_pos :: 
    Ptr Scale ->                            -- _obj : TInterface "Gtk" "Scale"
    IO CUInt


scaleGetValuePos ::
    (MonadIO m, ScaleK a) =>
    a ->                                    -- _obj
    m PositionType
scaleGetValuePos _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_scale_get_value_pos _obj'
    let result' = (toEnum . fromIntegral) result
    touchManagedPtr _obj
    return result'

-- method Scale::set_digits
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "digits", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "digits", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_set_digits" gtk_scale_set_digits :: 
    Ptr Scale ->                            -- _obj : TInterface "Gtk" "Scale"
    Int32 ->                                -- digits : TBasicType TInt32
    IO ()


scaleSetDigits ::
    (MonadIO m, ScaleK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- digits
    m ()
scaleSetDigits _obj digits = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_scale_set_digits _obj' digits
    touchManagedPtr _obj
    return ()

-- method Scale::set_draw_value
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "draw_value", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "draw_value", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_set_draw_value" gtk_scale_set_draw_value :: 
    Ptr Scale ->                            -- _obj : TInterface "Gtk" "Scale"
    CInt ->                                 -- draw_value : TBasicType TBoolean
    IO ()


scaleSetDrawValue ::
    (MonadIO m, ScaleK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- draw_value
    m ()
scaleSetDrawValue _obj draw_value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let draw_value' = (fromIntegral . fromEnum) draw_value
    gtk_scale_set_draw_value _obj' draw_value'
    touchManagedPtr _obj
    return ()

-- method Scale::set_has_origin
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "has_origin", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "has_origin", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_set_has_origin" gtk_scale_set_has_origin :: 
    Ptr Scale ->                            -- _obj : TInterface "Gtk" "Scale"
    CInt ->                                 -- has_origin : TBasicType TBoolean
    IO ()


scaleSetHasOrigin ::
    (MonadIO m, ScaleK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- has_origin
    m ()
scaleSetHasOrigin _obj has_origin = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let has_origin' = (fromIntegral . fromEnum) has_origin
    gtk_scale_set_has_origin _obj' has_origin'
    touchManagedPtr _obj
    return ()

-- method Scale::set_value_pos
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TInterface "Gtk" "PositionType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Scale", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pos", argType = TInterface "Gtk" "PositionType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_set_value_pos" gtk_scale_set_value_pos :: 
    Ptr Scale ->                            -- _obj : TInterface "Gtk" "Scale"
    CUInt ->                                -- pos : TInterface "Gtk" "PositionType"
    IO ()


scaleSetValuePos ::
    (MonadIO m, ScaleK a) =>
    a ->                                    -- _obj
    PositionType ->                         -- pos
    m ()
scaleSetValuePos _obj pos = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let pos' = (fromIntegral . fromEnum) pos
    gtk_scale_set_value_pos _obj' pos'
    touchManagedPtr _obj
    return ()