phooey-0.3: src/Examples.hs

{-# OPTIONS -fglasgow-exts -farrows #-}
----------------------------------------------------------------------
-- |
-- Module      :  Examples
-- Copyright   :  (c) Conal Elliott 2006
-- License     :  LGPL
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- Portability :  portable
-- 
-- Phooey examples.  Run them with 'runUI'
----------------------------------------------------------------------

module Examples where

import Control.Arrow
import Graphics.UI.Phooey
import Graphics.UI.Phooey.Imperative

-- Simple shopping list

ui1 :: UI () ()
ui1 =  title "Shopping List" $
       proc () -> do
         a  <- title "apples"   (islider 3)  -< (0,10)
         b  <- title "bananas"  (islider 7)  -< (0,10)
         title "total"  showDisplay          -< a+b


-- Dynamic bounds

ui2 = proc () -> do
        lo   <-  title "lo"   (islider 3)  -< (0,10)
        hi   <-  title "hi"   (islider 8)  -< (0,10)
        val  <-  title "val"  (islider 5)  -< (lo,hi)
        title "factorial" showDisplay      -< fact val

fact n = product [1 .. n]


-- In the two examples above, visual layout is implicitly chosen to be
-- top-down, following the order in which the components are declared in
-- the arrow expressions.  This choice may be overridden, as in the
-- following examples.

uiB1  = fromBottom  ui1
uiL1  = fromLeft    ui1
uiR1  = fromRight   ui1

ui3 =  fromBottom $
       proc () -> do
	    (a,b) <- fromRight fruit   -< (0,10)
	    title "total" showDisplay  -< a+b
  where       
   fruit =  title "apples"   (islider 3) &&&
	    title "bananas"  (islider 7)


-- Recursive examples.  These ones just hang.  Investigate.

ui4 = proc () -> do
        rec  lo   <-  title "lo"   (islider 3)  -< (0,hi)
             hi   <-  title "hi"   (islider 8)  -< (lo,10)
             val  <-  title "val"  (islider 5)  -< (lo,hi)
             title "factorial" showDisplay      -< fact val
        returnA -< ()


ui5 = proc () -> do
        rec  val <- title "val" (islider 6)  -< (val-5,val+5)
        title "squared" showDisplay          -< val*val



ui6 = proc () -> do
        s  <- title "message" textEntry  -< ()
        title "reversed" stringDisplay   -< reverse s


-- Simpler example for testing
uia = proc () -> do
        n <- islider 5 -< (0,10)
        showDisplay    -< fact n

uia' = fromLeft uia