{-# LANGUAGE ScopedTypeVariables #-}
-- | Publishes the main elements of a scale as reactive fields
module Graphics.UI.Gtk.Reactive.Property where
import Control.Monad (void, when)
import Control.Monad.IO.Class
import Graphics.UI.Gtk
import Data.ReactiveValue
-- * Attributes as reactive values
-- ** Signal-based reactimation functions.
-- | Create an RV based on a widget's attribute and signal. Before setting,
-- the value is checked against the current one. If they are the same, the
-- value is *not* set.
reactiveProperty :: Eq b
=> self
-> Signal self (IO ()) -> Attr self b
-> ReactiveFieldReadWrite IO b
reactiveProperty e sig attr =
ReactiveFieldReadWrite setter getter notifier
where getter = get e attr
setter v = postGUIAsync $ do
p <- getter
when (p /= v) $ set e [ attr := v ]
notifier p = void (on e sig p)
-- | Create an RV based on a widget's attribute and signal.
-- Before setting, the value is *not* checked against the current one.
-- The value is thus set even if they are the same.
reactivePropertyNE :: self
-> Signal self (IO ()) -> Attr self b
-> ReactiveFieldReadWrite IO b
reactivePropertyNE e sig attr =
ReactiveFieldReadWrite setter getter notifier
where getter = get e attr
setter v = postGUIAsync $ set e [ attr := v ]
notifier p = void (on e sig p)
reactiveSignalIO :: self
-> Signal self (IO ())
-> ReactiveFieldRead IO ()
reactiveSignalIO e sig =
ReactiveFieldRead getter notifier
where getter = return ()
notifier p = void (on e sig p)
reactiveSignalM :: (Monad m, MonadIO m)
=> self
-> a
-> Signal self (m a)
-> ReactiveFieldRead IO ()
reactiveSignalM e def sig =
ReactiveFieldRead getter notifier
where getter = return ()
notifier p = void (on e sig (liftIO p >> return def))
-- ** Handler-based reactimation functions
-- | Create an RV based on a widget's attribute and a handler.
-- Before setting, the value is checked against the current one.
-- If they are the same, the value is *not* set.
reactivePropertyH :: Eq b
=> self
-> (self -> IO () -> IO (ConnectId self)) -> Attr self b
-> ReactiveFieldReadWrite IO b
reactivePropertyH e sig attr =
ReactiveFieldReadWrite setter getter notifier
where getter = get e attr
setter v = postGUIAsync $ do
p <- getter
when (p /= v) $ set e [ attr := v ]
notifier p = void (e `sig` p)
-- | Create a unit read-only RV based on a widget's event handler.
reactivePropertyH_ :: self
-> (self -> IO () -> IO (ConnectId self))
-> ReactiveFieldRead IO ()
reactivePropertyH_ e sig =
ReactiveFieldRead getter notifier
where getter = return ()
notifier p = void (e `sig` p)
-- * Passive properties
-- | A passive reactive value is one that does not report when it changes.
--
-- This function returns a RW RV that encloses the given property, without
-- firing change events. The value of the attribute is *not* set if it is the
-- same as the current one.
--
-- To set without diffing, see 'passivePropertyNE'.
passiveProperty :: Eq b
=> self
-> Attr self b
-> ReactiveFieldReadWrite IO b
passiveProperty e attr =
ReactiveFieldReadWrite setter getter notifier
where getter = get e attr
setter v = postGUIAsync $ do
p <- getter
when (p /= v) $ set e [ attr := v ]
notifier _ = return ()
-- | Return a RW RV that encloses the given property, without firing change
-- events.
--
-- When writing to this RV, the value is *not* diffed against the previous one.
-- The underlying widget can thus still fire signals based on that change.
passivePropertyNE :: self
-> Attr self b
-> ReactiveFieldReadWrite IO b
passivePropertyNE e attr =
ReactiveFieldReadWrite setter getter notifier
where getter = get e attr
setter v = postGUIAsync $ set e [ attr := v ]
notifier _ = return ()
passivePropertyGE :: Eq b
=> self
-> (self -> b -> IO ()) -> (self -> IO b)
-> ReactiveFieldReadWrite IO b
passivePropertyGE e set get =
ReactiveFieldReadWrite setter getter notifier
where getter = get e
setter v = postGUIAsync $ do
p <- getter
when (p /= v) $ set e v
notifier _ = return ()