diff --git a/GtkTV.cabal b/GtkTV.cabal
--- a/GtkTV.cabal
+++ b/GtkTV.cabal
@@ -1,5 +1,5 @@
 Name:                GtkTV
-Version:             0.1.4
+Version:             0.1.6
 Cabal-Version:       >= 1.2
 Synopsis:            Gtk-based GUIs for Tangible Values
 Category:            User Interfaces
@@ -11,26 +11,31 @@
 Author:              Conal Elliott
 Maintainer:          conal@conal.net
 Homepage:            http://haskell.org/haskellwiki/GtkTV
-Package-Url:         http://code.haskell.org/~conal/code/GtkTV
 Copyright:           (c) 2009, 2010 by Conal Elliott
 License:             BSD3
 License-File:        COPYING
 Stability:           experimental
 build-type:          Simple
-
 extra-source-files:
-                       examples/test
+                     examples/test
+Package-Url:         http://code.haskell.org/~conal/code/GtkTV
+-- Wait until Cabal 1.6 is more wide-spread and then add the following
+-- in place of the Package-Url field and bump Cabal-Version to >= 1.6.
+-- 
+-- Source-Repository head
+--     type:         darcs
+--     location:     http://code.haskell.org/~conal/code/GtkTV
 
 Library
   hs-Source-Dirs:      src
   Extensions:
-  Build-Depends:       base<5, time, gtk, TypeCompose>=0.6.7, TV
-                     , OpenGL, gtkglext
+  Build-Depends:       base<5, time, gtk, TypeCompose>=0.7, TV, vector-space
+                     , OpenGL, gtkglext, bitmap, bitmap-opengl, stb-image
   Exposed-Modules:
                        Interface.TV.Gtk
   ghc-options:         -Wall
 
---  ghc-prof-options:    -prof -auto-all 
-
--- The dependence on OpenGL and gtkglext is a bit unfortunate.  Maybe
+-- The dependence on OpenGL, gtkglext etc is a bit unfortunate.  Maybe
 -- factor out the GL stuff to another package.
