Imperative.hs

----------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.Phooey.Imperative
-- Copyright   :  (c) Conal Elliott 2006
-- License     :  LGPL
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  provisional
-- Portability :  portable
-- 
-- Some imperative UI tools.
----------------------------------------------------------------------

module Graphics.UI.Phooey.Imperative
  (
  -- * Widget & layout tools
    above, leftOf, empty', hwidget,lhwidget ,hsliderDyn
  -- * Simple abstraction around widget containers and frames
  , Win, Wio, runWio
  )
  where

import Graphics.UI.WX
import Graphics.UI.WXCore (sliderGetMin,sliderGetMax,sliderSetRange)

import Control.Instances () -- For Monoid (IO a) instance

{-----------------------------------------------------------------------
    Widget & layout tools
-----------------------------------------------------------------------}

-- | Binary layout combinator
above, leftOf :: Layout -> Layout -> Layout
la `above`   lb = fill (column  0 [la,lb])
la `leftOf`  lb = fill (row     0 [la,lb])

-- | A stretchy empty layout
empty' :: Layout
empty' = fill empty

-- | Horizontally-filled widget layout
hwidget :: Widget w => w -> Layout
hwidget = hfill . widget

-- | Labeled, horizontally-filled widget layout
lhwidget :: Widget w => String -> w -> Layout
lhwidget str = boxed str . hwidget


-- | Dynamically bounded slider.  The main complication is keeping the
-- slider value within the dynamic bounds.
hsliderDyn  ::  Window a -> Bool -> [Prop (Slider ())]
            ->  IO (Slider (), (Int,Int) -> IO ())
hsliderDyn win showBounds props =
  do  -- The reason for +- 100 in |makeISlider| is simply to reserve
      -- space.  There's a wxWidgets (I think) oddity that requires manual
      -- resizing otherwise.
      ctl <- hslider win showBounds (-100) (100) props
      return (ctl, setBounds ctl)
 where
   setBounds ctl (lo',hi') = 
     do  sliderSetRange ctl lo' hi'
         val  <- get ctl selection
         when (val < lo')  (setVal ctl lo')
         when (val > hi')  (setVal ctl hi')
   setVal ctl x  =
     do  lo   <- sliderGetMin ctl
         hi   <- sliderGetMax ctl
         when (lo <= x && x <= hi)
           (set ctl [ selection := x ])


{-----------------------------------------------------------------------
    Wio -- simple abstraction around widget containers and frames
-----------------------------------------------------------------------}

-- | Container of widgets
type Win  = Panel ()
-- | Consumes container and yield layout
type Wio  = Win -> IO Layout

-- | Run a 'Wio': handle frame & widget creation, and apply layout.
runWio :: String -> Wio -> IO ()
runWio name wio = start $
  do  f        <- frame [ visible := False, text := name ]
      win      <- panel f []
      l        <- wio win
      set win  [ layout := l ]
      set f    [ layout := hwidget win, visible := True ]