Imperative.hs

{-# OPTIONS #-}

----------------------------------------------------------------------
-- |
-- Module      :  Examples.Imperative
-- Copyright   :  (c) Conal Elliott 2007
-- License     :  LGPL
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- Portability :  portable
-- 
-- Imperative Phooey examples
----------------------------------------------------------------------

module Examples.Imperative where

import Graphics.UI.Phooey.Imperative

import Graphics.UI.WX


runUI0  ::  IO ()
runUI0  = start $
  do  f      <- frame [ visible := False, text := "ui0" ]
      pan    <- panel f  []
      count  <- hslider pan True 0 10 [ selection := 3 ]
      countSub <- mkNews count
      double <- textEntry pan [ ]
      triple <- textEntry pan [ ]
      
      let updDouble = do  n <- get count selection
                          set double [ text := show (2*n) ]
      let updTriple = do  n <- get count selection
                          set triple [ text := show (3*n) ]
      countSub updDouble
      countSub updTriple
      updDouble
      updTriple
      set pan  [  layout :=
                   boxed "Shopping List" $
                   fill $ column 0
                     [  lhwidget "count"   count
                     ,  lhwidget "double"  double  {-""-}
                     ,  lhwidget "triple"  triple    ]  ]
      set f    [ layout := hwidget pan, visible := True ]

runUI1  ::  IO ()
runUI1  = start $
  do  f        <- frame [ visible := False, text := "ui1" ]
      pan      <- panel f  []
      apples   <- hslider pan True 0 10 [ selection := 3 ]
      newsA    <- mkNews apples
      bananas  <- hslider pan True 0 10 [ selection := 7 ]
      newsB    <- mkNews bananas
      total    <- textEntry pan [ ]
      let updTot = do  a  <- get apples selection
                       b  <- get bananas selection
                       set total [ text := show (a+b) ]
      newsA updTot
      newsB updTot
      updTot
      set pan  [  layout :=
                   boxed "Shopping List" $
                   fill $ column 0
                     [  lhwidget "apples"   apples
                     ,  lhwidget "bananas"  bananas  {-""-}
                     ,  lhwidget "total"    total    ]  ]
      set f    [ layout := hwidget pan, visible := True ]