UISF 0.3.0.2 → 0.4.0.0

raw patch · 23 files changed

+2838/−1761 lines, 23 filesdep +GLUTdep +arraydep −GLFWPVP ok

version bump matches the API change (PVP)

Dependencies added: GLUT, array

Dependencies removed: GLFW

API changes (from Hackage documentation)

Files

• FRP/UISF.hs +24/−8
• FRP/UISF/Asynchrony.hs +430/−0
• FRP/UISF/AuxFunctions.hs +35/−222
• FRP/UISF/Examples/Crud.hs +47/−38
• FRP/UISF/Examples/EnableGUI.hs +0/−20
• FRP/UISF/Examples/Examples.hs +45/−23
• FRP/UISF/Examples/Pinochle.hs +9/−8
• FRP/UISF/Examples/SevenGuis.lhs +48/−63
• FRP/UISF/Examples/fft.hs +2/−3
• FRP/UISF/Graphics.hs +36/−0
• FRP/UISF/Graphics/Color.hs +97/−0
• FRP/UISF/Graphics/Graphic.hs +237/−0
• FRP/UISF/Graphics/Text.hs +287/−0
• FRP/UISF/Graphics/Types.hs +32/−0
• FRP/UISF/Render/GLUT.hs +441/−0
• FRP/UISF/SOE.hs +0/−714
• FRP/UISF/UISF.hs +107/−114
• FRP/UISF/UITypes.hs +253/−70
• FRP/UISF/Widget.hs +358/−468
• FRP/UISF/Widget/Construction.hs +302/−0
• ReadMe.txt +3/−4
• UISF.cabal +12/−6
• changelog.txt +33/−0

@@ -3,17 +3,21 @@     UISF 
   , runUI'              -- :: UISF () () -> IO ()
   , runUI               -- :: UIParams -> UISF () () -> IO ()
-  , UIParams (..)       -- data UIParams = UIParams { ... }
-  , defaultUIParams     -- :: UIParams
+  , UIParams, defaultUIParams
+  , uiInitialize, uiClose, uiTitle, uiSize, uiInitFlow, uiTickDelay, uiCloseOnEsc, uiBackground
   , Dimension           -- type Dimension = (Int, Int)
     -- Widgets
   , label               -- :: String -> UISF a a
   , displayStr          -- :: UISF String ()
   , display             -- :: Show a => UISF a ()
   , withDisplay         -- :: Show b => UISF a b -> UISF a b
-  , textbox             -- :: UISF String String
+  , WrapSetting(..)     -- data WrapSetting = NoWrap | CharWrap | WordWrap
+  , displayField        -- :: WrapSetting -> UISF String ()
+  , textbox             -- :: String -> UISF (Event String) String
+  , textField           -- :: WrapSetting -> String -> UISF (Event String) String
   , textboxE            -- :: String -> UISF (Event String) String
   , title               -- :: String -> UISF a b -> UISF a b
+  , spacer              -- :: UISF a a
   , button              -- :: String -> UISF () Bool
   , stickyButton        -- :: String -> UISF () Bool
   , checkbox            -- :: String -> Bool -> UISF () Bool
@@ -22,10 +26,12 @@   , hSlider, vSlider    -- :: RealFrac a => (a, a) -> a -> UISF () a
   , hiSlider, viSlider  -- :: Integral a => a -> (a, a) -> a -> UISF () a
   , realtimeGraph       -- :: RealFrac a => Layout -> Time -> Color -> UISF [(a,Time)] ()
-  , Color (..)          -- data Color = Black | Blue | Green | Cyan | Red | Magenta | Yellow | White
+  , Color (..)          -- data Color = Black | Blue | Green | Cyan | Red | Magenta | Yellow | White ...
   , histogram           -- :: RealFrac a => Layout -> UISF (Event [a]) ()
   , histogramWithScale  -- :: RealFrac a => Layout -> UISF (SEvent [(a,String)]) ()
-  , listbox             -- :: (Eq a, Show a) => UISF ([a], Int) Int
+  , scrollable          -- :: Layout -> Dimension -> UISF a b -> UISF a b
+  , listbox             -- :: (Eq a, Show a) => [a] -> Int -> UISF (SEvent [a], SEvent Int) Int
+  , listbox'            -- :: (Eq a, Show a) => UISF ([a], Int) Int
   , canvas              -- :: Dimension -> UISF (Event Graphic) ()
   , canvas'             -- :: Layout -> (a -> Dimension -> Graphic) -> UISF (Event a) ()
   -- Widget Utilities
@@ -35,9 +41,14 @@   , setLayout           -- :: Layout -> UISF a b -> UISF a b
   , makeLayout          -- :: LayoutType -> LayoutType -> Layout
   , LayoutType (..)     -- data LayoutType = Stretchy { minSize :: Int } | Fixed { fixedSize :: Int }
+  , Layout              -- data Layout = Layout {..}
+  -- Time, effects, and asynchrony
   , getTime             -- :: UISF () Time
-  , asyncUISFV          -- :: NFData b => Double -> Double -> Automaton a b -> UISF a ([b], Bool)
-  , asyncUISFE          -- :: NFData b => Automaton a b -> UISF (SEvent a) (SEvent b)
+  , getDeltaTime        -- :: UISF () DeltaT
+  , ArrowIO(..)
+  , asyncVT
+  , asyncE
+  , asyncC
   , module FRP.UISF.AuxFunctions
   , module Control.Arrow
   ) where
@@ -45,7 +56,12 @@ import FRP.UISF.UITypes
 import FRP.UISF.UISF
 import FRP.UISF.Widget
-import FRP.UISF.SOE (Color (..))
+import FRP.UISF.Graphics (Color (..), WrapSetting(..),Dimension)
 
 import FRP.UISF.AuxFunctions
+import FRP.UISF.Asynchrony
 import Control.Arrow
