module FRP.UISF.Examples.Examples where
import FRP.UISF
import FRP.UISF.Graphics
import Numeric (showHex)
timeEx :: UISF () ()
timeEx = title "Time" $ accumTime >>> display <<< spacer
buttonEx :: UISF () ()
buttonEx = title "Buttons" $ topDown $ proc _ -> do
(x,y) <- leftRight (proc _ -> do
x <- edge <<< button "+" -< ()
y <- edge <<< button "-" -< ()
returnA -< (x, y)) -< ()
rec v <- delay 0 -< (case (x,y) of
(Just _, Nothing) -> v+1
(Nothing, Just _) -> v1
_ -> v)
display -< v
spacer -< ()
checkboxEx :: UISF () ()
checkboxEx = title "Checkboxes" $ topDown $ proc _ -> do
x <- checkbox "Monday" False -< ()
y <- checkbox "Tuesday" True -< ()
z <- checkbox "Wednesday" True -< ()
let v = bin x ++ bin y ++ bin z
displayStr -< v
spacer -< ()
where
bin True = "1"
bin False = "0"
radioButtonEx :: UISF () ()
radioButtonEx = title "Radio Buttons" $ topDown $ radio list 0 >>> arr (list!!) >>> displayStr >>> spacer
where
list = ["apple", "orange", "banana"]
shoppinglist :: UISF () ()
shoppinglist = title "Shopping List" $ topDown $ proc _ -> do
a <- spacer <<< title "apples" (hiSlider 1 (0,10) 3) -< ()
b <- spacer <<< title "bananas" (hiSlider 1 (0,10) 7) -< ()
title "total" display -< (a + b)
colorDemo :: UISF () ()
colorDemo = title "Color" $ leftRight $ proc _ -> do
r <- newColorSlider (coloredUIText Red "R") -< ()
g <- newColorSlider (coloredUIText Green "G") -< ()
b <- newColorSlider (coloredUIText Blue "B") -< ()
changed <- unique -< (r,g,b)
pad (4,8,0,0) $ canvas' layout rect -< changed
where
layout = makeLayout (Stretchy 10) (Stretchy 10)
newColorSlider l = title l $ topDown $ proc _ -> do
v <- viSlider 16 (0,255) 0 -< ()
_ <- setSize (22,22) displayStr -< showHex v ""
returnA -< v
rect (r,g,b) d = withColor' (rgbE r g b) (rectangleFilled ((0,0),d))
textboxdemo :: UISF () ()
textboxdemo = title "Saving Text" $ topDown $ proc _ -> do
str <- leftRight $ label "Text: " >>> textbox "" -< Nothing
b <- button "Save text to below" -< ()
rec str' <- delay "" -< if b then str else str'
leftRight $ label "Saved value: " >>> displayStr -< str'
uitext :: UIText
uitext = coloredUIText Red "H" `appendUIText`
coloredUIText Yellow "e" `appendUIText`
coloredUIText Green "l" `appendUIText`
coloredUIText Cyan "l" `appendUIText`
coloredUIText Blue "o" `appendUIText`
coloredUIText Magenta " W" `appendUIText`
coloredUIText Red "o" `appendUIText`
coloredUIText Yellow "r" `appendUIText`
coloredUIText Green "l" `appendUIText`
coloredUIText Cyan "d" `appendUIText`
coloredUIText Blue "!"
uitext' = fontUIText Helvetica18 uitext
uitextdemo = title "Color and Fonts" $ constA Nothing >>> textField CharWrap uitext' >>> constA ()
main :: IO ()
main = runUI (defaultUIParams {uiSize=(500, 520), uiCloseOnEsc=True}) $
(leftRight $ (bottomUp $ timeEx >>> buttonEx) >>> checkboxEx >>> radioButtonEx) >>>
(leftRight $ shoppinglist >>> colorDemo) >>> textboxdemo >>> uitextdemo
linesWith s = cons (case break (== '\n') s of
(l, "") -> (l,[])
(l, s') -> (l++"\n", case s' of
[] -> []
_:s'' -> linesWith s''))
where
cons ~(h, t) = h : t