{-# LANGUAGE ScopedTypeVariables #-} module FRP.Reactivity.Examples where import Codec.BMP import Control.Monad.IO.Class import Control.Monad import Control.Monad.Trans import Control.Monad.Fix import Foreign.Ptr import Data.Int import Data.Monoid import FRP.Reactivity.Combinators import qualified FRP.Reactivity.Draw as D import FRP.Reactivity.UI import FRP.Reactivity.Hook import FRP.Reactivity.Extras import Control.Applicative import Graphics.Win32 import Control.Monad.IO.Class import System.Mem -- Examples -- | Counter app - counts the number of times the button is pressed counter = run $ runHook $ -- Create a generic frame window... hCreate "Frame" (Appearance mempty "Counter" (0, 0, 400, 300), mempty :: Event (Appearance -> Appearance)) $ do -- and a button... w <- hCreate' "BUTTON" (Appearance (return ()) "Count" (0, 0, 200, 20), mempty) -- Make a label with a behavior that shows the count... let e = corec (\pr@(_, n) msg t -> case msg of Mouse _ Down _ -> ((Appearance mempty (show $ n + 1) (0, 20, 200, 40), n + 1), Appearance mempty (show $ n + 1) (0, 20, 200, 40), t) _ -> (pr, fst pr, t)) (mempty, 0 :: Int) (event w) hCreate' "STATIC" (mempty, fmap const e) -- Finally wait to close... wnd <- window Close <- lift $ liftE $ fmap return $ event wnd liftIO $ destroyWindow $ hwnd wnd -- | Make a graph of the sine function. animation = fmap (\b -> Appearance b "Graph" (0, 0, 250, 150)) $ graphBehavior (fmap sin time) (pure (0, 0, 250, 150)) (-1, 1) 10 (\_ -> rgb 212 100 0) graphing = run $ runHook $ hCreate "Frame" animation autoclose barChartTest = run $ runHook $ hCreate "Frame" (pure $ mempty { rect = (0, 0, 250, 150) }) $ barChart [("0", 10), ("1", 20)] 40 (250, 150) (const (rgb 255 0 0)) trackingBox ev = stepper mempty (fmap (\(x, y) -> Appearance (D.fillRect (rgb 0 255 0) (x - 20, y - 20, x + 20, y + 20)) "Tracker" (0, 0, 400, 300)) (mousePos ev)) mouseTracker = run $ do ev <- liftIO (chanSource defaultFrame) runHook (hCreate "Frame" (trackingBox (getEvent ev)) (autoclose >> window >>= \w -> lift (liftE (fmap return (event w))) >>= \x -> liftIO (print () >> addToEvent ev x))) blinky = run $ runHook $ hCreate "Frame" (fmap (\n -> Appearance (D.function (0, 0, 32767, 32767) (\_ x y -> rgb 0 (fromIntegral $ (x ^ 2 + y ^ 2) * round (n * 16)) (fromIntegral $ (x ^ 2 - y ^ 2) * round (n * 16)))) "" (0, 0, 400, 300)) time) $ do autoclose lift $ liftE $ fmap (const performGC) (tick 5) -- Scrollbars scrollbars = run $ runHook $ hCreate "Frame" (mempty { rect = (0, 0, 400, 300) }, mempty) $ do scroll $ hCreate' "BUTTON" (Appearance (return ()) "" (500, 300, 700, 330), mempty) autoclose highFive = run $ runHook $ do s <- liftIO $ chanSource defaultFrame w <- hCreate "Frame" (fmap (\s -> Appearance (return ()) s (0, 0, 400, 300)) $ stepper "High five" (justE (fmap (\x -> case x of Mouse _ Down _ -> Just "Too slow!" _ -> Nothing) (getEvent s)) <> cons "Don't leave me hanging" 5 mzero)) (autoclose >> window) lift $ liftS s (fmap return (event w))