grapefruit-examples-0.0.0.0: src/Examples/Grapefruit/Switching.hs

{-|
    A Grapefruit example which demonstrates switching.

    The application creates two counters. These can be incremented with the buttons
    “Inc 1” and “Inc 2”. On the very right of the window, you
    always see the current value of one of those counters. Initially, this is counter 1 but you
    can switch between both counters using the buttons “Switch to 1” and
    “Switch to 2”.

    At the start of the application and at each press on one of the
    “Switch to” buttons, a further counter is created. The value of the last of
    these counters is shown left to the other counter value. The initially created counter can be
    incremented by pushing the button “Inc 1” and each counter created by a press
    on “Switch to /n/” can be incremented by pushing the button
    “Inc /n/”.

    The implementation uses Grapefruit’s 'switch' function which provides switching between
    signal functions. The arguments of the resulting signal functions are automatically aged, that
    is, everything before the time they are used is cut off. The right counter value is created by
    counting the presses of the “Inc” buttons, aging the resulting signals and
    switching between the aged signals. The left counter value is produced by aging the
    “Inc” button press signals, counting the occurences in the aged signals and
    switching between the resulting counter signals.
-}
module Examples.Grapefruit.Switching (

    mainCircuit

) where

    -- Control
    import Control.Applicative          as Applicative
    import Control.Arrow (arr, returnA)

    -- FRP.Grapefruit
    import FRP.Grapefruit.Signal           as Signal
    import FRP.Grapefruit.Signal.Discrete  as DSignal
    import FRP.Grapefruit.Signal.Segmented as SSignal
    import FRP.Grapefruit.Record           as Record

    -- Graphics.UI.Grapefruit
    import Graphics.UI.Grapefruit.Comp        as UIComp
    import Graphics.UI.Grapefruit.Item        as UIItem
    import Graphics.UI.Grapefruit.Circuit     as UICircuit
    import Graphics.UI.Grapefruit.Backend.Std as StdUIBackend

    -- |The circuit describing the whole application.
    mainCircuit :: (StdUIBackend uiBackend) => UICircuit Window uiBackend era () (DSignal era ())
    mainCircuit = proc _ -> do
        X :& Closure ::= closure
          `With` _               <- window `with` windowContent -< X :& Title ::= pure "Switching"
                                                                     `With` ()
        returnA -< closure

    windowContent :: (StdUIBackend uiBackend) => UIItem Widget uiBackend era () ()
    windowContent = arr (const (X `With` ()))
                        |>> StdUIBackend.box Horizontal `with` boxContent >>|
                    arr (\(X `With` _) -> ())

    data Port = Port1 | Port2

    boxContent :: (StdUIBackend uiBackend) => UICircuit Widget uiBackend era () ()
    boxContent = proc _ -> do
        X :& Push ::= inc1      <- just pushButton -< X :& Text ::= pure "Inc 1"
        X :& Push ::= inc2      <- just pushButton -< X :& Text ::= pure "Inc 2"
        X :& Push ::= switchTo1 <- just pushButton -< X :& Text ::= pure "Switch to 1"
        X :& Push ::= switchTo2 <- just pushButton -< X :& Text ::= pure "Switch to 2"
        let

            port          = SSignal.fromInitAndUpdate Port1 (union (Port1 <$ switchTo1)
                                                                   (Port2 <$ switchTo2))

            localCounter  = unOSF $
                            switch ((\port -> withCounting port) <$> port) `sfApp` inc1
                                                                           `sfApp` inc2

            globalCounter = unOSF $
                            switch ((\port -> withoutCounting port) <$> port) `sfApp` count inc1
                                                                              `sfApp` count inc2

        X <- just label -< X :& Text ::= localCounter
        X <- just label -< X :& Text ::= globalCounter
        returnA -< ()

    withCounting :: Port -> SignalFun era (DSignal `Of` ()     :->
                                           DSignal `Of` ()     :->
                                           SSignal `Of` String)
    withCounting Port1 = SSF $ \inc1 ->
                         SSF $ \_    ->
                         OSF $ count inc1
    withCounting Port2 = SSF $ \_    ->
                         SSF $ \inc2 ->
                         OSF $ count inc2

    withoutCounting :: Port -> SignalFun era (SSignal `Of` String :->
                                              SSignal `Of` String :->
                                              SSignal `Of` String)
    withoutCounting Port1 = SSF $ \value1 ->
                            SSF $ \_      ->
                            OSF $ value1
    withoutCounting Port2 = SSF $ \_      ->
                            SSF $ \value2 ->
                            OSF $ value2

    count :: DSignal era dummy -> SSignal era String
    count dSignal = show <$> SSignal.scan 0 (\num _ -> succ num) dSignal