Examples.hs

{-# 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

-- Examples

-- | Counter app - counts the number of times the button is pressed
counter = run $ do
	-- Create a generic frame window...
	wnd <- create desktop "Frame" (pure (Appearance mempty "Counter" (0, 0, 400, 300)))

	-- and a button...
	w <- create wnd "BUTTON" (pure (mempty { rect = (0, 0, 200, 20), text = "Count" }))

	-- Make a label with a behavior that shows the count...
	let beh = stepper mempty $ 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)
	create wnd "STATIC" beh

	-- Finally wait to close...
	Close <- 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

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))) >>= liftIO . addToEvent ev))

-- 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