UI.hs

{-# OPTIONS -fglasgow-exts #-}

----------------------------------------------------------------------
-- |
-- Module      :  Interface.TV.UI
-- Copyright   :  (c) Conal Elliott 2006
-- License     :  LGPL
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- Portability :  portable
-- 
-- Graphical 'UI' instances of TV classes, plus UI-specific tools
----------------------------------------------------------------------

module Interface.TV.UI
  (
     islider , runUI
   , UI, module Interface.TV            -- re-exports
  ) where

import Control.Arrow (pure,(>>>))

import Graphics.UI.Phooey hiding (runUI,islider)
import qualified Graphics.UI.Phooey as Ph (islider)

import Interface.TV


{----------------------------------------------------------
    Instances
----------------------------------------------------------}

instance Present UI where
  presentPair    = fromLeft
  presentLambda  = fromTop
  presentTitle   = title
  -- presentCompose = id

-- For the Eros version, I'll want presentCompose to replace all inner
-- handles with one outer handle.

instance ToIO UI where toIO = runNamedUI "TV + Phooey"

instance CommonInsOuts UI where
  putString = stringDisplay
  getString = textEntry


-- | Integer-valued slider, given initial value and bounds
islider :: Int
        -> (Int,Int)
        -> Input UI Int
islider initial bounds =
  iPrim (pure (const bounds) >>> Ph.islider initial)


-- | Type-disambiguating alias for 'runTV'
runUI :: RunTV UI
runUI = runTV