{-----------------------------------------------------------------------------
    reactive-banana-wx
    
    Example: Currency Converter
------------------------------------------------------------------------------}
{-# LANGUAGE RecursiveDo #-}
import Data.Bits
import Data.Maybe
import Graphics.UI.WX hiding (Event)
import qualified Graphics.UI.WX.Events
import Graphics.UI.WXCore hiding (Event)
import Reactive.Banana
import Reactive.Banana.WX
import Text.Printf

{-----------------------------------------------------------------------------
    Main
------------------------------------------------------------------------------}
main = start $ do
    -- FIXME: Why does tab traversal not work?
    f        <- frame   [ text := "Currency Converter", tabTraversal := True ]
    dollar   <- entry f [ processEnter := True ]
    euro     <- entry f [ processEnter := True ]
    
    set f [layout := margin 10 $
            column 10 [
                grid 10 10 [[label "Dollar:", widget dollar],
                            [label "Euro:"  , widget euro  ]]
            , label "Amounts update while typing."
            ]]

    network <- compile $ mdo        
        euroIn   <- reactimateTextEntry euro    euroOut
        dollarIn <- reactimateTextEntry dollar  dollarOut

        let rate = 0.7 :: Double
            withString f s
                = maybe "-" (printf "%.2f") . fmap f 
                $ listToMaybe [x | (x,"") <- reads s] 
        
            -- define output values in terms of input values
            dollarOut, euroOut :: Discrete String
            dollarOut = withString (/ rate) <$> stepperD "0" euroIn
            euroOut   = withString (* rate) <$> stepperD "0" dollarIn

        return ()
    
    actuate network


-- text entry widget in terms of discrete time-varying values
reactimateTextEntry
    :: TextCtrl a
    -> Discrete String                    -- set programmatically (view)
    -> NetworkDescription (Event String)  -- read from user (controller)
reactimateTextEntry entry input = do
    sink entry [ text :== input ]

    -- Real-time text updates.
    -- Should be  wxEVT_COMMAND_TEXT_UPDATED  , but that's misisng from wxHaskell.
    e <- event1   entry keyboardUp
    b <- behavior entry text
    return $ b <@ e

-- observe "key up" events (many thanks to Abu Alam)
-- this should probably be in the wxHaskell library
keyboardUp  :: Graphics.UI.WX.Events.Event (Window a) (EventKey -> IO ())
keyboardUp  = newEvent "keyboardUp" windowGetOnKeyUp (windowOnKeyUp)