+
+{-# DEPRECATED getTime "As of UISF-0.4.0.0, use accumTime instead, which is a little different but should work fine" #-}
+getTime :: UISF () Time
+getTime = accumTime

@@ -0,0 +1,430 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  FRP.UISF.Asynchrony
+-- Copyright   :  (c) Daniel Winograd-Cort 2015
+-- License     :  see the LICENSE file in the distribution
+--
+-- Maintainer  :  dwc@cs.yale.edu
+-- Stability   :  experimental
+--
+-- This module provides functionality to allow UISF to perform 
+-- asynchronous computations.
+
+{-# LANGUAGE Arrows, TupleSections, FlexibleContexts #-}
+
+module FRP.UISF.Asynchrony (
+    -- * ArrowIO
+    -- $arrowio
+    ArrowIO(..),
+    -- * Signal Function Asynchrony
+    -- $automaton
+    Automaton(..), 
+    statefulFunctionToAutomaton,
+    actionToIOAuto,
+    statefulActionToIOAuto,
+    pureAutoToIOAuto,
+    -- $asynchrony
+    asyncV, asyncVOn,
+    asyncVT, asyncVTOn,
+    asyncE, asyncEOn,
+    asyncEIO, asyncEIOOn,
+    asyncC, asyncCOn,
+    asyncCIO, asyncCIOOn
+) where
+
+import Prelude hiding ((.), id)
+import Control.Category
+import Control.Arrow
+import Control.Arrow.Operations
+import Control.Arrow.Transformer.Automaton
+
+import Data.Sequence (empty, (<|), (|>), (><), 
+                      viewl, ViewL(..), viewr, ViewR(..))
+import qualified Data.Sequence as Seq
+
+import Control.Concurrent
+import Control.Exception (bracket)
+import Data.IORef
+import Data.Foldable (toList)
+import Control.DeepSeq
+
+import FRP.UISF.AuxFunctions (DeltaT, Time, SEvent, accumTime)
+
+{- $arrowio
+Programming with UISF is not pure functional reactive programming.  
+Indeed, the GUI nature demands a certain amount of effectful computation 
+to really allow for an interface at all.  That said, widgets allow only 
+very specific effects, and they are handled in such a way that the 
+programming feels functional and reactive.
+
+To allow for more generic needs, we introduce the ArrowIO class below, 
+which UISF instantiates.  Note that using the ArrowIO functions should 
+be done very carefully; if a lifted IO action blocks within the UISF, 
+it will very likely block the entire GUI.  Thus, when possible, one is 
+advised to use 'initialAIO' or 'terminalAIO', which are guaranteed to 
+perform their 'IO' action only once.
+-}
+
+-- | Instances of the ArrowIO class have an arrowized ability to 
+--   perform IO actions.
+class Arrow a => ArrowIO a where
+  -- | The liftAIO function lifts an IO action into an arrow.
+  liftAIO :: (b -> IO c) -> a b c
+  -- | The initialAIO function performs an IO action once when the 
+  --   arrow is first initialized and then uses the result of that 
+  --   action to generate the arrow itself.
+  initialAIO :: IO d -> (d -> a b c) -> a b c
+  -- | The terminalAIO function stores an IO action to be performed 
+  --   once when the arrow terminates.  This will typically be some 
+  --   sort of clean up behavior.
+  terminalAIO :: IO () -> a b b
+
+
+{- $automaton
+The functions we want to perform asynchronously may be pure, but it 
+is quite possible that they are somewhat more complex.  Thus, in 
+keeping with the general arrowized nature of UISF, we allow the 
+asynchronized functions to be Automatons.
+
+Use the 'Arrow' 'arr' function to convert a pure function to an 
+Automaton of any type.
+-}
+
+-- | Pure automatons from b to c are functions that take a b value 
+--  and return a c value along with a new pure automaton from b to c.
+type PureAuto = Automaton (->)
+
+-- | IO automatons from b to c are functions that take a b value and 
+--  perform an IO action that returns a c value along with a new IO 
+--  automaton from b to c.
+type IOAuto = Automaton (Kleisli IO)
+
+-- | A convenience function for converting stateful functions to 
+--  'Automaton's.
+statefulFunctionToAutomaton :: ArrowLoop a => s -> ((b,s) -> (c,s)) -> Automaton a b c
+statefulFunctionToAutomaton s f = loop $ second (delay s) >>> arr f
+
+-- | A convenience function for converting IO actions to 'IOAuto's.
+actionToIOAuto :: (b -> IO c) -> IOAuto b c
+actionToIOAuto f = Automaton (Kleisli g) where
+  g b = f b >>= (\c -> return (c, Automaton (Kleisli g)))
+
+-- | A convenience function for converting stateful IO actions to 
+--  'IOAuto's.
+statefulActionToIOAuto :: s -> ((b,s) -> IO (c,s)) -> IOAuto b c
+statefulActionToIOAuto s f = loop $ second (delay s) >>> actionToIOAuto f
+
+-- | A convenience function for lifting a 'PureAuto' into an 'IOAuto'.
+pureAutoToIOAuto :: PureAuto b c -> IOAuto b c
+pureAutoToIOAuto (Automaton f) = Automaton (Kleisli g) where
+  g b = let (c,f') = f b in return (c, pureAutoToIOAuto f')
+
+
+{- $asynchrony
+There are times when we want to perform some behavior during the 
+course of running an arrow, but that behavior doesn't temporally 
+align nicely with the main GUI.  For example:
+
+- We have an FRP program that needs to be run at a fixed time rate, 
+  with each tick through time well specified.
+
+- We have a costly computation or potentially blocking action whose 
+  result is not immediately 
+  relevant, and we do not want to sacrifice the GUI's response time 
+  by making it part of the main loop.  That is, we are okay with it 
+  taking multiple ticks to finish, but we don't want to slow down 
+  any current ticks.
+
+- We want to perform an action in a private, tight loop.  For instance, 
+  we need to poll a device, and we do not want the GUI's framerate tied 
+  to the polling frequency in any way.
+
+The following functions implement these different forms of asynchrony.
+-}
+
+
+
+-- | The asyncV functions is for \"Virtual time\" asynchrony.  The 
+--   embedded signal function is given along with an expected 
+--   clockrate, and the output conforms to that clockrate as well as it 
+--   can.
+--   
+--   The clockrate is the simulated rate of the input signal function.
+--   The buffer is the amount of time the given signal function is 
+--   allowed to get ahead of real time.
+--
+--   The output signal function takes and returns values in real time.  
+--   The input must be paired with time, and the return values are the 
+--   list of bs generated in the given time step, each time stamped.  
+--   Note that the returned list may be long if the clockrate is much 
+--   faster than real time and potentially empty if it's slower.
+--   Note also that the caller can check the time stamp on the element 
+--   at the end of the list to see if the inner, \"simulated\" signal 
+--   function is performing as fast as it should.
+asyncV :: (ArrowIO a, NFData c) => 
+          Double            -- ^ Clockrate
+       -> DeltaT            -- ^ Amount of time to buffer
+       -> PureAuto b c      -- ^ The automaton to run virtually
+       -> a (b, Time) [(c, Time)]
+asyncV = asyncVHelper forkIO
+
+-- | A variant of 'asyncV' that uses 'forkOn' internally and thus takes 
+--  a core ID to fork on.
+asyncVOn :: (ArrowIO a, NFData c) => 
+            Int             -- ^ Core to fork on
+         -> Double          -- ^ Clockrate
+         -> DeltaT          -- ^ Amount of time to buffer
+         -> PureAuto b c    -- ^ The automaton to run virtually
+         -> a (b, Time) [(c, Time)]
+asyncVOn = asyncVHelper . forkOn
+
+asyncVHelper :: (ArrowIO a, NFData c) => 
+            (IO () -> IO ThreadId) -- ^ fork
+         -> Double          -- ^ Clockrate
+         -> DeltaT          -- ^ Amount of time to buffer
+         -> PureAuto b c    -- ^ The automaton to convert to realtime
+         -> a (b, Time) [(c, Time)]
+asyncVHelper frk clockrate buffer sf = initialAIO iod darr where
+  iod = do
+    inp <- newIORef undefined
+    start <- newEmptyMVar
+    out <- newIORef empty
+    timevar <- newEmptyMVar
+    tid <- frk $ takeMVar start >> worker inp out timevar 1 1 sf
+    return (tid, inp, out, timevar, start)
+  darr (tid, inp, out, timevar, start) = proc (b,t) -> do
+    _ <- terminalAIO (killThread tid) -< ()
+    _ <- liftAIO (writeIORef inp) -< b -- send the worker the new input
+    _ <- initialAIO (putMVar start ()) (const $ liftAIO $ tryPutMVar timevar) -< t  -- update the time for the worker
+    c <- liftAIO (atomicModifyIORef out) -< Seq.spanl (\(_,t0) -> t >= t0) --collect ready results
+    returnA -< toList c
+  -- worker processes the inner, "simulated" signal function.
+  worker inp out timevar t count (Automaton sf) = do
+    b <- readIORef inp     -- get the latest input
+    let (c, sf') = sf b   -- do the calculation
+    s <- deepseq c $ atomicModifyIORef out (\s -> (s |> (c, fromIntegral count/clockrate), s))
+    t' <- if Seq.length s > 0 && snd (seqLastElem s) >= t+buffer then takeMVar timevar else return t
+    worker inp out timevar t' (count+1) sf'
+  seqLastElem s = Seq.index s (Seq.length s - 1)
+
+
+-- | A variant of 'asyncV' that uses a built-in time step of the arrow 
+--  to accumulate and use the current time.
+asyncVT :: (ArrowIO a, ArrowCircuit a, ArrowReader DeltaT a, NFData c) => 
+           Double            -- ^ Clockrate
+        -> DeltaT            -- ^ Amount of time to buffer
+        -> PureAuto b c      -- ^ The automaton to run virtually
+        -> a b [(c, Time)]
+asyncVT clockrate buffer sf = (id &&& accumTime) >>> asyncV clockrate buffer sf
+
+-- | A variant of 'asyncVT' that uses 'forkOn' internally and thus takes 
+--  a core ID to fork on.
+asyncVTOn :: (ArrowIO a, ArrowCircuit a, ArrowReader DeltaT a, NFData c) => 
+             Int             -- ^ Core to fork on
+          -> Double          -- ^ Clockrate
+          -> DeltaT            -- ^ Amount of time to buffer
+          -> PureAuto b c      -- ^ The automaton to run virtually
+          -> a b [(c, Time)]
+asyncVTOn i clockrate buffer sf = (id &&& accumTime) >>> asyncVOn i clockrate buffer sf
+
+
+
+-- | The asyncE (E for \"Event\") function takes a signal function (an Automaton) and converts 
+--   it into an asynchronous event-based signal function usable in a ArrowIO signal 
+--   function context.  The output arrow takes events of type a, feeds them to 
+--   the asynchronously running input signal function, and returns events with the output 
+--   b whenever they are ready.  The input signal function is expected to run slowly 
+--   compared to the output one, but it is capable of running just as fast.
+asyncE :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData c) => 
+          PureAuto b c  -- ^ The automaton to convert to asynchronize
+       -> a (SEvent b) (SEvent c)
+asyncE = asyncEHelper forkIO
+
+-- | A variant of 'asyncE' that uses 'forkOn' internally and thus takes 
+--  a core ID to fork on.
+asyncEOn :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData c) => 
+            Int             -- ^ Core to fork on
+         -> PureAuto b c    -- ^ The automaton to asynchronize
+         -> a (SEvent b) (SEvent c)
+asyncEOn = asyncEHelper . forkOn
+
+asyncEHelper :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData c) => 
+          (IO () -> IO ThreadId)    -- ^ fork
+       -> PureAuto b c              -- ^ The automaton to asynchronize
+       -> a (SEvent b) (SEvent c)
+asyncEHelper frk sf = initialAIO iod darr where
+  iod = do
+    inp <- newIORef empty
+    out <- newIORef empty
+    proceed <- newEmptyMVar
+    tid <- frk $ worker proceed inp out sf
+    return (tid, proceed, inp, out)
+  -- count should start at 0
+  darr (tid, proceed, inp, out) = proc eb -> do
+    _ <- terminalAIO (killThread tid) -< ()
+    case eb of
+      Just b -> 
+        liftAIO (\b -> atomicModifyIORef inp (\s -> (s |> b, ())) >> tryPutMVar proceed ()) -< b
+      Nothing -> returnA -< False
+    c <- liftAIO (const $ atomicModifyIORef out seqRestHead) -< ()
+    returnA -< c
+  -- worker processes the inner, "simulated" signal function.
+  -- worker :: MVar () -> IORef (Seq a) -> IORef (Seq b) -> Automaton a b -> IO ()
+  worker proceed inp out (Automaton sf) = do
+    eb <- atomicModifyIORef inp seqRestHead
+    case eb of
+      Nothing -> takeMVar proceed >> worker proceed inp out (Automaton sf)
+      Just b -> do
+        let (c, sf') = sf b     -- do the calculation
+        deepseq c $ atomicModifyIORef out (\s -> (s |> c, ()))
+        worker proceed inp out sf'
+  seqRestHead s = case viewl s of
+      EmptyL  -> (s,  Nothing)
+      a :< s' -> (s', Just a)
+
+
+-- | A variant of 'asyncE' that takes an 'IOAuto' and can thus perform 
+--  'IO' actions.
+asyncEIO :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData c) => 
+          (IO d, d -> IO ())    -- ^ Initialization and termination procedures
+       -> (d -> IOAuto b c)     -- ^ The automaton to asynchronize
+       -> a (SEvent b) (SEvent c)
+asyncEIO = asyncEIOHelper forkIO
+
+-- | A variant of 'asyncEIO' that uses 'forkOn' internally and thus takes 
+--  a core ID to fork on.
+asyncEIOOn :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData c) => 
+              Int                   -- ^ Core to fork on
+           -> (IO d, d -> IO ())    -- ^ Initialization and termination procedures
+           -> (d -> IOAuto b c)     -- ^ The automaton to asynchronize
+           -> a (SEvent b) (SEvent c)
+asyncEIOOn = asyncEIOHelper . forkOn
+
+asyncEIOHelper :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData c) => 
+          (IO () -> IO ThreadId)    -- ^ fork
+       -> (IO d, d -> IO ())        -- ^ Initialization and termination procedures
+       -> (d -> IOAuto b c)         -- ^ The automaton to asynchronize
+       -> a (SEvent b) (SEvent c)
+asyncEIOHelper frk (ini, term) sf = initialAIO iod darr where
+  iod = do
+    inp <- newIORef empty
+    out <- newIORef empty
+    proceed <- newEmptyMVar
+    tid <- frk $ bracket ini term $ worker proceed inp out . sf
+    return (tid, proceed, inp, out)
+  -- count should start at 0
+  darr (tid, proceed, inp, out) = proc eb -> do
+    _ <- terminalAIO (killThread tid) -< ()
+    case eb of
+      Just b -> 
+        liftAIO (\b -> atomicModifyIORef inp (\s -> (s |> b, ())) >> tryPutMVar proceed ()) -< b
+      Nothing -> returnA -< False
+    c <- liftAIO (const $ atomicModifyIORef out seqRestHead) -< ()
+    returnA -< c
+  -- worker processes the inner, "simulated" signal function.
+  -- worker :: MVar () -> IORef (Seq a) -> IORef (Seq b) -> Automaton a b -> IO ()
+  worker proceed inp out (Automaton sf) = do
+    eb <- atomicModifyIORef inp seqRestHead
+    case eb of
+      Nothing -> takeMVar proceed >> worker proceed inp out (Automaton sf)
+      Just b -> do
+        (c, sf') <- runKleisli sf $ b     -- do the action
+        deepseq c $ atomicModifyIORef out (\s -> (s |> c, ()))
+        worker proceed inp out sf'
+  seqRestHead s = case viewl s of
+      EmptyL  -> (s,  Nothing)
+      a :< s' -> (s', Just a)
+
+
+
+-- | The asyncC (C for \"Continuous time\") function allows a continuous 
+--   signal function to run as fast as it can asynchronously.  There are 
+--   no guarantees that all input data make it to the asynchronous signal 
+--   function; if this is required, asyncE should be used instead.  
+--   Rather, the embedded signal function runs as fast as it can on 
+--   whatever value it has most recently seen.  Its results are 
+--   bundled together in a list to be returned to the main signal 
+--   function.
+asyncC :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData c) => 
+          PureAuto b c  -- ^ The automaton to convert to realtime
+       -> a b [c]
+asyncC = asyncCHelper forkIO
+
+-- | A variant of 'asyncC' that uses 'forkOn' internally and thus takes 
+--  a core ID to fork on.
+asyncCOn :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData c) => 
+            Int           -- ^ Core to fork on
+         -> PureAuto b c  -- ^ The automaton to convert to realtime
+         -> a b [c]
+asyncCOn = asyncCHelper . forkOn
+
+asyncCHelper :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData c) => 
+            (IO () -> IO ThreadId)  -- ^ fork
+         -> PureAuto b c            -- ^ The automaton to convert to realtime
+         -> a b [c]
+asyncCHelper frk sf = initialAIO iod darr where
+  iod = do
+    inp <- newIORef undefined
+    start <- newEmptyMVar
+    out <- newIORef empty
+    tid <- frk $ takeMVar start >> worker inp out sf
+    return (tid, inp, out, start)
+  darr (tid, inp, out, start) = proc b -> do
+    _ <- terminalAIO (killThread tid) -< ()
+    _ <- liftAIO (writeIORef inp) -< b -- send the worker the new input
+    c <- initialAIO (putMVar start ()) (const $ liftAIO (\_ -> atomicModifyIORef out (\s -> (empty,s)))) -< () --collect ready results
+    returnA -< toList c
+  -- worker processes the inner, "simulated" signal function.
+  worker inp out (Automaton sf) = do
+    b <- readIORef inp    -- get the latest input
+    let (c, sf') = sf b   -- do the calculation
+    deepseq c $ atomicModifyIORef out (\s -> (s |> c, ()))
+    worker inp out sf'
+
+
+
+
+
+
+-- | A variant of 'asyncC' that takes an 'IOAuto' and can thus perform 
+--  'IO' actions.
+asyncCIO :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData c) => 
+          (IO d, d -> IO ())    -- ^ Initialization and termination procedures
+       -> (d -> IOAuto b c)     -- ^ The automaton to convert to realtime
+       -> a b [c]
+asyncCIO = asyncCIOHelper forkIO
+
+-- | A variant of 'asyncCIO' that uses 'forkOn' internally and thus takes 
+--  a core ID to fork on.
+asyncCIOOn :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData c) => 
+              Int                   -- ^ Core to fork on
+           -> (IO d, d -> IO ())    -- ^ Initialization and termination procedures
+           -> (d -> IOAuto b c)     -- ^ The automaton to convert to realtime
+           -> a b [c]
+asyncCIOOn = asyncCIOHelper . forkOn
+
+asyncCIOHelper :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData c) => 
+          (IO () -> IO ThreadId)    -- ^ fork
+       -> (IO d, d -> IO ())        -- ^ Initialization and termination procedures
+       -> (d -> IOAuto b c)         -- ^ The automaton to convert to realtime
+       -> a b [c]
+asyncCIOHelper frk (ini, term) sf = initialAIO iod darr where
+  iod = do
+    inp <- newIORef undefined
+    start <- newEmptyMVar
+    out <- newIORef empty
+    tid <- frk $ takeMVar start >> bracket ini term (worker inp out . sf)
+    return (tid, inp, out, start)
+  darr (tid, inp, out, start) = proc b -> do
+    _ <- terminalAIO (killThread tid) -< ()
+    _ <- liftAIO (writeIORef inp) -< b -- send the worker the new input
+    c <- initialAIO (putMVar start ()) (const $ liftAIO (\_ -> atomicModifyIORef out (\s -> (empty,s)))) -< () --collect ready results
+    returnA -< toList c
+  -- worker processes the inner, "simulated" signal function.
+  worker inp out (Automaton sf) = do
+    b <- readIORef inp    -- get the latest input
+    (c, sf') <- runKleisli sf $ b   -- do the action
+    deepseq c $ atomicModifyIORef out (\s -> (s |> c, ()))
+    worker inp out sf'
+
+

@@ -9,13 +9,12 @@ --
 -- Auxiliary functions for use with UISF or other arrows.
 
-{-# LANGUAGE Arrows, ScopedTypeVariables, TupleSections #-}
+{-# LANGUAGE Arrows, TupleSections, FlexibleContexts #-}
 
 module FRP.UISF.AuxFunctions (
     -- * Types
     SEvent, Time, DeltaT, 
-    ArrowTime(..), 
-    ArrowIO(..),
+    getDeltaT, accumTime, 
     -- * Useful SF Utilities (Mediators)
     constA, constSF, 
     edge, 
@@ -25,8 +24,7 @@     concatA, runDynamic, foldA, foldSF, 
     maybeA, evMap, 
     -- * Delays and Timers
-    delay, 
-    -- | delay is a unit delay.  It is exactly the delay from ArrowCircuit.
+    ArrowCircuit(..), 
     vdelay, fdelay, 
     vcdelay, fcdelay, 
     timer, genEvents, 
@@ -35,27 +33,17 @@     
 --    (=>>), (->>), (.|.),
 --    snapshot, snapshot_,
-
-    -- * Signal Function Asynchrony
-    -- $asynchrony
-    Automaton(..), 
-    asyncV, asyncE, asyncC, asyncC'
 ) where
 
 import Prelude hiding ((.), id)
 import Control.Category
 import Control.Arrow
 import Control.Arrow.Operations
-import Control.Arrow.Transformer.Automaton
 import Data.Sequence (empty, (<|), (|>), (><), 
                       viewl, ViewL(..), viewr, ViewR(..))
 import qualified Data.Sequence as Seq
 import Data.Maybe (listToMaybe)
 
-import Control.Concurrent
-import Data.IORef
-import Data.Foldable (toList)
-import Control.DeepSeq
 
 
 --------------------------------------
@@ -71,21 +59,14 @@ -- | DeltaT is a type synonym referring to a change in Time.
 type DeltaT = Double
 
--- | Instances of this class have arrowized access to time.  This is 
---   convenient in many cases where time is necessary but we would 
---   prefer not to make it an explicit argument.
-class ArrowTime a where
-    time :: a () Time
+-- | This is a convenience function for any DeltaT ArrowReader
+getDeltaT :: ArrowReader DeltaT a => a b DeltaT
+getDeltaT = readState
 
--- | Instances of the ArrowIO class have an arrowized ability to 
---   perform IO actions.
-class Arrow a => ArrowIO a where
-  -- | The liftAIO function lifts an IO action into an arrow.
-  liftAIO :: (b -> IO c) -> a b c
-  -- | The initialAIO function performs an IO action once upon the 
-  --   initialization of the arrow and then uses the result of that 
-  --   action to generate the arrow itself.
-  initialAIO :: IO d -> (d -> a b c) -> a b c
+-- | This function returns the accumulated delta times created by 
+--  getDeltaT.  Thus, it is the "accumulated" time.
+accumTime :: (ArrowCircuit a, ArrowReader DeltaT a) => a b Time
+accumTime = getDeltaT >>> arr (Just . (+)) >>> accum 0
 
 --------------------------------------
 -- Useful SF Utilities (Mediators)
@@ -112,8 +93,9 @@ --   to get the next value, and so on.
 accum :: ArrowCircuit a => b -> a (SEvent (b -> b)) b
 accum x = proc f -> do
-    rec b <- delay x -< maybe b ($b) f
-    returnA -< b
+    rec b <- delay x -< b'
+        let b' = maybe b ($b) f
+    returnA -< b'
 
 -- | The signal function unique will produce an event each time its input 
 --   signal changes.
@@ -127,13 +109,14 @@ --   happens, at which point it changes to the value attached to that 
 --   event, which it then holds until the next event, and so on.
 hold :: ArrowCircuit a => b -> a (SEvent b) b
-hold x = arr (fmap (const $)) >>> accum x
+hold x = arr (fmap const) >>> accum x
 
 -- | Now is a signal function that produces one event and then forever 
 --   after produces nothing.  It is essentially an impulse function.
 now :: ArrowCircuit a => a () (SEvent ())
-now = arr (const Nothing) >>> delay (Just ())
+now = constA Nothing >>> delay (Just ())
 
+{-# DEPRECATED mergeE "As of UISF-0.4.0.0, mergeE is being removed as it's basically just mappend from Monoid." #-}
 -- | mergeE merges two events with the given resolution function.
 mergeE :: (a -> a -> a) -> SEvent a -> SEvent a -> SEvent a
 mergeE _       Nothing     Nothing     = Nothing
@@ -141,6 +124,7 @@ mergeE _       Nothing     re@(Just _) = re
 mergeE resolve (Just l)    (Just r)    = Just (resolve l r)
 
+{-# DEPRECATED (~++) "As of UISF-0.4.0.0, (~++) is being removed as it is equivalent to Monoid's mappend." #-}
 -- | This is an infix specialization of 'mergeE' to lists.
 (~++) :: SEvent [a] -> SEvent [a] -> SEvent [a]
 (~++) = mergeE (++)
@@ -218,9 +202,9 @@ --   if events are too densely packed in the signal (compared to the 
 --   clock rate of the underlying arrow), then some events may be 
 --   over delayed.
-fdelay :: (ArrowTime a, ArrowCircuit a) => DeltaT -> a (SEvent b) (SEvent b)
+fdelay :: (ArrowReader DeltaT a, ArrowCircuit a) => DeltaT -> a (SEvent b) (SEvent b)
 fdelay d = proc e -> do
-    t <- time -< ()
+    t <- accumTime -< ()
     rec q <- delay empty -< maybe q' (\e' -> q' |> (t+d,e')) e
         let (ret, q') = case viewl q of
                 EmptyL -> (Nothing, q)
@@ -234,9 +218,9 @@ --   same as the order of events out and that no event will be skipped.  
 --   If the events are too dense or the delay argument drops too quickly, 
 --   some events may be over delayed.
-vdelay :: (ArrowTime a, ArrowCircuit a) => a (DeltaT, SEvent b) (SEvent b)
+vdelay :: (ArrowReader DeltaT a, ArrowCircuit a) => a (DeltaT, SEvent b) (SEvent b)
 vdelay = proc (d, e) -> do
-    t <- time -< ()
+    t <- accumTime -< ()
     rec q <- delay empty -< maybe q' (\e' -> q' |> (t,e')) e
         let (ret, q') = case viewl q of 
                 EmptyL -> (Nothing, q)
@@ -248,9 +232,9 @@ --   be accurate, but some data may be ommitted entirely.  As such, it is 
 --   not advisable to use fcdelay for event streams where every event must 
 --   be processed (that's what fdelay is for).
-fcdelay :: (ArrowTime a, ArrowCircuit a) => b -> DeltaT -> a b b
+fcdelay :: (ArrowReader DeltaT a, ArrowCircuit a) => b -> DeltaT -> a b b
 fcdelay i dt = proc v -> do
-    t <- time -< ()
+    t <- accumTime -< ()
     rec q <- delay empty -< q' |> (t+dt, v) -- this list has pairs of (emission time, value)
         let (ready, rest) = Seq.spanl ((<= t) . fst) q
             (ret, q') = case viewr ready of
@@ -273,9 +257,9 @@ --   delay amount variably changes, values are moved back and forth between 
 --   these two sequences as necessary.
 --   This should provide a slight performance boost.
-vcdelay :: (ArrowTime a, ArrowCircuit a) => DeltaT -> b -> a (DeltaT, b) b
+vcdelay :: (ArrowReader DeltaT a, ArrowCircuit a) => DeltaT -> b -> a (DeltaT, b) b
 vcdelay maxDT i = proc (dt, v) -> do
-    t <- time -< ()
+    t <- accumTime -< ()
     rec (qlow, qhigh) <- delay (empty,empty) -< 
                 (dropMostWhileL ((< t-maxDT) . fst) qlow', qhigh' |> (t, v))
                     -- this is two lists with pairs of (initial time, value)
@@ -307,9 +291,9 @@ --   fast enough compared to the timer frequency, this should give accurate and 
 --   predictable output and stay synchronized with any other timer and with 
 --   time itself.
-timer :: (ArrowTime a, ArrowCircuit a) => a DeltaT (SEvent ())
+timer :: (ArrowReader DeltaT a, ArrowCircuit a) => a DeltaT (SEvent ())
 timer = proc dt -> do
-    now <- time -< ()
+    now <- accumTime -< ()
     rec last <- delay 0 -< t'
         let ret = now >= last + dt
             t'  = latestEventTime last dt now
@@ -325,7 +309,7 @@ -- | genEvents is a timer that instead of returning unit events 
 --   returns the next element of the input list.  When the input 
 --   list is empty, the output stream becomes all Nothing.
-genEvents :: (ArrowTime a, ArrowCircuit a) => [b] -> a DeltaT (SEvent b)
+genEvents :: (ArrowReader DeltaT a, ArrowCircuit a) => [b] -> a DeltaT (SEvent b)
 genEvents lst = proc dt -> do
     e <- timer -< dt
     rec l <- delay lst -< maybe l (const $ drop 1 l) e
@@ -361,22 +345,21 @@ --   at the same timestep. In addition to any events emitted, a 
 --   streaming Bool is emitted that is True if the buffer is empty and 
 --   False if the buffer is full (meaning that events will still come).
-eventBuffer :: (ArrowTime a, ArrowCircuit a) => a (BufferOperation b) (SEvent [b], Bool)
-eventBuffer = arr (,()) >>> second time >>> eventBuffer'
+eventBuffer :: (ArrowReader DeltaT a, ArrowCircuit a) => a (BufferOperation b) (SEvent [b], Bool)
+eventBuffer = arr (,()) >>> second getDeltaT >>> eventBuffer'
 
 -- | eventBuffer' is a version that takes Time explicitly rather than 
 --   with ArrowTime.
-eventBuffer' :: ArrowCircuit a => a (BufferOperation b, Time) (SEvent [b], Bool)
-eventBuffer' = proc (bo', t) -> do
+eventBuffer' :: ArrowCircuit a => a (BufferOperation b, DeltaT) (SEvent [b], Bool)
+eventBuffer' = proc (bo', dt) -> do
     let (bo, doPlay', tempo') = collapseBO bo'
     doPlay <- hold True -< doPlay'
     tempo <- hold 1 -< tempo'
-    rec tprev  <- delay 0    -< t   --used to calculate dt, the change in time
-        buffer <- delay []   -< buffer' --the buffer
-        let dt = tempo * (t-tprev) --dt will never be negative
+    rec buffer <- delay []   -< buffer' --the buffer
+        let bufdt = tempo * dt
             (nextMsgs, buffer') = if doPlay 
                 -- Subtract delta time, update the buffer, and get any events that are ready
-                then getNextEvent (update (subTime buffer dt) bo)
+                then getNextEvent (update (subTime buffer bufdt) bo)
                 -- Regardless, update the buffer based on the operation
                 else (Nothing, update buffer bo)
     returnA -< (nextMsgs, null buffer')
@@ -432,174 +415,4 @@ snapshot_ :: SEvent a -> b -> SEvent b
 snapshot_ = flip $ fmap . const -- same as ->>
 
-
-
---------------------------------------
--- Signal Function Asynchrony
---------------------------------------
-
-{- $asynchrony
-Due to the ability for ArrowIO arrows to perform IO actions, they are 
-obviously not guaranteed to be pure, and thus when we run them, we say 
-that they run \"in real time\".  This means that the time between two 
-samples can vary and is inherently unpredictable.
-
-However, there are cases when we would like more control over the timing 
-of certain arrowized computations.  For instance, sometimes we have a 
-pure computation that we would like to run on a simulated clock.  This 
-computation will expect to produce values at specific intervals, and 
-because it's pure, that expectation can sort of be satisfied.
-
-To achieve this, we allow these sub-computations to be performed 
-asynchronously.  The following functions behave subtly differently 
-to exhibit different forms of asynchrony for different use cases.
--}
-
--- | The asyncV functions is for \"Virtual time\" asynchrony.  The 
---   embedded signal function is given along with an expected 
---   clockrate, and the output conforms to that clockrate as well as it 
---   can.
---   
---   The clockrate is the simulated rate of the input signal function.
---   The buffer is the amount of time the given signal function is 
---   allowed to get ahead of real time.  The threadHandler is where the 
---   ThreadId of the forked thread is sent.
---
---   The output signal function takes and returns values in real time.  
---   The input must be paired with time, and the return values are the 
---   list of bs generated in the given time step, each time stamped.  
---   Note that the returned list may be long if the clockrate is much 
---   faster than real time and potentially empty if it's slower.
---   Note also that the caller can check the time stamp on the element 
---   at the end of the list to see if the inner, \"simulated\" signal 
---   function is performing as fast as it should.
-asyncV :: (ArrowIO a, NFData c) => 
-          Double             -- ^ Clockrate
-       -> DeltaT             -- ^ Amount of time to buffer
-       -> (ThreadId -> a () ()) -- ^ The thread handler
-       -> (Automaton (->) b c)      -- ^ The automaton to convert to realtime
-       -> a (b, Time) [(c, Time)]
-asyncV clockrate buffer threadHandler sf = initialAIO iod darr where
-  iod = do
-    inp <- newEmptyMVar
-    out <- newIORef empty
-    timevar <- newEmptyMVar
-    tid <- forkIO $ worker inp out timevar 1 1 sf
-    return (tid, inp, out, timevar)
-  darr (tid, inp, out, timevar) = proc (b,t) -> do
-    _ <- threadHandler tid -< ()
-    _ <- liftAIO (\b -> tryTakeMVar inp >> putMVar inp b) -< b -- send the worker the new input
-    _ <- liftAIO (tryPutMVar timevar) -< t  -- update the time for the worker
-    c <- liftAIO (atomicModifyIORef out) -< Seq.spanl (\(_,t0) -> t >= t0) --collect ready results
-    returnA -< toList c
-  -- worker processes the inner, "simulated" signal function.
-  worker inp out timevar t count (Automaton sf) = do
-    b <- readMVar inp     -- get the latest input
-    let (c, sf') = sf b   -- do the calculation
-    s <- deepseq c $ atomicModifyIORef out (\s -> (s |> (c, fromIntegral count/clockrate), s))
-    t' <- if Seq.length s > 0 && snd (seqLastElem s) >= t+buffer then takeMVar timevar else return t
-    worker inp out timevar t' (count+1) sf'
-  seqLastElem s = Seq.index s (Seq.length s - 1)
-
-
-
--- | The asyncE (E for \"Event\") function takes a signal function (an Automaton) and converts 
---   it into an asynchronous event-based signal function usable in a ArrowIO signal 
---   function context.  The output arrow takes events of type a, feeds them to 
---   the asynchronously running input signal function, and returns events with the output 
---   b whenever they are ready.  The input signal function is expected to run slowly 
---   compared to the output one, but it is capable of running just as fast.
-asyncE :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData c) => 
-          (ThreadId -> a () ()) -- ^ The thread handler
-       -> (Automaton (->) b c)  -- ^ The automaton to convert to asynchronize
-       -> a (SEvent b) (SEvent c)
-asyncE threadHandler sf = initialAIO iod darr where
-  iod = do
-    inp <- newIORef empty
-    out <- newIORef empty
-    proceed <- newEmptyMVar
-    tid <- forkIO $ worker proceed inp out sf
-    return (tid, proceed, inp, out)
-  -- count should start at 0
-  darr (tid, proceed, inp, out) = proc eb -> do
-    _ <- threadHandler tid -< ()
-    case eb of
-      Just b -> 
-        liftAIO (\b -> atomicModifyIORef inp (\s -> (s |> b, ())) >> tryPutMVar proceed ()) -< b
-      Nothing -> returnA -< False
-    c <- liftAIO (const $ atomicModifyIORef out seqRestHead) -< ()
-    returnA -< c
-  -- worker processes the inner, "simulated" signal function.
-  -- worker :: MVar () -> IORef (Seq a) -> IORef (Seq b) -> Automaton a b -> IO ()
-  worker proceed inp out (Automaton sf) = do
-    eb <- atomicModifyIORef inp seqRestHead
-    case eb of
-      Nothing -> takeMVar proceed >> worker proceed inp out (Automaton sf)
-      Just b -> do
-        let (c, sf') = sf b     -- do the calculation
-        deepseq c $ atomicModifyIORef out (\s -> (s |> c, ()))
-        worker proceed inp out sf'
-  seqRestHead s = case viewl s of
-      EmptyL  -> (s,  Nothing)
-      a :< s' -> (s', Just a)
-
--- | The asyncC (C for \"Continuous time\") function allows a continuous 
---   signal function to run as fast as it can asynchronously.  There are 
---   no guarantees that all input data make it to the asynchronous signal 
---   function; if this is required, asyncE should be used instead.  
---   Rather, the embedded signal function runs as fast as it can on 
---   whatever value it has most recently seen.  Its results are 
---   bundled together in a list to be returned to the main signal 
---   function.
-asyncC :: (ArrowIO a, NFData c) => 
-          (ThreadId -> a () ()) -- ^ The thread handler
-       -> (Automaton (->) b c)  -- ^ The automaton to convert to realtime
-       -> a b [c]
---asyncC th sf = asyncC' th (const . return $ (), return) (first sf)
-asyncC threadHandler sf = initialAIO iod darr where
-  iod = do
-    inp <- newEmptyMVar
-    out <- newIORef empty
-    tid <- forkIO $ worker inp out sf
-    return (tid, inp, out)
-  darr (tid, inp, out) = proc b -> do
-    _ <- threadHandler tid -< ()
-    _ <- liftAIO (\b -> tryTakeMVar inp >> putMVar inp b) -< b -- send the worker the new input
-    c <- liftAIO (\_ -> atomicModifyIORef out (\s -> (empty,s))) -< () --collect ready results
-    returnA -< toList c
-  -- worker processes the inner, "simulated" signal function.
-  worker inp out (Automaton sf) = do
-    b <- readMVar inp     -- get the latest input
-    let (c, sf') = sf b   -- do the calculation
-    deepseq c $ atomicModifyIORef out (\s -> (s |> c, ()))
-    worker inp out sf'
-
-
--- | This is a version of asyncC that does IO actions on either end of 
---   the embedded signal function.
-asyncC' :: (ArrowIO a, ArrowLoop a, ArrowCircuit a, ArrowChoice a, NFData b) => 
-           (ThreadId -> a () ()) -- ^ The thread handler
-        -> (b -> IO d, e -> IO ()) -- ^ Effectful input and output channels for the automaton
-        -> (Automaton (->) (b,d) (c,e))  -- ^ The automaton to convert to asynchronize
-        -> a b [c]
-asyncC' threadHandler (iAction, oAction) sf = initialAIO iod darr where
-  iod = do
-    inp <- newIORef undefined
-    start <- newEmptyMVar
-    out <- newIORef empty
-    tid <- forkIO $ takeMVar start >> worker inp out sf
-    return (tid, inp, out, start)
-  darr (tid, inp, out, start) = proc b -> do
-    _ <- threadHandler tid -< ()
-    _ <- liftAIO $ (\b -> deepseq b $ writeIORef inp b) -< b -- send the worker the new input
-    c <- initialAIO (putMVar start ()) (const $ liftAIO (\_ -> atomicModifyIORef' out (\s -> (empty,s)))) -< () --collect ready results
-    returnA -< toList c
-  -- worker processes the inner, "simulated" signal function.
-  worker inp out (Automaton sf) = do
-    b <- readIORef inp     -- get the latest input
-    d <- iAction b
-    let ((c,e), sf') = sf (b,d)   -- do the calculation
-    oAction e
-    atomicModifyIORef' out (\s -> (s |> c, ()))
-    worker inp out sf'
 

@@ -31,7 +31,21 @@ instance Eq NameEntry where
     (NameEntry f1 l1) == (NameEntry f2 l2) = f1 == f2 && l1 == l2
 
+deleteFromDB :: (a -> Bool) -> Int -> Database a -> Database a
+deleteFromDB _ _ [] = []
+deleteFromDB f i (x:xs) = case (f x, i == 0) of
+    (True, True)    -> xs
+    (True, False)   -> x:deleteFromDB f (i-1) xs
+    (False, _)      -> x:deleteFromDB f i xs
 
+updateDB :: (a -> Bool) -> Int -> a -> Database a -> Database a
+updateDB _ _ _ [] = []
+updateDB f i a (x:xs) = case (f x, i == 0) of
+    (True, True)    -> a:xs
+    (True, False)   -> x:updateDB f (i-1) a xs
+    (False, _)      -> x:updateDB f i a xs
+
+
 -- defaultnames is a default database for our example
 defaultnames :: Database NameEntry
 defaultnames = [
@@ -41,7 +55,7 @@ 
 
 -- | This function will run the crud GUI with the default names.
-crud = runUI (defaultUIParams {uiSize=(350, 400), uiTitle="CRUD"}) (crudUISF defaultnames)
+crud = runUI (defaultUIParams {uiSize=(450, 400), uiTitle="CRUD"}) (crudUISF defaultnames)
 -- | main = crud
 main = crud
 
@@ -51,35 +65,29 @@ crudUISF :: Database NameEntry -> UISF () ()
 crudUISF initnamesDB = proc _ -> do
   rec
-    fStr <- leftRight $ label "Filter text: " >>> textboxE "" -< Nothing
-    (i, db, fdb, nameStr, surnStr) <- (| leftRight (do
-        (i, db, fdb) <- (| topDown (do
-            rec i <- listbox -< (fdb, i')
-                db <- delay initnamesDB -< db'
-                let fdb = filter (filterFun fStr) db
-            returnA -< (i, db, fdb)) |)
-        (nameStr, surnStr) <- (| topDown (do
-            rec nameStr <- leftRight $ label "Name:    " >>> textboxE "" -< nameStr'
-                surnStr <- leftRight $ label "Surname: " >>> textboxE "" -< surnStr'
-                let nameStr' = if previ == i then Nothing else Just $ firstName ((filter (filterFun fStr) db') `at` i')
-                    surnStr' = if previ == i then Nothing else Just $ lastName  ((filter (filterFun fStr) db') `at` i')
-            returnA -< (nameStr, surnStr)) |)
-        returnA -< (i, db, fdb, nameStr, surnStr)) |)
+    fStr <- leftRight $ label "Filter text: " >>> textbox "" -< Nothing
+    let fdb = filter (filterFun fStr) db
+    (i, nameData) <- (| leftRight (do
+        i <- listbox' -< (fdb, i')
+        nameData <- (| topDown (do
+            rec nameStr <- leftRight $ label "Name:    " >>> textbox "" -< nameStr'
+                surnStr <- leftRight $ label "Surname: " >>> textbox "" -< surnStr'
+                iUpdate <- unique -< i
+                let nameStr' = fmap (const $ firstName (fdb `at` i)) iUpdate
+                    surnStr' = fmap (const $ lastName  (fdb `at` i)) iUpdate
+            returnA -< NameEntry nameStr surnStr) |)
+        returnA -< (i, nameData)) |)
     buttons <- leftRight $ (edge <<< button "Create") &&& 
+                           (edge <<< button "Update") &&& 
                            (edge <<< button "Delete") -< ()
-    previ <- delay 0 -< i
-    let (db', i') = case buttons of
-            (Just _, Nothing) -> (db ++ [NameEntry nameStr surnStr], length fdb)
-            (Nothing, Just _) -> (deleteElem (filterFun fStr) i db,
-                              if i == length fdb - 1 then length fdb - 2 else i)
+    (db,i') <- delay (initnamesDB, -1) -< case buttons of
+            (Just _, (_, _))             -> (db ++ [nameData], length fdb)
+            (Nothing, (Just _, _))       -> (updateDB (filterFun fStr) i nameData db, i)
+            (Nothing, (Nothing, Just _)) -> (deleteFromDB (filterFun fStr) i db,
+                                             if i == length fdb - 1 then i - 1 else i)
             _ -> (db, i)
   returnA -< ()
   where
-    deleteElem _ _ [] = []
-    deleteElem f i (x:xs) = case (f x, i == 0) of
-        (True, True)    -> xs
-        (True, False)   -> x:deleteElem f (i-1) xs
-        (False, _)      -> x:deleteElem f i xs
     filterFun str name = and (map (\s -> isInfixOf s (map toLower $ show name)) (words (map toLower str)))
     lst `at` index = if index >= length lst || index < 0 then NameEntry "" "" else lst!!index
 
@@ -87,27 +95,28 @@ -- If we don't care about formatting, this code simplifies a huge amount to:
 -- crudUISF initnamesDB = proc _ -> do
 --   rec
---     (fStr,fi) <- leftRight $ label "Filter text: " >>> cursoredTextbox False ("",0) -< (fStr,fi)
---     i <- listbox -< (fdb, i')
---     db <- delay initnamesDB -< db'
+--     fStr <- leftRight $ label "Filter text: " >>> textbox "" -< Nothing
 --     let fdb = filter (filterFun fStr) db
---     (nameStr, ni) <- leftRight $ label "Name:    " >>> cursoredTextbox False "" -< (nameStr', ni)
---     (surnStr, si) <- leftRight $ label "Surname: " >>> cursoredTextbox False "" -< (surnStr', si)
---     let nameStr' = if previ == i' then nameStr else firstName ((filter (filterFun fStr) db') `at` i')
---         surnStr' = if previ == i' then surnStr else lastName ((filter (filterFun fStr) db') `at` i')
+--     i <- listbox -< (fdb, i')
+--     nameStr <- leftRight $ label "Name:    " >>> textbox "" -< nameStr'
+--     surnStr <- leftRight $ label "Surname: " >>> textbox "" -< surnStr'
+--     iUpdate <- unique -< i
+--     let nameStr' = fmap (const $ firstName (fdb `at` i)) iUpdate
+--         surnStr' = fmap (const $ lastName  (fdb `at` i)) iUpdate
+--         nameData = NameEntry nameStr surnStr
 --     buttons <- leftRight $ (edge <<< button "Create") &&& 
 --                            (edge <<< button "Delete") -< ()
---     previ <- delay 0 -< i
---     let (db', i') = case buttons of
---             (True, False) -> (db ++ [NameEntry nameStr surnStr], length fdb)
---             (False, True) -> (deleteElem (filterFun fStr) i db,
---                               if i == length fdb - 1 then length fdb - 2 else i)
+--     (db,i') <- delay (initnamesDB, -1) <- case buttons of
+--            (Just _, (_, _))             -> (db ++ [nameData], length fdb)
+--            (Nothing, (Just _, _))       -> (updateDB (filterFun fStr) i nameData db, i)
+--            (Nothing, (Nothing, Just _)) -> (deleteFromDB (filterFun fStr) i db,
+--                                             if i == length fdb - 1 then length fdb - 2 else i)
 --             _ -> (db, i)
 --   returnA -< ()
 --   where
 --     ...
 -- 
--- Clearly, this is much easier to read and clearer as to what is going on. 
+-- Clearly, this is easier to read and clearer as to what is going on. 
 -- However, to keep the style entirely arrow-based, we are forced to inject 
 -- arrow transformers (here leftRight and topDown) to modify chunks of the 
 -- code.  The banana brackets (| |) allow us to refrain from retyping the 

@@ -1,20 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}
-module EnableGUI(enableGUI) where
-
-import Data.Int
-import Foreign
-
-type ProcessSerialNumber = Int64
-
-foreign import ccall "GetCurrentProcess" getCurrentProcess :: Ptr ProcessSerialNumber -> IO Int16
-foreign import ccall "_CGSDefaultConnection" cgsDefaultConnection :: IO ()
-foreign import ccall "CPSEnableForegroundOperation" cpsEnableForegroundOperation :: Ptr ProcessSerialNumber -> IO ()
-foreign import ccall "CPSSignalAppReady" cpsSignalAppReady :: Ptr ProcessSerialNumber -> IO ()
-foreign import ccall "CPSSetFrontProcess" cpsSetFrontProcess :: Ptr ProcessSerialNumber -> IO ()
-
-enableGUI = alloca $ \psn -> do
-    getCurrentProcess psn
-    cgsDefaultConnection
-    cpsEnableForegroundOperation psn
-    cpsSignalAppReady psn
-    cpsSetFrontProcess psn

@@ -9,13 +9,13 @@ module FRP.UISF.Examples.Examples where
 
 import FRP.UISF
-import FRP.UISF.SOE (withColor', rgb, polygon)
+import FRP.UISF.Graphics
 
 import Numeric (showHex)
 
 -- | This example displays the time from the start of the GUI application.
 timeEx :: UISF () ()
-timeEx = title "Time" $ getTime >>> display
+timeEx = title "Time" $ accumTime >>> display <<< spacer
 
 -- | This example shows off 'button's and state by presenting a plus and 
 -- minus button with a counter that is adjusted by them.
@@ -30,6 +30,7 @@             (Nothing, Just _) -> v-1
             _ -> v)
   display -< v
+  spacer -< ()
 
 -- | This example shows off the 'checkbox' widgets.
 checkboxEx :: UISF () ()
@@ -39,13 +40,14 @@   z <- checkbox "Wednesday" True -< ()
   let v = bin x ++ bin y ++ bin z
   displayStr -< v
+  spacer -< ()
   where
     bin True = "1"
     bin False = "0"
 
 -- | This example shows off the 'radio' button widget.
 radioButtonEx :: UISF () ()
-radioButtonEx = title "Radio Buttons" $ topDown $ radio list 0 >>> arr (list!!) >>> displayStr
+radioButtonEx = title "Radio Buttons" $ topDown $ radio list 0 >>> arr (list!!) >>> displayStr >>> spacer
   where
     list = ["apple", "orange", "banana"]
 
@@ -53,49 +55,69 @@ --   this case).
 shoppinglist :: UISF () ()
 shoppinglist = title "Shopping List" $ topDown $ proc _ -> do
-  a <- title "apples"  $ hiSlider 1 (0,10) 3 -< ()
-  b <- title "bananas" $ hiSlider 1 (0,10) 7 -< () 
-  title "total" $ display -< (a + b)
+  a <- spacer <<< title "apples"  (hiSlider 1 (0,10) 3) -< ()
+  b <- spacer <<< title "bananas" (hiSlider 1 (0,10) 7) -< () 
+  title "total" display -< (a + b)
 
 -- | This example shows off both vertical sliders as well as the 'canvas' 
 -- widget.  The canvas widget can be used to easily create custom graphics 
 -- in the GUI.  Here, it is used to make a color swatch that is 
 -- controllable with RGB values by the sliders.
 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" -< ()
+colorDemo = title "Color" $ leftRight $ proc _ -> do
+  r <- newColorSlider (coloredUIText Red "R") -< ()
+  g <- newColorSlider (coloredUIText Green "G") -< ()
+  b <- newColorSlider (coloredUIText Blue "B") -< ()
   changed <- unique -< (r,g,b)
-  let rect = withColor' (rgb r g b) (box ((0,0),d))
-  pad (4,8,0,0) $ canvas d -< fmap (const rect) changed
+  pad (4,8,0,0) $ canvas' layout rect -< changed
   where
-    d = (170,170)
+    layout = makeLayout (Stretchy 10) (Stretchy 10)
     newColorSlider l = title l $ topDown $ proc _ -> do
       v <- viSlider 16 (0,255) 0 -< ()
-      _ <- displayStr -< showHex v ""
+      _ <- setSize (22,22) displayStr -< showHex v ""
       returnA -< v
-    box ((x,y), (w, h)) = polygon [(x, y), (x + w, y), (x + w, y + h), (x, y + h)]
+    rect (r,g,b) d = withColor' (rgbE r g b) (rectangleFilled ((0,0),d))
 
--- | This example shows off the 'textboxE' widget.  Text can be typed in, and 
+-- | This example shows off the 'textbox' widget.  Text can be typed in, and 
 -- that text is transferred to the 'display' widget below when the button 
 -- is pressed.
 textboxdemo :: UISF () ()
-textboxdemo = setLayout (makeLayout (Stretchy 150) (Fixed 100)) $ 
-                title "Saving Text" $ topDown $ proc _ -> do
-  str <- leftRight $ label "Text: " >>> textboxE "" -< Nothing
+textboxdemo = title "Saving Text" $ topDown $ proc _ -> do
+  str <- leftRight $ label "Text: " >>> textbox "" -< Nothing
   b <- button "Save text to below" -< ()
   rec str' <- delay "" -< if b then str else str'
   leftRight $ label "Saved value: " >>> displayStr -< str' 
-  returnA -< ()
 
+uitext :: UIText
+uitext = coloredUIText Red  "H" `appendUIText`
+    coloredUIText Yellow    "e" `appendUIText`
+    coloredUIText Green     "l" `appendUIText`
+    coloredUIText Cyan      "l" `appendUIText`
+    coloredUIText Blue      "o" `appendUIText`
+    coloredUIText Magenta  " W" `appendUIText`
+    coloredUIText Red       "o" `appendUIText`
+    coloredUIText Yellow    "r" `appendUIText`
+    coloredUIText Green     "l" `appendUIText`
+    coloredUIText Cyan      "d" `appendUIText`
+    coloredUIText Blue      "!"
+uitext' = fontUIText Helvetica18 uitext
+
+uitextdemo = title "Color and Fonts" $ constA Nothing >>> textField CharWrap uitext' >>> constA ()
+
 -- | This is the main demo that incorporates all of the other examples 
 -- together.  In addition to demonstrating how 
 -- different widgets can connect, it also shows off the tabbing 
 -- behavior built in to the GUI.  Pressing tab cycles through focusable 
 -- elements, and pressing shift-tab cycles in reverse.
 main :: IO ()
-main = runUI (defaultUIParams {uiSize=(500, 500)}) $ 
-  (leftRight $ (bottomUp $ timeEx >>> buttonEx) >>> (topDown $ checkboxEx) >>> radioButtonEx) >>>
-  (leftRight $ shoppinglist >>> colorDemo) >>> textboxdemo >>> arr id
+main = runUI (defaultUIParams {uiSize=(500, 520), uiCloseOnEsc=True}) $ 
+  (leftRight $ (bottomUp $ timeEx >>> buttonEx) >>> checkboxEx >>> radioButtonEx) >>>
+  (leftRight $ shoppinglist >>> colorDemo) >>> textboxdemo >>> uitextdemo
 
+linesWith s = cons (case break (== '\n') s of
+                      (l, "") -> (l,[])
+                      (l, s') -> (l++"\n", case s' of
+                                             []    -> []
+                                             _:s'' -> linesWith s''))
+  where
+    cons ~(h, t) =  h : t

@@ -24,8 +24,8 @@ 
 -- We make our own special type of button for inputting hand information, 
 -- so we import a few things directly from Widget and SOE.
-import FRP.UISF.Widget (cyclebox', padding, (//), whenG, box, marked, pushed, popped)
-import FRP.UISF.SOE (text, withColor)
+import FRP.UISF.Widget.Construction (cycleboxS, padding, (//), whenG, shadowBox, marked, pushed, popped)
+import FRP.UISF.Graphics (text, withColor)
 
 import Data.List (delete, foldl', group)
 import GHC.Arr (Ix(..), indexError)
@@ -113,13 +113,13 @@     --display -< shortShow hand
     leftRight $ label "Number of cards:" >>> setSize (40,22) display -< handLength hand
     leftRight $ label "Total meld =" >>> displayStr -< show (sum (map snd3 meld)) ++ ": " ++ show (map fst3 meld)
-    kittenSizeStr <- leftRight $ label "Kitty size =" >>> setSize (40,22) (textboxE "2") -< case (updateEv, handLength hand) of
+    kittenSizeStr <- leftRight $ label "Kitty size =" >>> setSize (40,22) (textbox "2") -< case (updateEv, handLength hand) of
             (Just _, 11) -> Just $ show 4
             (Just _, 15) -> Just $ show 3
             _ -> Nothing
     restr <- checkbox "Restrict trump suit?" False -< ()
     b <- edge <<< button "Calculate meld from kitty" -< ()
-    kre <- (asyncUISFE $ arr kittyResult) -< 
+    kre <- (asyncE $ arr kittyResult) -< 
             fmap (const (hand, kittenSizeStr, if restr then Just trump else Nothing)) b
     let (k,d) = case (clearEv, kre, b) of
             (Just _, _, _) -> (Just [], Just [])
@@ -243,7 +243,7 @@ -- It takes as argument the names of the cards to select and a dynamic 
 -- "clear" event.
 cardSelector :: String -> UISF (SEvent ()) Int
-cardSelector str = arr (fmap (const 0)) >>> cyclebox' d lst 0 where
+cardSelector str = arr (fmap (const 0)) >>> cycleboxS d lst 0 where
     (tw, th) = (8 * (length str + 3), 16) 
     (minw, minh) = (tw + padding * 2, th + padding * 2)
     d = makeLayout (Stretchy minw) (Fixed minh)
@@ -251,8 +251,8 @@       let x' = x + (w - tw) `div` 2 + if i>0 then 0 else -1
           y' = y + (h - th) `div` 2 + if i>0 then 0 else -1
       in withColor Black (text (x', y') s) 
-         // whenG inFocus (box marked b)
-         // box (if i>0 then pushed else popped) b
+         // whenG inFocus (shadowBox marked b)
+         // shadowBox (if i>0 then pushed else popped) b
     lst = zip (map draw [(0,"0 "++str++"s"), (1, "1 "++str), (2, "2 "++str++"s")]) [0,1,2]
 
 
@@ -262,9 +262,10 @@ -------------------------------------------------------------
 
 prepHistogramData :: Map.Map Int Int -> [(Double, String)]
-prepHistogramData m = map f [0..x] where
+prepHistogramData m = normalize $ map f [0..x] where
   x = maybe 0 (fst . fst) $ Map.maxViewWithKey m -- get max meld value (the max key in the map)
   f i = (fromIntegral $ fromMaybe 0 $ Map.lookup i m, show i) -- return pair of count and meld value (in String form)
+  normalize xs = map (\(x,s) -> (x/m,s)) xs where m = maximum (map fst xs)
 
 
 -- this only works for the ints in the list between 0 and 2 inclusive.

@@ -17,9 +17,7 @@ 
 > module FRP.UISF.Examples.SevenGuis where
 > import FRP.UISF
-> import FRP.UISF.UITypes (Layout)
 > import Text.Read (readMaybe)  -- For Temperature Converter
-> import Control.Monad (join)   -- For Temperature Converter
 > 
 > import System.Locale          -- For Flight Booker
 > --import Data.Time.Format.Locale    -- FIXME To be used with time >= 1.5
@@ -28,12 +26,13 @@ > import Data.Time.Format       -- For Flight Booker
 > import Data.Maybe             -- For Flight Booker, Circle Draw
 > 
-> import FRP.UISF.Widget        -- For Timer, Circle Draw
+> import FRP.UISF.Widget.Construction -- For Timer, Circle Draw
 > 
 > import Data.List (isInfixOf)  -- For CRUD
 > import Data.Char (toLower)    -- For CRUD
 > 
-> import FRP.UISF.SOE           -- For Circle Draw
+> import FRP.UISF.UITypes       -- For Circle Draw
+> import FRP.UISF.Graphics      -- For Circle Draw
 > import Data.List (delete)     -- For Circle Draw
 > import Control.Monad (mplus)  -- For Circle Draw
 
@@ -82,11 +81,16 @@ standard Haskell, and the second of which is simple with arrowized 
 FRP.
 
-The textboxE function takes a starting String to create a widget that 
+The textbox function takes a starting String to create a widget that 
 accepts an Event String as input and produces String as output.  We use 
 the "unique" transformer to transform this output into events that only 
 update when a change occurs.
 
+> uTextbox :: String -> UISF (SEvent String) (SEvent String)
+> uTextbox str = proc e -> do
+>   o <- unique <<< textbox str -< e
+>   returnA -< if o == e then Nothing else o
+
 The first half of the program sets up the 4 widgets (two textboxes and 
 two labels), and the second half does the text parsing and actual 
 conversion (note that this half is all pure Haskell code).
@@ -96,21 +100,21 @@ to prevent infinite recursion, we must put a "delay" into the loop, and 
 so we do this twice, once for each textbox.
 
-> tempCovertSF :: UISF () ()
-> tempCovertSF = leftRight $ proc _ -> do
->   rec c <- unique <<< textboxE "" -< updateC
+> tempConvertSF :: UISF () ()
+> tempConvertSF = leftRight $ proc _ -> do
+>   rec c <- uTextbox "" -< updateC
 >       label "degrees Celsius = " -< ()
->       f <- unique <<< textboxE "" -< updateF
+>       f <- uTextbox "" -< updateF
 >       label "degrees Fahrenheit" -< ()
->       let cNum = join $ fmap (readMaybe :: String -> Maybe Double) c
->           fNum = join $ fmap (readMaybe :: String -> Maybe Double) f
->           cNum' = if c == updateC then Nothing else cNum
->           fNum' = if f == updateF then Nothing else fNum
->       updateC <- delay Nothing -< fmap (\f -> show $ round $ (f - 32) * (5/9)) fNum'
->       updateF <- delay Nothing -< fmap (\c -> show $ round $ c * (9/5) + 32) cNum'
+>       updateC <- delay Nothing -< fmap (show . f2c) (f >>= readMaybe)
+>       updateF <- delay Nothing -< fmap (show . c2f) (c >>= readMaybe)
 >   returnA -< ()
+>   where f2c :: Double -> Int
+>         f2c f = round $ (f - 32) * (5/9)
+>         c2f :: Double -> Int
+>         c2f c = round $ c * (9/5) + 32
 >
-> tempConvert = runUI (defaultUIParams {uiSize=(400, 24), uiTitle="Temp Converter"}) tempCovertSF
+> tempConvert = runUI (defaultUIParams {uiSize=(440, 24), uiTitle="Temp Converter"}) tempConvertSF
 > gui2 = tempConvert
 
 
@@ -139,7 +143,7 @@ 
 > timeInputTextbox :: TimeLocale -> String -> String -> UISF () (SEvent UTCTime)
 > timeInputTextbox tl format start = leftRight $ proc _ -> do
->     t <- textboxE start -< Nothing
+>     t <- textbox start -< Nothing
 >     let ret = readTimeMaybe tl format t
 >     case ret of
 >       Just _ -> returnA -< ret
@@ -150,7 +154,7 @@ >                                       [(x, "")] -> Just x
 >                                       _ -> Nothing
 
-Note the use of the delay with the textboxE -- we need this because we 
+Note the use of the delay with the textbox -- we need this because we 
 will use the value t to determine whether to insert the label or not.
 
 Note the clever use of unique and resetText.  We would like the display 
@@ -164,7 +168,7 @@ >     choice <- radio ["one-way flight","return flight"] 0 -< ()
 >     t1 <- timeInputTextbox tl format (formatTime tl format currentTime) -< ()
 >     t2 <- case choice of
->             1 -> timeInputTextbox tl format (formatTime tl format currentTime) -< ()
+>             1 -> timeInputTextbox tl format (formatTime tl format nextweek) -< ()
 >             _ -> label "" -< Nothing
 >     resetText <- unique -< (choice, t1, t2)
 >     b <- if (choice == 0 && isJust t1) || (choice == 1 && verifyGreater t1 t2)
@@ -175,6 +179,7 @@ >     resultStr <- hold "" -< b
 >     displayStr -< resultStr
 >   where format ="%Y.%m.%d"
+>         nextweek = currentTime { utctDay = addDays 7 $ utctDay currentTime }
 >         -- outText formats the data for a booking confirmation
 >         outText tl format 0 (Just t1) _  = "You have booked a one-way flight on " 
 >             ++ (formatTime tl format t1) ++ "."
@@ -197,27 +202,16 @@ The timer is very straightforward with UISF even though there is no 
 built-in "gauge" widget.  We'll start by defining one by using the 
 canvas' widget builder.  The widget will take the pair of 
-(elapsed time, total duration) and draw a block of the appropriate 
+(elapsed time, total duration) and draw a rectangle of the appropriate 
 size.  To use canvas', we supply a layout argument (stretchy in the 
 horizontal direction but fixed to 30 pixels in the vertical direction).
 
 > gauge :: Layout -> UISF (DeltaT, DeltaT) ()
 > gauge l = unique >>> canvas' l draw where
->   draw (x,t) (w,h) = block ((0,padding),(min w' $ round $ x*(fromIntegral w')/t,h-2*padding))
+>   draw (x,t) (w,h) = rectangleFilled ((0,padding),(min w' $ round $ x*(fromIntegral w')/t,h-2*padding))
 >       where w' = (w - 2*padding)
 
-Next, we make a short helper function for keeping track of elapsed time.  
-UISF provides "getTime", which provides the number of seconds since the 
-GUI started; here we write getDeltaTime, which uses a simple "delay" 
-operator to find how much time has gone by in the most recent clock cycle.
-
-> getDeltaTime :: UISF () DeltaT
-> getDeltaTime = proc _ -> do
->   t <- getTime -< ()
->   pt <- delay 0 -< t
->   returnA -< t - pt
-
-With these two helpers, the program is a snap.  Note once again that 
+With this, the program is a snap.  Note once again that 
 since the elapsed time "e" is being used directly in the GUI's output, 
 we must apply a delay to it to prevent an infinite recursion.
 
@@ -303,33 +297,32 @@ in which case the banana bracketed code would not inherit its parent's 
 scope either, but still, it is less than ideal.
 
-We start by asking for the filter text and then using banana brackets 
-to define a "leftRight" layout portion.
+We start by asking for the filter text, filtering the database, and then 
+using banana brackets to define a "leftRight" layout portion.
 
 > crudSF :: Database NameEntry -> UISF () ()
 > crudSF initnamesDB = proc _ -> do
 >   rec
->     fStr <- leftRight $ label "Filter text: " >>> textboxE "" -< Nothing
->     (i, db, fdb, nameData) <- (| leftRight (do
+>     fStr <- leftRight $ label "Filter text: " >>> textbox "" -< Nothing
+>     let fdb = filter (filterFun fStr) db
+>     (i, nameData) <- (| leftRight (do
 
 This leftRight portion will have a listbox on the left and then a 
 topDown portion on the right that will be for entering name data.
 
->         rec i <- listbox -< (fdb, i')
->             db <- delay initnamesDB -< db'
->             let fdb = filter (filterFun fStr) db
+>         i <- listbox' -< (fdb, i')
 >         nameData <- (| topDown (do
 
 We add two textboxes for the first name and surname strings and 
 then set them to update whenever one of the listbox items is selected.
 
->             rec nameStr <- leftRight $ label "Name:    " >>> textboxE "" -< nameStr'
->                 surnStr <- leftRight $ label "Surname: " >>> textboxE "" -< surnStr'
+>             rec nameStr <- leftRight $ label "Name:    " >>> textbox "" -< nameStr'
+>                 surnStr <- leftRight $ label "Surname: " >>> textbox "" -< surnStr'
 >                 iUpdate <- unique -< i
->                 let nameStr' = fmap (const $ firstName ((filter (filterFun fStr) db') `at` i')) iUpdate
->                     surnStr' = fmap (const $ lastName  ((filter (filterFun fStr) db') `at` i')) iUpdate
+>                 let nameStr' = fmap (const $ firstName (fdb `at` i)) iUpdate
+>                     surnStr' = fmap (const $ lastName  (fdb `at` i)) iUpdate
 >             returnA -< NameEntry nameStr surnStr) |)
->         returnA -< (i, db, fdb, nameData)) |)
+>         returnA -< (i, nameData)) |)
 
 Finally, we make the three buttons, which we can do all at once with 
 arrow combinators.  Based on button presses, we update the database.
@@ -337,11 +330,11 @@ >     buttons <- leftRight $ (edge <<< button "Create") &&& 
 >                            (edge <<< button "Update") &&& 
 >                            (edge <<< button "Delete") -< ()
->     let (db', i') = case buttons of
+>     (db, i') <- delay (initnamesDB, -1) -< case buttons of
 >             (Just _, (_, _))             -> (db ++ [nameData], length fdb)
 >             (Nothing, (Just _, _))       -> (updateDB (filterFun fStr) i nameData db, i)
 >             (Nothing, (Nothing, Just _)) -> (deleteFromDB (filterFun fStr) i db,
->                                             if i == length fdb - 1 then length fdb - 2 else i)
+>                                             if i == length fdb - 1 then i - 1 else i)
 >             _ -> (db, i)
 >   returnA -< ()
 >   where
@@ -363,8 +356,7 @@ To start, let's write some code for circles.  We'll begin with a very 
 simple circle type, accessors for it, and a distance function for points.
 
-> -- type Point = (Int, Int) -- The Point class is imported from FRP.UISF.SOE
-> type Radius = Double
+> type Radius = Int
 > type Circle = (Point, Radius)
 > 
 > getCenter :: Circle -> Point
@@ -386,7 +378,7 @@ > getSelectedCircle p = getCircle' Nothing where
 >   getCircle' res [] = fmap snd res
 >   getCircle' res (c@(cp,cr):cs) = let d = distance p cp in
->     case (d<cr, isJust res) of
+>     case (d<fromIntegral cr, isJust res) of
 >       (True, True) -> getCircle' (if d < fst (fromJust res) then Just (d,c) else res) cs
 >       (True, False) -> getCircle' (Just (d,c)) cs
 >       _ -> getCircle' res cs
@@ -399,13 +391,6 @@   - It will send output events corresponding to mouse clicks.
   - It will display the circles with any that the cursor is in highlighted.
 
-First, we'll make two little drawing functions for making filled and open 
-circles.  UISF provides the more generic 'ellipse' and 'arc' functions, but 
-they can be easily adjusted for our purposes:
-
-> filledCircle (x,y) r' = let r = round r' in ellipse (x-r,y-r) (x+r,y+r)
-> openCircle   (x,y) r' = let r = round r' in arc     (x-r,y-r) (x+r,y+r) 0 360
-
 Now, we have the tools to make the circle canvas
 
 > type LeftClicks = SEvent Point
@@ -419,14 +404,14 @@ >       where 
 >         newLst = fromMaybe prevLst inpLst
 >         (clickEvts, focusCircle, mousePt, redraw) = case (evt, isJust inpLst) of
->           (Button pt True  True, d) -> ((Just pt, Nothing),  prevFC, prevPt, d)
->           (Button pt False True, d) -> ((Nothing, getSelectedCircle pt newLst), prevFC, prevPt, d)
+>           (Button pt LeftButton  True, d) -> ((Just pt, Nothing),  prevFC, prevPt, d)
+>           (Button pt RightButton True, d) -> ((Nothing, getSelectedCircle pt newLst), prevFC, prevPt, d)
 >           (MouseMove pt, d) -> let fc = getSelectedCircle pt newLst in ((Nothing, Nothing), fc, pt, prevFC /= fc || d)
 >           (_, d) -> ((Nothing, Nothing), getSelectedCircle prevPt newLst, prevPt, d)
 >     draw _ _ (cs,fc,_) = draw' cs fc
 >     draw' [] Nothing = nullGraphic
->     draw' [] (Just (p,r)) = withColor' gray2 $ filledCircle p r
->     draw' ((p,r):cs) fc = withColor Black (openCircle p r) // draw' cs fc
+>     draw' [] (Just (p,r)) = withColor MediumBeige $ circleFilled p r
+>     draw' ((p,r):cs) fc = withColor Black (circleOutline p r) // draw' cs fc
 
 Lastly, we'll create the undo/redo functionality.  This is all pure 
 Haskell code and has no UISF components.
@@ -498,14 +483,14 @@ The adjustment slider should only appear after a right click and before 
 the cancel or set buttons are pressed -- we use an 'accum' to achieve this.
 
->     isAdjustActive <- accum False -< fmap (const . const False) majorU 
+>     isAdjustActive <- accum False <<< delay Nothing -< fmap (const . const False) majorU 
 >                              `mplus` fmap (const . const False) cancel
 >                              `mplus` fmap (const . const True) rightClicks
 >     adjustC <- accum ((0,0),0) -< fmap const rightClicks
 >     (minorU, majorU, cancel) <- if isAdjustActive
 >                                 then do
 >                                 leftRight (label "Adjust Diameter of circle at" >>> display) -< getCenter adjustC
->                                 newR <- hSlider (2,200) defaultRadius -< () -- fmap getRadius rightClicks
+>                                 newR <- hiSlider 1 (2,200) defaultRadius -< () -- fmap getRadius rightClicks
 >                                 newRU <- unique -< newR
 >                                 (setButton, cancelButton) <- leftRight $ (edge <<< button "Set") &&& 
 >                                                                          (edge <<< button "Cancel") -< ()

@@ -13,8 +13,7 @@ 
 {-# LANGUAGE Arrows #-}
 module FRP.UISF.Examples.FFT where
-import FRP.UISF hiding (delay)
-import Control.Arrow.Operations
+import FRP.UISF
 import Numeric.FFT (fft)
 import Data.Complex
 import Data.Map (Map)
@@ -116,7 +115,7 @@     _ <- leftRight (label "Freq 1: " >>> display) -< f1
     f2 <- hSlider (1, 2000) 440 -< ()
     _ <- leftRight (label "Freq 2: " >>> display) -< f2
-    d <- asyncUISFV sr 0.1 myAutomaton -< (f1, f2)
+    d <- asyncVT sr 0.1 myAutomaton -< (f1, f2)
     let fft = listToMaybe $ catMaybes $ map (snd . fst) d
         s = map (\((s, _), t) -> (s,t)) d
     _ <- histogram (makeLayout (Stretchy 10) (Fixed 150)) -< fft

@@ -0,0 +1,36 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  FRP.UISF.Graphics
+-- Copyright   :  (c) Daniel Winograd-Cort 2015
+-- License     :  see the LICENSE file in the distribution
+--
+-- Maintainer  :  dwc@cs.yale.edu
+-- Stability   :  experimental
+
+{-# LANGUAGE BangPatterns, FlexibleInstances, TypeSynonymInstances #-}
+module FRP.UISF.Graphics (
+  Point, Angle, Dimension, Rect,
+  Color(..), RGB, colorToRGB, rgb, rgbE, extractRGB,
+  Graphic,
+  nullGraphic,
+  overGraphic,
+  withColor, withColor',
+  text, textLines,
+  ellipse, shearEllipse, line, polygon, polyline, polybezier, arc,
+  circleFilled, circleOutline, rectangleFilled, rectangleOutline,
+  translateGraphic, rotateGraphic, scaleGraphic,
+  boundGraphic,
+  UIText(..), UITexty(..),
+  uitextToString, splitUIText, takeUIText, dropUIText, uitextLen,
+  pureUIText, appendUIText, coloredUIText, rgbUIText, fontUIText,
+  textWidth, textWithinPixels, textHeight,
+  WrapSetting(..), prepText,
+  textWidth', textWithinPixels', textHeight',
+  BitmapFont(..)
+  ) where
+
+
+import FRP.UISF.Graphics.Types
+import FRP.UISF.Graphics.Color
+import FRP.UISF.Graphics.Text
+import FRP.UISF.Graphics.Graphic

@@ -0,0 +1,97 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  FRP.UISF.Graphics.Color
+-- Copyright   :  (c) Daniel Winograd-Cort 2015
+-- License     :  see the LICENSE file in the distribution
+--
+-- Maintainer  :  dwc@cs.yale.edu
+-- Stability   :  experimental
+
+{-# LANGUAGE BangPatterns, FlexibleInstances, TypeSynonymInstances #-}
+module FRP.UISF.Graphics.Color (
+  Color(..), RGB, colorToRGB, rgb, rgbE, extractRGB,
+  ) where
+
+import Data.Ix (Ix)
+import Control.DeepSeq
+
+
+-- | We provide a data type for colors to allow users to easily 
+--  and clearly specify common colors.  Primary and secondary 
+--  RGB colors are represented along with a few beige colors for use 
+--  in many GUI elements.
+data Color = Black
+           | Blue
+           | Green
+           | Cyan
+           | Red
+           | Magenta
+           | Yellow
+           | White
+           | Gray
+           | VLightBeige
+           | LightBeige -- ^ This is the default background color for the UI window.
+           | MediumBeige
+           | DarkBeige
+  deriving (Eq, Ord, Bounded, Enum, Ix, Show, Read)
+
+instance NFData Color where
+  rnf (!_) = ()
+
+-- | RGB can be used to specify colors more precisely.  Create them with 
+--  one of the two smart constructors 'rgb' or 'rgbE'.
+newtype RGB = RGB (Int, Int, Int)
+  deriving (Eq)
+
+instance Show RGB where
+  show (RGB (r, g, b)) = "{R="++show r++",G="++show g++",B="++show b++"}"
+
+instance NFData RGB where
+  rnf (RGB rgb) = rnf rgb
+
+-- | Generally used as an internal function for converting Color to RGB, 
+--  but can be used by anyone.
+colorToRGB :: Color -> RGB
+colorToRGB Black   = RGB (0, 0, 0)
+colorToRGB Blue    = RGB (0, 0, 255)
+colorToRGB Green   = RGB (0, 255, 0)
+colorToRGB Cyan    = RGB (0, 255, 255)
+colorToRGB Red     = RGB (255, 0, 0)
+colorToRGB Magenta = RGB (255, 0, 255)
+colorToRGB Yellow  = RGB (255, 255, 0)
+colorToRGB White   = RGB (255, 255, 255)
+colorToRGB Gray    = RGB (128, 128, 128)
+colorToRGB VLightBeige = rgbE 0xf1 0xef 0xe2
+colorToRGB LightBeige  = rgbE 0xec 0xe9 0xd8
+colorToRGB MediumBeige = rgbE 0xac 0xa8 0x99
+colorToRGB DarkBeige   = rgbE 0x71 0x6f 0x64
+-- In previous versions, there was a color called "blue3".
+-- blue3 = rgbE 0x31 0x3c 0x79 --dark slate blue
+
+
+
+-- | This function takes three integral values between 0 and 255 
+--  inclusive and create an RGB value with them.  If any of the 
+--  values fall outside the acceptable range, Nothing is returned.
+rgb :: (Integral r, Integral g, Integral b) => r -> g -> b -> Maybe RGB
+rgb r g b = do
+    r' <- bound r
+    g' <- bound g
+    b' <- bound b
+    return $ RGB (r',g',b')
+  where
+    bound :: (Integral i, Integral o) => i -> Maybe o
+    bound i = if i > 255 || i < 0 then Nothing else Just (fromIntegral i)
+
+-- | This is a version of 'rgb' that throws an error when a given 
+--  value falls outside the acceptable 0-255 range.  The error message 
+--  shows the bad input, so the extra Show constraint is necessary.
+rgbE :: (Integral r, Integral g, Integral b,
+         Show r, Show g, Show b) => r -> g -> b -> RGB
+rgbE r g b = case rgb r g b of
+  Just x  -> x
+  Nothing -> error $ "Invalid values given to rgbE: " ++ show (r,g,b)
+
+-- | Use this to extract the values from an RGB color.
+extractRGB :: (Integral r, Integral g, Integral b) => RGB -> (r,g,b)
+extractRGB (RGB (r, g, b)) = (fromIntegral r, fromIntegral g, fromIntegral b)

@@ -0,0 +1,237 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  FRP.UISF.Graphics.Graphic
+-- Copyright   :  (c) Daniel Winograd-Cort 2015
+-- License     :  see the LICENSE file in the distribution
+--
+-- Maintainer  :  dwc@cs.yale.edu
+-- Stability   :  experimental
+
+{-# LANGUAGE BangPatterns #-}
+module FRP.UISF.Graphics.Graphic (
+  -- $graphics
+  -- * Graphics
+  Graphic(..),
+  nullGraphic,
+  overGraphic,
+  withColor, withColor',
+  text, textLines,
+  ellipse, shearEllipse, line, polygon, polyline, polybezier, arc,
+  circleFilled, circleOutline, rectangleFilled, rectangleOutline,
+  translateGraphic, rotateGraphic, scaleGraphic,
+  boundGraphic
+  ) where
+
+
+import FRP.UISF.Graphics.Color
+import FRP.UISF.Graphics.Text
+import FRP.UISF.Graphics.Types
+import Control.DeepSeq
+
+{- $graphics
+This module provides an abstract representation for graphics in the GUI 
+along with a rendering function specific to OpenGL.
+
+The Graphic data type encodes an abstract graphic, which can be created 
+and combined with smart constructors.  This means that Graphics are 
+inherently restricted to what is possible in this abstract form.  For 
+example, OpenGL may support 3D rotations, but because the abstract 
+Graphic does not, they cannot be performed in UISF.
+
+For now, we have a lean set of graphics that should satisfy most GUI 
+needs.  Additionally, this layer of abstraction should make it easier 
+to add more graphical back ends (perhaps a web back end in the future?).  
+If UISF grows to include more graphical representations (e.g. more ways 
+to render text), we can add them as necessary.
+
+-}
+
+------------------------------------------------------------
+-- Graphic
+------------------------------------------------------------
+
+-- | The main Graphic data type stores graphic information.  
+--  Constructors are not directly exposed to encourage the use of 
+--  the smart constructors.
+--
+--  If you would like to add custom rendering functions for Graphic, 
+--  you will clearly need access to the constructors to destruct the 
+--  graphics.  Please request this, and I can either export them 
+--  or we can discuss adding more rendering functions to this library.
+
+data Graphic = 
+    NoGraphic
+  | GText Point UIText
+  | GPolyLine [Point]
+  | GPolygon [Point]
+  | GArc Rect Angle Angle
+  | GEllipse Rect
+  | GBezier [Point]
+  | GTranslate Point Graphic
+  | GRotate Point Angle Graphic
+  | GScale Double Double Graphic
+  | GColor RGB Graphic
+  | GBounded Rect Graphic
+  | OverGraphic Graphic Graphic
+  deriving (Eq, Show)
+
+instance NFData Graphic where
+  rnf NoGraphic = ()
+  rnf (GText (!_,!_) str) = rnf str
+  rnf (GPolyLine !pts) = ()
+  rnf (GPolygon !pts) = ()
+  rnf (GArc ((!_,!_),(!_,!_)) !_ !_) = ()
+  rnf (GEllipse ((!_,!_),(!_,!_))) = ()
+  rnf (GBezier !pts) = ()
+  rnf (GTranslate (!_,!_) g) = rnf g
+  rnf (GRotate (!_,!_) !_ g) = rnf g
+  rnf (GScale !_ !_ g) = rnf g
+  rnf (GColor !_ g) = rnf g
+  rnf (GBounded ((!_,!_),(!_,!_)) g) = rnf g
+  rnf (OverGraphic g1 g2) = rnf g1 `seq` rnf g2
+
+-- | The absence of a graphic.
+nullGraphic :: Graphic
+nullGraphic = NoGraphic
+
+-- | The overlay of two graphics, the first over the second.
+overGraphic :: Graphic -> Graphic -> Graphic
+overGraphic g1 NoGraphic = g1
+overGraphic NoGraphic g2 = g2
+overGraphic g1 g2 = OverGraphic g1 g2
+
+----------
+-- Text --
+----------
+
+-- | Paint the given text at the given point.
+text :: UITexty s => Point -> s -> Graphic
+text p = GText p . toUIText
+
+-- | A convenience function for painting a set of (Point,String) pairs.
+textLines :: UITexty s => [(Point, s)] -> Graphic
+textLines = foldl (\g (p,s) -> overGraphic (text p s) g) nullGraphic
+
+------------
+-- Colors --
+------------
+
+-- | Use the given color to paint the given graphic.
+withColor :: Color -> Graphic -> Graphic
+withColor = withColor' . colorToRGB
+
+-- | Use the given RGB color to paint the given graphic.
+withColor' :: RGB -> Graphic -> Graphic
+withColor' _ NoGraphic = NoGraphic
+withColor' c g = GColor c g
+
+
+------------
+-- Shapes --
+------------
+
+-- | Draw an ellipse bounded by the given rectangle.
+ellipse :: Rect -> Graphic
+ellipse = GEllipse
+
+-- | Draw a shear ellipse bounded by the given rectangle.  This code 
+--  was written originally by Paul Liu.
+shearEllipse :: Point -> Rect -> Graphic
+shearEllipse (x0,y0) r = 
+  let ((x1,y1), (w, h)) = normaliseRect r
+      (x2,y2) = (x1 + w, y1 + h)
+      x =  (x1 + x2) / 2  -- centre of parallelogram
+      y =  (y1 + y2) / 2
+      dx1 = (x1 - fromIntegral x0) / 2 -- distance to corners from centre
+      dy1 = (y1 - fromIntegral y0) / 2
+      dx2 = (x2 - fromIntegral x0) / 2
+      dy2 = (y2 - fromIntegral y0) / 2
+      pts = [ (round $ x + c*dx1 + s*dx2, round $ y + c*dy1 + s*dy2)
+            | (c,s) <- cos'n'sins ]
+      cos'n'sins = [ (cos a, sin a) | a <- segment 0 (2 * pi) (40 / (w + h))]
+  in GPolygon pts
+
+-- | Draw a line segment connecting the given two points.
+line :: Point -> Point -> Graphic
+line p q = GPolyLine [p,q]
+
+-- | Draw a filled polygon with corners defined by the given points.
+polygon :: [Point] -> Graphic
+polygon = GPolygon
+
+-- | Draw a sequence of line segments defined by the given points.
+polyline :: [Point] -> Graphic
+polyline = GPolyLine
+
+-- | Draw a Bezier curve defined by the given points.
+polybezier :: [Point] -> Graphic
+polybezier = GBezier
+
+-- | Draw an arc of the ellipse bounded by the given rectangle that 
+--  starts at the first angle measure and ends at the second.
+arc :: Rect -> Angle -> Angle -> Graphic
+arc = GArc
+
+-- | Draw a filled circle with given center and radius.
+circleFilled :: Point -> Int -> Graphic
+circleFilled (x,y) r = GEllipse ((x-r,y-r),(2*r,2*r))
+
+-- | Draw the outline of a circle with given center and radius.
+circleOutline :: Point -> Int -> Graphic
+circleOutline (x,y) r = GArc ((x-r,y-r),(2*r,2*r)) 0 360
+
+-- | Draw a filled rectangle.
+rectangleFilled :: Rect -> Graphic
+rectangleFilled ((x,y), (w, h)) = GPolygon [(x, y), (x + w, y), (x + w, y + h), (x, y + h)]
+
+-- | Draw the outline of a rectangle.
+rectangleOutline :: Rect -> Graphic
+rectangleOutline ((x,y), (w, h)) = GPolyLine [(x, y), (x + w, y), (x + w, y + h), (x, y + h)]
+
+
+---------------------
+-- Transformations --
+---------------------
+
+-- | Translate the given graphic so that its origin is at the given 
+--  point.
+translateGraphic :: Point -> Graphic -> Graphic
+translateGraphic _ NoGraphic = NoGraphic
+translateGraphic p g = GTranslate p g
+
+-- | Rotate the given graphic around the given point by the given 
+--  number of degrees.
+rotateGraphic :: Point -> Angle -> Graphic -> Graphic
+rotateGraphic _ _ NoGraphic = NoGraphic
+rotateGraphic p a g = GRotate p a g
+
+-- | Scale the given graphic in the X and Y dimension respectively.
+scaleGraphic :: Double -> Double -> Graphic -> Graphic
+scaleGraphic _ _ NoGraphic = NoGraphic
+scaleGraphic x y g = GScale x y g
+
+
+--------------
+-- Bounding --
+--------------
+
+-- | Cut the given graphic so that nothing outside of the given 
+--  rectangle is visible.
+boundGraphic :: Rect -> Graphic -> Graphic
+boundGraphic _ NoGraphic = NoGraphic
+boundGraphic r g = GBounded r g
+
+
+
+------------------------------------------------------------
+-- Helper functions
+------------------------------------------------------------
+normaliseRect :: Rect -> ((Double, Double),(Double, Double))
+normaliseRect ((x, y), (w, h)) = ((fromIntegral x', fromIntegral y'), (fromIntegral w', fromIntegral h'))
+  where (x',w') = if w < 0 then (x+w, 0-w) else (x, w)
+        (y',h') = if h < 0 then (y+h, 0-h) else (y, h)
+
+segment :: (Num t, Ord t) => t -> t -> t -> [t]
+segment start stop step = ts start
+  where ts i = if i >= stop then [stop] else i : ts (i + step)
+

@@ -0,0 +1,287 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  FRP.UISF.Graphics.Text
+-- Copyright   :  (c) Daniel Winograd-Cort 2015
+-- License     :  see the LICENSE file in the distribution
+--
+-- Maintainer  :  dwc@cs.yale.edu
+-- Stability   :  experimental
+
+{-# LANGUAGE BangPatterns, FlexibleInstances, TypeSynonymInstances #-}
+module FRP.UISF.Graphics.Text (
+  UIText(..), UITexty(..),
+  uitextToString, splitUIText, takeUIText, dropUIText, uitextLen,
+  pureUIText, appendUIText, coloredUIText, rgbUIText, fontUIText,
+  textWidth, textWithinPixels, textHeight,
+  WrapSetting(..), prepText,
+  textWidth', textWithinPixels', textHeight',
+  uitextLines, uitextWords,
+  BitmapFont(..),
+  ) where
+
+import Graphics.UI.GLUT.Fonts
+import Data.Array.IArray
+import Data.List (foldl')
+import Data.Char (isSpace)
+import Data.String (IsString(..))
+
+import FRP.UISF.Graphics.Color
+import FRP.UISF.Graphics.Types
+
+import Control.DeepSeq
+
+-- FIXME: I hate having an orphan instance here, but I'm not sure what to do about it.
+instance NFData BitmapFont where
+  rnf f = seq f ()
+
+defaultFont = Fixed9By15
+
+------------------------------------------------------------
+-- UI Text
+------------------------------------------------------------
+
+-- | Text in UISF can be rendered in multiple fonts and colors, 
+--  so we need a more powerful data type to encode it.  The UIText 
+--  data type does this.
+newtype UIText = UIText {unwrapUIT :: [(Maybe RGB, BitmapFont, String)]}
+  deriving (Eq, Show)
+instance NFData UIText where
+  rnf (UIText lst) = rnf lst
+instance IsString UIText where
+  fromString = pureUIText
+
+-- | To retain easy compatibility with Strings (or other text 
+--  representations), we also provide the UITexty class, which is 
+--  how all widgets that accept UIText should do so.
+class UITexty a where
+  toUIText :: a -> UIText
+
+instance UITexty UIText where
+  toUIText = id
+instance UITexty String where
+  toUIText = pureUIText
+--instance UITexty Text where
+--  toUIText = PureText . unpack
+
+-- | The empty string in UIText.
+emptyUIText :: UIText
+emptyUIText = UIText []
+
+-- | Returns True when given an empty string and False otherwise.
+isEmptyUIText :: UIText -> Bool
+isEmptyUIText uit = go (unwrapUIT uit) where
+  go [] = True
+  go ((_,_,[]):rest) = go rest
+  go _ = False
+
+-- | Removes all font and color formatting from a UIText, returning 
+--  its underlying String representation.
+uitextToString :: UIText -> String
+uitextToString (UIText lst) = concatMap (\(_,_,s) -> s) lst
+
+-- | Returns the number of characters in a UIText.
+uitextLen :: UIText -> Int
+uitextLen = length . uitextToString
+
+-- | Take a certain number of characters off of a UIText
+takeUIText :: Int -> UIText -> UIText
+takeUIText n = fst . splitUIText n
+--takeUIText n (UIText uit) = UIText $ go n uit where
+--  go 0 uit = uit
+--  go n [] = []
+--  go n ((c,f,s):rest) = let n' = n - length s in
+--    if n' < 0 then (c,f,drop n s):rest else go n' rest
+
+-- | Drop a certain number of characters from a UIText
+dropUIText :: Int -> UIText -> UIText
+dropUIText n = snd . splitUIText n
+
+-- | Split a UIText at the given character point.
+splitUIText :: Int -> UIText -> (UIText, UIText)
+splitUIText n (UIText uit) = let (u1,u2) = go n [] uit in (UIText u1, UIText u2) where
+  go 0 taken rest = (reverse taken, rest)
+  go n taken [] = (reverse taken, [])
+  go n taken ((c,f,s):rest) = let n' = n - length s in
+    if n' >= 0 then go n' ((c,f,s):taken) rest
+    else let (t,d) = splitAt n s in (reverse ((c,f,t):taken), (c,f,d):rest)
+
+-- | A convenience function for taking a UITexty object directly to the 
+--  underlying (RGB,Font,String) list.
+unwrapUITexty :: UITexty s => s -> [(Maybe RGB, BitmapFont, String)]
+unwrapUITexty = unwrapUIT . toUIText
+
+-- | Lifts a String to a UIText (with default color and font).
+pureUIText :: String -> UIText
+pureUIText s = UIText [(Nothing, defaultFont, s)]
+
+-- | Appends two UITexty objects together.
+appendUIText :: (UITexty s1, UITexty s2) => s1 -> s2 -> UIText
+appendUIText s1 s2 = UIText $ unwrapUITexty s1 ++ unwrapUITexty s2
+
+-- | Colors a UITexty object.
+coloredUIText :: UITexty s => Color -> s -> UIText
+coloredUIText c s = UIText $ map (\(_,f,str) -> (newC,f,str)) (unwrapUITexty s)
+ where newC = Just $ colorToRGB c
+
+-- | Colors a UITexty object with an exact RGB value.
+rgbUIText c s = UIText $ map (\(_,f,str) -> (c,f,str)) (unwrapUITexty s)
+
+-- | Converts the UITexty object to the given font.
+fontUIText f s = UIText $ map (\(c,_,str) -> (c,f,str)) (unwrapUITexty s)
+
+
+-- | Returns the width of the String in pixels as it will be rendered
+textWidth :: UITexty s => s -> Int
+textWidth s = sum $ map (\(_,f,str) -> textWidth' f str) (unwrapUITexty s)
+
+-- | Given a String and a number of pixels, returns the leading 
+--  substring that fits within the horizontal number of pixels along 
+--  with the remaining text of the String.
+textWithinPixels :: UITexty s => Int -> s -> (UIText, UIText)
+textWithinPixels i s = let (s1,s2) = go i (unwrapUITexty s) []
+  in (UIText s1, UIText s2) where
+  go i [] sofar = (reverse sofar, [])
+  go i ((c,f,str):rest) sofar = let i' = i - (textWidth' f str)
+    in if i' >= 0
+       then go i' rest ((c,f,str):sofar)
+       else let (s1,s2) = textWithinPixels' f i str
+            in (reverse $ (c,f,s1):sofar, (c,f,s2):rest)
+
+-- | Returns the height of the String in pixels as it will be rendered
+textHeight :: UITexty s => s -> Int
+textHeight s = go (unwrapUITexty s) where
+  go [] = textHeight' defaultFont ""
+  go lst = maximum $ map (\(_,f,str) -> textHeight' f str) lst
+
+-- | The Wrap Setting is used to determine how to split up a long piece 
+--  of text.
+data WrapSetting = NoWrap | CharWrap | WordWrap
+  deriving (Eq, Show)
+
+-- | Turn the given String into a list of Strings.  If the wrap setting 
+--  is NoWrap, then this is basically just the lines function.  If it 
+--  is CharWrap or WordWrap, then no string in the list will be wider 
+--  than the width of the bounding box.  The returned list of points 
+--  indicate each Point where a line should be drawn.  Note that this 
+--  list may not be the same length as the list of strings.
+--
+--  Typically, this will be used in conjunction with zip and textLines 
+--  to produce text graphics.
+prepText :: (UITexty s)
+         => WrapSetting -- ^ Whether we prefer newer or older text
+         -> Double      -- ^ Line spacing
+         -> Rect        -- ^ Bounding Box
+         -> s           -- ^ The text to print (which is allowed to have new lines)
+         -> ([Point], [UIText])
+prepText wrap spacing ((x,y),(w,h)) s = (pts, outStrs) where
+  lineHeight = round (fromIntegral (textHeight s) * spacing)
+  numLines = h `div` lineHeight
+  pts = zip (replicate numLines x) [y, y+lineHeight..]
+  outStrs = concatMap (wrapText wrap w) (uitextLines' $ toUIText s)
+
+-- | wrapText takes a wrap setting, a width, and a string, and turns 
+--  it into a list of strings representing each wrapped line.  Strings 
+--  are assumed to have no line breaks in them.  Calling unlines on the 
+--  output will create a String that is wrapped.
+wrapText :: UITexty s => WrapSetting -> Int -> s -> [UIText]
+wrapText NoWrap _ s = [toUIText s]
+wrapText CharWrap i s = if isEmptyUIText $ toUIText s
+    then []
+    else let (t,d) = textWithinPixels i s in t:wrapText CharWrap i d
+wrapText WordWrap i s = f i emptyUIText (uitextWords' $ toUIText s) where
+  f :: Int -> UIText -> [UIText] -> [UIText]
+  f _ sofar [] = if isEmptyUIText sofar then [] else [sofar]
+  f j sofar (w:ws) = case isEmptyUIText sofar of
+    True  -> if textWidth w > i 
+             then let (t,d) = textWithinPixels i w in t:f i emptyUIText (d:ws)
+             else f (i-textWidth w) w ws
+    False -> if textWidth w > j 
+             then sofar:f i emptyUIText (w:ws)
+             else f (j-textWidth w) (appendUIText sofar w) ws
+
+-- | The common String 'words' function applicable to UIText.
+uitextWords :: UIText -> [UIText]
+uitextWords = uitSplitter isSpace (\x -> ([], dropWhile isSpace x))
+
+-- | The common String 'lines' function applicable to UIText.
+uitextLines :: UIText -> [UIText]
+uitextLines = uitSplitter (== '\n') (\x -> ([], drop 1 x))
+
+-- | A variant of uitextLines that keeps the newline characters at the 
+--  ends of the output.
+uitextLines' :: UIText -> [UIText]
+uitextLines' = uitSplitter (== '\n') (splitAt 1)
+
+-- | A variant of uitextWords that keeps the whitespace characters at 
+--  the ends of the output.
+uitextWords' :: UIText -> [UIText]
+uitextWords' = uitSplitter isSpace (span isSpace)
+
+-- | A convenience function for writing functions like lines and words.
+uitSplitter :: (Char -> Bool) -> (String -> (String,String)) -> UIText -> [UIText]
+uitSplitter checker splitter (UIText lst) = map UIText $ uitSplitter' lst where
+  uitSplitter' [] = []
+  uitSplitter' uitext = go uitext [] where
+    go [] sofar = [reverse sofar]
+    go ((c,f,s):rest) sofar = case break checker s of
+      (_, "") -> go rest ((c,f,s):sofar)
+      (l,s') -> reverse ((c,f,l++s1):sofar) : uitSplitter' ((c,f,s2):rest)
+        where (s1,s2) = splitter s'
+
+
+-- | Returns the text height of a String rendered in the given bitmap font.
+textHeight' :: BitmapFont -> String -> Int
+textHeight' f _ = getFontHeight f
+
+-- | Returns the text width of a String rendered in the given bitmap font.
+textWidth' :: BitmapFont -> String -> Int
+textWidth' f str = foldl' (\acc c -> acc + (getFontArray f ! c)) 0 str
+
+-- | Splits a String based on what can fit within the given number of 
+--  pixels (the fst of the result) and what's left over (the snd).
+textWithinPixels' :: BitmapFont -> Int -> String -> (String, String)
+textWithinPixels' f i str = go f i str "" where
+  go _ _ [] sofar = (reverse sofar, "")
+  go f i (c:s) sofar = let i' = i - (getFontArray f ! c)
+    in if i' >= 0 then go f i' s (c:sofar) else (reverse sofar, c:s)
+
+-- | Returns the font height for a given font.
+getFontHeight :: BitmapFont -> Int
+getFontHeight Fixed8By13    = 14
+getFontHeight Fixed9By15    = 16
+getFontHeight TimesRoman10  = 14
+getFontHeight TimesRoman24  = 29
+getFontHeight Helvetica10   = 14
+getFontHeight Helvetica12   = 16
+getFontHeight Helvetica18   = 23
+--getFontHeight Roman         = 153
+--getFontHeight MonoRoman     = 153
+
+-- | Returns the font array for a given font.
+getFontArray :: BitmapFont -> Array Char Int
+getFontArray Fixed8By13     = fixed8By13
+getFontArray Fixed9By15     = fixed9By15
+getFontArray TimesRoman10   = timesRoman10
+getFontArray TimesRoman24   = timesRoman24
+getFontArray Helvetica10    = helvetica10
+getFontArray Helvetica12    = helvetica12
+getFontArray Helvetica18    = helvetica18
+--getFontArray Roman          = roman
+--getFontArray MonoRoman      = monoRoman
+
+
+
+-- | Makes Char width arrays for fonts.
+makeCharArray :: [(Char, Int)] -> Array Char Int
+makeCharArray = array (toEnum 0 :: Char, toEnum 255 :: Char)
+
+fixed8By13, fixed9By15, timesRoman10, timesRoman24, helvetica10, helvetica12, helvetica18, roman, monoRoman :: Array Char Int
+fixed8By13   = makeCharArray [('\NUL',0),('\SOH',8),('\STX',8),('\ETX',8),('\EOT',8),('\ENQ',8),('\ACK',8),('\a',8),('\b',8),('\t',8),('\n',0),('\v',8),('\f',8),('\r',8),('\SO',8),('\SI',8),('\DLE',8),('\DC1',8),('\DC2',8),('\DC3',8),('\DC4',8),('\NAK',8),('\SYN',8),('\ETB',8),('\CAN',8),('\EM',8),('\SUB',8),('\ESC',8),('\FS',8),('\GS',8),('\RS',8),('\US',8),(' ',8),('!',8),('"',8),('#',8),('$',8),('%',8),('&',8),('\'',8),('(',8),(')',8),('*',8),('+',8),(',',8),('-',8),('.',8),('/',8),('0',8),('1',8),('2',8),('3',8),('4',8),('5',8),('6',8),('7',8),('8',8),('9',8),(':',8),(';',8),('<',8),('=',8),('>',8),('?',8),('@',8),('A',8),('B',8),('C',8),('D',8),('E',8),('F',8),('G',8),('H',8),('I',8),('J',8),('K',8),('L',8),('M',8),('N',8),('O',8),('P',8),('Q',8),('R',8),('S',8),('T',8),('U',8),('V',8),('W',8),('X',8),('Y',8),('Z',8),('[',8),('\\',8),(']',8),('^',8),('_',8),('`',8),('a',8),('b',8),('c',8),('d',8),('e',8),('f',8),('g',8),('h',8),('i',8),('j',8),('k',8),('l',8),('m',8),('n',8),('o',8),('p',8),('q',8),('r',8),('s',8),('t',8),('u',8),('v',8),('w',8),('x',8),('y',8),('z',8),('{',8),('|',8),('}',8),('~',8),('\DEL',8),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',8),('\161',8),('\162',8),('\163',8),('\164',0),('\165',8),('\166',0),('\167',0),('\168',0),('\169',0),('\170',8),('\171',8),('\172',8),('\173',0),('\174',0),('\175',0),('\176',8),('\177',8),('\178',8),('\179',0),('\180',0),('\181',8),('\182',0),('\183',8),('\184',0),('\185',0),('\186',8),('\187',8),('\188',8),('\189',8),('\190',0),('\191',8),('\192',0),('\193',0),('\194',0),('\195',0),('\196',8),('\197',8),('\198',8),('\199',8),('\200',0),('\201',8),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',8),('\210',0),('\211',0),('\212',0),('\213',0),('\214',8),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',8),('\221',0),('\222',0),('\223',8),('\224',8),('\225',8),('\226',8),('\227',0),('\228',8),('\229',8),('\230',8),('\231',8),('\232',8),('\233',8),('\234',8),('\235',8),('\236',8),('\237',8),('\238',8),('\239',8),('\240',0),('\241',8),('\242',8),('\243',8),('\244',8),('\245',0),('\246',8),('\247',8),('\248',0),('\249',8),('\250',8),('\251',8),('\252',8),('\253',0),('\254',0),('\255',8)]
+fixed9By15   = makeCharArray [('\NUL',0),('\SOH',9),('\STX',9),('\ETX',9),('\EOT',9),('\ENQ',9),('\ACK',9),('\a',9),('\b',9),('\t',9),('\n',0),('\v',9),('\f',9),('\r',9),('\SO',9),('\SI',9),('\DLE',9),('\DC1',9),('\DC2',9),('\DC3',9),('\DC4',9),('\NAK',9),('\SYN',9),('\ETB',9),('\CAN',9),('\EM',9),('\SUB',9),('\ESC',9),('\FS',9),('\GS',9),('\RS',9),('\US',9),(' ',9),('!',9),('"',9),('#',9),('$',9),('%',9),('&',9),('\'',9),('(',9),(')',9),('*',9),('+',9),(',',9),('-',9),('.',9),('/',9),('0',9),('1',9),('2',9),('3',9),('4',9),('5',9),('6',9),('7',9),('8',9),('9',9),(':',9),(';',9),('<',9),('=',9),('>',9),('?',9),('@',9),('A',9),('B',9),('C',9),('D',9),('E',9),('F',9),('G',9),('H',9),('I',9),('J',9),('K',9),('L',9),('M',9),('N',9),('O',9),('P',9),('Q',9),('R',9),('S',9),('T',9),('U',9),('V',9),('W',9),('X',9),('Y',9),('Z',9),('[',9),('\\',9),(']',9),('^',9),('_',9),('`',9),('a',9),('b',9),('c',9),('d',9),('e',9),('f',9),('g',9),('h',9),('i',9),('j',9),('k',9),('l',9),('m',9),('n',9),('o',9),('p',9),('q',9),('r',9),('s',9),('t',9),('u',9),('v',9),('w',9),('x',9),('y',9),('z',9),('{',9),('|',9),('}',9),('~',9),('\DEL',9),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',9),('\161',9),('\162',9),('\163',9),('\164',0),('\165',9),('\166',0),('\167',0),('\168',0),('\169',0),('\170',9),('\171',9),('\172',9),('\173',0),('\174',0),('\175',0),('\176',9),('\177',9),('\178',9),('\179',0),('\180',0),('\181',9),('\182',0),('\183',9),('\184',0),('\185',0),('\186',9),('\187',9),('\188',9),('\189',9),('\190',0),('\191',9),('\192',0),('\193',0),('\194',0),('\195',0),('\196',9),('\197',9),('\198',9),('\199',9),('\200',0),('\201',9),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',9),('\210',0),('\211',0),('\212',0),('\213',0),('\214',9),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',9),('\221',0),('\222',0),('\223',9),('\224',9),('\225',9),('\226',9),('\227',0),('\228',9),('\229',9),('\230',9),('\231',9),('\232',9),('\233',9),('\234',9),('\235',9),('\236',9),('\237',9),('\238',9),('\239',9),('\240',0),('\241',9),('\242',9),('\243',9),('\244',9),('\245',0),('\246',9),('\247',9),('\248',0),('\249',9),('\250',9),('\251',9),('\252',9),('\253',0),('\254',0),('\255',9)]
+timesRoman10 = makeCharArray [('\NUL',0),('\SOH',2),('\STX',2),('\ETX',2),('\EOT',2),('\ENQ',2),('\ACK',2),('\a',2),('\b',2),('\t',2),('\n',0),('\v',2),('\f',2),('\r',2),('\SO',2),('\SI',2),('\DLE',2),('\DC1',2),('\DC2',2),('\DC3',2),('\DC4',2),('\NAK',2),('\SYN',2),('\ETB',2),('\CAN',2),('\EM',2),('\SUB',2),('\ESC',2),('\FS',2),('\GS',2),('\RS',2),('\US',2),(' ',2),('!',3),('"',4),('#',5),('$',5),('%',8),('&',8),('\'',3),('(',4),(')',4),('*',5),('+',6),(',',3),('-',7),('.',3),('/',3),('0',5),('1',5),('2',5),('3',5),('4',5),('5',5),('6',5),('7',5),('8',5),('9',5),(':',3),(';',3),('<',5),('=',6),('>',5),('?',4),('@',9),('A',8),('B',6),('C',7),('D',7),('E',6),('F',6),('G',7),('H',8),('I',4),('J',4),('K',7),('L',6),('M',10),('N',8),('O',7),('P',6),('Q',7),('R',7),('S',5),('T',6),('U',8),('V',8),('W',10),('X',8),('Y',8),('Z',6),('[',3),('\\',3),(']',3),('^',5),('_',5),('`',3),('a',4),('b',5),('c',4),('d',5),('e',4),('f',4),('g',5),('h',5),('i',3),('j',3),('k',5),('l',4),('m',8),('n',5),('o',5),('p',5),('q',5),('r',4),('s',4),('t',4),('u',5),('v',5),('w',8),('x',6),('y',5),('z',5),('{',4),('|',2),('}',4),('~',7),('\DEL',2),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',5),('\161',4),('\162',2),('\163',2),('\164',0),('\165',2),('\166',0),('\167',0),('\168',0),('\169',0),('\170',2),('\171',9),('\172',4),('\173',0),('\174',0),('\175',0),('\176',5),('\177',5),('\178',5),('\179',0),('\180',0),('\181',6),('\182',0),('\183',5),('\184',0),('\185',0),('\186',5),('\187',4),('\188',7),('\189',5),('\190',0),('\191',5),('\192',0),('\193',0),('\194',0),('\195',0),('\196',2),('\197',2),('\198',2),('\199',2),('\200',0),('\201',2),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',5),('\210',0),('\211',0),('\212',0),('\213',0),('\214',2),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',2),('\221',0),('\222',0),('\223',4),('\224',2),('\225',2),('\226',2),('\227',0),('\228',2),('\229',2),('\230',2),('\231',2),('\232',2),('\233',2),('\234',2),('\235',2),('\236',2),('\237',3),('\238',2),('\239',2),('\240',0),('\241',5),('\242',2),('\243',5),('\244',2),('\245',0),('\246',2),('\247',5),('\248',0),('\249',2),('\250',5),('\251',2),('\252',2),('\253',0),('\254',0),('\255',2)]
+timesRoman24 = makeCharArray [('\NUL',0),('\SOH',6),('\STX',6),('\ETX',6),('\EOT',6),('\ENQ',6),('\ACK',6),('\a',6),('\b',6),('\t',6),('\n',0),('\v',6),('\f',6),('\r',6),('\SO',6),('\SI',6),('\DLE',6),('\DC1',6),('\DC2',6),('\DC3',6),('\DC4',6),('\NAK',6),('\SYN',6),('\ETB',6),('\CAN',6),('\EM',6),('\SUB',6),('\ESC',6),('\FS',6),('\GS',6),('\RS',6),('\US',6),(' ',6),('!',8),('"',10),('#',13),('$',12),('%',19),('&',18),('\'',8),('(',8),(')',8),('*',12),('+',14),(',',7),('-',14),('.',6),('/',7),('0',12),('1',12),('2',12),('3',12),('4',12),('5',12),('6',12),('7',12),('8',12),('9',12),(':',6),(';',7),('<',13),('=',14),('>',13),('?',11),('@',22),('A',17),('B',16),('C',16),('D',17),('E',15),('F',14),('G',18),('H',19),('I',8),('J',11),('K',17),('L',14),('M',22),('N',18),('O',18),('P',15),('Q',18),('R',16),('S',13),('T',16),('U',18),('V',17),('W',23),('X',18),('Y',16),('Z',15),('[',8),('\\',7),(']',8),('^',11),('_',13),('`',7),('a',11),('b',12),('c',11),('d',12),('e',11),('f',7),('g',12),('h',13),('i',6),('j',6),('k',12),('l',6),('m',20),('n',13),('o',12),('p',12),('q',12),('r',8),('s',10),('t',7),('u',13),('v',11),('w',17),('x',13),('y',11),('z',10),('{',10),('|',6),('}',10),('~',13),('\DEL',6),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',11),('\161',9),('\162',6),('\163',6),('\164',0),('\165',6),('\166',0),('\167',0),('\168',0),('\169',0),('\170',6),('\171',19),('\172',8),('\173',0),('\174',0),('\175',0),('\176',12),('\177',13),('\178',11),('\179',0),('\180',0),('\181',16),('\182',0),('\183',13),('\184',0),('\185',0),('\186',12),('\187',8),('\188',14),('\189',13),('\190',0),('\191',8),('\192',0),('\193',0),('\194',0),('\195',0),('\196',6),('\197',6),('\198',6),('\199',6),('\200',0),('\201',6),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',14),('\210',0),('\211',0),('\212',0),('\213',0),('\214',6),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',6),('\221',0),('\222',0),('\223',11),('\224',6),('\225',6),('\226',6),('\227',0),('\228',6),('\229',6),('\230',6),('\231',6),('\232',6),('\233',6),('\234',6),('\235',6),('\236',6),('\237',8),('\238',6),('\239',6),('\240',0),('\241',13),('\242',6),('\243',12),('\244',6),('\245',0),('\246',6),('\247',12),('\248',0),('\249',6),('\250',12),('\251',6),('\252',6),('\253',0),('\254',0),('\255',6)]
+helvetica10  = makeCharArray [('\NUL',0),('\SOH',3),('\STX',3),('\ETX',3),('\EOT',3),('\ENQ',3),('\ACK',3),('\a',3),('\b',3),('\t',3),('\n',0),('\v',3),('\f',3),('\r',3),('\SO',3),('\SI',3),('\DLE',3),('\DC1',3),('\DC2',3),('\DC3',3),('\DC4',3),('\NAK',3),('\SYN',3),('\ETB',3),('\CAN',3),('\EM',3),('\SUB',3),('\ESC',3),('\FS',3),('\GS',3),('\RS',3),('\US',3),(' ',3),('!',3),('"',4),('#',6),('$',6),('%',9),('&',8),('\'',3),('(',4),(')',4),('*',4),('+',6),(',',3),('-',7),('.',3),('/',3),('0',6),('1',6),('2',6),('3',6),('4',6),('5',6),('6',6),('7',6),('8',6),('9',6),(':',3),(';',3),('<',6),('=',5),('>',6),('?',6),('@',11),('A',7),('B',7),('C',8),('D',8),('E',7),('F',6),('G',8),('H',8),('I',3),('J',5),('K',7),('L',6),('M',9),('N',8),('O',8),('P',7),('Q',8),('R',7),('S',7),('T',5),('U',8),('V',7),('W',9),('X',7),('Y',7),('Z',7),('[',3),('\\',3),(']',3),('^',6),('_',6),('`',3),('a',5),('b',6),('c',5),('d',6),('e',5),('f',4),('g',6),('h',6),('i',2),('j',2),('k',5),('l',2),('m',8),('n',6),('o',6),('p',6),('q',6),('r',4),('s',5),('t',4),('u',5),('v',6),('w',8),('x',6),('y',5),('z',5),('{',3),('|',3),('}',3),('~',7),('\DEL',3),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',5),('\161',4),('\162',3),('\163',3),('\164',0),('\165',3),('\166',0),('\167',0),('\168',0),('\169',0),('\170',3),('\171',9),('\172',4),('\173',0),('\174',0),('\175',0),('\176',6),('\177',5),('\178',5),('\179',0),('\180',0),('\181',8),('\182',0),('\183',5),('\184',0),('\185',0),('\186',6),('\187',3),('\188',7),('\189',6),('\190',0),('\191',3),('\192',0),('\193',0),('\194',0),('\195',0),('\196',3),('\197',3),('\198',3),('\199',3),('\200',0),('\201',3),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',6),('\210',0),('\211',0),('\212',0),('\213',0),('\214',3),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',3),('\221',0),('\222',0),('\223',5),('\224',3),('\225',3),('\226',3),('\227',0),('\228',3),('\229',3),('\230',3),('\231',3),('\232',3),('\233',3),('\234',3),('\235',3),('\236',3),('\237',3),('\238',3),('\239',3),('\240',0),('\241',5),('\242',3),('\243',6),('\244',3),('\245',0),('\246',3),('\247',6),('\248',0),('\249',3),('\250',6),('\251',3),('\252',3),('\253',0),('\254',0),('\255',3)]
+helvetica12  = makeCharArray [('\NUL',0),('\SOH',4),('\STX',4),('\ETX',4),('\EOT',4),('\ENQ',4),('\ACK',4),('\a',4),('\b',4),('\t',4),('\n',0),('\v',4),('\f',4),('\r',4),('\SO',4),('\SI',4),('\DLE',4),('\DC1',4),('\DC2',4),('\DC3',4),('\DC4',4),('\NAK',4),('\SYN',4),('\ETB',4),('\CAN',4),('\EM',4),('\SUB',4),('\ESC',4),('\FS',4),('\GS',4),('\RS',4),('\US',4),(' ',4),('!',3),('"',5),('#',7),('$',7),('%',11),('&',9),('\'',3),('(',4),(')',4),('*',5),('+',7),(',',4),('-',8),('.',3),('/',4),('0',7),('1',7),('2',7),('3',7),('4',7),('5',7),('6',7),('7',7),('8',7),('9',7),(':',3),(';',3),('<',7),('=',7),('>',7),('?',7),('@',12),('A',9),('B',8),('C',9),('D',9),('E',8),('F',8),('G',9),('H',9),('I',3),('J',7),('K',8),('L',7),('M',11),('N',9),('O',10),('P',8),('Q',10),('R',8),('S',8),('T',7),('U',8),('V',9),('W',11),('X',9),('Y',9),('Z',9),('[',3),('\\',4),(']',3),('^',6),('_',7),('`',3),('a',7),('b',7),('c',7),('d',7),('e',7),('f',3),('g',7),('h',7),('i',3),('j',3),('k',6),('l',3),('m',9),('n',7),('o',7),('p',7),('q',7),('r',4),('s',6),('t',3),('u',7),('v',7),('w',9),('x',6),('y',7),('z',6),('{',4),('|',3),('}',4),('~',7),('\DEL',4),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',7),('\161',5),('\162',4),('\163',4),('\164',0),('\165',4),('\166',0),('\167',0),('\168',0),('\169',0),('\170',3),('\171',11),('\172',5),('\173',0),('\174',0),('\175',0),('\176',7),('\177',7),('\178',7),('\179',0),('\180',0),('\181',11),('\182',0),('\183',7),('\184',0),('\185',0),('\186',6),('\187',4),('\188',8),('\189',7),('\190',0),('\191',3),('\192',0),('\193',0),('\194',0),('\195',0),('\196',4),('\197',4),('\198',4),('\199',4),('\200',0),('\201',4),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',7),('\210',0),('\211',0),('\212',0),('\213',0),('\214',4),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',4),('\221',0),('\222',0),('\223',7),('\224',4),('\225',4),('\226',4),('\227',0),('\228',4),('\229',4),('\230',4),('\231',4),('\232',4),('\233',4),('\234',4),('\235',4),('\236',4),('\237',3),('\238',4),('\239',4),('\240',0),('\241',7),('\242',4),('\243',7),('\244',4),('\245',0),('\246',4),('\247',7),('\248',0),('\249',4),('\250',7),('\251',4),('\252',4),('\253',0),('\254',0),('\255',4)]
+helvetica18  = makeCharArray [('\NUL',0),('\SOH',5),('\STX',5),('\ETX',5),('\EOT',5),('\ENQ',5),('\ACK',5),('\a',5),('\b',5),('\t',5),('\n',0),('\v',5),('\f',5),('\r',5),('\SO',5),('\SI',5),('\DLE',5),('\DC1',5),('\DC2',5),('\DC3',5),('\DC4',5),('\NAK',5),('\SYN',5),('\ETB',5),('\CAN',5),('\EM',5),('\SUB',5),('\ESC',5),('\FS',5),('\GS',5),('\RS',5),('\US',5),(' ',5),('!',6),('"',5),('#',10),('$',10),('%',16),('&',13),('\'',4),('(',6),(')',6),('*',7),('+',10),(',',5),('-',11),('.',5),('/',5),('0',10),('1',10),('2',10),('3',10),('4',10),('5',10),('6',10),('7',10),('8',10),('9',10),(':',5),(';',5),('<',10),('=',11),('>',10),('?',10),('@',18),('A',12),('B',13),('C',14),('D',13),('E',11),('F',11),('G',14),('H',13),('I',6),('J',10),('K',13),('L',10),('M',16),('N',13),('O',15),('P',12),('Q',15),('R',12),('S',13),('T',12),('U',13),('V',14),('W',18),('X',13),('Y',14),('Z',12),('[',5),('\\',5),(']',5),('^',9),('_',10),('`',4),('a',9),('b',11),('c',10),('d',11),('e',10),('f',6),('g',11),('h',10),('i',4),('j',4),('k',9),('l',4),('m',14),('n',10),('o',11),('p',11),('q',11),('r',6),('s',9),('t',6),('u',10),('v',10),('w',14),('x',10),('y',10),('z',9),('{',6),('|',4),('}',6),('~',10),('\DEL',5),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',10),('\161',7),('\162',5),('\163',5),('\164',0),('\165',5),('\166',0),('\167',0),('\168',0),('\169',0),('\170',4),('\171',14),('\172',7),('\173',0),('\174',0),('\175',0),('\176',11),('\177',10),('\178',10),('\179',0),('\180',0),('\181',15),('\182',0),('\183',10),('\184',0),('\185',0),('\186',10),('\187',5),('\188',11),('\189',9),('\190',0),('\191',6),('\192',0),('\193',0),('\194',0),('\195',0),('\196',5),('\197',5),('\198',5),('\199',5),('\200',0),('\201',5),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',10),('\210',0),('\211',0),('\212',0),('\213',0),('\214',5),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',5),('\221',0),('\222',0),('\223',9),('\224',5),('\225',5),('\226',5),('\227',0),('\228',5),('\229',5),('\230',5),('\231',5),('\232',5),('\233',5),('\234',5),('\235',5),('\236',5),('\237',6),('\238',5),('\239',5),('\240',0),('\241',10),('\242',5),('\243',10),('\244',5),('\245',0),('\246',5),('\247',11),('\248',0),('\249',5),('\250',10),('\251',5),('\252',5),('\253',0),('\254',0),('\255',5)]
+roman        = makeCharArray [('\NUL',0),('\SOH',0),('\STX',0),('\ETX',0),('\EOT',0),('\ENQ',0),('\ACK',0),('\a',0),('\b',0),('\t',0),('\n',0),('\v',0),('\f',0),('\r',0),('\SO',0),('\SI',0),('\DLE',0),('\DC1',0),('\DC2',0),('\DC3',0),('\DC4',0),('\NAK',0),('\SYN',0),('\ETB',0),('\CAN',0),('\EM',0),('\SUB',0),('\ESC',0),('\FS',0),('\GS',0),('\RS',0),('\US',0),(' ',105),('!',27),('"',51),('#',79),('$',76),('%',97),('&',102),('\'',14),('(',47),(')',48),('*',59),('+',97),(',',26),('-',101),('.',26),('/',82),('0',77),('1',67),('2',78),('3',77),('4',80),('5',78),('6',74),('7',77),('8',78),('9',74),(':',26),(';',26),('<',82),('=',97),('>',82),('?',74),('@',74),('A',80),('B',84),('C',84),('D',85),('E',78),('F',79),('G',90),('H',89),('I',21),('J',60),('K',79),('L',71),('M',97),('N',89),('O',89),('P',86),('Q',88),('R',82),('S',81),('T',72),('U',89),('V',82),('W',101),('X',72),('Y',80),('Z',74),('[',46),('\\',78),(']',46),('^',90),('_',104),('`',84),('a',67),('b',70),('c',69),('d',70),('e',69),('f',39),('g',71),('h',71),('i',29),('j',36),('k',63),('l',19),('m',124),('n',71),('o',72),('p',71),('q',71),('r',49),('s',62),('t',39),('u',71),('v',61),('w',80),('x',56),('y',66),('z',62),('{',42),('|',24),('}',41),('~',91),('\DEL',67),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',0),('\161',0),('\162',0),('\163',0),('\164',0),('\165',0),('\166',0),('\167',0),('\168',0),('\169',0),('\170',0),('\171',0),('\172',0),('\173',0),('\174',0),('\175',0),('\176',0),('\177',0),('\178',0),('\179',0),('\180',0),('\181',0),('\182',0),('\183',0),('\184',0),('\185',0),('\186',0),('\187',0),('\188',0),('\189',0),('\190',0),('\191',0),('\192',0),('\193',0),('\194',0),('\195',0),('\196',0),('\197',0),('\198',0),('\199',0),('\200',0),('\201',0),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',0),('\210',0),('\211',0),('\212',0),('\213',0),('\214',0),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',0),('\221',0),('\222',0),('\223',0),('\224',0),('\225',0),('\226',0),('\227',0),('\228',0),('\229',0),('\230',0),('\231',0),('\232',0),('\233',0),('\234',0),('\235',0),('\236',0),('\237',0),('\238',0),('\239',0),('\240',0),('\241',0),('\242',0),('\243',0),('\244',0),('\245',0),('\246',0),('\247',0),('\248',0),('\249',0),('\250',0),('\251',0),('\252',0),('\253',0),('\254',0),('\255',0)]
+monoRoman    = makeCharArray [('\NUL',0),('\SOH',0),('\STX',0),('\ETX',0),('\EOT',0),('\ENQ',0),('\ACK',0),('\a',0),('\b',0),('\t',0),('\n',0),('\v',0),('\f',0),('\r',0),('\SO',0),('\SI',0),('\DLE',0),('\DC1',0),('\DC2',0),('\DC3',0),('\DC4',0),('\NAK',0),('\SYN',0),('\ETB',0),('\CAN',0),('\EM',0),('\SUB',0),('\ESC',0),('\FS',0),('\GS',0),('\RS',0),('\US',0),(' ',105),('!',105),('"',105),('#',105),('$',105),('%',105),('&',105),('\'',105),('(',105),(')',105),('*',105),('+',105),(',',105),('-',105),('.',105),('/',105),('0',105),('1',105),('2',105),('3',105),('4',105),('5',105),('6',105),('7',105),('8',105),('9',105),(':',105),(';',105),('<',105),('=',105),('>',105),('?',105),('@',105),('A',105),('B',105),('C',105),('D',105),('E',105),('F',105),('G',105),('H',105),('I',105),('J',105),('K',105),('L',105),('M',105),('N',105),('O',105),('P',105),('Q',105),('R',105),('S',105),('T',105),('U',105),('V',105),('W',105),('X',105),('Y',105),('Z',105),('[',105),('\\',105),(']',105),('^',105),('_',105),('`',105),('a',105),('b',105),('c',105),('d',105),('e',105),('f',105),('g',105),('h',105),('i',105),('j',105),('k',105),('l',105),('m',105),('n',105),('o',105),('p',105),('q',105),('r',105),('s',105),('t',105),('u',105),('v',105),('w',105),('x',105),('y',105),('z',105),('{',105),('|',105),('}',105),('~',105),('\DEL',105),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',0),('\161',0),('\162',0),('\163',0),('\164',0),('\165',0),('\166',0),('\167',0),('\168',0),('\169',0),('\170',0),('\171',0),('\172',0),('\173',0),('\174',0),('\175',0),('\176',0),('\177',0),('\178',0),('\179',0),('\180',0),('\181',0),('\182',0),('\183',0),('\184',0),('\185',0),('\186',0),('\187',0),('\188',0),('\189',0),('\190',0),('\191',0),('\192',0),('\193',0),('\194',0),('\195',0),('\196',0),('\197',0),('\198',0),('\199',0),('\200',0),('\201',0),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',0),('\210',0),('\211',0),('\212',0),('\213',0),('\214',0),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',0),('\221',0),('\222',0),('\223',0),('\224',0),('\225',0),('\226',0),('\227',0),('\228',0),('\229',0),('\230',0),('\231',0),('\232',0),('\233',0),('\234',0),('\235',0),('\236',0),('\237',0),('\238',0),('\239',0),('\240',0),('\241',0),('\242',0),('\243',0),('\244',0),('\245',0),('\246',0),('\247',0),('\248',0),('\249',0),('\250',0),('\251',0),('\252',0),('\253',0),('\254',0),('\255',0)]

@@ -0,0 +1,32 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  FRP.UISF.Graphics.Types
+-- Copyright   :  (c) Daniel Winograd-Cort 2015
+-- License     :  see the LICENSE file in the distribution
+--
+-- Maintainer  :  dwc@cs.yale.edu
+-- Stability   :  experimental
+
+{-# LANGUAGE BangPatterns, FlexibleInstances, TypeSynonymInstances #-}
+module FRP.UISF.Graphics.Types (
+  -- * Useful Types
+  Point, Angle, Dimension, Rect
+  ) where
+
+
+------------------------------------------------------------
+-- Useful Types
+------------------------------------------------------------
+
+-- | Point describes a point on the GUI.
+type Point = (Int, Int)
+
+-- | A dimension specifies size.
+type Dimension = (Int, Int)
+
+-- | A rectangle has a (bottom left) corner point and a dimension.
+type Rect = (Point, Dimension)
+
+-- | Angles are used when making arcs, circles, etc. or when 
+--  performing rotations.  Angles are measured in Degrees
+type Angle = Double

@@ -0,0 +1,441 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  FRP.UISF.Render.GLUT
+-- Copyright   :  (c) Daniel Winograd-Cort 2015
+-- License     :  see the LICENSE file in the distribution
+--
+-- Maintainer  :  dwc@cs.yale.edu
+-- Stability   :  experimental
+
+module FRP.UISF.Render.GLUT (
+  -- $glut
+  Window,
+  WindowData (..),
+  openWindow,
+  closeWindow,
+  -- * Rendering Graphics in OpenGL
+  renderGraphicInOpenGL,
+  glutKeyToKey
+  ) where
+
+
+import Graphics.UI.GLUT hiding (Key(..), SpecialKey(..), MouseButton(..), vertex, Rect)
+import qualified Graphics.UI.GLUT as GLUT
+import qualified Graphics.Rendering.OpenGL as GL
+import Graphics.Rendering.OpenGL (($=), GLfloat)
+
+import Control.Concurrent
+import Control.Concurrent.MVar
+import Control.Concurrent.STM.TChan
+import Control.Exception (catch,IOException)
+import Control.Monad.STM (atomically)
+import Control.Monad (when)
+import Data.IORef
+import Data.List (unfoldr)
+
+import FRP.UISF.UITypes
+import FRP.UISF.Graphics
+import FRP.UISF.Graphics.Graphic (Graphic(..))
+import FRP.UISF.Graphics.Text (uitextLines)
+
+{- $glut
+This module provides the functions for UISF's direct interface with 
+GLUT and the GUI window itself.  The main function for this is 
+'openWindow', and once a window is open, almost all communication is 
+handled through the returned 'WindowData' object.  The one exception 
+to this is that one can externally close the window, 
+terminating the GUI altogether (although this requires the window 
+object, which is found in the WindowData).
+
+Note that the values in WindowData are all IO actions.  Thus, to get 
+the "current" value of the window's dimensions, one should run the 
+'windowDim' action "now".
+
+Note also that the 'Window' type is being re-exported here as it is 
+used in the 'WindowData' type.
+-}
+
+-------------------
+-- Window Functions
+-------------------
+
+-- | The WindowData object is used for communication between the 
+--  logic (UISF) and the window (GLUT).
+data WindowData = WindowData {
+  setGraphics  :: (Graphic, DirtyBit) -> IO (),
+  -- ^  This action allows a caller to set the current Graphic to display 
+  --    along with a 'DirtyBit' indicating if the Graphic needs to be 
+  --    redrawn.
+  getWindow    :: IO (Maybe Window),
+  -- ^  This action retrieves the active window.  For now, this is used 
+  --    both to check if the GUI is still running (a result of Nothing 
+  --    indicates that it is not) and to externally close the window.  
+  --    Note that if GLUT closes the window (e.g. the user clicks the 
+  --    close button), this reference will be updated to Nothing to 
+  --    prevent double closure.
+  getWindowDim :: IO Dimension,
+  -- ^  This action retrieves the window's current dimensions.  There 
+  --    is no way to set this value outside of the initial dimension 
+  --    provided by openWindow (perhaps a future feature).
+  getNextEvent :: IO UIEvent,
+  -- ^  This action retrieves the next keyboard/mouse event to be 
+  --    processed.  In the case that there is no new event, NoUIEvent 
+  --    is provided.
+  peekNextEvent :: IO UIEvent,
+  -- ^  This action peeks at the next keyboard/mouse event to be 
+  --    processed.  In the case that there is no new event, NoUIEvent 
+  --    is provided.  This was added for a potential performance boost.
+  getElapsedGUITime :: IO Double
+  -- ^  This action retrieves the number of real time seconds that have 
+  --    elapsed since the GUI began.
+}
+
+-- | This function creates the GUI window.  It takes as arguments 
+--  a default background color, a title for the window, and the initial 
+--  dimensions for the window; it produces a WindowData object to use 
+--  as communication to the window.
+--
+--  Note that the main GLUT loop is run in a separate OS thread produced 
+--  by forkOS.
+openWindow :: RGB -> String -> Dimension -> IO WindowData
+openWindow rgb title (x,y) = do
+  gRef  <- newIORef (nullGraphic, False)
+  wRef  <- newIORef Nothing
+  wdRef <- newIORef (x,y)
+  eChan <- atomically newTChan
+  continue <- newEmptyMVar
+  let w = WindowData (writeIORef gRef) (readIORef wRef)
+                     (readIORef wdRef) (nextEvent tryReadTChan eChan) 
+                     (nextEvent tryPeekTChan eChan) guiTime
+  -- REMARK: forkIO seems to work fine, but if GLUT starts misbehaving, 
+  --    this may need to change to forkOS.
+  forkIO (f gRef wRef wdRef eChan continue)
+  takeMVar continue
+  return w
+ where 
+  nextEvent r c = do
+    me <- atomically $ r c
+    case me of
+      Nothing -> return NoUIEvent
+      Just e  -> return e
+  f gRef wRef wdRef eChan continue = do
+    -- Initialize and create the window.
+    (_progName, otherArgs) <- getArgsAndInitialize
+    initialDisplayMode $= [DoubleBuffered]
+    w <- createWindow title
+    windowSize $= Size (fromIntegral x) (fromIntegral y)
+    -- Update the WindowData Window reference to point to this new window.
+    writeIORef wRef (Just w)
+    
+    -- We want the program to be able to continue when the window closes.
+    catch (actionOnWindowClose $= ContinueExecution)
+          (const (return ())::IOException->IO())
+    -- Set the default background color.
+    setBackgroundColor rgb
+    
+    -- Set up the various call back functions.
+    displayCallback $= displayCB gRef
+    idleCallback $= Just (idleCB gRef)
+    reshapeCallback $= Just (reshapeCB wdRef)
+    keyboardMouseCallback $= Just (keyboardMouseCB eChan)
+    motionCallback $= Just (motionCB eChan)
+    passiveMotionCallback $= Just (motionCB eChan)
+    catch (closeCallback $= Just (closeCB wRef))
+          (const (return ())::IOException->IO())
+    
+    -- These 4 settings are pulled from elsewhere.
+    -- They're probably good?
+    lineSmooth $= Enabled
+    blend $= Enabled
+    blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
+    lineWidth $= 1.5
+    
+    -- Indicate to the main thread that the window is good to go.
+    putMVar continue ()
+    
+    -- Begin the main loop.
+    mainLoop
+
+-- | When provided with an active window, this function will close 
+--  the window.
+closeWindow :: Window -> IO ()
+closeWindow = destroyWindow
+
+-- | Set the default background color for the GUI window.
+setBackgroundColor :: RGB -> IO ()
+setBackgroundColor rgb = clearColor $= Color4 r g b 0
+  where (r',g',b') = extractRGB rgb
+        r = fromIntegral r' / 255
+        g = fromIntegral g' / 255
+        b = fromIntegral b' / 255
+
+-- | The callback to update the display.
+displayCB :: IORef (Graphic, DirtyBit) -> DisplayCallback
+displayCB ref = do 
+  (g, _) <- readIORef ref
+  loadIdentity
+  clear [ColorBuffer, StencilBuffer]
+  (Size x y) <- get windowSize
+  renderGraphicInOpenGL (fromIntegral x, fromIntegral y) g
+  swapBuffers
+  postRedisplay Nothing
+
+-- | When the GUI is idle, we should check if the dirty bit is set.  
+--  If so, we signal a redraw of the display.
+idleCB :: IORef (Graphic, DirtyBit) -> IdleCallback
+idleCB ref = do
+  db <- atomicModifyIORef ref (\(g,db) -> ((g,False),db))
+  when db $ postRedisplay Nothing
+
+-- | When the window is resized, we perform this mess to make sure 
+--  everything is drawn properly.  This model assumes no stretching 
+--  and instead forces the user to deal with exact pixel sizes.
+reshapeCB :: IORef Dimension -> ReshapeCallback
+reshapeCB wdref size@(Size w h) = do
+  writeIORef wdref (fromIntegral w, fromIntegral h)
+  viewport $= (Position 0 0, size)
+  matrixMode $= Projection
+  loadIdentity
+  ortho2D 0 (realToFrac w) (realToFrac h) 0
+  matrixMode $= Modelview 0
+  loadIdentity
+  postRedisplay Nothing
+
+-- | When a keyboard or mouse event comes in, send it to the 'WindowData' 
+--  object for external processing.  Also, update the global keyState so 
+--  that 'isKeyPressed' and the has***Modifier functions work as expected.
+keyboardMouseCB :: TChan UIEvent -> KeyboardMouseCallback
+keyboardMouseCB chan key d modifiers (Position x y) = do
+  let k = glutKeyToKey key
+      down = (d == Down)
+      p = (fromIntegral x, fromIntegral y)
+  mods <- updateKeyState k down
+  case k of
+    (Char c) -> 
+      atomically $ writeTChan chan Key{ char = c, modifiers = mods, isDown = down}
+    (SpecialKey sk) -> 
+      atomically $ writeTChan chan SKey{ skey = sk, modifiers = mods, isDown = down}
+    (MouseButton mb) -> 
+      atomically $ writeTChan chan Button{ pt = p, mbutton = mb, isDown = down}
+
+-- | When the mouse moves at all, add an event to the 'WindowData' for 
+--  external processing.
+motionCB :: TChan UIEvent -> MotionCallback
+motionCB chan (Position x y) = 
+  atomically $ writeTChan chan MouseMove{ pt = (fromIntegral x, fromIntegral y)}
+
+-- | When the window closes, update the window stored in the 'WindowData'.
+closeCB :: IORef (Maybe Window) -> CloseCallback
+closeCB ref = writeIORef ref Nothing
+
+-- | Converts the GUI's elapsed time from GLUT's integral millisecond 
+--  standard into floating point seconds.
+guiTime :: IO Double
+guiTime = do
+  mills <- get elapsedTime
+  return $ fromIntegral mills / 1000
+
+
+------------------------------------------------------------
+-- Rendering Graphics in OpenGL
+------------------------------------------------------------
+
+-- | This function takes the current dimensions of the window 
+--  (necessary for the bounding operation 'boundGraphic') and a Graphic 
+--  and produces the OpenGL IO action that actually performs the 
+--  rendering.  Two notes about it:
+--
+--  - Currently, it is using 'Graphics.UI.GLUT.Fixed8By13' for 
+--    rendering text.
+--
+--  - I have had some trouble with nesting uses of PreservingMatrix 
+--    and scissoring, so bounded graphics (and perhaps other graphic 
+--    transformations in general) may be a little buggy.
+renderGraphicInOpenGL :: Dimension -> Graphic -> IO ()
+
+renderGraphicInOpenGL _ NoGraphic = return ()
+
+renderGraphicInOpenGL s (GColor rgb graphic) = (GL.color color >> renderGraphicInOpenGL s graphic) where
+  (r,g,b) = extractRGB rgb
+  color = GL.Color3 (c2f r) (c2f g) (c2f b) :: GL.Color3 GLfloat
+  c2f i = fromIntegral i / 255
+
+renderGraphicInOpenGL _ (GText (x,y) uistr) = 
+  let tlines = zip (uitextLines uistr) [0..]
+      drawLine (s,i) = do 
+        -- We need to zipWith like this to get the String x-offsets.
+        let ss = unfoldr buildList (0,unwrapUIT s)
+            buildList (_,[]) = Nothing
+            buildList (x,(c,f,str):rest) = Just ((x,c,f,str), (x+textWidth' f str, rest))
+            th = textHeight s
+            yoff = (i * th) + (th `div` 2) + 3
+        mapM_ (drawStr yoff) ss
+      drawStr yoff (xoff, c, f, str) = GL.preservingMatrix $ do
+        case c of
+          Nothing -> return ()
+          Just rgb -> GL.color color where
+            (r,g,b) = extractRGB rgb
+            color = GL.Color3 (c2f r) (c2f g) (c2f b) :: GL.Color3 GLfloat
+            c2f i = fromIntegral i / 255
+--      This code is used for Bitmap fonts (raster offset values may need to be adjusted)
+        GL.currentRasterPosition $= GLUT.Vertex4 
+            (fromIntegral $ x + xoff) 
+            (fromIntegral $ y + yoff) 0 1
+        GLUT.renderString f str
+--      This code is used for Stroke fonts (scale and translate values may need to be adjusted)
+--        GL.translate (vector (x, y+16*(i+1)))
+--        GL.scale 0.12 (-0.12) (1::GLfloat)
+--        GLUT.renderString GLUT.MonoRoman s
+  in mapM_ drawLine tlines
+
+renderGraphicInOpenGL _ (GPolyLine ps) = 
+  GL.renderPrimitive GL.LineStrip (mapM_ vertex ps)
+
+renderGraphicInOpenGL _ (GPolygon ps) = 
+  GL.renderPrimitive GL.Polygon (mapM_ vertex ps)
+
+renderGraphicInOpenGL _ (GEllipse rect) = GL.preservingMatrix $ do
+  let ((x, y), (width, height)) = normaliseRect rect
+      r@(r1,r2) = (width / 2, height / 2)
+  GL.translate $ vectorR (x + r1, y + r2) --r
+  GL.renderPrimitive GL.Polygon $ mapM_ vertexR 
+    [ (r1 * cos i, r2 * sin i) | i <- segment 0 (2 * pi) (6 / (r1 + r2)) ]
+
+renderGraphicInOpenGL _ (GArc rect start extent) = GL.preservingMatrix $ do
+  let ((x, y), (width, height)) = normaliseRect rect
+      r@(r1, r2) = (width / 2, height / 2)
+  GL.translate $ vectorR (x + r1, y + r2)
+  GL.renderPrimitive GL.LineStrip $ mapM_ vertexR 
+    [ (r1 * cos i, r2 * sin i) | i <- segment (-(start + extent) * pi / 180) 
+        (-start * pi / 180) (6 / (r1 + r2)) ]
+
+renderGraphicInOpenGL _ (GBezier []) = return ()
+renderGraphicInOpenGL s (GBezier ps) = renderGraphicInOpenGL s (GPolyLine ps') where
+  ps' = map (bezier ps) (segment 0 1 dt)
+  dt = 1 / (lineLength ps / 8)
+  lineLength :: [Point] -> Double
+  lineLength ((x1,y1):(x2,y2):ps') = 
+    let dx = fromIntegral $ x2 - x1
+        dy = fromIntegral $ y2 - y1
+    in sqrt (dx * dx + dy * dy) + lineLength ((x2,y2):ps')
+  lineLength _ = 0
+  bezier :: [Point] -> Double -> Point
+  bezier [(x1,y1)] _t = (x1, y1)
+  bezier [(x1,y1),(x2,y2)] t = (x1 + round (fromIntegral (x2 - x1) * t), 
+                                y1 + round (fromIntegral (y2 - y1) * t))
+  bezier ps t = bezier (map (\ (p, q) -> bezier [p,q] t) (zip ps (tail ps))) t
+
+renderGraphicInOpenGL s (GTranslate (x,y) g) = 
+  GL.translate (vector (x,y)) >> renderGraphicInOpenGL s g >> GL.translate (vector (0-x,0-y))
+--renderGraphicInOpenGL (GTranslate p g) = 
+--  GL.preservingMatrix $ GL.translate (vector p) >> renderGraphicInOpenGL g
+
+renderGraphicInOpenGL s@(_,windowY) (GBounded ((x,y), (w,h)) g) = do
+    let [x', y', w', h'] = map fromIntegral [x, windowY-y-h, w, h]
+    oldScissor <- GL.get GL.scissor
+    let ((x'',y''),(w'',h'')) = maybe ((x',y'),(w',h'))
+            (\(GL.Position a b, GL.Size c d) -> intersect ((x',y'),(w',h')) ((a,b),(c,d))) oldScissor
+    -- FIXME: This intersection of scissors may not be right, but I'm not sure what's better
+    GL.scissor $= Just (GL.Position x'' y'', GL.Size w'' h'')
+    renderGraphicInOpenGL s g
+    GL.scissor $= oldScissor
+  where
+    intersect ((x,y),(w,h)) ((x',y'),(w',h')) = ((x'',y''),(w'',h'')) where
+      x'' = min x x'
+      y'' = min y y'
+      w'' = max 0 $ (min (x+w) (x'+w')) - x''
+      h'' = max 0 $ (min (y+h) (y'+h')) - y''
+
+
+renderGraphicInOpenGL s (GRotate p a' g) = 
+  GL.preservingMatrix $ GL.rotate a (vector p) >> renderGraphicInOpenGL s g
+--  GL.rotate a (vector p) >> renderGraphicInOpenGL g >> GL.rotate (0-a) (vector p)
+  where a = realToFrac a'
+
+renderGraphicInOpenGL s (GScale x' y' g) = 
+  GL.preservingMatrix $ GL.scale x y (1::GLfloat) >> renderGraphicInOpenGL s g
+--  GL.scale x y (1::GLfloat) >> renderGraphicInOpenGL g >> GL.scale (1/x) (1/y) (1::GLfloat)
+  where x = realToFrac x'
+        y = realToFrac y'
+
+renderGraphicInOpenGL s (OverGraphic over base) = 
+  renderGraphicInOpenGL s base >> renderGraphicInOpenGL s over
+
+
+
+------------------------------------------------------------
+-- Helper functions
+------------------------------------------------------------
+normaliseRect :: Rect -> ((Double, Double),(Double, Double))
+normaliseRect ((x, y), (w, h)) = ((fromIntegral x', fromIntegral y'), (fromIntegral w', fromIntegral h'))
+  where (x',w') = if w < 0 then (x+w, 0-w) else (x, w)
+        (y',h') = if h < 0 then (y+h, 0-h) else (y, h)
+
+segment :: (Num t, Ord t) => t -> t -> t -> [t]
+segment start stop step = ts start
+  where ts i = if i >= stop then [stop] else i : ts (i + step)
+
+vertex :: Point -> IO ()
+vertex (x,y) = GL.vertex $ GL.Vertex3 (fromIntegral x) (fromIntegral y) (0::GLfloat)
+
+vertexR :: (Double,Double) -> IO ()
+vertexR (x,y) = GL.vertex $ GL.Vertex3 (realToFrac x) (realToFrac y) (0::GLfloat)
+
+vector :: (Int, Int) -> GL.Vector3 GLfloat
+vector (x,y) = GL.Vector3 (fromIntegral x) (fromIntegral y) 0
+
+vectorR :: (Double,Double) -> GL.Vector3 GLfloat
+vectorR (x,y) = GL.Vector3 (realToFrac x) (realToFrac y) 0
+
+
+------------------------------------------------------------
+-- Key support
+------------------------------------------------------------
+
+-- | Convert GLUT's key codes to UISF's internal ones.
+glutKeyToKey :: GLUT.Key -> Key
+glutKeyToKey key 
+ = case key of
+        GLUT.Char '\13'                            -> SpecialKey KeyEnter
+        GLUT.Char '\9'                             -> SpecialKey KeyTab
+        GLUT.Char '\ESC'                           -> SpecialKey KeyEsc
+        GLUT.Char '\DEL'                           -> SpecialKey KeyDelete
+        GLUT.Char '\BS'                            -> SpecialKey KeyBackspace
+        GLUT.Char c                                -> Char c
+        GLUT.SpecialKey GLUT.KeyF1                 -> SpecialKey KeyF1
+        GLUT.SpecialKey GLUT.KeyF2                 -> SpecialKey KeyF2
+        GLUT.SpecialKey GLUT.KeyF3                 -> SpecialKey KeyF3
+        GLUT.SpecialKey GLUT.KeyF4                 -> SpecialKey KeyF4
+        GLUT.SpecialKey GLUT.KeyF5                 -> SpecialKey KeyF5
+        GLUT.SpecialKey GLUT.KeyF6                 -> SpecialKey KeyF6
+        GLUT.SpecialKey GLUT.KeyF7                 -> SpecialKey KeyF7
+        GLUT.SpecialKey GLUT.KeyF8                 -> SpecialKey KeyF8
+        GLUT.SpecialKey GLUT.KeyF9                 -> SpecialKey KeyF9
+        GLUT.SpecialKey GLUT.KeyF10                -> SpecialKey KeyF10
+        GLUT.SpecialKey GLUT.KeyF11                -> SpecialKey KeyF11
+        GLUT.SpecialKey GLUT.KeyF12                -> SpecialKey KeyF12
+        GLUT.SpecialKey GLUT.KeyLeft               -> SpecialKey KeyLeft
+        GLUT.SpecialKey GLUT.KeyUp                 -> SpecialKey KeyUp
+        GLUT.SpecialKey GLUT.KeyRight              -> SpecialKey KeyRight
+        GLUT.SpecialKey GLUT.KeyDown               -> SpecialKey KeyDown
+        GLUT.SpecialKey GLUT.KeyPageUp             -> SpecialKey KeyPageUp
+        GLUT.SpecialKey GLUT.KeyPageDown           -> SpecialKey KeyPageDown
+        GLUT.SpecialKey GLUT.KeyHome               -> SpecialKey KeyHome
+        GLUT.SpecialKey GLUT.KeyEnd                -> SpecialKey KeyEnd
+        GLUT.SpecialKey GLUT.KeyInsert             -> SpecialKey KeyInsert
+        GLUT.SpecialKey GLUT.KeyNumLock            -> SpecialKey KeyNumLock
+        GLUT.SpecialKey GLUT.KeyBegin              -> SpecialKey KeyBegin
+        GLUT.SpecialKey GLUT.KeyDelete             -> SpecialKey KeyDelete
+        GLUT.SpecialKey (GLUT.KeyUnknown i)        -> SpecialKey (KeyUnknown i)
+        GLUT.SpecialKey GLUT.KeyShiftL             -> SpecialKey KeyShiftL
+        GLUT.SpecialKey GLUT.KeyShiftR             -> SpecialKey KeyShiftR
+        GLUT.SpecialKey GLUT.KeyCtrlL              -> SpecialKey KeyCtrlL
+        GLUT.SpecialKey GLUT.KeyCtrlR              -> SpecialKey KeyCtrlR
+        GLUT.SpecialKey GLUT.KeyAltL               -> SpecialKey KeyAltL
+        GLUT.SpecialKey GLUT.KeyAltR               -> SpecialKey KeyAltR
+        GLUT.MouseButton GLUT.LeftButton           -> MouseButton LeftButton
+        GLUT.MouseButton GLUT.MiddleButton         -> MouseButton MiddleButton
+        GLUT.MouseButton GLUT.RightButton          -> MouseButton RightButton
+        GLUT.MouseButton GLUT.WheelUp              -> MouseButton WheelUp
+        GLUT.MouseButton GLUT.WheelDown            -> MouseButton WheelDown
+        GLUT.MouseButton (GLUT.AdditionalButton i) -> MouseButton (AdditionalButton i)

@@ -1,714 +0,0 @@-module FRP.UISF.SOE (
-  -- * Window Functions
-  runGraphics,
-  Title,
-  Size,
-  Window,
-  openWindow,
-  getMainWindowSize,
-  clearWindow,
-  drawInWindow,
-  drawInWindowNow,
-  setGraphic,
-  setGraphic',
-  setDirty,
-  closeWindow,
-  openWindowEx,
-  -- * Drawing Functions
-  RedrawMode,
-  drawGraphic,
-  drawBufferedGraphic,
-  Graphic,
-  nullGraphic,
-  emptyGraphic,
-  overGraphic ,
-  overGraphics,
-  translateGraphic,
-  Color (..),
-  RGB,
-  RGBA,
-  rgb,
-  rgba,
-  withColor,
-  withColor',
-  text,
-  Point,
-  ellipse,
-  shearEllipse,
-  line,
-  polygon,
-  polyline,
-  polyBezier,
-  Angle,
-  arc,
-  scissorGraphic,
---  Region,     --Regions are an unused feature
---  createRectangle,
---  createEllipse,
---  createPolygon,
---  andRegion,
---  orRegion,
---  xorRegion,
---  diffRegion,
---  drawRegion,
---  getKey,     -- See note at definition for why these are left out
---  getLBP,
---  getRBP,
-  -- * Event Handling Functions
-  Key(..),
-  SpecialKey (..),
-  UIEvent (..),
-  hasShiftModifier, hasCtrlModifier, hasAltModifier, 
-  maybeGetWindowEvent,
-  getWindowEvent,
-  Word32,
-  timeGetTime,
-  word32ToInt,
-  isKeyPressed
-  ) where
-
-import Data.Ix (Ix)
-import Data.Word (Word32)
-import Graphics.UI.GLFW (Key(..), SpecialKey(..), KeyButtonState(..))
-import qualified Graphics.UI.GLFW as GLFW
-import qualified Graphics.Rendering.OpenGL as GL
-import Graphics.Rendering.OpenGL (($=), GLfloat)
-import System.IO.Unsafe (unsafePerformIO)
-import Control.Monad (when, unless)
-import Control.Concurrent.STM.TChan
-import Control.Monad.STM (atomically)
-import Control.Concurrent.MVar
-import Data.IORef
-import Data.List (delete)
-
-
--------------------
--- Key state
--------------------
-
-keyState :: IORef ([Char],[SpecialKey])
-keyState = unsafePerformIO $ newIORef ([],[])
-
-addCharToKeyState :: Char -> IO ()
-addCharToKeyState c = atomicModifyIORef keyState $ \(cs,ss) -> ((c:cs,ss),())
-
-addSKeyToKeyState :: SpecialKey -> IO ()
-addSKeyToKeyState s = atomicModifyIORef keyState $ \(cs,ss) -> ((cs,s:ss),())
-
-removeCharFromKeyState :: Char -> IO ()
-removeCharFromKeyState c = atomicModifyIORef keyState $ \(cs,ss) -> ((delete c cs,ss),())
-
-removeSKeyFromKeyState :: SpecialKey -> IO ()
-removeSKeyFromKeyState s = atomicModifyIORef keyState $ \(cs,ss) -> ((cs,delete s ss),())
-
--------------------
--- Window Functions
--------------------
-
-runGraphics :: IO () -> IO ()
-runGraphics main = main
-
-type Title = String
-type Size = (Int, Int)
-
-data Window = Window {
-  graphicVar :: MVar (Graphic, Bool), -- ^ boolean to remember if it's dirty
-  eventsChan :: TChan UIEvent
-}
-
--- | Graphic is just a wrapper for OpenGL IO
-newtype Graphic = Graphic (IO ())
-
-initialized, opened :: MVar Bool
-initialized = unsafePerformIO (newMVar False)
-opened = unsafePerformIO (newMVar False)
-
-initialize :: IO ()
-initialize = do
-  i <- readMVar initialized
-  unless i $ do
-      _ <- GLFW.initialize
-      modifyMVar_ initialized (const $ return True)
-      return ()
-
-openWindow :: Title -> Size -> IO Window
-openWindow title size =
-  openWindowEx title Nothing (Just size) drawBufferedGraphic
-
--- pos is always ignored due to GLFW
-openWindowEx :: Title -> Maybe Point -> Maybe Size -> RedrawMode -> IO Window
-openWindowEx title _position size (RedrawMode _useDoubleBuffer) = do
-  let siz = maybe (GL.Size 400 300) fromSize size
-  initialize
-  gVar <- newMVar (emptyGraphic, False)
-  eChan <- atomically newTChan
-  _ <- GLFW.openWindow siz [GLFW.DisplayStencilBits 8, GLFW.DisplayAlphaBits 8] GLFW.Window
-  GLFW.windowTitle $= title
-  modifyMVar_ opened (\_ -> return True)
-  GL.shadeModel $= GL.Smooth
-  -- enable antialiasing
-  GL.lineSmooth $= GL.Enabled
-  GL.blend $= GL.Enabled
-  GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
-  GL.lineWidth $= 1.5
-
-  -- this will hang on Windows
-  -- let updateWindow = readMVar gVar >>= (\(Graphic g) -> g >> GLFW.swapBuffers)
-  -- GLFW.windowRefreshCallback $= updateWindow
-
-  let motionCallback (GL.Position x y) = atomically $ 
-        writeTChan eChan MouseMove { pt = (fromIntegral x, fromIntegral y) }
-  GLFW.mousePosCallback $= motionCallback
-     
-  let charCallback c Press = do 
-        ks <- readIORef keyState
-        atomically $ writeTChan eChan Key{ char = c, modifiers = ks, isDown = True}
-      charCallback c Release = return () -- This never happens
-  let keyCallBack (CharKey c) Press = do
---        ks <- readIORef keyState
---        atomically $ writeTChan eChan Key{ char = c, modifiers = ks, isDown = True}
-        addCharToKeyState c
-      keyCallBack (CharKey c) Release = do
-        removeCharFromKeyState c
-        ks <- readIORef keyState
-        atomically $ writeTChan eChan Key{ char = c, modifiers = ks, isDown = False}
-      keyCallBack (SpecialKey sk) Press = do
-        ks <- readIORef keyState
-        atomically $ writeTChan eChan SKey{ skey = sk, modifiers = ks, isDown = True}
-        addSKeyToKeyState sk
-      keyCallBack (SpecialKey sk) Release = do
-        removeSKeyFromKeyState sk
-        ks <- readIORef keyState
-        atomically $ writeTChan eChan SKey{ skey = sk, modifiers = ks, isDown = False}
-  GLFW.charCallback $= charCallback 
-  GLFW.keyCallback  $= keyCallBack
-  GLFW.enableSpecial GLFW.KeyRepeat
-
-  GLFW.mouseButtonCallback $= (\but state -> do
-    GL.Position x y <- GL.get GLFW.mousePos
-    atomically $ writeTChan eChan Button{
-        pt = (fromIntegral x, fromIntegral y),
-        isLeft = (but == GLFW.ButtonLeft),
-        isDown = (state == Press)})
-
-  GLFW.windowSizeCallback $= atomically . writeTChan eChan . Resize
-  GLFW.windowRefreshCallback $= atomically (writeTChan eChan Refresh)
-  GLFW.windowCloseCallback $= (closeWindow_ eChan >> return True)
-
-  return Window {
-    graphicVar = gVar,
-    eventsChan = eChan
-  }
-
-getMainWindowSize :: IO Size
-getMainWindowSize = do
-  (GL.Size x y) <- GL.get GLFW.windowSize
-  return (fromIntegral x, fromIntegral y)
-
-clearWindow :: Window -> IO ()
-clearWindow win = setGraphic win (Graphic (return ()))
-
-drawInWindow :: Window -> Graphic -> IO ()
-drawInWindow win graphic = 
-  modifyMVar_ (graphicVar win) (\ (g, _) -> 
-    return (overGraphic graphic g, True)) 
-
--- | if window is marked as dirty, mark it clean, draw and swap buffer;
--- otherwise do nothing.
-updateWindowIfDirty :: Window -> IO ()
-updateWindowIfDirty win = do
-   io <- modifyMVar (graphicVar win) (\ (g@(Graphic io), dirty) -> 
-            return ((g, False), when dirty (io >> GLFW.swapBuffers)))
-   io
-
-drawInWindowNow :: Window -> Graphic -> IO ()
-drawInWindowNow win graphic = do
-  drawInWindow win graphic
-  updateWindowIfDirty win
-
--- | setGraphic set the given Graphic over empty (black) background for
--- display in current Window.
-setGraphic :: Window -> Graphic -> IO ()
-setGraphic win graphic = 
-    modifyMVar_ (graphicVar win) (\_ -> 
-        return (overGraphic graphic emptyGraphic, True))
-
-setGraphic' :: Window -> Graphic -> IO ()
-setGraphic' win graphic = 
-    modifyMVar_ (graphicVar win) (\(_, dirty) -> 
-        return (overGraphic graphic emptyGraphic, dirty))
-
-setDirty :: Window -> IO ()
-setDirty win = 
-    modifyMVar_ (graphicVar win) (\(g, _) -> return (g, True))
-
-closeWindow :: Window -> IO ()
-closeWindow win = closeWindow_ (eventsChan win)
-
-closeWindow_ :: TChan UIEvent -> IO ()
-closeWindow_ chan = do
-  atomically $ writeTChan chan Closed
-  modifyMVar_ opened (\_ -> return False)
-  GLFW.closeWindow
-  GLFW.pollEvents
-
---------------------
--- Drawing Functions
---------------------
-
-newtype RedrawMode = RedrawMode Bool
-
-drawGraphic :: RedrawMode
-drawGraphic = RedrawMode False
-
-drawBufferedGraphic :: RedrawMode
-drawBufferedGraphic = RedrawMode True
-
-data Color = Black
-           | Blue
-           | Green
-           | Cyan
-           | Red
-           | Magenta
-           | Yellow
-           | White
-  deriving (Eq, Ord, Bounded, Enum, Ix, Show, Read)
-
-type Angle = GLfloat
-
-nullGraphic :: Graphic
-nullGraphic = Graphic $ return ()
-
-emptyGraphic :: Graphic
-emptyGraphic = Graphic $ do 
-  GL.clearColor $= GL.Color4 (0xec/0xff) (0xe9/0xff) (0xd8/0xff) (0x00) -- GL.Color4 0 0 0 0
-  GL.clear [GL.ColorBuffer, GL.StencilBuffer]
-
-translateGraphic :: (Int, Int) -> Graphic -> Graphic
-translateGraphic (x, y) (Graphic g) = Graphic $ do
-  GL.translate (GL.Vector3 (fromIntegral x) (fromIntegral y) (0::GLfloat))
-  g
-  GL.translate (GL.Vector3 (fromIntegral (0-x)) (fromIntegral (0-y)) (0::GLfloat))
---translateGraphic (x, y) (Graphic g) = Graphic $ GL.preservingMatrix $ do
---  GL.translate (GL.Vector3 (fromIntegral x) (fromIntegral y) (0::GLfloat))
---  g
-
-overGraphic :: Graphic -> Graphic -> Graphic
-overGraphic (Graphic over) (Graphic base) = Graphic (base >> over)
-
-overGraphics :: [Graphic] -> Graphic
-overGraphics = foldl1 overGraphic
-
-colorToRGB :: Color -> GL.Color3 GLfloat
-colorToRGB Black   = GL.Color3 0 0 0
-colorToRGB Blue    = GL.Color3 0 0 1
-colorToRGB Green   = GL.Color3 0 1 0
-colorToRGB Cyan    = GL.Color3 0 1 1
-colorToRGB Red     = GL.Color3 1 0 0
-colorToRGB Magenta = GL.Color3 1 0 1
-colorToRGB Yellow  = GL.Color3 1 1 0
-colorToRGB White   = GL.Color3 1 1 1
-
-withColor :: Color -> Graphic -> Graphic
-withColor color = withColor' (colorToRGB color)
-
-withColor' :: GL.Color a => a -> Graphic -> Graphic
-withColor' color (Graphic g) = Graphic (GL.color color >> g)
-
-type RGB = GL.Color3 GL.GLfloat
-type RGBA = GL.Color4 GL.GLfloat
-
-rgb :: (Integral r, Integral g, Integral b) => r -> g -> b -> RGB
-rgb r g b = GL.Color3 (c2f r) (c2f g) (c2f b) :: RGB
-rgba :: (Integral r, Integral g, Integral b, Integral a) => r -> g -> b -> a -> RGBA
-rgba r g b a = GL.Color4 (c2f r) (c2f g) (c2f b) (c2f a) :: RGBA
-c2f :: (Integral c, Fractional f) => c -> f
-c2f i = fromIntegral i / 255
-
-text :: Point -> String -> Graphic
-text (x,y) str = Graphic $ GL.preservingMatrix $ do
-  GL.translate (GL.Vector3 (fromIntegral x) (fromIntegral y + 16) (0::GLfloat))
-  GL.scale 1 (-1) (1::GLfloat)
-  GLFW.renderString GLFW.Fixed8x16 str
-
-type Point = (Int, Int)
-
-ellipse :: Point -> Point -> Graphic
-ellipse pt1 pt2 = Graphic $ GL.preservingMatrix $ do
-  let (x, y, width, height) = normaliseBounds pt1 pt2
-      (r1, r2) = (width / 2, height / 2)
-  GL.translate (GL.Vector3 (x + r1) (y + r2) 0)
-  GL.renderPrimitive GL.Polygon (circle r1 r2 0 (2 * pi) (6 / (r1 + r2)))
-      
-shearEllipse :: Point -> Point -> Point -> Graphic
-shearEllipse p0 p1 p2 = Graphic $ 
-  let (x0,y0) = fromPoint p0
-      (x1,y1, w, h) = normaliseBounds p1 p2
-      (x2,y2) = (x1 + w, y1 + h)
-      x =  (x1 + x2) / 2  -- centre of parallelogram
-      y =  (y1 + y2) / 2
-      dx1 = (x1 - x0) / 2 -- distance to corners from centre
-      dy1 = (y1 - y0) / 2
-      dx2 = (x2 - x0) / 2
-      dy2 = (y2 - y0) / 2
-      pts = [ (x + c*dx1 + s*dx2, y + c*dy1 + s*dy2)
-            | (c,s) <- cos'n'sins ]
-      cos'n'sins = [ (cos a, sin a) | a <- segment 0 (2 * pi) (40 / (w + h))]
-  in GL.renderPrimitive GL.Polygon $ 
-        mapM_ (\ (x, y) -> GL.vertex (vertex3 x y 0)) pts
-
-line :: Point -> Point -> Graphic
-line (x1, y1) (x2, y2) = Graphic $ 
-  GL.renderPrimitive GL.LineStrip (do
-    GL.vertex (vertex3 (fromIntegral x1) (fromIntegral y1) 0)
-    GL.vertex (vertex3 (fromIntegral x2) (fromIntegral y2) 0))
-
-polygon :: [Point] -> Graphic
-polygon ps = Graphic $
-  GL.renderPrimitive GL.Polygon (foldr1 (>>) (map 
-    (\ (x, y) -> GL.vertex (vertex3 (fromIntegral x) (fromIntegral y) 0))
-    ps))
-
-polyline :: [Point] -> Graphic
-polyline ps = Graphic $ 
-  GL.renderPrimitive GL.LineStrip (foldr1 (>>) (map 
-    (\ (x, y) -> GL.vertex (vertex3 (fromIntegral x) (fromIntegral y) 0))
-    ps))
-
-polyBezier :: [Point] -> Graphic
-polyBezier [] = Graphic $ return ()
-polyBezier ps = polyline (map (bezier ps) (segment 0 1 dt))
-  where
-    dt = 1 / (lineLength ps / 8)
-    lineLength :: [Point] -> GLfloat
-    lineLength ((x1,y1):(x2,y2):ps') = 
-      let dx = x2 - x1
-          dy = y2 - y1
-      in sqrt (fromIntegral (dx * dx + dy * dy)) + lineLength ((x2,y2):ps')
-    lineLength _ = 0
-
-bezier :: [Point] -> GLfloat -> Point
-bezier [(x1,y1)] _t = (x1, y1)
-bezier [(x1,y1),(x2,y2)] t = (x1 + truncate (fromIntegral (x2 - x1) * t), 
-                              y1 + truncate (fromIntegral (y2 - y1) * t))
-bezier ps t = bezier (map (\ (p, q) -> bezier [p,q] t) (zip ps (tail ps))) t
-
-arc :: Point -> Point -> Angle -> Angle -> Graphic
-arc pt1 pt2 start extent = Graphic $ GL.preservingMatrix $ do
-  let (x, y, width, height) = normaliseBounds pt1 pt2
-      (r1, r2) = (width / 2, height / 2)
-  GL.translate (GL.Vector3 (x + r1) (y + r2) 0)
-  GL.renderPrimitive GL.LineStrip (circle r1 r2 
-    (-(start + extent) * pi / 180) (-start * pi / 180) (6 / (r1 + r2)))
-
-
-scissorGraphic :: (Point, Size) -> Graphic -> Graphic
-scissorGraphic ((x,y), (w,h)) (Graphic g) = Graphic $ do
-    (_,windowY) <- getMainWindowSize
-    let [x', y', w', h'] = map fromIntegral [x, windowY-y-h, w, h]
-    oldScissor <- GL.get GL.scissor
-    GL.scissor $= Just (GL.Position x' y', GL.Size w' h')
-    g
-    GL.scissor $= oldScissor
-
-
--------------------
--- Region Functions
--------------------
-
-{- Unused
-
-createRectangle :: Point -> Point -> Region
-createRectangle pt1 pt2 =
-  let (x,y,width,height) = normaliseBounds' pt1 pt2 
-      [x0, y0, x1, y1] = map fromIntegral [x, y, x + width, y + height]
-      drawing = 
-        GL.renderPrimitive GL.Quads (do
-        GL.vertex (vertex3 x0 y0 0)
-        GL.vertex (vertex3 x1 y0 0)
-        GL.vertex (vertex3 x1 y1 0)
-        GL.vertex (vertex3 x0 y1 0))
-   in [[Pos ("R" ++ show (x0,y0,x1,y1), drawing)]]
-
-createEllipse :: Point -> Point -> Region
-createEllipse pt1 pt2 =
-  let (x,y,width,height) = normaliseBounds' pt1 pt2
-      drawing = 
-        GL.preservingMatrix $ do
-          let (x, y, width, height) = normaliseBounds pt1 pt2
-              (r1, r2) = (width / 2, height / 2)
-          GL.translate (GL.Vector3 (x + r1) (y + r2) 0)
-          GL.renderPrimitive GL.Polygon (circle r1 r2 0 (2 * pi) (6 / (r1 + r2)))
-  in [[Pos ("E" ++ show (x, y, width, height), drawing)]]
-
-createPolygon :: [Point] -> Region
-createPolygon [] = [[]]
-createPolygon ps =
-  let (minx, maxx, miny, maxy) = (minimum (map fst ps), maximum (map fst ps),
-                                  minimum (map snd ps), maximum (map snd ps))
-      drawing = do
-        GL.renderPrimitive GL.Polygon (foldr1 (>>) (map 
-          (\ (x, y) -> GL.vertex (vertex3 (fromIntegral x) (fromIntegral y) 0))
-          ps))
-   in [[Pos ("P"++show ps, drawing)]]
-
-andRegion, orRegion, xorRegion, diffRegion :: Region -> Region -> Region
-
--- We'll convert region expression into disjuction canonical form
--- so as to make rendering easier using Stencil buffer.
-
-type Region = [Conjuction]
-type Conjuction = [Atom]
-data Atom = Pos Atom' | Neg Atom'
-type Atom' = (String, IO ())
-instance Show Atom where
-  show (Pos (s, _)) = "+" ++ s
-  show (Neg (s, _)) = "-" ++ s
-
-conjuction :: Region -> Region -> Region
-conjuction xs ys = [ x ++ y | x <- xs, y <- ys ]
-disjuction xs ys = xs ++ ys
-negTerm [] = []
-negTerm xs = foldl1 conjuction (map negA xs)
-  where
-    negA :: Conjuction -> Region 
-    negA ys = map negS ys
-    negS :: Atom -> Conjuction
-    negS (Pos i) = [Neg i]
-    negS (Neg i) = [Pos i]
-
-data RegionOp = AND | OR | XOR | DIFF
-
-andRegion  = combineRegion AND
-orRegion   = combineRegion OR
-xorRegion  = combineRegion XOR
-diffRegion = combineRegion DIFF
-
-drawRegion :: Region -> Graphic
-drawRegion term = Graphic drawAux
-  where
-    drawAux = do
-      GL.stencilMask $= 1
-      GL.stencilTest $= GL.Enabled
-      sequence_ [drawConjuction (posT t) (negT t) | t <- term]
-      GL.stencilTest $= GL.Disabled
-
-    posT [] = []
-    posT (Pos x:xs) = x : posT xs
-    posT (_:xs) = posT xs
-
-    negT [] = []
-    negT (Neg x:xs) = x : negT xs
-    negT (_:xs) = negT xs
-
-    drawConjuction ps ns = do
-      -- render all positive atoms only to stencil buffer
-      GL.depthFunc $= Just GL.Never
-      GL.stencilMask $= 0xff
-      GL.stencilFunc $= (GL.Greater, 0, 0xff)
-      -- every pixel rendered increases the value in the stencil buffer by 1
-      GL.stencilOp $= (GL.OpIncr, GL.OpIncr, GL.OpZero)
-      mapM_ drawIt ps
-      -- render all negative atoms to clear the stencil pixel to 0
-      GL.stencilOp $= (GL.OpZero, GL.OpZero, GL.OpZero)
-      mapM_ drawIt ns
-      -- finally render all positive atoms to screen where the stencil pixel
-      -- equals (length ps)
-      GL.depthFunc $= Just GL.Always
-      GL.stencilFunc $= (GL.Equal, fromIntegral $ length ps, 0xff)
-      GL.stencilOp $= (GL.OpZero, GL.OpZero, GL.OpZero)
-      mapM_ drawIt ps
-
-    drawIt (_, io) = io
-
---combineRegion :: Cairo.Operator -> Region -> Region -> Region
-combineRegion operator a b =
-  case operator of
-    AND -> conjuction a b
-    OR -> disjuction a b
-    XOR -> disjuction (conjuction (negTerm a) b) (conjuction a (negTerm b))
-    DIFF -> conjuction a (negTerm b)
-
--}
----------------------------
--- Event Handling Functions
----------------------------
-
-data UIEvent = 
-    Key {
-      char :: Char,
-      modifiers :: ([Char],[SpecialKey]),
-      isDown :: Bool
-    }
-  | SKey {
-      skey :: SpecialKey,
-      modifiers :: ([Char],[SpecialKey]),
-      isDown :: Bool
-    }
-  | Button {
-     pt :: Point,
-     isLeft :: Bool,
-     isDown :: Bool
-    }
-  | MouseMove {
-      pt :: Point
-    }
-  | Resize GL.Size
-  | Refresh
-  | Closed
-  | NoUIEvent
- deriving Show
-
-hasShiftModifier :: ([Char],[SpecialKey]) -> Bool
-hasShiftModifier (_, sks) = elem LSHIFT sks || elem RSHIFT sks
-
-hasCtrlModifier :: ([Char],[SpecialKey]) -> Bool
-hasCtrlModifier (_, sks) = elem LCTRL sks || elem RCTRL sks
-
-hasAltModifier :: ([Char],[SpecialKey]) -> Bool
-hasAltModifier (_, sks) = elem LALT sks || elem RALT sks
-
--- | getWindowEvent and maybeGetWindowEvent both take an additional argument 
---  sleepTime that tells how long to sleep in the case where there are no
---  window events to return.  This is used to allow the cpu to take other 
---  tasks at these times rather than needlessly spinning.  The sleepTime 
---  parameter used to be fixed at 0.01.
-
-getWindowEvent :: Double -> Window -> IO UIEvent
-getWindowEvent sleepTime win = do
-  event <- maybeGetWindowEvent sleepTime win
-  maybe (getWindowEvent sleepTime win) return event
-
-maybeGetWindowEvent :: Double -> Window -> IO (Maybe UIEvent)
-maybeGetWindowEvent sleepTime win = let winChan = eventsChan win in do
-  updateWindowIfDirty win
-  mevent <- atomically $ tryReadTChan winChan
-  case mevent of
-    Nothing -> GLFW.sleep sleepTime >> GLFW.pollEvents >> return Nothing
-    Just Refresh -> do
-      (Graphic io, _) <- readMVar (graphicVar win)
-      io
-      GLFW.swapBuffers
-      maybeGetWindowEvent sleepTime win
-    Just (e@(Resize _)) -> do
-      (Resize size@(GL.Size w h)) <- getLastResizeEvent winChan e
-      GL.viewport $= (GL.Position 0 0, size)
-      GL.matrixMode $= GL.Projection
-      GL.loadIdentity
-      GL.ortho2D 0 (realToFrac w) (realToFrac h) 0
-      -- force a refresh, needed for OS X
-      atomically $ writeTChan winChan Refresh
-      maybeGetWindowEvent sleepTime win
-    Just e -> return (Just e)
-
--- | When a window is resized, all of the resize events queue up until the 
---   mouse button is released.  This causes some delay as each individual 
---   resize event is handled and then the window is redrawn.  This function 
---   clears all resize and refresh events until the last resize one.
---   Note that because this function is used, a Refresh event should follow 
---   the resizing.
-getLastResizeEvent :: TChan UIEvent -> UIEvent -> IO UIEvent
-getLastResizeEvent ch prev = do
-    mevent <- atomically $ tryReadTChan ch
-    case mevent of
-      Nothing -> return prev
-      Just (e@(Resize _)) -> getLastResizeEvent ch e
-      Just Refresh        -> getLastResizeEvent ch prev
-      Just e -> atomically (unGetTChan ch e) >> return prev
-
-
---  getKeyEx, getKey, getButton, getLBP, and getRBP are defined here but 
---  never used in Euterpea.  Furthermore, due to the change in getWindowEvent 
---  so that it now requires a sleepTime argument (previously fixed at 0.01), 
---  they either need to be parameterized over sleepTime or set.  I'm not 
---  sure which is the better solution, so I will leave them commented out 
---  until they're needed.
-
-{-
-getKeyEx :: Window -> Bool -> IO Char
-getKeyEx win down = loop
-  where loop = do e <- getWindowEvent win
-                  case e of
-                    (Key { char = ch, isDown = d })
-                      | d == down -> return ch
-                    Closed -> return '\x0'
-                    _ -> loop
-
-getKey :: Window -> IO Char
-getKey win = do
-  ch <- getKeyEx win True
-  if ch == '\x0' then return ch
-    else getKeyEx win False
-
-getButton :: Window -> Int -> Bool -> IO Point
-getButton win but down = loop
-  where loop = do e <- getWindowEvent win
-                  case e of
-                    (Button { pt = pt, isDown = id })
-                      | id == down -> return pt
-                    _ -> loop
-
-getLBP :: Window -> IO Point
-getLBP w = getButton w 1 True
-
-getRBP :: Window -> IO Point
-getRBP w = getButton w 2 True
--}
-
--- | use GLFW's high resolution timer
-timeGetTime :: IO Double
-timeGetTime = GL.get GLFW.time
-
-word32ToInt :: Word32 -> Int
-word32ToInt = fromIntegral
-
--- | Designed to be used with Key, CharKey, or SpecialKey
-isKeyPressed :: Enum a => a -> IO Bool
-isKeyPressed k = do
-    kbs <- GLFW.getKey k
-    return $ case kbs of
-        Press   -> True
-        Release -> False
-
-----------------------
--- Auxiliary Functions
-----------------------
-
---vertex4 :: GLfloat -> GLfloat -> GLfloat -> GLfloat -> GL.Vertex4 GLfloat
---vertex4 = GL.Vertex4
-
-vertex3 :: GLfloat -> GLfloat -> GLfloat -> GL.Vertex3 GLfloat
-vertex3 = GL.Vertex3
-
-normaliseBounds :: Point -> Point -> (GLfloat,GLfloat,GLfloat,GLfloat)
-normaliseBounds (x1,y1) (x2,y2) = (x, y, width, height)
-  where x = fromIntegral $ min x1 x2
-        y = fromIntegral $ min y1 y2
-        width  = fromIntegral $ abs $ x1 - x2
-        height = fromIntegral $ abs $ y1 - y2
-
---normaliseBounds' :: Point -> Point -> (Int,Int,Int,Int)
---normaliseBounds' (x1,y1) (x2,y2) = (x, y, width, height)
---  where x = min x1 x2
---        y = min y1 y2
---        width  = abs $ x1 - x2
---        height = abs $ y1 - y2
-
-fromPoint :: Point -> (GLfloat, GLfloat)
-fromPoint (x1, x2) = (fromIntegral x1, fromIntegral x2)
-
-fromSize :: Size -> GL.Size
-fromSize (x, y) = GL.Size (fromIntegral x) (fromIntegral y)
-
--- we add 20 pixels to the y position to leave space for window title bar
---fromPosition (x, y) = GL.Position (fromIntegral x) (20 + fromIntegral y)
-
-circle :: GLfloat -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()
-circle r1 r2 start stop step =
-  let vs = [ (r1 * cos i, r2 * sin i) | i <- segment start stop step ]
-  in mapM_ (\(x, y) -> GL.vertex (vertex3 x y 0)) vs
-
-segment :: (Num t, Ord t) => t -> t -> t -> [t]
-segment start stop step = ts start
-  where ts i = if i >= stop then [stop] else i : ts (i + step)
-

@@ -10,46 +10,48 @@ -- A simple Graphical User Interface with concepts borrowed from Phooey
 -- by Conal Elliot.
 
-{-# LANGUAGE ScopedTypeVariables, Arrows, RecursiveDo, CPP, OverlappingInstances, FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE Arrows, RecursiveDo, CPP, OverlappingInstances, FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-}
 
 module FRP.UISF.UISF (
     UISF(..),
     uisfSource, uisfSink, uisfPipe,
     uisfSourceE, uisfSinkE, uisfPipeE,
     -- * UISF Getters
-    getTime, getCTX, getEvents, getFocusData, addTerminationProc, getMousePosition, 
+    getDeltaTime, getCTX, withCTX, getEvents, getFocusData, addTerminationProc, getMousePosition, 
     -- * UISF constructors, transformers, and converters
     mkUISF, 
-    -- * UISF Lifting
-    -- $lifting
-    asyncUISFE, asyncUISFV, --asyncUISFC, 
     -- * Layout Transformers
     -- $lt
     leftRight, rightLeft, topDown, bottomUp, 
     conjoin, unconjoin, 
     setLayout, setSize, pad, 
     -- * Execute UI Program
-    UIParams (..), defaultUIParams,
+    UIParams, defaultUIParams,
+    uiInitialize, uiClose, uiTitle, uiSize, uiInitFlow, uiTickDelay, uiCloseOnEsc, uiBackground,
     runUI, runUI'
 
 ) where
 
 #if __GLASGOW_HASKELL__ >= 610
 import Control.Category
-import Prelude hiding ((.), id)
+import Prelude hiding ((.), id, mapM_)
+#else
+import Prelude hiding (mapM_)
 #endif
 import Control.Arrow
 import Control.Arrow.Operations
 
-import FRP.UISF.SOE
+import FRP.UISF.Graphics
+import FRP.UISF.Render.GLUT
 import FRP.UISF.UITypes
 
-import FRP.UISF.AuxFunctions (Automaton, Time, evMap, 
-                              SEvent, ArrowTime (..), ArrowIO (..),
-                              asyncE, asyncV)
+import FRP.UISF.AuxFunctions
+    (SEvent, Time, DeltaT, getDeltaT, accumTime, evMap)
+import FRP.UISF.Asynchrony
+    (ArrowIO (..), Automaton, asyncE, asyncEOn, asyncV)
 
-import Control.Monad (when)
-import qualified Graphics.UI.GLFW as GLFW (sleep)
+import Control.Monad (when, unless)
+import Data.Foldable (mapM_)
 import Control.Concurrent
 import Control.DeepSeq
 import Data.IORef
@@ -62,7 +64,7 @@ 
 data UISF b c = UISF 
   { uisfLayout :: Flow -> Layout,
-    uisfFun    :: (CTX, Focus, Time, UIEvent, b) -> 
+    uisfFun    :: (CTX, Focus, DeltaT, UIEvent, b) -> 
                   IO (DirtyBit, Focus, Graphic, TerminationProc, c, UISF b c) }
 
 instance Category UISF where
@@ -121,10 +123,20 @@     fun inps = do
       d <- iod
       (db, foc', g, tp, c, uisff') <- uisfFun (f d) inps
-      return (db, foc', g, tp, c, uisff')
+      return (db, foc', g, tp, c, setDirty uisff')
+    setDirty (UISF l f) = UISF l h where
+      h inp = do
+        (_, foc', g, tp, c, uisf) <- f inp
+        return (True, foc', g, tp, c, uisf)
+  terminalAIO = addTerminationProc
 
-instance ArrowTime UISF where
-  time = getTime
+instance ArrowReader DeltaT UISF where
+  readState = getDeltaTime
+  newReader (UISF l f) = UISF l h where
+    h (ctx, foc, dt, e, (b, dt')) = do
+      (db, foc', g, tp, c, uisf) <- f (ctx, foc, dt', e, b)
+      return (db, foc', g, tp, c, newReader uisf)
+    
 
 
 ------------------------------------------------------------
@@ -161,13 +173,23 @@ ------------------------------------------------------------
 
 -- | Get the time signal from a UISF.
-getTime      :: UISF () Time
-getTime      = mkUISF nullLayout (\(_,f,t,_,_) -> (False, f, nullGraphic, nullTP, t))
+getDeltaTime :: UISF b DeltaT
+getDeltaTime = mkUISF nullLayout (\(_,f,dt,_,_) -> (False, f, nullGraphic, nullTP, dt))
 
+{-# DEPRECATED getCTX "As of UISF-0.4.0.0, use withCTX instead" #-}
 -- | Get the context signal from a UISF.
+--   This has been deprecated in favor of withCTX as it can provide 
+--   misleading information.
 getCTX       :: UISF () CTX
 getCTX       = mkUISF nullLayout (\(c,f,_,_,_) -> (False, f, nullGraphic, nullTP, c))
 
+-- | Provide the context signal to the UISF.
+withCTX :: UISF (CTX,a) b -> UISF a b
+withCTX (UISF l f) = UISF l h where
+  h (ctx, foc, t, e, b) = do
+    (db, foc', g, tp, c, uisf) <- f (ctx, foc, t, e, (ctx,b))
+    return (db, foc', g, tp, c, withCTX uisf)
+
 -- | Get the UIEvent signal from a UISF.
 getEvents    :: UISF () UIEvent
 getEvents    = mkUISF nullLayout (\(_,f,_,e,_) -> (False, f, nullGraphic, nullTP, e))
@@ -193,43 +215,12 @@   returnA -< p
 
 -- | This function creates a UISF with the given parameters.
-mkUISF :: Layout -> ((CTX, Focus, Time, UIEvent, a) -> (DirtyBit, Focus, Graphic, TerminationProc, b)) -> UISF a b
+mkUISF :: Layout -> ((CTX, Focus, DeltaT, UIEvent, a) -> (DirtyBit, Focus, Graphic, TerminationProc, b)) -> UISF a b
 mkUISF l f = UISF (const l) fun where
   fun inps = let (db, foc, g, tp, b) = f inps in return (db, foc, g, tp, b, mkUISF l f)
 
 
 ------------------------------------------------------------
--- * UISF Lifting
-------------------------------------------------------------
--- $lifting The following two functions are for lifting Automatons to UISFs.  
-
--- | This is the standard one that appropriately keeps track of 
---   simulated time vs real time.  
---
--- The clockrate is the simulated rate of the input signal function.
--- The buffer is the number of time steps the given signal function is allowed 
--- to get ahead of real time.  The real amount of time that it can get ahead is
--- the buffer divided by the clockrate seconds.
--- The output signal function takes and returns values in real time.  The return 
--- values are the list of bs generated in the given time step, each time stamped.
--- 
--- Note that the returned list may be long if the clockrate is much 
--- faster than real time and potentially empty if it's slower.
--- Note also that the caller can check the time stamp on the element 
--- at the end of the list to see if the inner, "simulated" signal 
--- function is performing as fast as it should.
-asyncUISFV :: NFData b => Double -> Double -> Automaton (->) a b -> UISF a [(b, Time)]
-asyncUISFV clockrate buffer sf = proc a -> do
-  t <- time -< ()
-  asyncV clockrate buffer (addTerminationProc . killThread) sf -< (a, t)
-
-
--- | We can also lift a signal function to a UISF asynchronously.
-asyncUISFE :: NFData b => Automaton (->) a b -> UISF (SEvent a) (SEvent b)
-asyncUISFE = asyncE (addTerminationProc . killThread)
-
-
-------------------------------------------------------------
 -- * Layout Transformers
 ------------------------------------------------------------
 
@@ -273,9 +264,9 @@ -- | Add space padding around a widget.
 pad  :: (Int, Int, Int, Int) -> UISF a b -> UISF a b
 pad args@(w,n,e,s) (UISF fl f) = UISF layout h where
-  layout ctx = let l = fl ctx in l { hFixed = hFixed l + w + e, vFixed = vFixed l + n + s }
-  h (ctx, foc, t, e, b) = let ((x,y),(bw,bh)) = bounds ctx in do
-    (db, foc', g, tp, c, uisf) <- f (ctx {bounds = ((x + w, y + n),(bw,bh))}, foc, t, e, b)
+  layout ctx = let l = fl ctx in l { wFixed = wFixed l + w + e, hFixed = hFixed l + n + s }
+  h (ctx, foc, t, evt, b) = let ((x,y),(bw,bh)) = bounds ctx in do
+    (db, foc', g, tp, c, uisf) <- f (ctx {bounds = ((x + w, y + n),(bw-w-e,bh-n-s))}, foc, t, evt, b)
     return (db, foc', g, tp, c, pad args uisf)
 
 
@@ -293,13 +284,24 @@   , uiTitle :: String       -- ^ The UI window's title.
   , uiSize :: Dimension     -- ^ The size of the UI window.
   , uiInitFlow :: Flow      -- ^ The initial Flow setting.
-  , uiTickDelay :: Double   -- ^ How long the UI will sleep between clock 
+  , uiTickDelay :: DeltaT   -- ^ How long the UI will sleep between clock 
                             --   ticks if no events are detected.  This 
                             --   should be probably be set to O(milliseconds), 
                             --   but it can be set to 0 for better performance 
                             --   (but also higher CPU usage)
+  , uiCloseOnEsc :: Bool    -- ^ Should the UI window close when the user 
+                            --   presses the escape key?
+  , uiBackground :: RGB     -- ^ The default color of the UI window background.
 }
 
+instance Show UIParams where
+  show p = "{UIParams containing: title="++show (uiTitle p)++
+           ", size="++show (uiSize p)++
+           ", initial flow="++show (uiInitFlow p)++
+           ", tick delay="++show (uiTickDelay p)++
+           ", background color="++show (uiBackground p)++
+           (if uiCloseOnEsc p then ", and closes on ESC}" else ", and does not close on ESC}")
+
 -- | This is the default UIParams value and what is used in runUI'.
 defaultUIParams :: UIParams
 defaultUIParams = UIParams {
@@ -308,7 +310,9 @@     uiTitle = "User Interface",
     uiSize = (300, 300),
     uiInitFlow = TopDown,
-    uiTickDelay = 0.001
+    uiTickDelay = 0.001,
+    uiCloseOnEsc = False,
+    uiBackground = colorToRGB LightBeige
 }
 
 defaultCTX :: Flow -> Dimension -> CTX
@@ -328,70 +332,59 @@ runUI p sf = do
     tref <- newIORef Nothing
     uiInitialize p
-    w <- openWindowEx (uiTitle p) (Just (0,0)) (Just $ uiSize p) drawBufferedGraphic
-    finally (go tref w) (terminate tref w)
+    w <- openWindow (uiBackground p) (uiTitle p) (uiSize p)
+    finally (go tref w defaultFocus 0 sf) (terminate tref w)
   where
     terminate tref w = do
-      closeWindow w
+      setGraphics w (nullGraphic, False)
+      mwindow <- getWindow w
+      mapM_ closeWindow mwindow
       tproc <- readIORef tref
+      --sequence_ tproc
       case tproc of
         Nothing -> return ()
         Just t -> t
-      --mapM_ killThread tids
       uiClose p
-    go tref w = runGraphics $ do
-      (events, addEv) <- makeStream
-      let pollEvents = windowUser (uiTickDelay p) w addEv
-      -- poll events before we start to make sure event queue isn't empty
-      t0 <- timeGetTime
-      pollEvents
-      let render :: Bool -> [UIEvent] -> Focus -> UISF () () -> IO ()
-          render drawit' (inp:inps) lastFocus uisf = do
-            wSize <- getMainWindowSize
-            t <- timeGetTime
-            let rt = t - t0
+    go tref w lastFocus tprev uisf = do
+      mwindow <- getWindow w
+      -- If the window is not there, GL has closed it.  Time to stop.
+      case mwindow of
+        Nothing -> return ()
+        Just _ -> do
+          ev <- getNextEvent' w
+          -- If the event is the Escape key, that may be a signal to stop.
+          let die = case ev of
+                (SKey KeyEsc _ True) -> True
+                _ -> False
+          unless (uiCloseOnEsc p && die) $ do
+            -- If there's no event (NoUIEvent), then sleep for tickdelay before processing.
+            when (ev == NoUIEvent) (threadDelay $ truncate $ uiTickDelay p * 1000000)
+            -- For any other event, immediately process it.
+            wSize <- getWindowDim w
+            t <- getElapsedGUITime w
             let ctx = defaultCTX (uiInitFlow p) wSize
-            (dirty, foc, graphic, tproc', _, uisf') <- uisfFun uisf (ctx, lastFocus, rt, inp, ())
-            -- delay graphical output when event queue is not empty
-            setGraphic' w graphic
-            let drawit = dirty || drawit'
-                foc' = resetFocus foc
+            (dirty, foc, graphic, tproc', _, uisf') <- uisfFun uisf (ctx, lastFocus, t-tprev, ev, ())
+            let foc' = resetFocus foc
+                -- When we're in the middle of setting focus, don't set 
+                -- the graphic yet.  Wait until it's done, and then set it.
+                dirty' = case (snd lastFocus, snd foc') of
+                    (_, SetFocusTo _) -> False
+                    (SetFocusTo _, NoFocus) -> True
+                    _ -> dirty
+            case dirty' of 
+              -- Is this deepseq even helping?
+              True -> deepseq graphic $ setGraphics w (graphic, True)
+              False -> setGraphics w (graphic, False)
             atomicModifyIORef' tref (\tproc -> (mergeTP tproc' tproc, ()))
-            foc' `seq` case inp of
-              -- Timer only comes in when we are done processing user events
-              NoUIEvent -> do 
-                -- output graphics 
-                when drawit $ setDirty w
-                quit <- pollEvents
-                if quit then return ()
-                        else render False inps foc' uisf'
-              _ -> render drawit inps foc' uisf'
-          render _ [] _ _ = return ()
-      render True events defaultFocus sf
-      -- wait a little while before all Midi messages are flushed
-      GLFW.sleep 0.5
-
-windowUser :: Double -> Window -> (UIEvent -> IO ()) -> IO Bool
-windowUser tickDelay w addEv = do 
-  quit <- getEvents
-  addEv NoUIEvent
-  return quit
- where 
-  getEvents :: IO Bool
-  getEvents = do
-    mev <- maybeGetWindowEvent tickDelay w
-    case mev of
-      Nothing -> return False
-      Just e  -> case e of
--- There's a bug somewhere with GLFW that makes pressing ESC freeze up 
--- GHCi (specifically when calling GLFW.closeWindow), so I've removed this.
---        SKey GLFW.ESC True -> closeWindow w >> return True
-        Closed          -> return True
-        _               -> addEv e >> getEvents
-
-makeStream :: IO ([a], a -> IO ())
-makeStream = do
-  ch <- newChan
-  contents <- getChanContents ch
-  return (contents, writeChan ch)
-
+            go tref w foc' t uisf'
+    -- this getNextEvent' function is implementing a possible performance boost.
+    -- TODO: Does this actually help at all?
+    getNextEvent' w = do
+      e <- getNextEvent w
+      case e of
+        MouseMove _ -> do
+          e' <- peekNextEvent w
+          case e' of
+            MouseMove _ -> getNextEvent' w
+            _ -> return e
+        _ -> return e

@@ -9,10 +9,37 @@ 
 {-# LANGUAGE RecursiveDo #-}
 
-module FRP.UISF.UITypes where
+module FRP.UISF.UITypes (
+  -- * UI Types
+  -- $uitypes
+  TerminationProc(..), nullTP, mergeTP,
+  -- * Rendering Context
+  CTX(..), Flow(..),
+  -- * UI Layout
+  makeLayout, LayoutType(..), nullLayout, Layout(..),
+  -- * Context and Layout Functions
+  divideCTX, mergeLayout, 
+  -- * Graphics
+  mergeGraphics,
+  -- * System State
+  DirtyBit, Focus, WidgetID, FocusInfo(..),
+  -- * UIEvent
+  UIEvent(..),
+  Key(..),
+  SpecialKey(..),
+  MouseButton(..),
+  -- * Key State Checks
+  hasShiftModifier, hasCtrlModifier, hasAltModifier,
+  isKeyPressed,
+  -- * Framework Connections
+  -- $frameworkconnections
+  updateKeyState
+  ) where
 
-import FRP.UISF.SOE
-import FRP.UISF.AuxFunctions (mergeE)
+import FRP.UISF.Graphics
+import Data.IORef
+import Data.List (delete)
+import System.IO.Unsafe (unsafePerformIO)
 
 ------------------------------------------------------------
 -- * UI Types
@@ -70,7 +97,10 @@ 
 -- | A method for merging two termination procedures.
 mergeTP :: TerminationProc -> TerminationProc -> TerminationProc
-mergeTP = mergeE (>>)
+mergeTP Nothing     Nothing     = Nothing
+mergeTP le@(Just _) Nothing     = le
+mergeTP Nothing     re@(Just _) = re
+mergeTP (Just l)    (Just r)    = Just (l >> r)
 
 
 ------------------------------------------------------------
@@ -99,10 +129,6 @@ 
 -- | Flow determines widget ordering.
 data Flow = TopDown | BottomUp | LeftRight | RightLeft deriving (Eq, Show)
--- | A dimension specifies size.
-type Dimension = (Int, Int)
--- | A rectangle has a corner point and a dimension.
-type Rect = (Point, Dimension)
 
 
 ------------------------------------------------------------
@@ -123,10 +149,10 @@ makeLayout :: LayoutType  -- ^ Horizontal Layout information
            -> LayoutType  -- ^ Vertical Layout information
            -> Layout
-makeLayout (Fixed h) (Fixed v) = Layout 0 0 h v 0 0
-makeLayout (Stretchy minW) (Fixed v) = Layout 1 0 0 v minW 0
-makeLayout (Fixed h) (Stretchy minH) = Layout 0 1 h 0 0 minH
-makeLayout (Stretchy minW) (Stretchy minH) = Layout 1 1 0 0 minW minH
+makeLayout (Fixed w) (Fixed h) = Layout 0 0 w h 0 0 0
+makeLayout (Stretchy wMin) (Fixed h) = Layout 1 0 0 h wMin 0 0
+makeLayout (Fixed w) (Stretchy hMin) = Layout 0 1 w 0 0 hMin 0
+makeLayout (Stretchy wMin) (Stretchy hMin) = Layout 1 1 0 0 wMin hMin 0
 
 -- | A dimension can either be:
 data LayoutType = 
@@ -137,29 +163,32 @@ 
 -- | The null layout is useful for \"widgets\" that do not appear or 
 --   take up space on the screen.
-nullLayout = Layout 0 0 0 0 0 0
+nullLayout = NullLayout --Layout 0 0 0 0 0 0 0
 
 
 -- | More complicated layouts can be manually constructed with direct 
 -- access to the Layout data type.
 --
--- 1. hFill and vFill specify how much stretching space (in comparative 
---    units) in the horizontal and vertical directions should be 
---    allocated for this widget.
+-- 1. wStretch and hStretch specify how much stretching space (in comparative 
+--    units) in the width and height should be allocated for this widget.
 -- 
--- 2. hFixed and vFixed specify how much non-stretching space (in pixels) 
+-- 2. wFixed and hFixed specify how much non-stretching space (in pixels) 
 --    of width and height should be allocated for this widget.
 -- 
--- 3. minW and minH specify minimum values (in pixels) of width and height 
+-- 3. wMin and hMin specify minimum values (in pixels) of width and height 
 --    for the widget's stretchy dimensions.
+--
+-- 4. lFill specifies how much expanding space (in comparative units) this 
+--    widget should fill out in excess space that would otherwise be unused.
 
-data Layout = Layout
-  { hFill  :: Int
-  , vFill  :: Int
-  , hFixed :: Int
-  , vFixed :: Int
-  , minW   :: Int
-  , minH   :: Int
+data Layout = NullLayout | Layout
+  { wStretch :: Int
+  , hStretch :: Int
+  , wFixed   :: Int
+  , hFixed   :: Int
+  , wMin     :: Int
+  , hMin     :: Int
+  , lFill    :: Int
   } deriving (Eq, Show)
 
 
@@ -174,41 +203,33 @@ -- | Divides the CTX among the two given layouts.
 
 divideCTX :: CTX -> Layout -> Layout -> (CTX, CTX)
-divideCTX ctx@(CTX a ((x, y), (w, h)) c) 
-          ~(Layout wFill  hFill  wFixed  hFixed  wMin  hMin) 
-          ~(Layout wFill' hFill' wFixed' hFixed' wMin' hMin') =
-  if c then (ctx, ctx) else
-  case a of
-    TopDown   -> (CTX a ((x, y),                 (w1T, h1T)) c, 
-                  CTX a ((x, y + h1T),           (w2T, h2T)) c)
-    BottomUp  -> (CTX a ((x, y + h - h1T),       (w1T, h1T)) c, 
-                  CTX a ((x, y + h - h1T - h2T), (w2T, h2T)) c)
-    LeftRight -> (CTX a ((x, y),                 (w1L, h1L)) c, 
-                  CTX a ((x + w1L, y),           (w2L, h2L)) c)
-    RightLeft -> (CTX a ((x + w - w1L, y),       (w1L, h1L)) c, 
-                  CTX a ((x + w - w1L - w2L, y), (w2L, h2L)) c)
-  where
-    -- The commented out code here forces the contexts to match exactly 
-    -- what the layout requests.  The code in place matches to the first 
-    -- layout and then gives the rest of the context to the second.
-    -- A more robust design may require a special "filler" layout that 
-    -- is not stretchy but will accept any leftover pixels.  We could 
-    -- then have a filler widget that is essentially (arr id) with this 
-    -- special layout.
-    wportion fill = div' (fill * (w - wFixed - wFixed')) (wFill + wFill')
-    (w1L,w2L) = let w1 = wFixed  + max wMin  (wportion wFill)
-                    w2 = wFixed' + max wMin' (wportion wFill')
-                in (w1, w-w1) --if w1+w2 > w then (w1, w-w1) else (w1, w2)
-    h1L = h --max hMin  (if hFill  == 0 then hFixed  else h)
-    h2L = h --max hMin' (if hFill' == 0 then hFixed' else h)
-    hportion fill = div' (fill * (h - hFixed - hFixed')) (hFill + hFill')
-    (h1T,h2T) = let h1 = hFixed  + max hMin  (hportion hFill)
-                    h2 = hFixed' + max hMin' (hportion hFill')
-                in (h1, h-h1) --if h1+h2 > h then (h1, h-h1) else (h1, h2)
-    w1T = w --max wMin  (if wFill  == 0 then wFixed  else w)
-    w2T = w --max wMin' (if wFill' == 0 then wFixed' else w)
-    div' b 0 = 0
-    div' b d = div b d
+divideCTX ctx@(CTX a ((x, y), (w, h)) c) l1 l2 = if c then (ctx,ctx) else case (l1,l2) of
+  (NullLayout, _) -> (CTX a ((0,0),(0,0)) c, ctx)
+  (_, NullLayout) -> (ctx, CTX a ((0,0),(0,0)) c)
+  ((Layout wStretch  hStretch  wFixed  hFixed  wMin  hMin  lFill), 
+   (Layout wStretch' hStretch' wFixed' hFixed' wMin' hMin' lFill')) ->
+      case a of
+        TopDown   -> (CTX a ((x, y),                 (w1T, h1T)) c, 
+                      CTX a ((x, y + h1T),           (w2T, h2T)) c)
+        BottomUp  -> (CTX a ((x, y + h - h1T),       (w1T, h1T)) c, 
+                      CTX a ((x, y + h - h1T - h2T), (w2T, h2T)) c)
+        LeftRight -> (CTX a ((x, y),                 (w1L, h1L)) c, 
+                      CTX a ((x + w1L, y),           (w2L, h2L)) c)
+        RightLeft -> (CTX a ((x + w - w1L, y),       (w1L, h1L)) c, 
+                      CTX a ((x + w - w1L - w2L, y), (w2L, h2L)) c)
+      where
+        (w1L,w2L,w1T,w2T) = calc w wStretch wStretch' wFixed wFixed' wMin wMin' lFill lFill'
+        (h1T,h2T,h1L,h2L) = calc h hStretch hStretch' hFixed hFixed' hMin hMin' lFill lFill'
+        calc len stretch stretch' fixed fixed' lmin lmin' fill fill' = (st1, st2, fi1, fi2) where
+          portion s = div' (s * (len - fixed - fixed')) (stretch + stretch')
+          (st1,st2) = let u = min len $ fixed  + max lmin  (portion stretch)
+                          v =           fixed' + max lmin' (portion stretch')
+                          por f = div' (f * (len - u - v)) (fill + fill')
+                      in if u+v > len then (u, len-u) else (u + por fill, v + por fill')
+          fi1 = if fill  > 0 then len else max lmin  (if stretch  == 0 then fixed  else len)
+          fi2 = if fill' > 0 then len else max lmin' (if stretch' == 0 then fixed' else len)
+        div' b 0 = 0
+        div' b d = div b d
 
 
 -----------------
@@ -217,15 +238,18 @@ -- | Merge two layouts into one.
 
 mergeLayout :: Flow -> Layout -> Layout -> Layout
-mergeLayout a (Layout n m u v minw minh) (Layout n' m' u' v' minw' minh') = 
+mergeLayout a NullLayout l = l
+mergeLayout a l NullLayout = l
+mergeLayout a (Layout n m u v minw minh lFill) (Layout n' m' u' v' minw' minh' lFill') = 
   case a of
-    TopDown   -> Layout (max' n n') (m + m') (max u u') (v + v') (max minw minw') (minh + minh')
-    BottomUp  -> Layout (max' n n') (m + m') (max u u') (v + v') (max minw minw') (minh + minh')
-    LeftRight -> Layout (n + n') (max' m m') (u + u') (max v v') (minw + minw') (max minh minh')
-    RightLeft -> Layout (n + n') (max' m m') (u + u') (max v v') (minw + minw') (max minh minh')
+    TopDown   -> Layout (max' n n') (m + m') (max u u') (v + v') (max minw minw') (minh + minh') lFill''
+    BottomUp  -> Layout (max' n n') (m + m') (max u u') (v + v') (max minw minw') (minh + minh') lFill''
+    LeftRight -> Layout (n + n') (max' m m') (u + u') (max v v') (minw + minw') (max minh minh') lFill''
+    RightLeft -> Layout (n + n') (max' m m') (u + u') (max v v') (minw + minw') (max minh minh') lFill''
   where
     max' 0 0 = 0
     max' _ _ = 1
+    lFill'' = lFill + lFill'
 
 
 ------------------------------------------------------------
@@ -237,11 +261,11 @@ -- based on their layouts and the context.
 -- TODO: Make sure this works as well as it should
 mergeGraphics :: CTX -> (Graphic, Layout) -> (Graphic, Layout) -> Graphic
-mergeGraphics ctx (g1, l1) (g2, l2) = case (l1 == nullLayout, l2 == nullLayout) of
-  (True,  True)  -> nullGraphic
-  (True,  False) -> g2
-  (False, True)  -> g1
-  (False, False) -> overGraphic g2 g1
+mergeGraphics ctx (g1, l1) (g2, l2) = case (l1, l2) of
+  (NullLayout,  NullLayout)  -> nullGraphic
+  (NullLayout,  _) -> g2
+  (_, NullLayout)  -> g1
+  (_, _) -> overGraphic g2 g1
 
 
 ------------------------------------------------------------
@@ -281,5 +305,164 @@   deriving (Show, Eq)
 
 
+------------------------------------------------------------
+-- * UIEvent
+------------------------------------------------------------
+
+
+-- | The UIEvent data type captures the various types of events that 
+--  the UI can produce.  These are covered by regular keys, special 
+--  keys, mouse button presses, and mouse movement.  Any key event 
+--  is accompanied by a list of 'Key's that were down when the given 
+--  event took place.
+data UIEvent = 
+  -- | A Key UIEvent indicates that the user has typed a regular key 
+  --  on his/her keyboard.  These will either be upper or lowercase 
+  --  characters.
+    Key {
+      char :: Char,
+      modifiers :: [Key],
+      isDown :: Bool
+    }
+  -- | A SKey UIEvent indicates that the user has typed a special 
+  --  key.  These are Enter, Backspace, Tab, Delete, etc.  See 
+  --  'SpecialKey' for more.
+  | SKey {
+      skey :: SpecialKey,
+      modifiers :: [Key],
+      isDown :: Bool
+    }
+  -- | A Button UIEvent indicates that the user has pressed a mouse 
+  --  button.
+  | Button {
+     pt :: Point,
+     mbutton :: MouseButton,
+     isDown :: Bool
+    }
+  -- | Every time the mouse moves, a MouseMove UIEvent will fire.
+  | MouseMove {
+      pt :: Point
+    }
+  -- | The NoUIEvent fires when nothing else is going on.  It is 
+  --  important that this happens to allow interaction-independent 
+  --  processing to continue (e.g. timers, animations, etc.).
+  | NoUIEvent
+ deriving (Eq,Show)
+
+
+-------------------
+-- Key state
+-------------------
+{- $frameworkconnections
+The 'updateKeyState' function is for use by the GUI framework.  It is 
+not intended for use unless one wants to build their own framework.
+
+The key state is kept around so that it is easy to check if a given 
+key or button is currently pressed down.  Unfortunately, I've coded it 
+as a global IORef, which means I'm using unsafePerformIO.
+-}
+
+-- | The global IORef storing the state of all current key presses.
+keyState :: IORef [Key]
+keyState = unsafePerformIO $ newIORef []
+
+-- | This should be called by the GUI engine (GLUT) whenever the user 
+--  presses or releases a key/button.  As long as it is called every 
+--  time, it will keep an accurate key state.
+updateKeyState :: Key   -- ^ The Key pressed/released.
+               -> Bool  -- ^ True if pressed, False if released.
+               -> IO [Key]  -- ^ The updated key state.
+updateKeyState k s = case s of
+    True  -> atomicModifyIORef keyState (dup . add)
+    False -> atomicModifyIORef keyState (dup . remove)
+  where
+    add ks = if k `elem` ks then ks else k:ks
+    remove ks = delete k ks
+    dup x = (x,x)
+
+-- | This is a convenience function that tests whether either of the 
+--  right or left shift keys is in the given list.
+hasShiftModifier :: [Key] -> Bool
+hasShiftModifier ks = elem (SpecialKey KeyShiftL) ks || elem (SpecialKey KeyShiftR) ks
+
+-- | This is a convenience function that tests whether either of the 
+--  right or left control keys is in the given list.
+hasCtrlModifier :: [Key] -> Bool
+hasCtrlModifier ks = elem (SpecialKey KeyCtrlL) ks || elem (SpecialKey KeyCtrlR) ks
+
+-- | This is a convenience function that tests whether either of the 
+--  right or left alt keys is in the given list.
+hasAltModifier :: [Key] -> Bool
+hasAltModifier ks = elem (SpecialKey KeyAltL) ks || elem (SpecialKey KeyAltR) ks
+
+-- | Checks the global key state to determine whether the given key is 
+--  currently pressed down.
+isKeyPressed :: Key -> IO Bool
+isKeyPressed k = do
+    ks <- readIORef keyState
+    return $ elem k ks
+
+
+
+
+
+-- | A Key can either be a character, a special key, or a mouse button.
+data Key
+   = Char Char
+   | SpecialKey SpecialKey
+   | MouseButton MouseButton
+   deriving ( Eq, Ord, Show )
+
+-- | A special key is any non-standard character key.  According to 
+--  GLUT, 'KeyUnknown' should never be used, probably because it will 
+--  be treated as a weird Char instead of a SpecialKey.
+data SpecialKey
+   = KeyF1
+   | KeyF2
+   | KeyF3
+   | KeyF4
+   | KeyF5
+   | KeyF6
+   | KeyF7
+   | KeyF8
+   | KeyF9
+   | KeyF10
+   | KeyF11
+   | KeyF12
+   | KeyLeft
+   | KeyUp
+   | KeyRight
+   | KeyDown
+   | KeyPageUp
+   | KeyPageDown
+   | KeyHome
+   | KeyEnd
+   | KeyInsert
+   | KeyNumLock
+   | KeyBegin
+   | KeyDelete
+   | KeyShiftL
+   | KeyShiftR
+   | KeyCtrlL
+   | KeyCtrlR
+   | KeyAltL
+   | KeyAltR
+   | KeyEnter
+   | KeyTab
+   | KeyEsc
+   | KeyBackspace
+   | KeyUnknown Int
+   deriving ( Eq, Ord, Show )
+
+-- | The standard mouse buttons are represented, but for specialty mice, 
+--  one can also use the 'AdditionalButton' value.
+data MouseButton
+   = LeftButton
+   | MiddleButton
+   | RightButton
+   | WheelUp
+   | WheelDown
+   | AdditionalButton Int
+   deriving ( Eq, Ord, Show )
 
 

@@ -7,43 +7,23 @@ -- Maintainer  :  dwc@cs.yale.edu
 -- Stability   :  experimental
 --
--- A simple Graphical User Interface based on FRP. It uses the SOE
--- graphics library, and draws custom widgets on the screen.
--- 
--- SOE graphics uses OpenGL as the primitive drawing routine, and
--- GLFW library to provide window and input support.
--- 
--- The monadic UI concept is borrowed from Phooey by Conal Elliott.
+-- These are the default, built-in widgets for UISF.
 
 {-# LANGUAGE RecursiveDo, Arrows, TupleSections #-}
 {-# OPTIONS_HADDOCK prune #-}
 
 module FRP.UISF.Widget where
 
-import FRP.UISF.SOE
+import FRP.UISF.Widget.Construction
+import FRP.UISF.Graphics
 import FRP.UISF.UITypes
 import FRP.UISF.UISF
-import FRP.UISF.AuxFunctions (SEvent, Time, timer, edge, delay, constA, concatA)
+import FRP.UISF.AuxFunctions
 
 import Control.Arrow
-import Data.Maybe (fromMaybe)
+import Data.Char (isSpace)
 
-------------------------------------------------------------
--- Shorthand and Helper Functions
-------------------------------------------------------------
 
--- Default padding between border and content
-padding :: Int
-padding = 3 
-
--- Introduce a shorthand for overGraphic
-(//) :: Graphic -> Graphic -> Graphic
-(//) = overGraphic
-
--- And a nice way to make a graphic under only certain conditions
-whenG :: Bool -> Graphic -> Graphic
-whenG b g = if b then g else nullGraphic
-
 ------------------------------------------------------------
 -- * Widgets
 ------------------------------------------------------------
@@ -52,29 +32,46 @@ -- Text Label --
 ----------------
 -- | Labels are always left aligned and vertically centered.
-label :: String -> UISF a a
+label :: UITexty s => s -> UISF a a
 label s = mkBasicWidget layout draw
   where
-    (minw, minh) = (length s * 8 + padding * 2, 16 + padding * 2)
+    (minw, minh) = (textWidth s + padding * 2, textHeight s + padding * 2)
     layout = makeLayout (Fixed minw) (Fixed minh)
     draw ((x, y), (w, h)) = withColor Black $ text (x + padding, y + (h `div` 2) - 8) s
 
 -----------------
 -- Display Box --
 -----------------
+-- | DisplayField is an output widget showing the instantaneous value of
+--  a signal of Strings.  It will show the String over how ever much 
+--  space it has available to it.  The static argument will decide what 
+--  to cut off in the case where it does not have space to show the 
+--  entire String: if given True, it will prefer the older characters 
+--  (cutting off later text), and if given False, it will prefer the 
+--  newer characters (cutting off older ones.
+displayField :: UITexty s => WrapSetting -> UISF s ()
+displayField wrap = arr toUIText >>> mkWidget (toUIText "") layout (\v v' _ _ -> ((), v, v /= v')) draw 
+  where
+    minh = textHeight "" + padding * 2
+    layout = makeLayout (Stretchy $ padding * 2) (Stretchy minh)
+    draw b@((x,y), (w, h)) _ s = 
+      let th = textHeight s
+          w' = w - padding * 2
+          (pts', texts) = prepText wrap 1 ((x+padding,y+padding), (w-padding*2, h-padding*2)) s
+          pts = map (\(x,y) -> (x+padding,y+padding)) pts'
+      in withColor Black (textLines $ zip pts $ map (fst . textWithinPixels w') texts)
+         // shadowBox pushed b 
+         // withColor White (rectangleFilled b)
+
+
 -- | DisplayStr is an output widget showing the instantaneous value of
 --   a signal of strings.
 displayStr :: UISF String ()
-displayStr = mkWidget "" d (\v v' _ _ -> ((), v, v /= v')) draw 
-  where
-    minh = 16 + padding * 2
-    d = makeLayout (Stretchy 8) (Fixed minh)
-    draw b@((x,y), (w, _h)) _ s = 
-      let n = (w - padding * 2) `div` 8
-      in withColor Black (text (x + padding, y + padding) (take n s)) 
-         // box pushed b 
-         // withColor White (block b)
+displayStr = setLayout layout $ displayField NoWrap
+  where layout = makeLayout (Stretchy $ padding * 2) (Fixed $ textHeight "" + padding * 2)
 
+
+
 -- | display is a widget that takes any show-able value and displays it.
 display :: Show a => UISF a ()
 display = arr show >>> displayStr
@@ -91,149 +88,221 @@ --------------
 -- Text Box --
 --------------
--- | Textbox is a widget showing the instantaneous value of a signal of 
--- strings.
--- 
--- The textbox widget will often be used with ArrowLoop (the rec keyword).  
--- However, it uses 'delay' internally, so there should be no fear of a blackhole.
--- 
--- The textbox widget supports mouse clicks and typing as well as the 
--- left, right, end, home, delete, and backspace special keys.
-textbox :: UISF String String
-textbox = focusable $ 
-  conjoin $ proc s -> do
-    inFocus <- isInFocus -< ()
-    k <- getEvents -< ()
-    ctx <- getCTX -< ()
-    rec let (s', i) = if inFocus then update s iPrev ctx k else (s, iPrev)
-        iPrev <- delay 0 -< i
-    displayStr -< seq i s'
-    inf <- delay False -< inFocus
-    b <- if inf then timer -< 0.5 else returnA -< Nothing
-    b' <- edge -< not inFocus --For use in drawing the cursor
-    rec willDraw <- delay True -< willDraw'
-        let willDraw' = maybe willDraw (const $ not willDraw) b --if isJust b then not willDraw else willDraw
-    canvas' displayLayout drawCursor -< case (inFocus, b, b', i == iPrev) of
-              (True,  Just _, _, _) -> Just (willDraw, i)
-              (True,  _, _, False)  -> Just (willDraw, i)
-              (False, _, Just _, _) -> Just (False, i)
-              _ -> Nothing
-    returnA -< s'
-  where
-    minh = 16 + padding * 2
-    displayLayout = makeLayout (Stretchy 8) (Fixed minh)
-    update s  i _ (Key c _ True)          = (take i s ++ [c] ++ drop i s, i+1)
-    update s  i _ (SKey BACKSPACE _ True) = (take (i-1) s ++ drop i s, max (i-1) 0)
-    update s  i _ (SKey DEL       _ True) = (take i s ++ drop (i+1) s, i)
-    update s  i _ (SKey LEFT      _ True) = (s, max (i-1) 0)
-    update s  i _ (SKey RIGHT     _ True) = (s, min (i+1) (length s))
-    update s _i _ (SKey END       _ True) = (s, length s)
-    update s _i _ (SKey HOME      _ True) = (s, 0)
-    update s _i c (Button (x,_) True True) = (s, min (length s) $ (x - xoffset c) `div` 8)
-    update s  i _ _                        = (s, max 0 $ min i $ length s)
-    drawCursor (False, _) _ = nullGraphic
-    drawCursor (True, i) (w,_h) = 
-        let linew = padding + i*8
-        in if linew > w then nullGraphic else withColor Black $
-            line (linew, padding) (linew, 16+padding)
-    xoffset = fst . fst . bounds
+-- | The textbox widget creates a one line field where users can 
+--  enter text.  It supports mouse clicks and typing as well as the 
+--  left, right, end, home, delete, and backspace special keys.
+--
+--  The value displayed can be generated by mouse and keyboard events, 
+--  but it can also be set programmatically by providing the widget's 
+--  input stream with an event containing the value to display.  By 
+--  using rec and delay, one can update the contents based on e.g. 
+--  other widgets.
+--
+--  The static argument provides the textbox with initial text.
+textbox :: UITexty s => s -> UISF (SEvent s) String
+textbox s = (setLayout layout . textField CharWrap) s >>> arr uitextToString
+  where layout = makeLayout (Stretchy $ padding * 2) (Fixed $ textHeight "" + padding * 2)
 
--- | This variant of the textbox takes a static argument that is 
---   the initial value in the textbox.  Then, it takes a stream of 
---   'SEvent String' and only externally updates the contents of the 
---   textbox when an event occurs.
-textboxE :: String -> UISF (SEvent String) String
-textboxE startingVal = proc ms -> do
-  rec s  <- delay startingVal -< ts
-      ts <- textbox -< maybe s id ms
+{-# DEPRECATED textboxE "As of UISF-0.4.0.0, use textbox instead" #-}
+textboxE :: UITexty s => s -> UISF (SEvent s) String
+textboxE = textbox
+
+-- | The textbox' variant of textbox contains no internal state about 
+--  the text it displays.  Thus, it must be paired with rec and delay 
+--  and used bidirectionally to be effective.
+textbox' :: UITexty s => UISF s UIText
+textbox' = setLayout layout $ textField' CharWrap
+  where layout = makeLayout (Stretchy $ padding * 2) (Fixed $ textHeight "" + padding * 2)
+
+-- | TextFields are like textboxes but can support multiple lines.  By 
+--  default, they are stretchy in the vertical dimension.
+textField :: UITexty s => WrapSetting -> s -> UISF (SEvent s) UIText
+textField wrap startingVal = proc ms -> do
+  rec s  <- delay $ toUIText startingVal -< ts
+      ts <- textField' wrap -< maybe s toUIText ms
   returnA -< ts
 
+-- | A variant of textField that contains no internal state about the 
+--  text it displays.
+textField' :: UITexty s => WrapSetting -> UISF s UIText
+textField' wrap = focusable $ mkWidget (toUIText "",0) layout process draw 
+  where
+    paddedRect :: Rect -> Rect
+    paddedRect ((x,y), (w, h)) = ((x+padding,y+padding), (w-padding*2, h-padding*2))
+    layout = makeLayout (Stretchy $ padding * 2) (Stretchy $ textHeight "" + padding * 2)
+    draw b@((x,y), (w, h)) inFocus (s,i) = 
+      let texth = textHeight s
+          w' = w - padding * 2
+          b' = paddedRect b
+          (pts, texts) = prepText wrap 1 b' s
+          (i',j) = calcLine (i,0) (map uitextToString texts)
+          texts' = drop (j + 1 - length pts) texts
+          j' = min j (length pts - 1)
+          cursory = y + padding + j'*texth
+          cursorx = x + 1+padding + textWidth (takeUIText i' $ texts !! j)
+          cpt1 = (cursorx, cursory)
+          cpt2 = (cursorx, cursory+texth)
+      in withColor Black (textLines $ zip pts $ map (fst . textWithinPixels w') texts')
+         // whenG (inFocus && inside cpt1 b' && inside cpt2 b') 
+                  (withColor Gray $ line cpt1 cpt2)
+         // shadowBox pushed b 
+         // withColor White (rectangleFilled b)
+    calcLine ij [] = ij
+    calcLine (i,j) [s] = if i < length s then (i,j) else case reverse s of
+      '\n':_ -> (0,j+1)
+      _ -> (i,j)
+    calcLine (i,j) (s:ss) = let i' = i - length s in if i' >= 0 then calcLine (i',j+1) ss else (i,j)
+    trimTailWS :: UIText -> UIText
+    trimTailWS (UIText uit) = case reverse uit of
+      [] -> UIText uit
+      ((c,f,str):uit') -> case reverse str of
+        [] -> trimTailWS $ UIText $ reverse uit'
+        (ch:s') -> if isSpace ch then UIText $ reverse ((c,f,reverse s'):uit')
+                   else UIText uit
+    process str state@(_,i) b@((x,y),(w,_)) evt = (snew, (snew,inew), state /= (snew,inew))
+      where 
+        s = toUIText str
+        texth = textHeight s
+        (pts, texts) = prepText wrap 1 (paddedRect b) s
+        strings = map uitextToString texts
+        (i',j) = calcLine (i,0) strings
+        (snew,inew) = case evt of
+          (Key c _ True)             -> let (t,d) = splitUIText i s 
+                                        in (t `appendUIText` toUIText [c] `appendUIText` d, i+1)
+          (SKey KeyEnter     _ True) -> let (t,d) = splitUIText i s 
+                                        in (t `appendUIText` toUIText "\n" `appendUIText` d, i+1) 
+          (SKey KeyBackspace _ True) -> let (t,d) = splitUIText (i-1) s 
+                                        in (t `appendUIText` dropUIText 1 d, max (i-1) 0)
+          (SKey KeyDelete    _ True) -> let (t,d) = splitUIText i s 
+                                        in (t `appendUIText` dropUIText 1 d, i)
+          (SKey KeyLeft      _ True) -> (s, max (i-1) 0)
+          (SKey KeyRight     _ True) -> (s, min (i+1) (uitextLen s))
+          -- For KeyUp, we are on the jth line moving to the (j-1)th line.
+          -- We add up the first (j-2) lines and then add the number of characters 
+          -- in line (j-1) that take up the same pixel width as the number at i' in 
+          -- the jth line.
+          -- Note that because j is 0-indexed, we add 1 whenever we do a take.
+          (SKey KeyUp        _ True) -> (s, if j <= 0 then 0 else
+            sum (map length $ take (j-1) strings) +
+            (uitextLen $ fst $ textWithinPixels (textWidth $ takeUIText i' (texts!!j)) 
+                            $ trimTailWS (texts!!(j-1))))
+          -- KeyDown is the same as KeyUp but in the other direction.
+          (SKey KeyDown      _ True) -> (s, if j >= length texts - 1 then uitextLen s else
+            sum (map length $ take (j+1) strings) + 
+            (uitextLen $ fst $ textWithinPixels (textWidth $ takeUIText i' (texts!!j)) 
+                            $ trimTailWS (texts!!(j+1))))
+          (SKey KeyEnd       _ True) -> (s, uitextLen s)
+          (SKey KeyHome      _ True) -> (s, 0)
+          (Button (bx,by) LeftButton True) -> (s,
+            let j' = ((by - y) `div` texth) + max 0 (j - length pts)
+            in if j' >= length texts then uitextLen s 
+               else sum (map length $ take j' strings) + 
+                    (uitextLen $ fst $ textWithinPixels (bx - x) $ trimTailWS (texts!!j')))
+          _  -> (s, max 0 $ min i $ uitextLen s)
+
+
+
+
 -----------
 -- Title --
 -----------
 -- | Title frames a UI by borders, and displays a static title text.
-title :: String -> UISF a b -> UISF a b
+title :: UITexty s => s -> UISF a b -> UISF a b
 title str (UISF fl f) = UISF layout h where
-  (tw, th) = (length str * 8, 16)
+  (tw, th) = (textWidth str, textHeight str)
   drawit ((x, y), (w, h)) = 
     withColor Black (text (x + 10, y) str) 
-    // withColor' bg (block ((x + 8, y), (tw + 4, th))) 
-    // box marked ((x, y + 8), (w, h - 16))
-  layout ctx = let l = fl ctx in l { hFixed = hFixed l + tw, vFixed = vFixed l + 36 }
-                                    -- ,minW = max (tw + 20) (minW l), minH = max 36 (minH l) }
+    // withColor bg (rectangleFilled ((x + 8, y), (tw + 4, th))) 
+    // shadowBox marked ((x, y + 8), (w, h - 8))
+  layout ctx = let l = fl ctx in l { wMin = max (wMin l) tw, hFixed = hFixed l + th + 10 }
   h (CTX flow bbx@((x,y), (w,h)) cj,foc,t,inp, a) = 
-    let ctx' = CTX flow ((x + 4, y + 20), (w - 8, h - 32)) cj
+    let ctx' = CTX flow ((x + 6, y + th+2), (w - 12, h - th - 10)) cj
     in do (db, foc', g, cd, b, uisf) <- f (ctx', foc, t, inp, a)
           return (db, foc', drawit bbx // g, cd, b, title str uisf)
 
 
+-- | spacer is an empty widget that will take up empty space without 
+--  requesting any space.  This can be useful for lining up other 
+--  widgets, for instance if one wants the borders from titles to align 
+--  even when the titles are bordering widgets of slightly different 
+--  sizes.
+spacer :: UISF a a
+spacer = mkBasicWidget (Layout 0 0 0 0 0 0 1) (const nullGraphic)
+
+
 ------------
 -- Button --
 ------------
 -- | A button is a focusable input widget with a state of being on or off.  
--- It can be activated with either a button press or the enter key.
--- (Currently, there is no support for the space key due to non-special 
---  keys not having Release events.)
--- Buttons also show a static label.
+--  It can be activated with either a button press, the enter key, or the 
+--  space key.  Buttons also show a static label.
 -- 
--- The regular button is down as long as the mouse button or key press is 
--- down and then returns to up.
-button :: String -> UISF () Bool
-button = genButton False
-
--- | The sticky button, on the other hand, once 
--- pressed, remains depressed until is is clicked again to be released.
--- Thus, it looks like a button, but it behaves more like a checkbox.
-stickyButton :: String -> UISF () Bool
-stickyButton = genButton True
-
--- This is used to create the buttons.
-genButton :: Bool -> String -> UISF () Bool
-genButton sticky l = focusable $ 
-  mkWidget False d (if sticky then processSticky else processRegular) draw
+--  The regular button is down as long as the mouse button or key press is 
+--  down and then returns to up.
+button :: UITexty s => s -> UISF () Bool
+button l = focusable $ 
+  mkWidget False d process draw
   where
-    (tw, th) = (8 * length l, 16) 
+    (tw, th) = (textWidth l, textHeight l)
     (minw, minh) = (tw + padding * 2, th + padding * 2)
     d = makeLayout (Stretchy minw) (Fixed minh)
     draw b@((x,y), (w,h)) inFocus down = 
       let x' = x + (w - tw) `div` 2 + if down then 0 else -1
           y' = y + (h - th) `div` 2 + if down then 0 else -1
       in withColor Black (text (x', y') l) 
-         // whenG inFocus (box marked b)
-         // box (if down then pushed else popped) b
-    processRegular _ s b evt = (s', s', s /= s')
+         // whenG inFocus (shadowBox marked b)
+         // shadowBox (if down then pushed else popped) b
+    process _ s b evt = (s', s', s /= s')
       where 
         s' = case evt of
-          Button pt True down | pt `inside` b -> case (s, down) of
+          Button pt LeftButton down | pt `inside` b -> case (s, down) of
             (False, True) -> True
             (True, False) -> False
             _ -> s
           MouseMove pt       -> (pt `inside` b) && s
-          SKey ENTER _ down -> down
+          SKey KeyEnter _ down -> down
           Key ' ' _ down -> down
           _ -> s
-    processSticky _ s b evt = (s', s', s /= s')
-      where 
-        s' = case evt of
-          Button pt True True | pt `inside` b -> not s
-          SKey ENTER _ True -> not s
-          Key ' ' _ True -> not s
-          _ -> s
 
 
+-- | The sticky button, on the other hand, once 
+-- pressed, remains depressed until is is clicked again to be released.
+-- Thus, it looks like a button, but it behaves more like a checkbox.
+stickyButton :: UITexty s => s -> UISF () Bool
+stickyButton l = constA Nothing >>> stickyButtonS l
+
+-- | This variant of stickyButton is settable by its input stream.
+stickyButtonS :: UITexty s => s -> UISF (SEvent Bool) Bool
+stickyButtonS l = arr (fmap $ \b -> if b then 1 else 0) >>> cycleboxS d lst 0 where
+  (tw, th) = (textWidth l, textHeight l)
+  (minw, minh) = (tw + padding * 2, th + padding * 2)
+  d = makeLayout (Stretchy minw) (Fixed minh)
+  draw down b@((x,y), (w,h)) inFocus = 
+    let x' = x + (w - tw) `div` 2 + if down then 0 else -1
+        y' = y + (h - th) `div` 2 + if down then 0 else -1
+    in withColor Black (text (x', y') l) 
+       // whenG inFocus (shadowBox marked b)
+       // shadowBox (if down then pushed else popped) b
+  lst = [(draw False, False),(draw True, True)]
+
+
 ---------------
 -- Check Box --
 ---------------
 -- | Checkbox allows selection or deselection of an item.
 --   It has a static label as well as an initial state.
-checkbox :: String -> Bool -> UISF () Bool
-checkbox l state = proc _ -> do
+checkbox :: UITexty s => s -> Bool -> UISF () Bool
+checkbox l state = constA Nothing >>> checkboxS l state
+
+-- | This variant of checkbox is settable by its input stream.
+checkboxS :: UITexty s => s -> Bool -> UISF (SEvent Bool) Bool
+checkboxS l state = proc eb -> do
   rec s  <- delay state -< s'
       e  <- edge <<< toggle state d draw -< s
-      let s' = maybe s (const $ not s) e
+      let s' = maybe (maybe s (const $ not s) e) id eb
   returnA -< s'
   where
-    (tw, th) = (8 * length l, 16) 
+    (tw, th) = (textWidth l, textHeight l)
     (minw, minh) = (tw + padding * 2, th + padding * 2)
     d = makeLayout (Stretchy minw) (Fixed minh)
     draw ((x,y), (_w,h)) inFocus down = 
@@ -241,14 +310,14 @@           y' = y + (h - th) `div` 2
           b = ((x + padding + 2, y + h `div` 2 - 6), (12, 12))
       in  withColor Black (text (x', y') l) 
-          // whenG inFocus (box marked b)
+          // whenG inFocus (shadowBox marked b)
           // whenG down 
-             (withColor' gray3 $ polyline 
+             (withColor DarkBeige $ polyline 
                [(x + padding + 5, y + h `div` 2),
                 (x + padding + 7, y + h `div` 2 + 3),
                 (x + padding + 11, y + h `div` 2 - 2)])
-          // box pushed b 
-          // withColor White (block b)
+          // shadowBox pushed b 
+          // withColor White (rectangleFilled b)
 
 
 ---------------------
@@ -261,14 +330,12 @@ --   The output stream is a list of each a value that was paired with a 
 --   String value for which the check box is checked.
 checkGroup :: [(String, a)] -> UISF () [a]
-checkGroup sas = let (s, a) = unzip sas in
-  constA (repeat ()) >>> 
-  concatA (zipWith checkbox s (repeat False)) >>>
-  arr (map fst . filter snd . zip a)
+checkGroup sas = constA (repeat Nothing) >>> checkGroupS sas
 
---checkGroup :: [String] -> UISF () [Bool]
---checkGroup ss = constA (repeat ()) >>> 
---                concatA (zipWith checkbox ss (repeat False))
+checkGroupS :: [(String, a)] -> UISF [SEvent Bool] [a]
+checkGroupS sas = let (s, a) = unzip sas in
+  concatA (zipWith checkboxS s (repeat False)) >>>
+  arr (map fst . filter snd . zip a)
 
 
 -------------------
@@ -279,68 +346,93 @@ -- and the index of the initially selected one, and the widget itself 
 -- returns the continuous stream representing the index of the selected 
 -- choice.
-radio :: [String] -> Int -> UISF () Int
-radio labels i = proc _ -> do
+radio :: UITexty s => [s] -> Int -> UISF () Int
+radio labels i = constA Nothing >>> radioS labels i
+
+-- | This variant of radio is settable by its input stream.
+radioS :: UITexty s => [s] -> Int -> UISF (SEvent Int) Int
+radioS labels i = proc ei -> do
   rec s   <- delay i -< s''
       s'  <- aux 0 labels -< s
-      let s'' = maybe s id s'
+      let s'' = maybe (maybe s id s') id ei
   returnA -< s''
   where
-    aux :: Int -> [String] -> UISF Int (SEvent Int)
+    --aux :: Int -> [String] -> UISF Int (SEvent Int)
     aux _ [] = arr (const Nothing)
     aux j (l:ls) = proc n -> do
       u <- edge <<< toggle (i == j) d draw -< n == j
       v <- aux (j + 1) ls -< n
       returnA -< maybe v (const $ Just j) u
       where
-        (tw, th) = (8 * length l, 16) 
+        (tw, th) = (textWidth l, textHeight l)
         (minw, minh) = (tw + padding * 2, th + padding * 2)
         d = makeLayout (Stretchy minw) (Fixed minh)
         draw ((x,y), (_w,h)) inFocus down = 
-          let x' = x + padding + 16 
-              y' = y + (h - th) `div` 2
-          in  withColor Black (text (x', y') l) 
-              // whenG down (circle gray3 (x,y) (5,6) (9,10))
-              // circle gray3 (x,y) (2,3) (12,13) 
-              // circle gray0 (x,y) (2,3) (13,14) 
-              // whenG inFocus (circle gray2 (x,y) (0,0) (14,15))
+          let xT = x + padding + 16 
+              yT = y + (h - th) `div` 2
+              xC = x + padding + 2
+              yC = y + (th `div` 2)
+          in  withColor Black (text (xT, yT) l) 
+              // withColor DarkBeige (circleOutline (xC, yC) 5)
+              // withColor White (arc ((xC-5, yC-5), (11, 11)) 0 360)
+              // whenG down    (withColor DarkBeige (circleFilled (xC, yC) 3))
+              // whenG inFocus (withColor MediumBeige (circleOutline (xC, yC) 7))
 
 --------------
 -- List Box --
 --------------
+
+
 -- | The listbox widget creates a box with selectable entries.
--- The input stream is the list of entries as well as which entry is 
--- currently selected, and the output stream is the index of the newly 
--- selected entry.  Note that the index can be greater than the length 
--- of the list (simply indicating no choice selected).
-listbox :: (Eq a, Show a) => UISF ([a], Int) Int
-listbox = focusable $ mkWidget ([], -1) layout process draw >>> delay (-1)
+--  It takes two static values indicating the initial list 
+--  of data to display and the initial index selected (use -1 for no 
+--  selection).  It takes two event streams that can be used to 
+--  independently set the list and index.  The output stream is the 
+--  currently selected index.
+--
+--  Note that the index can be greater than the length 
+--  of the list (simply indicating no choice selected).
+listbox :: (Eq a, Show a) => [a] -> Int -> UISF (SEvent [a], SEvent Int) Int
+listbox sDB sI = proc (eDB, eI) -> do
+  rec let db' = maybe db id eDB
+      db <- delay sDB -< db'
+      i' <- delay sI  -< i
+      i  <- listbox'  -< (db', maybe i' id eI)
+  returnA -< i
+
+-- | This variant of listbox does not keep its list or index stored 
+--  internally and thus accepts a stream of those values.  As such, 
+--  it requires no static initializing parameters.  This can be useful 
+--  when the list or index are being updated frequently.
+listbox' :: (Eq a, Show a) => UISF ([a], Int) Int
+listbox' = focusable $ mkWidget ([], -1) layout process draw
   where
-    layout = makeLayout (Stretchy 80) (Stretchy 16)
+    layout = makeLayout (Stretchy 80) (Stretchy lineheight)
     -- takes the rectangle to draw in and a tuple of the list of choices and the index selected
-    lineheight = 16
+    lineheight = textHeight ""
     --draw :: Show a => Rect -> ([a], Int) -> Graphic
-    draw rect@(_,(w,_h)) _ (lst, i) = 
-        genTextGraphic rect i lst  
-        // box pushed rect 
-        // withColor White (block rect)
+    draw rect@((x,y'),(w,_h)) _ (lst, i) = 
+        genTextGraphic (y'+2) i lst --shadowbox is 2 pixels wide, so we add 2 to y
+        // shadowBox pushed rect 
+        // withColor White (rectangleFilled rect)
         where
-          n = (w - padding * 2) `div` 8
+          trimText v = fst $ textWithinPixels (w - padding * 2) (show v)
           genTextGraphic _ _ [] = nullGraphic
-          genTextGraphic ((x,y),(w,h)) i (v:vs) = (if i == 0
-                then withColor White (text (x + padding, y + padding) (take n (show v)))
-                     // withColor Blue (block ((x,y),(w,lineheight)))
-                else withColor Black (text (x + padding, y + padding) (take n (show v)))) 
-                     // genTextGraphic ((x,y+lineheight),(w,h-lineheight)) (i - 1) vs
+          genTextGraphic y i (v:vs) = (if i == 0
+                then withColor White (text (x + padding, y + padding) (trimText v))
+                     // withColor Blue (rectangleFilled ((x+2,y),(w-4,lineheight)))
+                      --shadowbox is 2 pixels wide, so we add 2 to x and subtract 4 from w
+                else withColor Black (text (x + padding, y + padding) (trimText v))) 
+                // genTextGraphic (y+lineheight) (i - 1) vs
     process :: Eq a => ([a], Int) -> ([a], Int) -> Rect -> UIEvent -> (Int, ([a], Int), Bool)
     process (lst,i) olds bbx e = (i', (lst, i'), olds /= (lst, i'))
         where
         i' = case e of
-          Button pt True True -> boundCheck $ pt2index pt
-          SKey DOWN _ True   -> min (i+1) (length lst - 1)
-          SKey UP   _ True   -> max (i-1) 0
-          SKey HOME _ True   -> 0
-          SKey END  _ True   -> length lst - 1
+          Button pt LeftButton True -> boundCheck $ pt2index pt
+          SKey KeyDown _ True   -> min (i+1) (length lst - 1)
+          SKey KeyUp   _ True   -> max (i-1) 0
+          SKey KeyHome _ True   -> 0
+          SKey KeyEnd  _ True   -> length lst - 1
           _ -> boundCheck i
         ((_,y),_) = bbx
         pt2index (_px,py) = (py-y) `div` lineheight
@@ -352,7 +444,7 @@ ----------------
 
 -- $ Sliders are input widgets that allow the user to choose a value within 
--- a given range.  They come in both continous and discrete flavors as well 
+-- a given range.  They come in both continuous and discrete flavors as well 
 -- as in both vertical and horizontal layouts.
 -- 
 -- Sliders take a boundary argument giving the minimum and maximum possible 
@@ -361,16 +453,32 @@ 
 hSlider, vSlider :: RealFrac a => (a, a) -> a -> UISF () a
 -- | Horizontal Continuous Slider
-hSlider = slider True
+hSlider a b = constA Nothing >>> hSliderS a b
 -- | Vertical Continuous Slider
-vSlider = slider False
+vSlider a b = constA Nothing >>> vSliderS a b
+
 hiSlider, viSlider :: Integral a => a -> (a, a) -> a -> UISF () a
 -- | Horizontal Discrete Slider
-hiSlider = iSlider True
+hiSlider a b c = constA Nothing >>> hiSliderS a b c
 -- | Vertical Discrete Slider
-viSlider = iSlider False
+viSlider a b c = constA Nothing >>> viSliderS a b c
 
-slider :: RealFrac a => Bool -> (a, a) -> a -> UISF () a
+
+-- $ Sliders also come in a programmatically updatable variety.
+
+hSliderS, vSliderS :: RealFrac a => (a, a) -> a -> UISF (SEvent a) a
+-- | Settable Horizontal Continuous Slider
+hSliderS = slider True
+-- | Settable Vertical Continuous Slider
+vSliderS = slider False
+
+hiSliderS, viSliderS :: Integral a => a -> (a, a) -> a -> UISF (SEvent a) a
+-- | Settable Horizontal Discrete Slider
+hiSliderS = iSlider True
+-- | Settable Vertical Discrete Slider
+viSliderS = iSlider False
+
+slider :: RealFrac a => Bool -> (a, a) -> a -> UISF (SEvent a) a
 slider hori (min, max) = mkSlider hori v2p p2v jump
   where
     v2p v w = truncate ((v - min) / (max - min) * fromIntegral w)
@@ -381,7 +489,7 @@       let v' = v + fromIntegral d * (max - min) * 16 / fromIntegral w
       in if v' < min then min else if v' > max then max else v'
 
-iSlider :: Integral a => Bool -> a -> (a, a) -> a -> UISF () a
+iSlider :: Integral a => Bool -> a -> (a, a) -> a -> UISF (SEvent a) a
 iSlider hori step (min, max) = mkSlider hori v2p p2v jump
   where
     v2p v w = w * fromIntegral (v - min) `div` fromIntegral (max - min)
@@ -408,8 +516,8 @@ -- (value,time) event pairs, but since there can be zero or more points 
 -- at once, we use [] rather than 'SEvent' for the type.
 -- The values in the (value,time) event pairs should be between -1 and 1.
-realtimeGraph :: RealFrac a => Layout -> Time -> Color -> UISF [(a,Time)] ()
-realtimeGraph layout hist color = arr ((),) >>> first getTime >>>
+realtimeGraph :: RealFrac a => Layout -> DeltaT -> Color -> UISF [(a,Time)] ()
+realtimeGraph layout hist color = arr ((),) >>> first accumTime >>>
   mkWidget ([(0,0)],0) layout process draw
   where draw _              _ ([],        _) = nullGraphic
         draw ((x,y), (w,h)) _ (lst@(_:_), t) = translateGraphic (x,y) $ 
@@ -427,22 +535,21 @@ -- Histogram --
 ---------------
 -- | The histogram widget creates a histogram of the input map.  It assumes 
--- that the elements are to be displayed linearly and evenly spaced.
+-- that the elements are to be displayed linearly and evenly spaced.  Also, 
+-- the values to be plotted must be between 0 and 1 (inclusive).
 histogram :: RealFrac a => Layout -> UISF (SEvent [a]) ()
 histogram layout = 
   mkWidget Nothing layout process draw
   where process Nothing Nothing  _ _ = ((), Nothing, False)
         process Nothing (Just a) _ _ = ((), Just a, False) --TODO check if this should be True
         process (Just a) _       _ _ = ((), Just a, True)
-        draw (xy, (w, h)) _ = translateGraphic xy . mymap (polyline . mkPts)
+        draw (xy, (w, h)) _ (Just lst@(_:_)) = translateGraphic xy $ polyline $ mkPts lst
           where mkPts l  = zip (reverse $ xs $ length l) (map adjust . normalize . reverse $ l)
                 xs n     = let k = n-1 in 0 : map (\x -> truncate $ fromIntegral (w*x) / fromIntegral k) [1..k]
                 adjust i = buffer + truncate (fromIntegral (h - 2*buffer) * (1 - i))
-                normalize lst = map (/m) lst where m = maximum lst
-                buffer = truncate $ fromIntegral h / 10
-                mymap :: ([a] -> Graphic) -> SEvent [a] -> Graphic
-                mymap f (Just lst@(_:_)) = f lst
-                mymap _ _ = nullGraphic
+                normalize lst = map (max 0 . min 1) lst
+                buffer = min 12 $ truncate $ fromIntegral h / 10
+        draw _ _ _ = nullGraphic
 
 -- | The histogramWithScale widget creates a histogram and an x coordinate scale.
 histogramWithScale :: RealFrac a => Layout -> UISF (SEvent [(a,String)]) ()
@@ -451,164 +558,72 @@   where process Nothing Nothing  _ _ = ((), Nothing, False)
         process Nothing (Just a) _ _ = ((), Just a, False) --TODO check if this should be True
         process (Just a) _       _ _ = ((), Just a, True)
-        draw (xy, (w, h)) _ = mymap (polyline . mkPts) mkScale
-          where mkPts l  = zip (reverse $ xs $ length l) (map adjust . normalize . reverse $ l)
+        draw (xy, (w, h)) _ (Just lst@(_:_)) = translateGraphic xy $ mkScale strLst // (polyline $ mkPts aLst)
+          where (aLst, strLst) = unzip lst
+                mkPts l  = zip (reverse $ xs $ length l) (map adjust . normalize . reverse $ l)
                 xs n     = let k  = n-1
-                               w' = w - sidebuffer * 2
-                           in sidebuffer : map (\x -> sidebuffer + (truncate $ fromIntegral (w'*x) / fromIntegral k)) [1..k]
-                adjust i = bottombuffer + truncate (fromIntegral (h - topbuffer - bottombuffer) * (1 - i))
-                normalize lst = map (/m) lst where m = maximum lst
-                topbuffer = truncate $ fromIntegral h / 10
-                bottombuffer = max 20 topbuffer
-                sidebuffer = 20
-                mkScale l = foldl (\pg (x,s) -> translateGraphic xy (withColor Black (text (x-((8*length s) `div` 2), h-12) s)) // pg) 
+                               w' = w - leftbuffer - rightbuffer
+                           in leftbuffer : map (\x -> leftbuffer + (truncate $ fromIntegral (w'*x) / fromIntegral k)) [1..k]
+                adjust i = topbuffer + truncate (fromIntegral (h - topbuffer - bottombuffer) * (1 - i))
+                normalize lst = map (max 0 . min 1) lst
+                topbuffer = min 12 $ truncate $ fromIntegral h / 10
+                bottombuffer = 20
+                leftbuffer = 4 + (8 * length (head strLst)) `div` 2
+                rightbuffer = 4 + (8 * length (last strLst)) `div` 2
+                mkScale l = foldl (\pg (x,s) -> withColor Black (text (x-((8*length s) `div` 2), h-16) s) // pg) 
                                   nullGraphic $ zip (xs $ length l) l
-                mymap :: ([a] -> Graphic) -> ([String] -> Graphic) -> SEvent [(a,String)] -> Graphic
-                mymap f g (Just lst@(_:_)) = let (fl,gl) = unzip lst in g gl // translateGraphic xy (f fl)
-                mymap _ _ _ = nullGraphic
+        draw _ _ _ = nullGraphic
 
 
 ------------------------------------------------------------
--- * Widget Builders
+-- *** Virtual Real Estate
 ------------------------------------------------------------
 
--- | mkWidget is a helper function to make stateful widgets easier to write.  
--- In essence, it breaks down the idea of a widget into 4 constituent 
--- components: state, layout, computation, and drawing.
--- 
--- As 'mkWidget' allows for making stateful widgets, the first parameter is 
--- simply the initial state.
--- 
--- The layout is the static layout that this widget will use.  It 
--- cannot be dependent on any streaming arguments, but a layout can have 
--- \"stretchy\" sides so that it can expand/shrink to fit an area.  Learn 
--- more about making layouts in 'UIType's UI Layout section -- specifically, 
--- check out the 'makeLayout' function and the 'LayoutType' data type.
--- 
--- The computation is where the logic of the widget is held.  This 
--- function takes as input the streaming argument a, the widget's state, 
--- a Rect of coordinates indicating the area that has been allotted for 
--- this widget, and the 'UIEvent' that is triggering this widget's activation 
--- (see the definition of 'UIEvent' in SOE).  The output consists of the 
--- streaming output, the new state, and the dirty bit, which represents 
--- whether the widget needs to be redrawn.
--- 
--- Lastly, the drawing routine takes the same Rect as the computation, a 
--- Bool that is true when this widget is in focus and false otherwise, 
--- and the current state of the widget (technically, this state is the 
--- one freshly returned from the computation).  Its output is the Graphic 
--- that this widget should display.
-
-mkWidget :: s                                 -- ^ initial state
-         -> Layout                            -- ^ layout
-         -> (a -> s -> Rect -> UIEvent ->
-             (b, s, DirtyBit))                -- ^ computation
-         -> (Rect -> Bool -> s -> Graphic)    -- ^ drawing routine
-         -> UISF a b
-mkWidget i layout comp draw = proc a -> do
-  rec s  <- delay i -< s'
-      (b, s') <- mkUISF layout aux -< (a, s)
-  returnA -< b
-    where
-      aux (ctx,f,t,e,(a,s)) = (db, f, g, nullTP, (b, s'))
-        where
-          rect = bounds ctx
-          (b, s', db) = comp a s rect e
-          g = scissorGraphic rect $ draw rect (snd f == HasFocus) s'
-
--- | Occasionally, one may want to display a non-interactive graphic in 
--- the UI.  'mkBasicWidget' facilitates this.  It takes a layout and a 
--- simple drawing routine and produces a non-interacting widget.
-mkBasicWidget :: Layout               -- ^ layout
-              -> (Rect -> Graphic)    -- ^ drawing routine
-              -> UISF a a
-mkBasicWidget layout draw = mkUISF layout $ \(ctx, f, _, _, a) ->
-  (False, f, draw $ bounds ctx, nullTP, a)
-
-
--- | The toggle is useful in the creation of both 'checkbox'es and 'radio' 
--- buttons.  It displays on/off according to its input, and when the mouse 
--- is clicked on it, it will output True (otherwise it outputs False).
--- 
--- The UISF returned from a call to toggle accepts the state stream and 
--- returns whether the toggle is being clicked.
-
-toggle :: (Eq s) => s                     -- ^ Initial state value
-       -> Layout                          -- ^ The layout for the toggle
-       -> (Rect -> Bool -> s -> Graphic)  -- ^ The drawing routine
-       -> UISF s Bool
-toggle iState layout draw = focusable $ 
-  mkWidget iState layout process draw
+-- | The scrollable function puts sub-widgets into a virtual canvas that 
+--  can be scrolled using sliders that appear when necessary.  The first 
+--  argument is the actual layout of the scrollable area, and the second 
+--  argument is the size of the virtual canvas.
+scrollable :: Layout -> Dimension -> UISF a b -> UISF a b
+scrollable layout (w,h) sf = withCTX $ proc ((CTX flow (asdf, (w',h')) _),a) -> do
+  (| bottomUp (do
+    ws <- if w > w' then hSlider (0,1) 0 -< ()
+                    else returnA -< 0
+    (| rightLeft (do
+      hs <- if h > h' then vSlider (0,1) 0 -< ()
+                      else returnA -< 0
+      transform sf -< (flow, ws, hs, a) ) |) ) |)
   where
-    process s s' _ e = (on, s, s /= s')
-      where 
-        on = case e of
-          Button _ True   True -> True
-          SKey ENTER _ True -> True
-          Key  ' '      _ True -> True
-          _ -> False 
+    transform (UISF fl f) = UISF (const layout) fun where
+      fun (CTX flow' bbx'@((x',y'), (w',h')) cj',foc,t,inp, (flow, ws, hs, a)) = do
+        (db, foc', g, cd, b, uisf) <- f (ctx', foc, t, update inp, a)
+        return (db, foc', restrict g, cd, b, transform uisf)
+          where
+            xoff = max 0 $ round $ (fromIntegral (w-w')) * ws
+            yoff = max 0 $ round $ (fromIntegral (h-h')) * hs
+            ctx' = CTX flow ((x',y'), (w,h)) cj'
+            update (MouseMove p) = MouseMove $ adjustPoint p bbx' (w,h) (xoff,yoff)
+            update (Button p@(x,y) mb isDown) = Button (adjustPoint p bbx' (w,h) (xoff,yoff)) mb isDown
+            update e = e
+            restrict g = boundGraphic bbx' $ translateGraphic (0-xoff,0-yoff) g
+            compareRange :: Ord a => a -> (a,a) -> Ordering
+            compareRange x (l,u) = case (x < l, x > u) of
+              (True, _) -> LT
+              (False, True) -> GT
+              _ -> EQ
+            adjustPoint (x,y) ((x',y'), (w',h')) (w,h) (xoff,yoff) = (xu,yu) where
+              xu = case compareRange x (x', x'+w') of
+                      LT -> x - xoff
+                      EQ -> x + xoff
+                      GT -> x + w - w'
+              yu = case compareRange y (y', y'+h') of
+                      LT -> y - yoff
+                      EQ -> y + yoff
+                      GT -> y + h - h'
 
--- | The mkSlider widget builder is useful in the creation of all sliders.
 
-mkSlider :: Eq a => Bool              -- ^ True for horizontal, False for vertical
-         -> (a -> Int -> Int)         -- ^ A function for converting a value to a position
-         -> (Int -> Int -> a)         -- ^ A function for converting a position to a value
-         -> (Int -> Int -> a -> a)    -- ^ A function for determining how much to jump when 
-                                      -- a click is on the slider but not the target
-         -> a                         -- ^ The initial value for the slider
-         -> UISF () a
-mkSlider hori val2pos pos2val jump val0 = focusable $ 
-  mkWidget (val0, Nothing) d process draw 
-  where
-    rotP p@(x,y) ((bx,by),_) = if hori then p else (bx + y - by, by + x - bx)
-    rotR r@(p,(w,h)) bbx = if hori then r else (rotP p bbx, (h,w))
-    (minw, minh) = (16 + padding * 2, 16 + padding * 2)
-    (tw, th) = (16, 8)
-    d = if hori then makeLayout (Stretchy minw) (Fixed minh)
-                else makeLayout (Fixed minh) (Stretchy minw)
-    val2pt val ((bx,by), (bw,_bh)) = 
-      let p = val2pos val (bw - padding * 2 - tw)
-      in (bx + p + padding, by + 8 - th `div` 2 + padding) 
-    bar ((x,y),(w,_h)) = ((x + padding + tw `div` 2, y + 6 + padding), 
-                         (w - tw - padding * 2, 4))
-    draw b inFocus (val, _) = 
-      let p@(mx,my) = val2pt val (rotR b b)
-      in  box popped (rotR (p, (tw, th)) b) 
-          // whenG inFocus (box marked $ rotR (p, (tw-2, th-2)) b) 
-          // withColor' bg (block $ rotR ((mx + 2, my + 2), (tw - 4, th - 4)) b) 
-          // box pushed (rotR (bar (rotR b b)) b)
-    process _ (val, s) b evt = (val', (val', s'), val /= val') 
-      where
-        (val', s') = case evt of
-          Button pt' True down -> let pt = rotP pt' bbx in
-            case (pt `inside` target, down) of
-              (True, True) -> (val, Just (ptDiff pt val))
-              (_, False)   -> (val, Nothing)
-              (False, True) | pt `inside` bar' -> clickonbar pt
-              _ -> (val, s)
-          MouseMove pt' -> let pt = rotP pt' bbx in
-            case s of
-              Just pd -> (pt2val pd pt, Just pd)
-              Nothing -> (val, s)
-          SKey LEFT  _ True -> if hori then (jump (-1) bw val, s) else (val, s)
-          SKey RIGHT _ True -> if hori then (jump 1    bw val, s) else (val, s)
-          SKey UP    _ True -> if hori then (val, s) else (jump (-1) bw val, s)
-          SKey DOWN  _ True -> if hori then (val, s) else (jump 1    bw val, s)
-          SKey HOME  _ True -> (pos2val 0  (bw - 2 * padding - tw), s)
-          SKey END   _ True -> (pos2val bw (bw - 2 * padding - tw), s)
-          _ -> (val, s)
-        bbx@((bx,_by),(bw,_bh)) = rotR b b
-        bar' = let ((x,y),(w,h)) = bar bbx in ((x,y-4),(w,h+8))
-        target = (val2pt val bbx, (tw, th)) 
-        ptDiff (x,_) val = 
-          let (x', y') = val2pt val bbx
-          in (x' + tw `div` 2 - x, y' + th `div` 2 - x)
-        pt2val (dx, _dy) (x,_y) = pos2val (x + dx - bx - tw `div` 2) (bw - 2 * padding - tw)
-        clickonbar (x',_y') = 
-          let (x,_y) = val2pt val bbx
-              val' = jump (if x' < x then -1 else 1) bw val
-          in (val', s)
-
+------------------------------------------------------------
+-- *** Custom Graphics
+------------------------------------------------------------
 
 -- | Canvas displays any graphics. The input is a signal of graphics
 -- events because we only want to redraw the screen when the input
@@ -630,129 +645,4 @@     process (Just a) _ _ _ = ((), Just a, True)
     process Nothing  a _ _ = ((), a, False)
 
-
----------------
--- Cycle Box --
----------------
--- | cyclebox is a clickable widget that cycles through a predefined set 
---   set of appearances/output values.
-cyclebox :: Layout -> [(Rect -> Bool -> Graphic, b)] -> Int -> UISF () b
-cyclebox d lst start = focusable $ 
-  mkWidget start d process draw
-  where
-    len = length lst
-    incr i = (i+1) `mod` len
-    draw b inFocus i = (fst (lst!!i)) b inFocus
-    process _ i b evt = (snd (lst!!i'), i', i /= i')
-      where 
-        i' = case evt of
-          Button _ True True -> incr i
-          SKey ENTER _ True -> incr i
-          Key ' ' _ True -> incr i
-          _ -> i
-
--- | cyclebox' is a cyclebox that additionally accepts input events that 
---   can set it to a particular appearance/output.
-cyclebox' :: Layout -> [(Rect -> Bool -> Graphic, b)] -> Int -> UISF (SEvent Int) b
-cyclebox' d lst start = focusable $ 
-  mkWidget start d process draw
-  where
-    len = length lst
-    incr i = (i+1) `mod` len
-    draw b inFocus i = (fst (lst!!i)) b inFocus
-    process ei i b evt = (snd (lst!!i'), i', i /= i')
-      where 
-        j = fromMaybe i ei
-        i' = case evt of
-          Button _ True True -> incr j
-          SKey ENTER _ True -> incr j
-          Key ' ' _ True -> incr j
-          _ -> j
-
-
-------------------------------------------------------------
--- * Focus
-------------------------------------------------------------
-
--- $ Any widget that wants to accept mouse button clicks or keystrokes 
--- must be focusable.  The focusable function below achieves this.
-
--- | Making a widget focusable makes it accessible to tabbing and allows 
--- it to see any mouse button clicks and keystrokes when it is actually 
--- in focus.
-focusable :: UISF a b -> UISF a b
-focusable (UISF layout f) = proc x -> do
-  rec hasFocus <- delay False -< hasFocus'
-      (y, hasFocus') <- UISF layout (h f) -< (x, hasFocus)
-  returnA -< y
- where
-  h fun (ctx, (myid,focus),t, inp, (a, hasFocus)) = do
-    lshift <- isKeyPressed LSHIFT
-    rshift <- isKeyPressed RSHIFT
-    let isShift = lshift || rshift
-        (f, hasFocus') = case (focus, hasFocus, inp) of
-          (HasFocus, _, _) -> (HasFocus, True)
-          (SetFocusTo n, _, _) | n == myid -> (NoFocus, True)
-          (DenyFocus, _, _) -> (DenyFocus, False)
-          (_, _,    Button pt _ True) -> (NoFocus, pt `inside` bounds ctx)
-          (_, True, SKey TAB _ True) -> if isShift then (SetFocusTo (myid-1), False) 
-                                                    else (SetFocusTo (myid+1), False)
-          (_, _, _) -> (focus, hasFocus)
-        focus' = if hasFocus' then HasFocus else DenyFocus
-        inp' = if hasFocus' then (case inp of 
-              SKey TAB _ _ -> NoUIEvent
-              _ -> inp)
-               else (case inp of 
-              Button _ _ True -> NoUIEvent
-              Key  _ _ _      -> NoUIEvent
-              SKey _ _ _      -> NoUIEvent
-              _ -> inp)
-        redraw = hasFocus /= hasFocus'
-    (db, _, g, cd, b, UISF newLayout fun') <- fun (ctx, (myid,focus'), t, inp', a)
-    return (db || redraw, (myid+1,f), g, cd, (b, hasFocus'), UISF newLayout (h fun'))
-
--- | Although mouse button clicks and keystrokes will be available once a 
--- widget marks itself as focusable, the widget may also simply want to 
--- know whether it is currently in focus to change its appearance.  This 
--- can be achieved with the following signal function.
-isInFocus :: UISF () Bool
-isInFocus = getFocusData >>> arr ((== HasFocus) . snd)
-
-
-------------------------------------------------------------
--- UI colors and drawing routine
-------------------------------------------------------------
-
-bg, gray0, gray1, gray2, gray3, blue3 :: RGB
-bg = rgb 0xec 0xe9 0xd8
-gray0 = rgb 0xff 0xff 0xff
-gray1 = rgb 0xf1 0xef 0xe2
-gray2 = rgb 0xac 0xa8 0x99
-gray3 = rgb 0x71 0x6f 0x64
-blue3 = rgb 0x31 0x3c 0x79
-
-box :: [(RGB,RGB)] -> Rect -> Graphic
-box [] _ = nullGraphic 
-box ((t, b):cs) ((x, y), (w, h)) = 
-  box cs ((x + 1, y + 1), (w - 2, h - 2)) 
-  // withColor' t (line (x, y) (x, y + h - 1) 
-                   // line (x, y) (x + w - 2, y)) 
-  // withColor' b (line (x + 1, y + h - 1) (x + w - 1, y + h - 1) 
-                   // line (x + w - 1, y) (x + w - 1, y + h - 1))
-
-circle :: RGB -> Point -> Dimension -> Dimension -> Graphic
-circle c (x, y) (w1, h1) (w2, h2) = 
-  withColor' c $ arc (x + padding + w1, y + padding + h1) 
-                     (x + padding + w2, y + padding + h2) 0 360
-
-block :: Rect -> Graphic
-block ((x,y), (w, h)) = polygon [(x, y), (x + w, y), (x + w, y + h), (x, y + h)]
-
-pushed, popped, marked :: [(RGB,RGB)]
-pushed = [(gray2, gray0),(gray3, gray1)]
-popped = [(gray1, gray3),(gray0, gray2)]
-marked = [(gray2, gray0),(gray0, gray2)]
-
-inside :: Point -> Rect -> Bool
-inside (u, v) ((x, y), (w, h)) = u >= x && v >= y && u < x + w && v < y + h
 

@@ -0,0 +1,302 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  FRP.UISF.Widget.Construction
+-- Copyright   :  (c) Daniel Winograd-Cort 2015
+-- License     :  see the LICENSE file in the distribution
+--
+-- Maintainer  :  dwc@cs.yale.edu
+-- Stability   :  experimental
+--
+-- This module provides functions and utilities that help in the 
+-- construction of new widgets.  They are used by FRP.UISF.Widget, 
+-- and can be used for any custom widgets as well.
+
+{-# LANGUAGE RecursiveDo, Arrows #-}
+
+module FRP.UISF.Widget.Construction where
+
+import FRP.UISF.Graphics
+import FRP.UISF.UITypes
+import FRP.UISF.UISF
+import FRP.UISF.AuxFunctions (SEvent, delay, constA)
+
+import Control.Arrow
+import Data.Maybe (fromMaybe)
+
+
+------------------------------------------------------------
+-- Shorthand and Helper Functions
+------------------------------------------------------------
+
+-- | Default padding between border and content.
+padding :: Int
+padding = 3 
+
+-- | The default assumed background color of the GUI window.
+bg :: Color
+bg = LightBeige
+
+-- | An infix shorthand for overGraphic.
+(//) :: Graphic -> Graphic -> Graphic
+(//) = overGraphic
+
+-- | A nice way to make a graphic under only certain conditions.
+whenG :: Bool -> Graphic -> Graphic
+whenG True  g = g
+whenG False _ = nullGraphic
+
+-- | Tests whether a Point is within the bounds of a rectangle.
+inside :: Point -> Rect -> Bool
+inside (u, v) ((x, y), (w, h)) = u >= x && v >= y && u < x + w && v < y + h
+
+
+
+------------------------------------------------------------
+-- * Widget Builders
+------------------------------------------------------------
+
+-- | mkWidget is a helper function to make stateful widgets easier to write.  
+-- In essence, it breaks down the idea of a widget into 4 constituent 
+-- components: state, layout, computation, and drawing.
+-- 
+-- As 'mkWidget' allows for making stateful widgets, the first parameter is 
+-- simply the initial state.
+-- 
+-- The layout is the static layout that this widget will use.  It 
+-- cannot be dependent on any streaming arguments, but a layout can have 
+-- \"stretchy\" sides so that it can expand/shrink to fit an area.  Learn 
+-- more about making layouts in 'UIType's UI Layout section -- specifically, 
+-- check out the 'makeLayout' function and the 'LayoutType' data type.
+-- 
+-- The computation is where the logic of the widget is held.  This 
+-- function takes as input the streaming argument a, the widget's state, 
+-- a Rect of coordinates indicating the area that has been allotted for 
+-- this widget, and the 'UIEvent' that is triggering this widget's activation 
+-- (see the definition of 'UIEvent' in SOE).  The output consists of the 
+-- streaming output, the new state, and the dirty bit, which represents 
+-- whether the widget needs to be redrawn.
+-- 
+-- Lastly, the drawing routine takes the same Rect as the computation, a 
+-- Bool that is true when this widget is in focus and false otherwise, 
+-- and the current state of the widget (technically, this state is the 
+-- one freshly returned from the computation).  Its output is the Graphic 
+-- that this widget should display.
+
+mkWidget :: s                                 -- ^ initial state
+         -> Layout                            -- ^ layout
+         -> (a -> s -> Rect -> UIEvent ->
+             (b, s, DirtyBit))                -- ^ computation
+         -> (Rect -> Bool -> s -> Graphic)    -- ^ drawing routine
+         -> UISF a b
+mkWidget i layout comp draw = proc a -> do
+  rec s  <- delay i -< s'
+      (b, s') <- mkUISF layout aux -< (a, s)
+  returnA -< b
+    where
+      aux (ctx,f,t,e,(a,s)) = (db, f, g, nullTP, (b, s'))
+        where
+          rect = bounds ctx
+          (b, s', db) = comp a s rect e
+          g = {-scissorGraphic rect $ -} draw rect (snd f == HasFocus) s'
+
+-- | Occasionally, one may want to display a non-interactive graphic in 
+-- the UI.  'mkBasicWidget' facilitates this.  It takes a layout and a 
+-- simple drawing routine and produces a non-interacting widget.
+mkBasicWidget :: Layout               -- ^ layout
+              -> (Rect -> Graphic)    -- ^ drawing routine
+              -> UISF a a
+mkBasicWidget layout draw = mkUISF layout $ \(ctx, f, _, _, a) ->
+  (False, f, draw $ bounds ctx, nullTP, a)
+
+
+-- | The toggle is useful in the creation of both 'checkbox'es and 'radio' 
+-- buttons.  It displays on/off according to its input, and when the mouse 
+-- is clicked on it, it will output True (otherwise it outputs False).
+-- 
+-- The UISF returned from a call to toggle accepts the state stream and 
+-- returns whether the toggle is being clicked.
+
+toggle :: (Eq s) => s                     -- ^ Initial state value
+       -> Layout                          -- ^ The layout for the toggle
+       -> (Rect -> Bool -> s -> Graphic)  -- ^ The drawing routine
+       -> UISF s Bool
+toggle iState layout draw = focusable $ 
+  mkWidget iState layout process draw
+  where
+    process s s' _ e = (on, s, s /= s')
+      where 
+        on = case e of
+          Button _ LeftButton True -> True
+          SKey KeyEnter _     True -> True
+          Key  ' '      _     True -> True
+          _ -> False 
+
+-- | The mkSlider widget builder is useful in the creation of all sliders.
+
+mkSlider :: Eq a => Bool              -- ^ True for horizontal, False for vertical
+         -> (a -> Int -> Int)         -- ^ A function for converting a value to a position
+         -> (Int -> Int -> a)         -- ^ A function for converting a position to a value
+         -> (Int -> Int -> a -> a)    -- ^ A function for determining how much to jump when 
+                                      -- a click is on the slider but not the target
+         -> a                         -- ^ The initial value for the slider
+         -> UISF (SEvent a) a
+mkSlider hori val2pos pos2val jump val0 = focusable $ 
+  mkWidget (val0, Nothing) d process draw 
+  where
+    rotP p@(x,y) ((bx,by),_) = if hori then p else (bx + y - by, by + x - bx)
+    rotR r@(p,(w,h)) bbx = if hori then r else (rotP p bbx, (h,w))
+    (minw, minh) = (16 + padding * 2, 16 + padding * 2)
+    (tw, th) = (16, 8)
+    d = if hori then makeLayout (Stretchy minw) (Fixed minh)
+                else makeLayout (Fixed minh) (Stretchy minw)
+    val2pt val ((bx,by), (bw,_bh)) = 
+      let p = val2pos val (bw - padding * 2 - tw)
+      in (bx + p + padding, by + 8 - th `div` 2 + padding) 
+    bar ((x,y),(w,_h)) = ((x + padding + tw `div` 2, y + 6 + padding), 
+                         (w - tw - padding * 2, 4))
+    draw b inFocus (val, _) = 
+      let p@(mx,my) = val2pt val (rotR b b)
+      in  shadowBox popped (rotR (p, (tw, th)) b) 
+          // whenG inFocus (shadowBox marked $ rotR (p, (tw-2, th-2)) b) 
+          // withColor bg (rectangleFilled $ rotR ((mx + 2, my + 2), (tw - 4, th - 4)) b) 
+          // shadowBox pushed (rotR (bar (rotR b b)) b)
+    process ea (val, s) b evt = (val', (val', s'), val /= val') 
+      where
+        (val', s') = case ea of
+          Just a -> (a, s)
+          Nothing -> case evt of
+            Button pt' LeftButton down -> let pt = rotP pt' bbx in
+              case (pt `inside` target, down) of
+                (True, True) -> (val, Just (ptDiff pt val))
+                (_, False)   -> (val, Nothing)
+                (False, True) | pt `inside` bar' -> (clickonbar pt, s)
+                _ -> (val, s)
+            MouseMove pt' -> let pt = rotP pt' bbx in
+              case s of
+                Just pd -> (pt2val pd pt, Just pd)
+                Nothing -> (val, s)
+            SKey KeyLeft  _ True -> if hori then (jump (-1) bw val, s) else (val, s)
+            SKey KeyRight _ True -> if hori then (jump 1    bw val, s) else (val, s)
+            SKey KeyUp    _ True -> if hori then (val, s) else (jump (-1) bw val, s)
+            SKey KeyDown  _ True -> if hori then (val, s) else (jump 1    bw val, s)
+            SKey KeyHome  _ True -> (pos2val 0  (bw - 2 * padding - tw), s)
+            SKey KeyEnd   _ True -> (pos2val bw (bw - 2 * padding - tw), s)
+            _ -> (val, s)
+        bbx@((bx,_by),(bw,_bh)) = rotR b b
+        bar' = let ((x,y),(w,h)) = bar bbx in ((x,y-4),(w,h+8))
+        target = (val2pt val bbx, (tw, th)) 
+        ptDiff (x,_) val = 
+          let (x', y') = val2pt val bbx
+          in (x' + tw `div` 2 - x, y' + th `div` 2 - x)
+        pt2val (dx, _dy) (x,_y) = pos2val (x + dx - bx - tw `div` 2) (bw - 2 * padding - tw)
+        clickonbar (x',_y') = 
+          let (x,_y) = val2pt val bbx
+          in jump (if x' < x then -1 else 1) bw val
+
+
+---------------
+-- Cycle Box --
+---------------
+-- | cyclebox is a clickable widget that cycles through a predefined set 
+--   set of appearances/output values.
+cyclebox :: Layout -> [(Rect -> Bool -> Graphic, b)] -> Int -> UISF () b
+cyclebox d lst start = constA Nothing >>> cycleboxS d lst start
+
+-- | cycleboxS is a cyclebox that additionally accepts input events that 
+--   can set it to a particular appearance/output.
+cycleboxS :: Layout -> [(Rect -> Bool -> Graphic, b)] -> Int -> UISF (SEvent Int) b
+cycleboxS d lst start = focusable $ 
+  mkWidget start d process draw
+  where
+    len = length lst
+    incr i = (i+1) `mod` len
+    draw b inFocus i = (fst (lst!!i)) b inFocus
+    process ei i b evt = (snd (lst!!i'), i', i /= i')
+      where 
+        j = fromMaybe i ei
+        i' = case evt of
+          Button _ LeftButton True -> incr j
+          SKey KeyEnter _     True -> incr j
+          Key ' ' _           True -> incr j
+          _ -> j
+
+
+------------------------------------------------------------
+-- * Focus
+------------------------------------------------------------
+
+-- $ Any widget that wants to accept mouse button clicks or keystrokes 
+-- must be focusable.  The focusable function below achieves this.
+
+-- | Making a widget focusable makes it accessible to tabbing and allows 
+-- it to see any mouse button clicks and keystrokes when it is actually 
+-- in focus.
+focusable :: UISF a b -> UISF a b
+focusable (UISF layout f) = proc x -> do
+  rec hasFocus <- delay False -< hasFocus'
+      (y, hasFocus') <- UISF layout (h f) -< (x, hasFocus)
+  returnA -< y
+ where
+  h fun (ctx, (myid,focus),t, inp, (a, hasFocus)) = do
+    let (f, hasFocus') = case (focus, hasFocus, inp) of
+          (HasFocus, _, _) -> (HasFocus, True)
+          (SetFocusTo n, _, _) | n == myid -> (NoFocus, True)
+          (DenyFocus, _, _) -> (DenyFocus, False)
+          (_, _,    Button pt _ True) -> (NoFocus, pt `inside` bounds ctx)
+          (_, True, SKey KeyTab ms True) -> if hasShiftModifier ms 
+                                            then (SetFocusTo (myid-1), False) 
+                                            else (SetFocusTo (myid+1), False)
+          (_, _, _) -> (focus, hasFocus)
+        focus' = if hasFocus' then HasFocus else DenyFocus
+        inp' = if hasFocus' then (case inp of 
+              SKey KeyTab _ _ -> NoUIEvent
+              _ -> inp)
+               else (case inp of 
+              Button _ _ True -> NoUIEvent -- TODO: why "True" and not "_"?
+              Key  _ _ _      -> NoUIEvent
+              SKey _ _ _      -> NoUIEvent
+              _ -> inp)
+        redraw = hasFocus /= hasFocus'
+    (db, _, g, cd, b, UISF newLayout fun') <- fun (ctx, (myid,focus'), t, inp', a)
+    return (db || redraw, (myid+1,f), g, cd, (b, hasFocus'), UISF newLayout (h fun'))
+
+-- | Although mouse button clicks and keystrokes will be available once a 
+-- widget marks itself as focusable, the widget may also simply want to 
+-- know whether it is currently in focus to change its appearance.  This 
+-- can be achieved with the following signal function.
+isInFocus :: UISF () Bool
+isInFocus = getFocusData >>> arr ((== HasFocus) . snd)
+
+
+------------------------------------------------------------
+-- * Supplemental Drawing Function
+------------------------------------------------------------
+
+-- | A convenience function for making a box that appears to have a 
+--  shadow.  This is accomplished by using four colors representing:
+--
+--  (Top outside, Top inside, Bottom inside, Bottom Outside).
+--
+--  This is designed to be used with the below values 'pushed', 
+--  'popped', and 'marked'.
+shadowBox :: (Color,Color,Color,Color) -> Rect -> Graphic
+shadowBox (to,ti,bi,bo) ((x, y), (w, h)) = 
+     withColor to (line (x, y) (x, y + h - 1) 
+                // line (x, y) (x + w - 2, y)) 
+  // withColor bo (line (x + 1, y + h - 1) (x + w - 1, y + h - 1) 
+                // line (x + w - 1, y) (x + w - 1, y + h - 1))
+  // withColor ti (line (x + 1, y + 1) (x + 1, y + h - 2) 
+                // line (x + 1, y + 1) (x + w - 3, y + 1)) 
+  // withColor bi (line (x + 2, y + h - 2) (x + w - 2, y + h - 2) 
+                // line (x + w - 2, y + 1) (x + w - 2, y + h - 2))
+
+pushed, popped, marked :: (Color,Color,Color,Color)
+-- | A 'pushed' 'shadowBox' appears as if it is pushed inward.
+pushed = (MediumBeige, DarkBeige, VLightBeige, White)
+-- | A 'popped' 'shadowBox' appears as if it pops outward.
+popped = (VLightBeige, White, MediumBeige, DarkBeige)
+-- | A 'marked' 'shadowBox' appears somewhat between popped and pushed 
+--  and is designed to indicate that the box is at the ready.
+marked = (MediumBeige, White, MediumBeige, White)
+
+

@@ -7,17 +7,16 @@ -----------------------------
 
 The UISF package provides an arrowized FRP library for graphical user 
-interfaces.  UISF stems from work done on Euterpea 
-(http://haskell.cs.yale.edu/).
+interfaces.  UISF stems from work done on Euterpea (http://haskell.cs.yale.edu/).
 
-See Liense for licensing information.
+See License for licensing information.
 
 
 ============================
 ==== Getting the Source ====
 ============================
 
-Currently (1/14/2015), the most up-to-date version of UISF is 
+Currently (7/20/2015), the most up-to-date version of UISF is 
 available through GitHub at:
 
     https://github.com/dwincort/UISF

@@ -1,5 +1,5 @@ name:           UISF
-version:        0.3.0.2
+version:        0.4.0.0
 Cabal-Version:  >= 1.8
 license:        BSD3
 license-file:   License
@@ -17,7 +17,6 @@ extra-source-files:
         ReadMe.txt,
         changelog.txt,
-        FRP/UISF/Examples/EnableGUI.hs
         FRP/UISF/Examples/SevenGuis.lhs
         FRP/UISF/Examples/Pinochle.hs
         FRP/UISF/Examples/fft.hs
@@ -32,13 +31,20 @@         FRP.UISF.Examples.Crud,
         FRP.UISF.Examples.Examples,
         FRP.UISF.AuxFunctions,
-        FRP.UISF.SOE,
-        FRP.UISF.UITypes,
+        FRP.UISF.Asynchrony,
+        FRP.UISF.Graphics,
+        FRP.UISF.Graphics.Color,
+        FRP.UISF.Graphics.Graphic,
+        FRP.UISF.Graphics.Text,
+        FRP.UISF.Graphics.Types,
+        FRP.UISF.Render.GLUT,
         FRP.UISF.UISF,
+        FRP.UISF.UITypes,
         FRP.UISF.Widget,
+        FRP.UISF.Widget.Construction,
         FRP.UISF
   other-modules:
   build-depends:
         base >= 4 && < 5, containers, transformers, 
-        arrows >= 0.4, GLFW >= 0.5, OpenGL >= 2.8, 
-        deepseq >= 1.3, stm >= 2.4
+        arrows >= 0.4, OpenGL >= 2.8, GLUT >= 2.5,
+        deepseq >= 1.3, stm >= 2.4, array

@@ -1,5 +1,38 @@ changelog
 
+0.4.0.0
+In big news, the whole GLFW back end was removed and replaced with GLUT.  
+This should hopefully improve stability and make future updates easier.  
+The code is also somewhat parameterized on the back end, meaning that it 
+can accept alternate rendering options fairly easily.  I encourage users 
+to write rendering functions for the new Graphic type and submit pull requests.
+
+NEW FEATURES
+* Added scrollable widget
+* Added displayField widget
+* Added new settable widgets (named ***S) that allow one to programmatically 
+    set data within widgets.
+* Extended the Color data type to include the common UI grays.
+* ArrowIO updated to include terminalIO function
+
+BUG FIXES/ADJUSTMENTS
+* removed implicit delay from accum (this also affects hold)
+* removed implicit delay from listbox
+* Restructured Layout data type (layout smart constructors are unaffected)
+* histogram widgets no longer normalize their input data by default (also 
+    fixed some graphical issues)
+
+RENAMED/MOVED
+* ArrowTime has been replaced with an ArrowReader DeltaT instance
+* Old asynchronous functions have been replaced with new ones
+* Widget constructors moved to their own module
+
+REMOVED/DEPRECATED:
+* textboxE has been deprecated and replaced with textbox
+* mergeE and (~++) have been deprecated
+* UIParams no longer export a constructor (use defaultUIParams with record syntax updates)
+
+
 0.3.0.2
 * Added changelog
 * Fixed a bug with nested focusable widgets incorrectly focusing