+
+--  ghc-prof-options:    -prof -auto-all 
diff --git a/src/Interface/TV/Gtk.hs b/src/Interface/TV/Gtk.hs
--- a/src/Interface/TV/Gtk.hs
+++ b/src/Interface/TV/Gtk.hs
@@ -1,5 +1,8 @@
-{-# LANGUAGE RecursiveDo, MultiParamTypeClasses #-}
+{-# LANGUAGE RecursiveDo, MultiParamTypeClasses, ScopedTypeVariables
+           , TypeFamilies
+  #-}
 {-# OPTIONS_GHC -Wall #-}
+-- {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}   -- TEMP
 ----------------------------------------------------------------------
 -- |
 -- Module      :  Interface.TV.Gtk
@@ -16,7 +19,10 @@
   ( -- * TV type specializations
     In, Out, GTV, gtv, runGTV, runOut, runOutIO
     -- * UI primitives
-  , R, sliderRIn, sliderIIn, clockIn, fileNameIn, renderOut
+  , R, sliderRIn, sliderIIn, clockIn
+  , rateSliderIn, integralIn
+  , fileNameIn, renderOut
+  , emptyTexture, textureIsEmpty, textureIn
   , module Interface.TV
   ) where
 
@@ -29,13 +35,20 @@
 
 import Graphics.UI.Gtk hiding (Action)
 import Graphics.UI.Gtk.OpenGL
+import qualified Graphics.Rendering.OpenGL as G
 import Graphics.Rendering.OpenGL hiding (Sink,get)
+-- For textures
+import Data.Bitmap.OpenGL
+import Codec.Image.STB
 
+-- From vector-space
+import Data.VectorSpace
+
 -- From TypeCompose
 import Data.Title
 import Data.Pair
 import Data.Lambda
-import Control.Compose (ToOI(..),Cofunctor(..),Flip(..))
+import Control.Compose (ToOI(..),Cofunctor(..),Flip(..),result,argument,(~>))
 
 import Interface.TV
 
@@ -55,7 +68,11 @@
 runGTV :: GTV a -> IO ()
 runGTV = runTV
 
+-- Equivalently:
+-- 
+--   runGTV :: RunTV MkI MkO
 
+
 {--------------------------------------------------------------------
     Actions & info sinks
 --------------------------------------------------------------------}
@@ -77,33 +94,48 @@
 --------------------------------------------------------------------}
 
 -- Make a input UI.
-newtype MkI  a = MkI (MkI' a)
+newtype MkI  a = MkI { unMkI :: MkI' a }
 
+inMkI :: (MkI' a -> MkI' b) -> (MkI a -> MkI b)
+inMkI = unMkI ~> MkI
+
+inMkI2 :: (MkI' a -> MkI' b -> MkI' c) -> (MkI a -> MkI b -> MkI c)
+inMkI2 = unMkI ~> inMkI
+
 -- Representation type for 'MkI'.  Takes a change call-back and produces a widget, a
 -- polling operation and a termination clean-up action.
 type MkI' a = Action -> IO (Widget, IO a, Action)
 
 -- Make an output UI.
-newtype MkO a = MkO (MkO' a)
+newtype MkO a = MkO { unMkO :: MkO' a }
 
+inMkO :: (MkO' a -> MkO' b) -> (MkO a -> MkO b)
+inMkO = unMkO ~> MkO
+
+inMkO2 :: (MkO' a -> MkO' b -> MkO' c) -> (MkO a -> MkO b -> MkO c)
+inMkO2 = unMkO ~> inMkO
+
 -- Representation type for 'MkO'.  Produce a widget, a way to send it new
 -- info to display, and a termination clean-up action.
 type MkO' a = IO (Widget, Sink a, Action)
 
+
+{--------------------------------------------------------------------
+    Instances
+--------------------------------------------------------------------}
+
 -- Currently, the clean-up actions are created only by clockDtI, and just
 -- propagated by the other combinators.
 
 instance Functor MkI where
-  fmap f (MkI h) = MkI h'
+  fmap f = inMkI ((result.fmap) f')
     where
-      h' refresh = do (wid,poll,clean) <- h refresh
-                      return (wid, fmap f poll, clean)
+      f' (wid,poll,clean) = (wid, fmap f poll, clean)
 
 instance Cofunctor MkO where
-  cofmap f (MkO io) = MkO io'
+  cofmap f = inMkO (fmap f')
    where
-     io' = do (wid,sink,cleanup) <- io
-              return (wid,sink . f,cleanup)
+     f' (wid,sink,cleanup) = (wid,sink . f,cleanup)
 
 -- Note that Functor & Cofunctor are isomorphic to a standard form.
 -- Consider redefining MkI' and MkO' accordingly.  See how other instances
@@ -131,16 +163,64 @@
     do w <- checkButtonNew
        return (toWidget w, toggleButtonSetActive w, return ())
 
+instance Pair MkI where
+  -- pair (MkI ia) (MkI ib) = MkI $ \ refresh ->
+  pair = inMkI2 $ \ ia ib -> \ refresh ->
+    do box <- boxNew Horizontal False 10
+       (wa,geta,cleana) <- ia refresh
+       (wb,getb,cleanb) <- ib refresh
+       set box [ containerChild := wa , containerChild := wb ]
+       return (toWidget box, liftA2 (,) geta getb, cleana >> cleanb)
 
--- | Add post-processing.  (Could use 'fmap' instead, but 'result' is more
--- specifically typed.)
-result :: (b -> b') -> ((a -> b) -> (a -> b'))
-result = (.)
+instance Pair MkO where
+  pair = inMkO2 $ \ oa ob ->
+    do box <- boxNew Horizontal False 10
+       (wa,snka,cleana) <- oa
+       (wb,snkb,cleanb) <- ob
+       set box [ containerChild := wa , containerChild := wb ]
+       return (toWidget box, snka >+> snkb, cleana >> cleanb)
 
--- | Add pre-processing.
-argument :: (a' -> a) -> ((a -> b) -> (a' -> b))
-argument = flip (.)
+instance Title_f MkI where
+  title_f str = inMkI $ \ ia -> \ refresh ->
+    do (widget,geta,cleana) <- ia refresh
+       frame  <- frameNew
+       set frame [ frameLabel      := str
+                 -- , frameShadowType := ShadowEtchedOut
+                 , containerChild  := widget ]
+       return (toWidget frame, geta, cleana)
 
+instance Title_f MkO where
+  title_f str = inMkO $ \ oa ->
+   do (widget,sink,clean) <- oa
+      frame  <- frameNew
+      set frame [ frameLabel      := str
+                -- , frameShadowType := ShadowEtchedOut
+                , containerChild  := widget ]
+      return (toWidget frame, sink, clean)
+
+instance Lambda MkI MkO where
+  lambda = (unMkI ~> unMkO ~> MkO) $ \ ia ob ->
+    mdo box  <- boxNew Vertical False 0  -- 10?
+        reff <- newIORef (error "mkLambda: no function yet")
+        let refresh = do f <- readIORef reff
+                         a <- geta   -- forward ref geta
+                         snkb (f a)  -- forward ref snkb
+        (wa,geta,cleana) <- ia refresh
+        (wb,snkb,cleanb) <- ob
+        -- set box [ containerChild := wa , containerChild := wb ]
+        -- Hack: stretch output but not input.  Really I want to choose
+        -- per widget and propagate upward.
+        boxPackStart box wa PackNatural 0
+        boxPackStart box wb PackGrow    0
+        return ( toWidget box
+               , \ f -> writeIORef reff f >> refresh
+               , cleana >> cleanb)
+
+
+{--------------------------------------------------------------------
+    Execution
+--------------------------------------------------------------------}
+
 runMkO :: String -> MkO a -> a -> Action
 runMkO = (result.result.argument) return runMkOIO
 
@@ -188,7 +268,6 @@
     UI primitives
 --------------------------------------------------------------------}
 
-
 data Orient = Horizontal | Vertical deriving (Read,Show)
 
 boxNew :: Orient -> Bool -> Int -> IO Box
@@ -198,55 +277,6 @@
 boxer :: BoxClass box => (a -> b -> IO box) -> (a -> b -> IO Box)
 boxer = (result.result.fmap) toBox
 
-instance Pair MkI where
-  pair (MkI ia) (MkI ob) = MkI $ \ refresh ->
-    do box <- boxNew Horizontal False 10
-       (wa,geta,cleana) <- ia refresh
-       (wb,getb,cleanb) <- ob refresh
-       set box [ containerChild := wa , containerChild := wb ]
-       return (toWidget box, liftA2 (,) geta getb, cleana >> cleanb)
-
-instance Pair MkO where
-  pair (MkO oa) (MkO ob) = MkO $
-    do box <- boxNew Horizontal False 10
-       (wa,snka,cleana) <- oa
-       (wb,snkb,cleanb) <- ob
-       set box [ containerChild := wa , containerChild := wb ]
-       return (toWidget box, snka >+> snkb, cleana >> cleanb)
-
-instance Title_f MkI where
-  title_f str (MkI ia) = MkI $ \ refresh ->
-    do (widget,geta,cleana) <- ia refresh
-       frame  <- frameNew
-       set frame [ frameLabel      := str
-                 -- , frameShadowType := ShadowEtchedOut
-                 , containerChild  := widget ]
-       return (toWidget frame, geta, cleana)
-
-instance Title_f MkO where
-  title_f str (MkO oa) = MkO $
-   do (widget,sink,clean) <- oa
-      frame  <- frameNew
-      set frame [ frameLabel      := str
-                -- , frameShadowType := ShadowEtchedOut
-                , containerChild  := widget ]
-      return (toWidget frame, sink, clean)
-
-instance Lambda MkI MkO where
-  lambda (MkI ia) (MkO ob) = MkO $
-    mdo box  <- boxNew Vertical False 0  -- 10?
-        reff <- newIORef (error "mkLambda: no function yet")
-        let update = do f <- readIORef reff
-                        a <- geta   -- note loop
-                        snkb (f a)
-        (wa,geta,cleana) <- ia update
-        (wb,snkb,cleanb) <- ob
-        set box [ containerChild := wa , containerChild := wb ]
-        return ( toWidget box
-               , \ f -> writeIORef reff f >> update
-               , cleana >> cleanb)
-
-
 primMkI :: MkI' a -> In a
 primMkI = iPrim . MkI
 
@@ -261,7 +291,7 @@
 -- being float on the GLSL side.
 
 sliderRIn :: (R,R) -> R -> In R
-sliderRIn = sliderGIn realToFrac realToFrac 0.01 5
+sliderRIn = sliderGIn realToFrac realToFrac 0.005 5
 
 sliderIIn :: (Int,Int) -> Int -> In Int
 sliderIIn = sliderGIn fromIntegral round 1 0
@@ -291,25 +321,13 @@
      -- TODO: experiment with return False vs True
      return (toWidget w, getter, return ())
 
+-- -- Prevent vertical stretching
+-- noVert :: WidgetClass w => w -> IO Widget
+-- noVert w = do b <- boxNew Vertical False 0
+--               boxPackStart b w PackNatural 0
+--               return (toWidget b)
 
-fileNameIn :: FilePath -> In FilePath
-fileNameIn start = primMkI $ \ refresh ->
-  do w <- fileChooserButtonNew "Select file" FileChooserActionOpen
-     fileChooserSetFilename w start
-     onCurrentFolderChanged w refresh
-     -- fileChooserGetFilename w >>= print    -- testing
-     return ( toWidget w
-            , fromMaybe start <$> fileChooserGetFilename w
-            , return () )
 
--- mkTextureI :: GlTexture -> In GlTexture
--- mkTextureI = error "mkTexture: not yet implemented"
-
--- mkTexture start refresh (BaseG oi) = do ...
--- mkTexture _ _ _ = error "mkTexture: not BaseG"
-
--- onEntryActivate :: EntryClass ec => ec -> Action -> IO (ConnectId ec)
-
 -- | A clock that reports time in seconds and updates at the given period
 -- (in seconds).
 clockDtI :: R -> In R
@@ -325,7 +343,6 @@
 -- running when gtk starts up again.  Particularly useful in ghci, where
 -- restarting gtk is commonplace.
 
-
 -- | A clock that updates every 1/60 second
 clockIn :: In R
 clockIn = clockDtI (1/60)
@@ -335,18 +352,68 @@
 time = (fromRational . toRational . utctDayTime) <$> getCurrentTime
 
 
+-- | Rate slider.  Convenience function built from 'sliderRin' and 'integralDtIn'.
+rateSliderDtIn :: R -> (R,R) -> R -> In R
+rateSliderDtIn period = (result.result) (integralDtIn period) sliderRIn
+
+-- | Rate slider.  Updates result (integral) 60 times per second.
+-- Specialization of 'rateSliderDtIn'.
+rateSliderIn :: (R,R) -> R -> In R
+rateSliderIn = rateSliderDtIn (1/60)
+
+-- | Integral of an input, with given update interval (in seconds)
+integralDtIn :: (VectorSpace v, Eq v, Scalar v ~ Float) =>
+                R -> In v -> In v
+integralDtIn period inp = primMkI $ \ refresh ->
+  do refT  <- time >>= newIORef
+     refX  <- newIORef zeroV
+     (w,getV,cleanV) <- mkI' (return ())
+     timeout <- timeoutAddFull (refresh >> return True)
+                  priorityDefaultIdle (round (period * 1000))
+     let getX = do v <- getV
+                   prevX <- readIORef refX
+                   if (v /= zeroV) then
+                     do t <- time
+                        prevT <- readIORef refT
+                        let x = prevX ^+^ (t - prevT) *^ v
+                        writeIORef refT t
+                        writeIORef refX x
+                        return x
+                    else
+                       return prevX
+     return (w, getX, timeoutRemove timeout >> cleanV)
+ where
+   MkI mkI' = input inp
+
+-- Better: getX changes no state.  Instead, update refT & refX when slider changes.
+-- In any case, only invoke refresh when the rate is nonzero
+
+-- | Integral of an input.  Updates result (integral) 60 times per second.
+integralIn :: (VectorSpace v, Eq v, Scalar v ~ Float) =>
+              In v -> In v
+integralIn = integralDtIn (1/60)
+
+
+-- CONCERN: integration can apply to pair-valued inputs (e.g., constructed
+-- by 'pair'), but the DeepArrow dissecting operations will not be able to
+-- split apart the (pair-valued) integral input.
+
+
 {--------------------------------------------------------------------
     GtkGL stuff
 --------------------------------------------------------------------}
 
+mkCanvas :: IO GLDrawingArea
+mkCanvas =
+ glConfigNew [ GLModeRGBA, GLModeDepth , GLModeDouble, GLModeAlpha ]
+  >>= glDrawingAreaNew
+
 -- | Render output, given a rendering action.  Handles all set-up.
 -- Intended as an implementation substrate for functional graphics. 
 renderOut :: Out Action
 renderOut = primMkO $
   do initGL
-     glconfig <- glConfigNew [ GLModeRGBA, GLModeDepth
-                             , GLModeDouble, GLModeAlpha ]
-     canvas <- glDrawingAreaNew glconfig
+     canvas <- mkCanvas
      widgetSetSizeRequest canvas 300 300
      -- Initialise some GL setting just before the canvas first gets shown
      -- (We can't initialise these things earlier since the GL resources that
@@ -359,22 +426,113 @@
           clearColor $= Color4 0 0 0.2 1
      -- Stash the latest draw action for use in onExpose
      drawRef <- newIORef (return ())
-     -- Sync canvas size with GL viewport, and use draw action
      let display draw =
            -- Draw in context
-           withGLDrawingArea canvas $ \glwindow ->
+           withGLDrawingArea canvas $ \ glwindow ->
               do clear [DepthBuffer, ColorBuffer]
+                 flipY
                  draw
+                 flipY
                  -- glWaitVSync
                  finish
                  glDrawableSwapBuffers glwindow
                  writeIORef drawRef draw
+     -- Sync canvas size with and use draw action
      onExpose canvas $ \_ -> 
        do (w',h') <- widgetGetSize canvas
-          let w = fromIntegral w' ; h = fromIntegral h'
-          let dim :: GLsizei; start :: GLsizei -> GLint
-              dim = w `min` h ; start s = fromIntegral ((s - dim) `div` 2)
-          viewport $= (Position (start w) (start h), Size dim dim)  -- square??
+          let w = fromIntegral w' :: GLsizei
+              h = fromIntegral h'
+              maxWH = w `max` h
+              start s = fromIntegral ((s - maxWH) `div` 2)
+          viewport $= (Position (start w) (start h), Size maxWH maxWH)  -- square
           readIORef drawRef >>= display
           return True
      return (toWidget canvas, display, return ())
+
+flipY :: Action
+flipY = scale 1 (-1 :: GLfloat) 1
+
+-- Is there another way to flip Y?
+
+-- | An empty texture.  Test with 'textureIsEmpty'
+emptyTexture :: TextureObject
+emptyTexture = TextureObject bogusTO
+
+bogusTO :: G.GLuint
+bogusTO = -1
+
+-- | Is a texture empty?
+textureIsEmpty :: TextureObject -> Bool
+textureIsEmpty (TextureObject i) = i == bogusTO
+
+loadTexture :: FilePath -> IO (Either String TextureObject)
+loadTexture path =
+  do e  <- loadImage path
+     case e of
+       Left err -> return (Left err)
+       Right im -> Right <$> makeSimpleBitmapTexture im
+
+
+-- Is there a more elegant formulation of loadTex?  It's close to
+-- being fmap on Either.  I can almost get there as follows:
+-- 
+--   foo :: FilePath -> IO (Either String (IO TextureObject))
+--   foo = (result.fmap.fmap) makeSimpleBitmapTexture loadImage
+
+-- loadImage :: FilePath -> IO (Either String Image)
+-- makeSimpleBitmapTexture :: Image -> IO TextureObject
+
+
+
+fileNameIn :: FilePath -> In FilePath
+fileNameIn start = primMkI $ \ refresh ->
+  do w <- fileChooserButtonNew "Select file" FileChooserActionOpen
+     fileChooserSetFilename w start
+     onCurrentFolderChanged w refresh
+     return ( toWidget w
+            , fromMaybe start <$> fileChooserGetFilename w
+            , return () )
+
+textureIn :: In TextureObject
+textureIn = fileMungeIn loadTexture deleteTexture emptyTexture
+
+deleteTexture :: Sink TextureObject
+deleteTexture tex | textureIsEmpty tex = return ()
+                  | otherwise          =
+                      do -- putStrLn $ "deleteTexture " ++ show tex
+                         deleteObjectNames [tex]
+
+fileMungeIn :: -- Show a =>   -- for debugging
+               (FilePath -> IO (Either String a)) -> Sink a -> a -> In a
+fileMungeIn munge free start = primMkI $ \ refresh ->
+  do w <- fileChooserButtonNew "Select file" FileChooserActionOpen
+     current <- newIORef start
+     -- onCurrentFolderChanged w $ putStrLn "onCurrentFolderChanged"
+     -- onFileActivated w $ putStrLn "onFileActivated"
+     -- I'm changing the value on preview.  TODO: change back if the
+     -- user cancels.
+     onUpdatePreview w $
+       do -- putStrLn "onUpdatePreview"
+          mb <- fileChooserGetFilename w
+          case mb of
+            Nothing -> return ()
+            Just path ->
+              do e <- munge path
+                 case e of
+                   Left   _ -> return ()
+                   -- Left err -> putStrLn $ "fileMungeIn error: " ++ err
+                   Right a  -> do readIORef current >>= free
+                                  writeIORef current a
+                                  -- putStrLn $ "fileMungeIn: new value " ++ show a
+                                  refresh
+     return (toWidget w, readIORef current, return ())
+
+
+-- TODO: Replace the error message with a GUI version.
+
+-- We're freeing the old thingie before saving the new thingie.  In a
+-- multi-threaded setting, there could be dire consequences.
+
+-- I'd like to move to a consistently GC'd setting, in which textures,
+-- shaders, etc are GC'd.  In that case, what keeps GPU resources alive?
+
diff --git a/src/test.hs b/src/test.hs
--- a/src/test.hs
+++ b/src/test.hs
@@ -14,7 +14,7 @@
 
 import Control.Arrow ((&&&))
 
-import Interface.TV.Gtk
+import Interface.TV.Gtk2
 import Control.Arrow.DeepArrow
 import Data.FunArr
 
@@ -86,6 +86,8 @@
 t9 :: Action
 t9 = testI $ stringIn "bloop"
 
+i5 :: In String
+i5 = fileNameIn "bloop"
 
 {--------------------------------------------------------------------
     Taken from GuiTV (based on Reactive, Phooey, and wxhaskell)
@@ -141,21 +143,38 @@
 renderGray :: Sink Float
 renderGray x' = do -- putStrLn "renderGray"
                    color (Color4 x x x x)
-                   square
+                   renderSquare
  where
    x = realToFrac x' :: GLfloat
 
-square :: Action
-square = renderPrimitive Quads $  -- start drawing a polygon (4 sided)
-           do vert (-o)   o  -- top left
-              vert   o    o  -- top right
-              vert   o  (-o) -- bottom right
-              vert (-o) (-o) -- bottom left
+-- Render a square with vertex coordinates ranging from -1 to 1 and
+-- texture coordinates ranging from 0 to 1
+renderSquare :: Action
+renderSquare =
+  do renderPrimitive Quads $  -- start drawing a polygon (4 sided)
+       do vert 0 1 -- top left
+          vert 1 1 -- top right
+          vert 1 0 -- bottom right
+          vert 0 0 -- bottom left
  where
-   vert x y = vertex (Vertex3 x y (0 :: GLfloat))
-   o = 0.9
+   vert :: GLfloat -> GLfloat -> Action
+   vert u v = do texCoord (TexCoord2 u v)
+                 vertex (Vertex2 (q u) (q v))
+     where q w = 2 * w - 1
 
 
+renderTexture :: Sink TextureObject
+renderTexture tex | textureIsEmpty tex = return ()
+                  | otherwise          = do useTexture tex
+                                            renderSquare
+
+useTexture :: Sink TextureObject
+useTexture obj =
+  do texture Texture2D $= Enabled
+     activeTexture $= TextureUnit 0
+     textureBinding Texture2D $= Just obj
+
+
 iGray :: In R
 iGray = title "gray level" $ sliderRIn (0,1) 0.5
 
@@ -198,3 +217,9 @@
 
 tv12 :: GTV (R -> (Action,Action))
 tv12 = result dupA $$ tv8
+
+tv13 :: GTV (TextureObject -> Action)
+tv13 = tv (lambda textureIn renderOut) renderTexture
+
+tv14 :: GTV (R -> R)
+tv14 = tv (lambda (title "rate" $ integralIn $ sliderRIn (-10,10) 0) defaultOut) id