module FRP.UISF.Examples.Examples where
import FRP.UISF
import FRP.UISF.SOE (withColor', rgb, polygon)
import Numeric (showHex)
import Data.Maybe (listToMaybe, catMaybes)
timeEx :: UISF () ()
timeEx = title "Time" $ getTime >>> display
buttonEx :: UISF () ()
buttonEx = title "Buttons" $ 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
checkboxEx :: UISF () ()
checkboxEx = title "Checkboxes" $ proc _ -> do
x <- checkbox "Monday" False -< ()
y <- checkbox "Tuesday" True -< ()
z <- checkbox "Wednesday" True -< ()
let v = bin x ++ bin y ++ bin z
displayStr -< v
where
bin True = "1"
bin False = "0"
radioButtonEx :: UISF () ()
radioButtonEx = title "Radio Buttons" $ radio list 0 >>> arr (list!!) >>> displayStr
where
list = ["apple", "orange", "banana"]
shoppinglist :: UISF () ()
shoppinglist = title "Shopping List" $ proc _ -> do
a <- title "apples" $ hiSlider 1 (0,10) 3 -< ()
b <- title "bananas" $ hiSlider 1 (0,10) 7 -< ()
title "total" $ display -< (a + b)
colorDemo :: UISF () ()
colorDemo = setSize (300, 220) $ title "Color" $ pad (4,0,4,0) $ leftRight $ proc _ -> do
r <- newColorSlider "R" -< ()
g <- newColorSlider "G" -< ()
b <- newColorSlider "B" -< ()
prevRGB <- delay (0,0,0) -< (r,g,b)
changed <- delay True -< (r,g,b) == prevRGB
let rect = withColor' (rgb r g b) (box ((0,0),d))
pad (4,8,0,0) $ canvas d -< if changed then Just rect else Nothing
where
d = (170,170)
newColorSlider l = title l $ topDown $ proc _ -> do
v <- viSlider 16 (0,255) 0 -< ()
_ <- displayStr -< showHex v ""
returnA -< v
box ((x,y), (w, h)) = polygon [(x, y), (x + w, y), (x + w, y + h), (x, y + h)]
textboxdemo :: UISF () ()
textboxdemo = proc _ -> do
str <- leftRight $ label "Text: " >>> textboxE "" -< Nothing
b <- button "Save text to below" -< ()
rec str' <- delay "" -< if b then str else str'
leftRight $ label "Saved value: " >>> displayStr -< str'
returnA -< ()
main :: IO ()
main = runUI (500,500) "UI Demo" $
(leftRight $ (bottomUp $ timeEx >>> buttonEx) >>> checkboxEx >>> radioButtonEx) >>>
(leftRight $ shoppinglist >>> colorDemo) >>> textboxdemo