diff --git a/FieldTrip.cabal b/FieldTrip.cabal
new file mode 100644
--- /dev/null
+++ b/FieldTrip.cabal
@@ -0,0 +1,46 @@
+Name:                FieldTrip
+Version:             0.2
+Synopsis: 	     Functional 3D
+Category:            graphics
+Description:
+  FieldTrip is a library for functional 3D geometry
+  .
+  Please see the project wiki page: <http://haskell.org/haskellwiki/reactive>
+  .
+  The module documentation pages have links to colorized source code and
+  to wiki pages where you can read and contribute user comments.  Enjoy!
+  .
+  &#169; 2008 by Andy Gill and Conal Elliott; BSD3 license.
+Author:              Conal Elliott and Andy Gill
+Maintainer:          conal@conal.net, andygill@ku.edu
+Homepage:            http://haskell.org/haskellwiki/FieldTrip
+Package-Url:	     http://code.haskell.org/f3d
+Copyright:           (c) 2007-2008 by Conal Elliott and Andy Gill
+License:             BSD3
+Stability:           experimental
+build-type:	     Simple
+Hs-Source-Dirs:      src
+Extensions:          
+Build-Depends:       base, old-time, OpenGL, GLUT, TypeCompose, MemoTrie, vector-space >= 0.4.1, graphicsFormats
+Exposed-Modules:     
+		     Graphics.FieldTrip
+		     Graphics.FieldTrip.Misc
+		     Graphics.FieldTrip.Vector2
+		     Graphics.FieldTrip.Vector3
+		     Graphics.FieldTrip.Point2
+		     Graphics.FieldTrip.Point3
+		     Graphics.FieldTrip.Normal3
+		     Graphics.FieldTrip.Transform
+		     Graphics.FieldTrip.Transform2
+		     Graphics.FieldTrip.Transform3
+		     Graphics.FieldTrip.Color
+		     Graphics.FieldTrip.Material
+		     Graphics.FieldTrip.Render
+		     Graphics.FieldTrip.ParamSurf
+		     Graphics.FieldTrip.Image
+		     Graphics.FieldTrip.Geometry2
+		     Graphics.FieldTrip.Geometry3
+		     
+ghc-options:         -Wall -O2
+
+-- TypeCompose is used for its IO monoid.  Not much of a reason.
diff --git a/Makefile b/Makefile
new file mode 100644
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,3 @@
+# For special configuration, especially for docs.  Otherwise see README.
+
+include ../my-cabal-make.inc
diff --git a/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -0,0 +1,10 @@
+A functional 3D graphics library.
+
+We're just getting started, so abstractions are in flux.  I think we'll
+want this library to have functional 3D and rely on another library (e.g.,
+Reactive) for animation and reactivity.
+
+If you want to try things out from inside ghci, use the following command line.
+
+ghci -isrc:FieldTrip-GLUT/src:examples examples/Test.hs
+
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/TODO b/TODO
new file mode 100644
--- /dev/null
+++ b/TODO
@@ -0,0 +1,31 @@
+## To do
+
+### Both
+
+* Colors, at least.  Textures!
+* Display frame rate and polygon count in viewer.
+* Feeback between frame rate and error bound.
+* Decide whether we want coordinate-polymorphism (Float/Double).  Often
+requires type annotations.  If not, do we wire in Float or Double?
+* Revisit dependency on TypeCompose.
+* Change this file to markdown mode (TODO.md) and use pandoc (via make) to
+generate a prettier version.  And longlines mode as well.
+
+### Conal
+
+* Improve adaptive tessellation.  Account for perspective viewing and for
+the nature of a parametric surface (e.g., derivative bounds).
+* Blog about the AD stuff that uses linear maps
+
+### Andy
+
+* Get our demo working inside GHCi, in a way we can restart
+* Work out how to use an Image as a 2D-texture
+* Add a Text -> Image function (adaptive to error bound)
+
+
+## Done
+
+* Tablet, as an example
+* General parametric surfaces with computed normals, using automatic
+differentiation (AD).
diff --git a/doc/Makefile b/doc/Makefile
new file mode 100644
--- /dev/null
+++ b/doc/Makefile
@@ -0,0 +1,13 @@
+.SUFFIXES: .dot .png
+
+DOT_FILES =	datatypes.dot \
+		packages.dot \
+		relate.dot
+
+build:: $(DOT_FILES:.dot=.png)
+
+clean:
+	rm *.png
+
+%.png: %.dot
+	dot -Tpng $< > $@
diff --git a/doc/datatypes.dot b/doc/datatypes.dot
new file mode 100644
--- /dev/null
+++ b/doc/datatypes.dot
@@ -0,0 +1,76 @@
+digraph G {
+
+	rankdir=LR;
+
+	GContext[label="GContext\n(Graphics Context)"];
+
+	Geometry2[label="Geometry2"];
+
+	Geometry3[label="Geometry3"];
+
+	renderIO[shape="box",label="renderIO\n(render compiler)"]; 
+		Geometry3 -> renderIO;
+		renderIO -> Renderer;
+	rendererG[shape="box",label="rendererG\n(adding primitive\nshape to geometry)"];  
+		rendererG -> Renderer[dir="back"]; 
+		Geometry3 -> rendererG[dir="back"];
+
+	Renderer[label="Renderer\n(GContext -> IO ())"];
+
+
+	flatG[shape="box"];
+		Geometry2 -> flatG; flatG -> Geometry3;
+
+	HeightField_a[label="HeightField a\n(a,a) -> a"];
+	Surf_a[label="Surf a\n(a,a) -> (a,a,a)"];
+	Curve2_a[label="Curve2 a\na -> (a,a)"];
+	Curve3_a[label="Curve3 a\na -> (a,a,a)"];
+
+	hfSurf[shape="box"];
+		HeightField_a -> hfSurf;
+		hfSurf -> Surf_a;
+
+	Surf_der[label="Surf (Vector2 R :> R)"];
+		Surf_a -> Surf_der[label="a : (Vector R :> R)",style="dashed"];
+
+
+	surfG[shape="box"];
+		Surf_der -> surfG;
+		surfG -> Geometry3;
+
+	Image_a[label="Image a\n(R,R) -> a"];
+
+	ImageC[label="ImageC\nImage Color"];
+		Image_a -> ImageC[label="a : Color",style="dashed"];
+	Region[label="Region\nImage Bool"];
+		Image_a -> Region[label="a : Bool",style="dashed"];
+
+	surfGP[shape="box",label="surfG'"];
+		Surf_der -> surfGP;
+		ImageC  -> surfGP;
+		surfGP -> Geometry3;
+
+	circle[shape="box"];
+		circle -> Curve2_a;
+	semiCircle[shape="box"];
+		semiCircle -> Curve2_a;
+
+	{ rank=same;
+	revolve[shape="box"];
+	sphere1[shape="box"];
+	}
+
+		Curve2_a -> revolve;
+		revolve -> Surf_a;
+
+		sphere1 -> revolve[style="dotted"];
+		semiCircle -> sphere1[style="dotted"];		
+		sphere1 -> Surf_a;
+
+
+	sphere[shape="box"];
+		sphere -> Geometry3;
+		sphere -> surfG[style=dotted];
+		sphere1 -> sphere[style=dotted];
+
+}
diff --git a/doc/packages.dot b/doc/packages.dot
new file mode 100644
--- /dev/null
+++ b/doc/packages.dot
@@ -0,0 +1,28 @@
+digraph G {
+
+	rankdir=TB;
+
+	FieldTrip[shape="box",style="filled",fillcolor="yellow"];
+
+	OpenGL[shape="box"];
+	FieldTrip->OpenGL;
+
+	GLUT[shape="box"];
+	FieldTripGLUT->GLUT;
+	GLUT->OpenGL;
+
+	TypeCompose[shape="box"];
+	frp -> TypeCompose;
+
+	FieldTripGLUT[shape="box",style="filled",fillcolor="yellow",label="FieldTrip-GLUT"];
+	FieldTripGLUT->FieldTrip;
+
+	frp[shape="box",label="simply-reactive"];
+	FieldTripGLUT->frp;
+
+
+	vectorspace[label="vector-space",shape=box];
+
+	frp -> vectorspace;
+
+}
diff --git a/doc/relate.dot b/doc/relate.dot
new file mode 100644
--- /dev/null
+++ b/doc/relate.dot
@@ -0,0 +1,54 @@
+digraph G {
+
+
+	subgraph cluster_1 {
+	label="Specifing Scenes\n ";
+
+	f3d[shape="box",style="filled",fillcolor="yellow"];
+	}
+
+
+	OpenGL[shape="box"];
+	OpenGLHW[shape="box",label="Hardware\nSupport"];
+
+	f3d -> OpenGL;
+	OpenGL -> OpenGLHW;
+
+	subgraph cluster_2 {
+	label="Rendering Scenes\n(using one of)";
+	f3d_glut[shape="box",style="filled",fillcolor="green",label="f3d-glut"];
+	f3d_glfw[shape="box",style="filled",fillcolor="green",label="f3d-glfw"];
+	f3d_sdl[shape="box",style="filled",fillcolor="green",label="f3d-sdl"];	
+	f3d_other[shape="box",style="filled",fillcolor="green",label="f3d-(...)"];
+	}
+
+
+
+	GLUT[shape="box"];
+	GLFW[shape="box"];
+	SDL[shape="box"];
+	OTHER[shape="box",label="..."];
+
+	f3d_glut -> GLUT;
+	f3d_glfw -> GLFW;
+	f3d_sdl -> SDL;
+	f3d_other -> OTHER;
+
+
+	WINDOWING[shape="box",label="OS Specific Window Management"];
+
+	GLUT -> WINDOWING;
+	GLFW -> WINDOWING;
+	SDL -> WINDOWING;
+	OTHER -> WINDOWING;
+
+
+	sample[shape="box",style="filled",fillcolor="yellow",label="Sample Application"];
+	sample -> f3d;
+	sample -> f3d_glut;
+
+
+
+
+
+}
diff --git a/examples/src/Perf.hs b/examples/src/Perf.hs
new file mode 100644
--- /dev/null
+++ b/examples/src/Perf.hs
@@ -0,0 +1,175 @@
+{-# LANGUAGE TypeOperators #-}
+{-# OPTIONS_GHC -Wall #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Perf
+-- Copyright   :  (c) Andy J Gill and Conal Elliott 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net
+-- Stability   :  experimental
+-- 
+-- Try get peformance better
+----------------------------------------------------------------------
+
+-- module Test where
+
+-- import Data.Monoid
+-- import Control.Applicative
+
+import Graphics.Rendering.OpenGL (Color)
+-- import Graphics.FieldTrip.Glut 
+
+-- import Data.Derivative ((:>))
+
+import Graphics.FieldTrip.Misc
+-- import Graphics.FieldTrip.Geometry2
+import Graphics.FieldTrip.Geometry3
+-- import Graphics.FieldTrip.Transform
+-- import Graphics.FieldTrip.Transform3
+import Graphics.FieldTrip.Vector2
+import Graphics.FieldTrip.Vector3
+import Graphics.FieldTrip.Color
+import Graphics.FieldTrip.Image
+-- import Graphics.FieldTrip.Render
+
+import qualified Graphics.FieldTrip.ParamSurf as P
+import Graphics.FieldTrip.ParamSurf hiding (torus)
+
+-- import Data.Behavior
+-- import Data.Reactive
+
+import Data.VectorSpace
+import Data.MemoTrie
+-- import System.Environment	
+-- import Data.Cross
+-- import Debug.Trace
+
+import Graphics.FieldTrip.Normal3
+import System.Time
+import Data.Derivative
+import Data.IORef
+import System.IO.Unsafe
+
+torusCrate :: Geometry3
+torusCrate = colorG blue $ surfG fun
+
+main :: IO ()
+main = do
+        () <- return () -- stops the rest from being a CAF
+
+	writeIORef counterVar 0
+
+	let fun2 :: Vector2 R -> VN3 R
+            fun2 v = vsurf fun v
+	let sz       = 49
+            numVerts = sqr (succ sz)
+
+	putStrLn ("Test: " ++ show numVerts ++ " vertices")
+
+	clock <- newClock
+        -- getClockTime >>= print
+
+	sequence_ [ p `seq` n `seq` return ()
+                  | x <- map (/sz) [0..sz]
+		  , y <- map (/sz) [0..sz]
+		  , let VN p n = fun2 (Vector2 x y) ]
+	-- getClockTime >>= print
+        t <- clock
+        putStrLn $ show t ++ " seconds.  " ++
+                   show (numVerts / t) ++ " vertices per second."
+
+        count <- readIORef counterVar
+
+	putStrLn $ "Count == " ++ show count
+        putStrLn $ "Count/vertex == " ++ show (fromIntegral count / numVerts)
+
+-- A provider of relative time
+type Clock = IO R
+
+newClock :: IO Clock
+newClock = currRelTime `fmap` getClockTime
+
+-- Get the current time in seconds, relative to a start 'ClockTime'.
+currRelTime :: ClockTime -> IO R
+currRelTime (TOD sec0 pico0) = fmap delta getClockTime
+ where
+   delta (TOD sec pico) =
+     fromIntegral (sec-sec0) + 1.0e-12 * fromIntegral (pico-pico0)
+
+
+sqr :: Num a => a -> a
+sqr a = a * a
+
+fun :: Surf (Vector2 R :> R)
+fun v = 0 ^/ magnitude r1
+  where
+    r1 = unvector3D (normalV (vector3D (tt v)))
+
+tt :: Surf (Vector2 R :> R)
+tt = P.torus 1 (1/2)
+
+normalV :: Vector2 R :> Vector3 R -> Vector2 R :> Vector3 R
+normalV v = d (Left ()) `cross3` d (Right ())
+   where
+     d = untrie (derivative v)
+
+	-- vector3F :: Three (Vector2 R :> R) -> Vector2 R :> Vector3 R
+	-- vector3F (u,v,w) = liftA3 Vector3 u v w
+
+	-- unvector3F :: Vector2 R :> Vector3 R -> Three (Vector2 R :> R)
+	-- unvector3F d = (vector3x <$> d, vector3y <$> d, vector3z <$> d)
+
+
+cross3X :: (Vector2 R :> Vector3 R) -> (Vector2 R :> Vector3 R) -> Vector2 R :> Vector3 R
+cross3X = distrib cross3X'
+
+-- when i replaced the recursive cross3X with (^+^), the cross3X per
+-- vertex drops from 73 to 1.  but the running time stays about the same.
+
+cross3X' :: Vector3 R -> Vector3 R -> Vector3 R
+Vector3 ax ay az `cross3X'` Vector3 bx by bz = counter $
+	    Vector3 (ay * bz - az * by)
+	            (az * bx - ax * bz)
+	            (ax * by - ay * bx)
+
+
+--	let v = P.torus 1 (1/2) xy
+--	((fmap (\ v -> v ^+^ (0 *^ normal v)) tt)) xy
+--             displace (P.torus 1 (1/2)) (\ (_,_) -> 0) -- (stretchH eggcrateH)
+
+--tt = P.torus 1 (1/2)
+--tt = \ (u,v) -> (u,v,u*v)
+--tt = revolve (const (1,0) ^+^ (1/2) *^ liftA2 (,) cosU sinU)
+
+testH :: HeightField (Vector2 R :> R) -> Geometry3
+testH = surfG . hfSurf . stretchH
+
+testH' :: Color c => Image c -> HeightField (Vector2 R :> R) -> Geometry3
+testH' im = flip surfG' im . hfSurf . stretchH
+
+stretchH :: Fractional s => HeightField s -> HeightField s
+stretchH hf = (/ 5) . hf . (* 5)
+
+ptor :: Color c => Image c -> Geometry3
+ptor = surfG' (P.torus 1 (1/2))
+
+groovy :: ImageC
+groovy (s,t) =
+  rgba (sinU (3*s+5*t)) (cosU (5*t-3*s)) (sinU (3*s+5*t)) ((1+sinU (5*s*t) / 2))
+
+redTorus, greenCyl :: Geometry3
+redTorus = colorG red   $ torus 1 (1/2)
+greenCyl = colorG green $ cylinder (1/3) 3
+
+
+{-# NOINLINE counterVar #-}
+counterVar :: IORef Int
+counterVar = unsafePerformIO $ newIORef 0
+
+{-# NOINLINE counter #-}
+counter :: a -> a
+counter a = unsafePerformIO $ do
+		val <- readIORef counterVar
+		writeIORef counterVar $! succ val
+		return $ a
diff --git a/examples/src/Tablet.hs b/examples/src/Tablet.hs
new file mode 100644
--- /dev/null
+++ b/examples/src/Tablet.hs
@@ -0,0 +1,105 @@
+{-# OPTIONS_GHC -Wall #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Tablet
+-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net, andygill@ku.edu
+-- Stability   :  experimental
+-- 
+-- Tablet shape with rounded corners
+----------------------------------------------------------------------
+
+module Tablet where
+
+import Data.Monoid
+
+import Graphics.FieldTrip.Misc
+import Graphics.FieldTrip.Vector3
+import Graphics.FieldTrip.Transform
+import Graphics.FieldTrip.Transform2
+import Graphics.FieldTrip.Geometry2
+import Graphics.FieldTrip.Geometry3
+
+--import Graphics.FieldTrip.QParamSurf as Q
+
+-- 2D rectangle with rounded corners, having given width, height, and
+-- rounding radius.
+roundedRect :: R -> R -> R -> Geometry2
+roundedRect width height radius = right `sandwich2` center
+  -- Build out of left, center, right.
+  -- The sides sandwich the center to make the whole; and
+  -- the quarter-disks sandwich the edge strip to make the right side.
+ where
+   -- Trimmed dimensions
+   width'  = width-2*radius
+   height' = height-2*radius
+   center = box2 width' height
+   -- Quarter-disk at origin, angle ranges from 0 to pi/2 (3pm to noon)
+   qdisk = uscale2 radius *% diskWedge (1/4)
+   ne = move2Y (height'/2) qdisk
+   se = move2Y (-height'/2) (rotate2 (-pi/2::Float) *% qdisk)
+   right = move2X (width'/2) $
+           ne `mappend` move2X (radius/2) (box2 radius height') `mappend` se
+
+-- Sandwich @inside@ between @outside@ and a flipped version of @outside@
+sandwich2 :: Geometry2 -> Filter2
+outside `sandwich2` inside = andFlip2 outside `mappend` inside
+
+
+
+-- 3D tablet shape, with flat top & bottom, using roundedRect.
+-- Cylinders for the four corners.
+
+tablet1 :: R -> R -> R -> R -> Geometry3
+tablet1 width height depth radius = top `sandwichY` edging
+ where
+   width'  = width-2*radius
+   height' = height-2*radius
+   top = move3Z (depth/2) $ flatG (roundedRect width height radius)
+   edging  = andFlip3 (zVector3::Vector3 Float) ell
+   ell = capped height' (width'/2) `mappend`
+         pivot3Z (capped width' (height'/2))
+   capped len dx = ( move3X (dx+radius) $
+                     pivot3Y $
+                     flatG (box2 depth len) )
+                   `mappend`
+                   ( move3 dx (len/2) 0 $
+                     cylinder radius depth )
+
+-- Or with more rounding.
+-- 3D tablet with half-cylinders for sides and quarter-sphere corners,
+-- having given width, height, and depth.  Rounding radius is depth/2.
+tablet2 :: R -> R -> R -> Geometry3
+tablet2 width height depth = ell `sandwichZ` center
+  -- Build out of two ell shapes sandwiching a center box.  Each ell has
+  -- two cylinders and two spheres.  I can't yet make partial spheres or
+  -- cylinders, so I'll make full ones, which will be partly hidden (half
+  -- of each cylinder and 3/4 of each sphere).  Later, make the partial
+  -- versions, to reduce computing and rendering.
+ where
+   radius   = depth/2
+   width'   = width-2*radius
+   height'  = height-2*radius
+   center   = box3 width' height' depth
+   right    = move3X (width'/2) $
+              move3Y (height'/2) (sphere radius) `sandwichX` rightCyl
+   ell      = move3Y (height'/2) topCyl `mappend` right
+   rightCyl = cyl xVector3 height'
+   topCyl   = cyl yVector3 width'
+   cyl :: Vector3 Float -> R -> Geometry3
+   cyl axis len = pivot3 axis $ cylinder radius len
+
+
+---- utilities
+
+-- Sandwich @inside@ between @outside@ and a flipped version of @outside@
+sandwich3 :: Vector3 Float -> Geometry3 -> Filter3
+sandwich3 axis outside inside = andFlip3 axis outside `mappend` inside
+
+-- Specializations
+sandwichX, sandwichY, sandwichZ :: Geometry3 -> Filter3
+sandwichX = sandwich3 xVector3
+sandwichY = sandwich3 yVector3
+sandwichZ = sandwich3 zVector3
diff --git a/examples/src/Test.hs b/examples/src/Test.hs
new file mode 100644
--- /dev/null
+++ b/examples/src/Test.hs
@@ -0,0 +1,175 @@
+{-# LANGUAGE TypeOperators #-}
+-- {-# OPTIONS_GHC -Wall #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Test
+-- Copyright   :  (c) Andy J Gill and Conal Elliott 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net
+-- Stability   :  experimental
+-- 
+-- Tablet shape with rounded corners
+----------------------------------------------------------------------
+
+module Main where
+
+import Data.Monoid
+import Control.Applicative
+
+import Graphics.Rendering.OpenGL (Color)
+import Graphics.FieldTrip.Glut 
+
+import Data.VectorSpace
+import Data.Derivative ((:>))
+
+import Graphics.FieldTrip.Misc
+import Graphics.FieldTrip.Geometry2
+import Graphics.FieldTrip.Geometry3
+import Graphics.FieldTrip.Transform
+import Graphics.FieldTrip.Transform3
+import Graphics.FieldTrip.Vector2
+import Graphics.FieldTrip.Vector3
+import Graphics.FieldTrip.Color
+import Graphics.FieldTrip.Material
+import Graphics.FieldTrip.Image
+import Graphics.FieldTrip.Render
+import qualified Graphics.FieldTrip.ParamSurf as P
+import Graphics.FieldTrip.ParamSurf hiding (torus)
+
+import Graphics.Formats
+
+-- These next two aren't yet release openly.
+
+-- import Graphics.Formats.Obj
+-- import Codec.Image.DevIL
+
+import System.IO.Unsafe
+
+-- import Data.Behavior
+import FRP.Reactive.Reactive
+
+import FRP.Reactive.Internal.Misc (Sink)
+
+-- import Tablet
+
+main :: IO ()
+main =
+  do -- ilInit
+     anim3 $ spinningG $
+         -- flatG ubox2
+         -- uscale3 (3::R) *% (sphere 0.3 `mappend` flatG ubox2)
+         -- cube
+         -- flatG $ uscale2 (0.5::R) *% diskWedge (1/3)
+         -- flatG $ roundedRect 2 3 (1/2)
+         -- pivot3 (xVector3::Vector3 R) $ cylinder (1/2) 2
+         -- tablet1 2 3 (1/2) (1/4)
+         -- tablet2 2 3 (1/2)
+         -- cone 1 1
+         -- redTorus `mappend` greenCyl
+         torusPair
+         -- ptor (rings . (50 *^))
+         -- ptor (checker . (50 *^))
+         -- ptor groovy
+         -- testH' groovy eggcrateH
+         -- testH rippleH
+         -- when testing the next two, increase gcErr (below) to 0.05
+         -- torusCrate
+         -- torusCrate'
+         -- loadObj "Astin DB9.obj"
+
+-- loadObj :: String -> Geometry3
+-- loadObj x =
+--   renderableG obj
+--   where
+--      obj = unsafePerformIO
+--               $ objFromFile ("examples/" ++ x) ["examples/"]
+
+plasmat :: Col -> Filter3
+plasmat col = materialG (plastic col)
+
+torusCrate, torusCrate' :: Geometry3
+torusCrate = plasmat yellow $ surfG $
+             displace (P.torus 1 (1/2)) (stretchH eggcrateH)
+
+torusCrate' = flip surfG' groovy $
+              displace (P.torus 1 (1/2)) (stretchH eggcrateH)
+
+testH :: HeightField (Vector2 R :> R) -> Geometry3
+testH = surfG . hfSurf . stretchH
+
+testH' :: Color c => Image c -> HeightField (Vector2 R :> R) -> Geometry3
+testH' im = flip surfG' im . hfSurf . stretchH
+
+stretchH :: Fractional s => HeightField s -> HeightField s
+stretchH hf = (/ 10) . hf . (* 10)
+
+ptor :: Color c => Image c -> Geometry3
+ptor = surfG' (P.torus 1 (1/2))
+
+groovy :: ImageC
+groovy (s,t) =
+  rgba (sinU (3*s+5*t)) (cosU (5*t-3*s)) (sinU (3*s+5*t)) ((1+sinU (5*s*t) / 2))
+
+redTorus, greenCyl :: Geometry3
+redTorus = plasmat red   $ torus 1 (1/2)
+greenCyl = plasmat green $ cylinder (1/3) 3
+
+torusPair :: Geometry3
+torusPair = f red (1/2) `mappend` pivot3X (f green (-1/2))
+ where
+   tor = torus 1 (2/5)
+   f :: Col -> R -> Geometry3
+   f col dx = plasmat col (move3X dx tor)
+
+spinningG :: Geometry3 -> Anim Geometry3
+spinningG g env = liftA2 (*%) (spinning env) (pure g)
+
+spinning :: Anim (Transform3 Double)
+spinning env = (f . (*1)) <$> timeR env
+ where
+   f t = translate3 (Vector3 (0::Double) 0 (3*sin (-t/5)))
+         `mappend` rotate3 t (Vector3 0.1 0.2 0.3)
+         `mappend` scale3 0.2 0.2 0.2
+
+{-
+
+-- This reads mouse clicks, and 
+withClick :: GlutEvents -> Behavior Double
+withClick events = timeB
+{-
+fmap (\ (a,b) -> b)
+		 $ snapshot mouseEvents timeB
+-}
+  where
+	mouseEvents :: Event Bool
+	mouseEvents = fmap (\ (_,x,_,_) ->
+				       case x of
+					 Up -> False
+					 Down -> True)
+		   $ filterMP (\ (key,state,mods,pos) ->
+				    case (key,state) of
+				      (MouseButton _,Down) -> True
+				      _ -> False) 
+			       (keyboardMouseEvent events)
+
+-}
+
+view :: Filter3
+view = move3Z (-3 :: R)
+
+animate :: Sink a -> Sink (Anim a)
+animate f anim = runWithGlut ((fmap.fmap) f anim)
+
+anim2 :: Sink (Anim Geometry2)
+anim2 = animate render2
+
+anim3 :: Sink (Anim Geometry3)
+anim3 = animate (renderWith3 gc . view)
+ where
+   gc = defaultGC { gcErr = 0.01 }
+
+
+-- Later:
+
+-- type Anim a = GlutEvents -> Behavior a
diff --git a/src/Graphics/FieldTrip.hs b/src/Graphics/FieldTrip.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip.hs
@@ -0,0 +1,48 @@
+{-# OPTIONS -Wall #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FieldTrip
+-- Copyright   :  (c) Conal Elliott 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net
+-- Stability   :  experimental
+-- 
+-- A functional library for 3D graphics
+----------------------------------------------------------------------
+
+module Graphics.FieldTrip
+  ( module Graphics.FieldTrip.Misc
+  , module Graphics.FieldTrip.Vector2
+  , module Graphics.FieldTrip.Vector3
+  , module Graphics.FieldTrip.Point2
+  , module Graphics.FieldTrip.Point3
+  , module Graphics.FieldTrip.Normal3
+  , module Graphics.FieldTrip.Transform
+  , module Graphics.FieldTrip.Transform2
+  , module Graphics.FieldTrip.Transform3
+  , module Graphics.FieldTrip.Color
+  , module Graphics.FieldTrip.Material
+  , module Graphics.FieldTrip.Render
+  , module Graphics.FieldTrip.ParamSurf
+  , module Graphics.FieldTrip.Image
+  , module Graphics.FieldTrip.Geometry2
+  , module Graphics.FieldTrip.Geometry3
+  ) where
+
+import Graphics.FieldTrip.Misc
+import Graphics.FieldTrip.Vector2
+import Graphics.FieldTrip.Vector3
+import Graphics.FieldTrip.Point2
+import Graphics.FieldTrip.Point3
+import Graphics.FieldTrip.Normal3
+import Graphics.FieldTrip.Transform
+import Graphics.FieldTrip.Transform2
+import Graphics.FieldTrip.Transform3
+import Graphics.FieldTrip.Color
+import Graphics.FieldTrip.Material
+import Graphics.FieldTrip.Render
+import Graphics.FieldTrip.ParamSurf hiding (frustrum,torus)
+import Graphics.FieldTrip.Image
+import Graphics.FieldTrip.Geometry2
+import Graphics.FieldTrip.Geometry3
diff --git a/src/Graphics/FieldTrip/Color.hs b/src/Graphics/FieldTrip/Color.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/Color.hs
@@ -0,0 +1,152 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses
+           , UndecidableInstances, TypeSynonymInstances
+  #-}
+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}  -- Color4
+
+----------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FieldTrip.Color
+-- Copyright   :  (c) Conal Elliott 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net
+-- Stability   :  experimental
+-- 
+-- Color helpers
+----------------------------------------------------------------------
+
+module Graphics.FieldTrip.Color
+  (
+    Col, rgb, rgba, rgb255
+  , transparent, black, white, red, green, blue, yellow, purple
+  , HasColor(..)
+  , VC(..)
+  , overC, overPre, overNon
+  ) where
+
+import Graphics.Rendering.OpenGL
+
+import Data.VectorSpace
+import Graphics.FieldTrip.Misc
+
+
+-- | Our color type (with alpha)
+type Col = Color4 R
+
+rgba :: s -> s -> s -> s -> Color4 s
+rgba = Color4
+
+rgb :: Num s => s -> s -> s -> Color4 s
+rgb r g b = Color4 r g b 1
+
+
+grey :: Num s => s -> Color4 s
+grey x = rgb x x x
+
+transparent, black, white,
+ red, green, blue,
+ yellow, purple :: Fractional s => Color4 s
+
+transparent = rgba 0 0 0 0
+
+white = grey 1
+black = grey 0
+
+red    = rgb 1 0 0
+green  = rgb 0 1 0
+blue   = rgb 0 0 1
+
+yellow = rgb 1 1 0
+
+purple = rgb255 160  32 240
+
+rgb255 :: Fractional s => s -> s -> s -> Color4 s
+rgb255 r g b = rgb (byte r) (byte g) (byte b)
+
+byte :: Fractional s => s -> s
+byte = (/ 255)
+
+class HasColor c where toColor :: c -> Col
+
+instance HasColor Bool where
+  toColor True  = white
+  toColor False = transparent
+
+instance HasColor Float  where toColor = grey
+
+instance Color Bool where
+  color  = color . toColor
+  colorv = error "colorv: not defined on Bool"
+instance Color R where
+  color  = color . toColor
+  colorv = error "colorv: not defined on R"
+
+-- instance HasColor Double where toColor = grey
+-- instance Color Double where color = color . toColor
+
+
+-- Experiment.  See also Graphics.FieldTrip.Vertex
+
+-- | Vertex and color
+data VC v c = VC !v !c
+
+instance (Vertex v, Color c) => Vertex (VC v c)
+  where
+    vertex (VC v c) = color c >> vertex v
+    vertexv = error "vertexv: undefined on VC"
+
+
+-- UndecidableInstances because "the Coverage Condition fails" below
+
+instance AdditiveGroup u => AdditiveGroup (Color4 u) where
+  zeroV = Color4 zeroV zeroV zeroV zeroV
+  Color4 r g b a ^+^ Color4 r' g' b' a'
+        = Color4 (r^+^r') (g^+^g') (b^+^b') (a^+^a')
+  negateV (Color4 r g b a)
+        = Color4 (negateV r) (negateV g) (negateV b) (negateV a)
+
+instance VectorSpace u s => VectorSpace (Color4 u) s where
+  s *^ (Color4 r g b a)
+        = Color4 (s*^r) (s*^g) (s*^b) (s*^a)
+
+instance (InnerSpace r s, VectorSpace s s')
+    => InnerSpace (Color4 r) s where
+  Color4 r g b a <.> Color4 r' g' b' a' =
+    r<.>r' ^+^ g<.>g' ^+^ b<.>b' ^+^ a<.>a'
+
+instance Functor Color4 where
+  fmap f (Color4 r g b a) = Color4 (f r) (f g) (f b) (f a)
+
+-- instance Applicative Color4 where
+--   pure = grey
+--   Color4 f h k l <*> Color4 r g b a = Color4 (f r) (h g) (k b) (l a)
+
+-- I don't know how to define 'pure' above without requiring Num on the
+-- parameter, which then breaks the required unrestricted polymorphism.
+
+
+
+-- Do OpenGL colors have pre-multiplied alpha?  If so, color overlay is
+-- simple.
+
+-- | Overlay (alpha-blend) first color onto the second, accounting for
+-- transparency
+overC :: Fractional s => Color4 s -> Color4 s -> Color4 s
+overC = overPre
+
+-- The definition depends on whether we're using pre-multiplied or
+-- non-premultiplied alpha in the Color4 representation.  I don't know
+-- which.
+overPre, overNon :: Fractional s => Binop (Color4 s)
+
+Color4 r g b a `overPre` Color4 r' g' b' a' =
+  Color4 (r // r') (g // g') (b // b') (a // a')
+ where
+   top // bot = top + (1-a) * bot
+
+Color4 r g b a `overNon` Color4 r' g' b' a' =
+  Color4 (r // r') (g // g') (b // b') ao
+ where
+   top // bot    = ((top*a) `pre` (bot*a')) / ao
+   ao            = a `pre` a'
+   top `pre` bot = top + (1-a) * bot
diff --git a/src/Graphics/FieldTrip/Geometry2.hs b/src/Graphics/FieldTrip/Geometry2.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/Geometry2.hs
@@ -0,0 +1,225 @@
+{-# OPTIONS_GHC -Wall #-}
+{-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FieldTrip.Geometry2
+-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net, andygill@ku.edu
+-- Stability   :  experimental
+-- 
+-- 2D geometry
+----------------------------------------------------------------------
+
+module Graphics.FieldTrip.Geometry2
+  (
+    Geometry2, renderer2, renderWith2, render2
+  , ubox2, box2
+  , approx2, udisk, polygon, regularPolygon
+  , diskWedge, regularPolygonWedge
+  -- * Text
+  , utext, utextWidth, utextBaseline
+  -- * Geometry2 filters
+  , Filter2, move2, move2X, move2Y, andFlip2
+  ) where
+
+import Data.Monoid
+import Control.Applicative
+import System.IO.Unsafe( unsafePerformIO )
+
+import Graphics.UI.GLUT
+
+import Graphics.FieldTrip.Misc
+import Graphics.FieldTrip.Point2
+import Graphics.FieldTrip.Transform
+import Graphics.FieldTrip.Transform2
+import Graphics.FieldTrip.Render
+import Graphics.FieldTrip.Material
+
+-- | 2D geometry
+-- In the 'Monoid' instance, 'mempty' is completely invisible (aka
+-- transparent or empty), and @a 'mappend' b@ places @a@ on top of @b@.
+
+newtype Geometry2 = Renderer2 { unRenderer2 :: Renderer }
+
+-- TODO: consider expanding Geometry2 with more constructors, as in
+-- Geometry3, e.g., 
+-- 
+--   -- | 2D geometry
+--   data Geometry2
+--      = EmptyG
+--      | OverG Geometry2 Geometry2
+--      | forall s. (Floating s, Real s, MatrixComponent s) =>
+--           TransformG (Transform2 s) Geometry2
+--      | RenderG Renderer
+--      -- temporary:
+--      | ColorG ColorTrans Geometry2
+
+
+inRenderer2 :: (Renderer -> Renderer)
+        -> (Geometry2 -> Geometry2)
+inRenderer2 f = Renderer2 . f . unRenderer2
+
+inRenderer22 :: (Renderer -> Renderer -> Renderer)
+         -> (Geometry2 -> Geometry2 -> Geometry2)
+inRenderer22 f = inRenderer2 . f . unRenderer2
+
+instance Monoid Geometry2 where
+  mempty  = Renderer2 (pure (return ()))
+  mappend = inRenderer22 (liftA2 (>>))
+
+-- | Make a geometry from a rendering action.  The action must leave graphics
+-- state as it found it.
+renderer2 :: Renderer -> Geometry2
+renderer2 = Renderer2
+
+-- | Render the geometry, given a graphics context.  Leaves graphics state unchanged.
+renderWith2 :: GContext -> Geometry2 -> IO ()
+renderWith2 = flip unRenderer2
+
+-- | Render the geometry with default graphics context.  See also 'renderWith2'.
+render2 :: Geometry2 -> IO ()
+render2 = renderWith2 defaultGC
+
+instance (Floating s, Real s, MatrixComponent s) =>
+     Transform (Transform2 s) Geometry2 where
+  xf *% im = Renderer2 $ \ gc ->
+               preservingMatrix $ do
+                 tweakMatrix2 xf
+                 renderWith2 (onErr (tweakError2 xf) gc) im
+
+
+-- | Box2 of given @width@ and @height@.  See also 'ubox2.
+box2 :: (Real s, Floating s, MatrixComponent s) => s -> s -> Geometry2
+box2 width height = scale2 width height *% ubox2
+
+-- | Box2 of unit @width@ and @height@.  See also 'box2.
+ubox2 :: Geometry2
+ubox2 = polygon [Vertex2 p p, Vertex2 p m, Vertex2 m m, Vertex2 m p]
+ where
+   p,m :: Float
+   p = 1/2
+   m = -p
+
+-- | Approximate one geometry by another, given an error bound
+approx2 :: (ErrorBound -> Geometry2) -> Geometry2
+approx2 f = Renderer2 $ \ gc -> renderWith2 gc (f (gcErr gc))
+
+-- | The unit disk, approximated as regular n-gons
+udisk :: Geometry2
+udisk = approx2 $ regularPolygon . max 3 . round . recip
+
+-- | Portion of a disk
+diskWedge :: R -> Geometry2
+diskWedge frac =
+  approx2 $ regularPolygonWedge frac . max 3 . round . (frac /)
+
+-- | A polygon
+polygon :: VertexComponent s => [Vertex2 s] -> Geometry2
+polygon vs =
+  renderer2 (\(GC _ mTrans _) -> do material (mTrans defaultMat)
+                                    renderPrimitive Polygon (mapM_ vertex vs))
+
+-- | Regular polygon
+regularPolygon :: Int -> Geometry2
+regularPolygon sides
+  | sides < 3 = error "regularPolygon must have at least three sides"
+  | otherwise = polygon points
+ where
+   points :: [Point2 Float]
+   points = [ point2Polar 1 (fromIntegral i * theta)
+            | i <- [sides,sides-1 .. 1]]
+   theta  = 2*pi / fromIntegral sides
+
+-- | Regular polygon wedge.  Oops!  only works for frac <= 1/2, since
+-- otherwise the polygon is non-convex.
+regularPolygonWedge :: forall s. (Ord s, Floating s, VertexComponent s) =>
+                       s -> Int -> Geometry2
+regularPolygonWedge frac sides
+  | sides < 1 = error "regularPolygonWedge must have at least one side"
+  | frac > 1/2 = error "regularPolygonWedge: requires frac <= 1/2 for now."
+  | otherwise = renderer2 $ const $
+                  renderPrimitive Polygon $
+                    do verts
+                       vertex (point2 0 0 :: Point2 s)
+ where
+   verts :: IO ()
+   verts = sequence_ [ v (fromIntegral i * theta)
+                     | i <- [sides,sides-1 .. 0]]
+   p :: s -> Point2 s
+   p = point2Polar 1
+   v :: s -> IO ()
+   v = vertex . p
+   theta :: s
+   theta  = frac * (2*pi / fromIntegral sides)
+
+-- TODO: refactor regularPolygon & regularPolygonWedge, and disk & wedge.
+
+-- TODO: verify counter-clockwise order.  might not be what GL expects.
+
+
+{--------------------------------------------------------------------
+    Text
+--------------------------------------------------------------------}
+
+-- Utility function for allowing material transformations for when lifted to
+-- 3d geometry.
+withDefaultMat :: IO () -> Geometry2
+withDefaultMat x =
+  renderer2 (\(GC _ mTrans _) -> material (mTrans defaultMat) >> x)
+
+-- TODO: I think withDefaultMat leaves the graphics state changed, thus
+-- breaking composability.  - Conal
+
+glText :: String -> Geometry2
+glText = withDefaultMat . preservingMatrix . renderString Roman
+
+glAboveBaseline, glBelowBaseline :: Double
+glAboveBaseline = 119.05
+glBelowBaseline = 33.33
+
+glTextWidth :: String -> Double
+glTextWidth = fromIntegral . unsafePerformIO . stringWidth Roman
+
+-- | The passed string of text centered at the origin with height 1.0
+utext :: String -> Geometry2
+utext s = (m . sc . glText) s
+  where
+    h = glAboveBaseline + glBelowBaseline
+    z = glBelowBaseline / h
+    m = move2 (-utextWidth s/2) (-0.5 + z)
+    sc = (*%) (uscale2 (1.0/h))
+
+-- | The width of the geometry of utext of that string.
+utextWidth :: String -> Double
+utextWidth = flip (/) (glAboveBaseline+glBelowBaseline) . glTextWidth
+
+-- | The height of the baseline of geometry created by utext. This can be
+-- used for underlining, for example.
+utextBaseline :: Double
+utextBaseline = glBelowBaseline/(glAboveBaseline+glBelowBaseline) - 0.5
+
+
+
+{--------------------------------------------------------------------
+    Filters
+--------------------------------------------------------------------}
+
+-- | Geometry2 filter
+type Filter2 = Geometry2 -> Geometry2
+
+-- | Simplified interface to 'translate2'
+move2 :: (MatrixComponent s, Real s, Floating s) =>
+         s -> s -> Filter2
+move2 dx dy = (translate2 (Vector2 dx dy) *%)
+
+-- | Specializations of 'move2'
+move2X, move2Y :: (MatrixComponent s, Real s, Floating s) =>
+                  s -> Filter2
+move2X dx = move2 dx 0
+move2Y dy = move2 0 dy
+
+-- | A geometry plus its a rotated-by-pi version.
+andFlip2 :: Filter2
+andFlip2 im = im `mappend` (rotate2 (pi :: Float) *% im)
diff --git a/src/Graphics/FieldTrip/Geometry3.hs b/src/Graphics/FieldTrip/Geometry3.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/Geometry3.hs
@@ -0,0 +1,393 @@
+{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses
+           , ParallelListComp, ScopedTypeVariables, TypeOperators
+	   , FlexibleContexts, TypeFamilies
+  #-}
+-- {-# OPTIONS_GHC -Wall #-}
+-- TODO: restore
+----------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FieldTrip.Geometry3
+-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net, andygill@ku.edu
+-- Stability   :  experimental
+-- 
+-- 3D geometry
+----------------------------------------------------------------------
+
+module Graphics.FieldTrip.Geometry3
+  (
+    Geometry3, onMaterialG, materialG, rendererG, renderableG, flatG
+  , renderWith3, render3
+  , normalArrowG
+  , cube, box3
+  , sphere, usphere, frustrum, cone, cylinder, torus
+  , surfG, surfG'
+  -- * Geometry filters
+  , Filter3, move3, move3X, move3Y, move3Z, pivot3, andFlip3
+  , pivot3X, pivot3Y, pivot3Z
+	-- tmp
+  ,vsurf
+  )
+  where
+
+-- TODO: restore exports when i get this module compiling again
+
+import Data.Monoid
+import Control.Applicative
+
+import Graphics.Rendering.OpenGL hiding (normal)
+import qualified Graphics.Rendering.OpenGL as G
+
+-- TypeCompose
+import Control.Instances () -- IO monoid
+
+import Data.VectorSpace
+import Data.MemoTrie
+import Data.Basis
+import Data.Cross
+import Data.AffineSpace
+
+import Graphics.FieldTrip.Misc
+import Graphics.FieldTrip.Vector2
+import Graphics.FieldTrip.Vector3
+import Graphics.FieldTrip.Normal3
+import Graphics.FieldTrip.Point3
+import Graphics.FieldTrip.Color
+import Graphics.FieldTrip.Material
+import Graphics.FieldTrip.Transform
+import Graphics.FieldTrip.Transform3
+import Graphics.FieldTrip.Render
+import Graphics.FieldTrip.Geometry2
+-- import Graphics.FieldTrip.Image
+
+import Graphics.Formats
+
+-- for parametric surfaces
+import Data.Derivative ((:>),pureD,idD,powVal)
+import qualified Graphics.FieldTrip.ParamSurf as P
+import Graphics.FieldTrip.ParamSurf hiding (frustrum,torus)
+
+-- | 3D geometry
+data Geometry3
+   = EmptyG
+   | UnionG     Geometry3 Geometry3
+   | forall s. (Floating s, Real s, MatrixComponent s) =>
+        TransformG (Transform3 s) Geometry3
+   | RenderG Renderer
+   | GContextG (Unop GContext) Geometry3
+   -- temporary:
+   | MaterialG MaterialTrans Geometry3
+   -- TextureG   Image Geometry3
+   -- LightG     LightType            -- embedded light     
+
+-- TODO: textures & lights.  What interface to use for textures?  I'd like
+-- to have a composable image type.
+
+-- TODO: consider dropping EmptyG in favor of a trivial use of RenderG.
+-- Possible drawback: loss of optimization.
+
+-- Why represent 3d geometry as an algebraic type but 2d geometry as a
+-- rendering action?  Because of embeddable lights and cameras, which can
+-- be extracted by a first pass for rendering in a second pass.  We could
+-- represent a geometry as a set of lights and cameras plus a rendering
+-- action.  We'll probably want to gather up and use all of the lights,
+-- but just one of the cameras.  Question: how to select an embedded camera?
+-- 
+-- Still -- make 2d & 3d consistent, even if currently unnecessary for 2d.
+-- 
+-- Why *embed* lights and cameras in the geometry instead of specifying
+-- them separately?  Because then they can be placed deeply into the
+-- scene, accumulating transforms, along with the visible geometry.
+
+-- TODO: consider replacing RenderG with something more declarative,
+-- such as a parametric surface and an image.  Then we could do other
+-- things with geometry.
+
+-- | Make a geometry from a rendering action.  The action must leave graphics
+-- state as it found it.
+rendererG :: Renderer -> Geometry3
+rendererG = RenderG
+
+renderableG :: Renderable a => a -> Geometry3
+renderableG = rendererG . const . render
+
+instance Monoid Geometry3 where
+  mempty  = EmptyG
+  mappend = UnionG  -- TODO: optimize
+
+instance  (Floating s, Real s, MatrixComponent s)
+     => Transform (Transform3 s) Geometry3  where
+  (*%) = TransformG
+
+-- | Modify the material in a geometry.  See also 'materialG'.
+onMaterialG :: MaterialTrans -> Filter3
+onMaterialG = MaterialG
+
+-- | Replace the material of a geometry.  More generally, see 'onMaterialG'.
+materialG :: Material -> Filter3
+materialG = MaterialG . const
+
+-- | Render the geometry, given a graphics context.  Leaves graphics state unchanged.
+renderWith3 :: GContext -> Geometry3 -> IO ()
+renderWith3 = flip renderIO
+
+-- | Render the geometry with default graphics context.  See also 'renderWith3'.
+render3 :: Geometry3 -> IO ()
+render3 = renderWith3 defaultGC
+
+-- | Use a graphics context transformer. 
+-- TODO: rewrite onColor usi9ng renderUsing3.
+renderUsing3 :: Unop GContext -> Geometry3 -> Geometry3
+renderUsing3 = GContextG 
+
+normalArrowG :: Col -> Filter3
+normalArrowG col = renderUsing3 (\ gc -> gc { gcNormals = Just col })
+
+-- -- | Flatten 3d geometry to 2d.
+-- flatten :: Geometry3 -> Geometry2
+-- flatten = renderer2 . renderIO
+
+-- IO version.
+renderIO :: Geometry3 -> Renderer
+renderIO EmptyG              = mempty
+renderIO (g `UnionG` g')     = renderIO g `mappend` renderIO g'
+renderIO (xf `TransformG` g) = \ gc -> preservingMatrix $
+                                   do tweakMatrix3 xf
+                                      renderIO g (onErr (tweakError3 xf) gc)
+renderIO (RenderG r)         = r
+renderIO (GContextG f g)     = \ gc -> renderIO g (f gc)
+renderIO (MaterialG i g)        = \ (GC err o norms) -> renderIO g (GC err (o.i) norms)
+
+-- TODO: resolve inconsistency between style for tweaking err vs colortrans.
+
+
+-- | Flat geometry
+flatG :: Geometry2 -> Geometry3
+flatG g2 = rendererG $ \ gc ->
+              -- The 2d geometry likely omits normals, so set them all here.  If we
+              -- don't, then normals from 3D geometry will contaminate 2D.
+              G.normal (Normal3 0 0 (1 :: R)) >> renderWith2 gc g2
+
+
+-- TODO: Get flatG and flatten to work together.  I'd like flatten to 
+
+---- primitives
+
+-- | Four-tuple.  Useful for making quadrilateral geometry.
+data Quad p = Quad !p !p !p !p
+
+-- Useful?
+instance Functor Quad where
+  f `fmap` Quad a b c d = Quad (f a) (f b) (f c) (f d)
+
+-- TODO: Get flatG and flatten to work together.
+
+-- Unit cube
+cube :: Geometry3
+cube = topBottom `mappend` pivoted xAxis `mappend` pivoted yAxis
+ where
+   topBottom = andFlip3 yAxis (move3Z (1/2 :: R) side)
+--   side = flatG ubox2
+   side = surfG (hfSurf (const 0))
+   pivoted   = flip pivot3 topBottom
+   xAxis, yAxis :: Vector3 R -- monomorphic versions
+   xAxis = xVector3
+   yAxis = yVector3
+
+-- Box with given sizes in X, Y, and Z
+box3 :: (MatrixComponent s, Real s, Floating s) =>
+        s -> s -> s -> Geometry3
+box3 sx sy sz = scale3 sx sy sz *% cube
+
+
+-- TODO:
+-- + more elegant/modular way to specify normals
+-- + triangle fans
+
+
+-- | Unit sphere
+usphere :: Geometry3
+usphere = surfG (sphere1 :: Surf (Vector2 R :> R))
+
+-- | Sphere with given radius
+sphere :: R -> Geometry3
+sphere r = uscale3 r *% usphere
+
+-- | Frustrum of a cone, with given base radius, top radius, and height,
+-- centered at origin.
+frustrum :: R -> R -> R -> Geometry3
+frustrum baseR topR h =
+  surfG (P.frustrum (pureD baseR) (pureD topR) (pureD h))
+
+-- | Cone with given base radius and height, and height,
+-- centered at origin..
+cone :: R -> R -> Geometry3
+cone r h = frustrum r 0 h
+
+-- | Cylinder with given radius and height, centered at origin, and height,
+-- centered at origin..
+cylinder :: R -> R -> Geometry3
+cylinder r h = frustrum r r h
+
+-- | Torus with given radii for the sweep and the swept circle
+torus :: R -> R -> Geometry3
+torus sr cr = surfG (P.torus (pureD sr) (pureD cr))
+
+-- General surface renderer
+renderSurfG :: (Fractional s, Vertex b) =>
+               (Vector2 s -> b) -> ErrorBound -> IO ()
+renderSurfG f = logMemo (3/4) $ \ err -> sequence_ $
+  let -- Surface samples.
+      -- outs :: [[VN3 R]]
+      outs = (fmap.fmap) f (params err)
+  in
+    [ renderPrimitive TriangleStrip $ sequence_ $
+        [ vertex vn' >> vertex vn | vn <- row | vn' <- row' ]
+      | row <- outs | row' <- tail outs ] 
+
+renderNormalArrowsG :: (Vector2 R -> VN3 R) -> ErrorBound -> Col -> IO ()
+renderNormalArrowsG f = logMemo (1/4) $ \ err col -> sequence_ $
+  let -- Surface samples.
+      -- outs :: [[VN3 R]]
+      outs = (fmap.fmap) f (params err)
+  in
+    [ renderPrimitive Lines $ sequence_ $
+        [ case vn of
+	   (VN pt3 nor3) -> 
+		color col >> vertex pt3 >> vertex (add err pt3 nor3) | vn <- row ]
+      | row <- outs ]
+  where add :: R -> Vertex3 R -> Normal3 R -> Vertex3 R
+        add err (Vertex3 x y z) (Normal3 x' y' z') = Vertex3 (x + x' * err') (y + y' * err') (z + z' * err')
+		where err' = sqrt err
+
+-- | Parametric surface without texture
+surfG :: Surf (Vector2 R :> R) -> Geometry3
+
+surfG surf = rendererG $ \ (GC err fmat norms) ->
+               do material (fmat defaultMat)
+                  rsurf err
+		  case norms of
+		    Nothing   -> return ()
+		    Just col' -> arrows err col'
+ where
+   -- out of the \ (GC ...) so computed once per surf, not once per gc
+   the_surf = vsurf surf
+   rsurf    = renderSurfG the_surf
+   arrows   = renderNormalArrowsG the_surf
+
+-- The types of surfG and related functions can be parameterized over
+-- scalar types and material type.
+
+-- | Parametric surface with texture
+-- surfG' :: Surf (Vector2 R :> R) -> ImageC -> Geometry3
+surfG' :: ( Floating s, InnerSpace s s, HasBasis s s, HasTrie (Basis s), Basis s ~ ()
+          , VertexComponent s, NormalComponent s, Color c) =>
+          Surf (Vector2 s :> s) -> ((s, s) -> c) -> Geometry3
+surfG' surf img = rendererG $ \ (GC err _ _) -> rsurf err
+ where
+   -- out of the \ (GC ...) so computed once per surf, not once per gc
+   rsurf = renderSurfG (vsurf' surf img)
+
+-- TODO: refactor surfG' & surfG
+
+-- type VNC s = VC (VN3 s) (Color4 s)
+
+vsurf' :: (InnerSpace s s, Floating s, HasBasis s s, HasTrie (Basis s), Basis s ~ ()) =>
+          Surf (Vector2 s :> s) -> ((s,s) -> c) -> Vector2 s -> VC (VN3 s) c
+vsurf' surf img = liftA2 VC (vsurf surf) (img . coords2)
+ where
+   coords2 (Vector2 x y) = (x,y)
+
+
+
+-- Parameter space samples, based on error bound.  Should really depend on
+-- the surface properties.  Redo later.
+params :: forall s. Fractional s => ErrorBound -> [[Vector2 s]]
+params err = [[Vector2 u v | u <- us] | v <- vs]
+ where
+   -- Steps/facets in u and in v.  Placeholder.
+   -- TODO: consider how to distribute the error for surfaces.  Maybe use
+   -- derivative bounds and adaptively tessellate.
+   nu :: Int
+   nu = round (recip err) `max` 1
+   -- nv = ...
+   du :: s
+   du = recip (fromIntegral nu)
+   -- dv = du                              -- recip (fromIntegral nv)
+   -- nu+1 u samples, and nv+1 v samples
+   us,vs :: [s]
+   us = fmap ((subtract 0.5).(*du).fromIntegral) [0::Int .. nu]
+   vs = us                     -- fmap ((*du).fromIntegral) [0::Int .. nu]
+
+-- TODO: consider redoing tessellation functionally, i.e., generating a
+-- list of OpenGL primitives instead of rendering them.  So far, I don't
+-- see a benefit.
+
+
+-- x',y',z' :: a :-* (a :> s)
+
+-- look for a simpler formulation, exploiting linearity.  first collapse
+-- @(a:>s, a:>s, a:>s)@ to @a:>(s,s,s)@.
+
+-- vec3 = linearD (\ (x,y,z) -> Vector3 x y z)
+
+-- type SurfPt s = Two s :> Three s
+type SurfPt s = Vector2 s :> Vector3 s
+
+vsurf :: ( InnerSpace s s, Floating s
+         , HasBasis s s, HasTrie (Basis s), Basis s ~ ()) =>
+         Surf (Vector2 s :> s) -> (Vector2 s -> VN3 s)
+vsurf surf = toVN3 . vector3D . surf . unvector2D . idD
+
+-- dId :: R2 -> R2 :> R2
+-- unvec2 . dId :: R2 -> (R2:>R,R2:>R)
+-- surf . unvec2 . dId :: R2 -> (R2:>R,R2:>R,R2:>R)
+-- vec3 . surf . unvec2 . dId :: R2 -> R2 :> R3
+-- toVN3 . vec3 . surf . unvec2 . dId :: R2 -> VN3
+
+toVN3 :: (Floating s, InnerSpace s s, HasBasis s s, HasTrie (Basis s)
+         , HasNormal (SurfPt s), InnerSpace (SurfPt s) (Vector2 s :> s)
+         ) =>
+         SurfPt s -> VN3 s
+
+toVN3 v =
+  VN (origin3 .+^ powVal v)
+     (vectorToNormal3 (powVal (normal v)))
+
+
+-- toVN3 :: a
+-- toVN3 = error "toVN3"
+
+
+---- Geometry3 filters
+
+-- Geometry3 filter
+type Filter3 = Geometry3 -> Geometry3
+
+-- move3 :: R -> R -> R -> Filter3
+move3 :: (MatrixComponent s, Real s, Floating s) =>
+         s -> s -> s -> Filter3
+move3 dx dy dz = (translate3 (Vector3 dx dy dz) *%)
+
+move3X, move3Y, move3Z :: (MatrixComponent s, Real s, Floating s) =>
+                          s -> Filter3
+move3X dx = move3 dx 0 0
+move3Y dy = move3 0 dy 0
+move3Z dz = move3 0 0 dz
+
+-- Rotate pi/2 about axis
+pivot3 :: (MatrixComponent s, Floating s, Real s) =>
+          Vector3 s -> Filter3
+pivot3 axis = (rotate3 (pi/2) axis *%)
+
+pivot3X, pivot3Y, pivot3Z :: Filter3
+pivot3X = pivot3 (xVector3 :: Vector3 R)
+pivot3Y = pivot3 (yVector3 :: Vector3 R)
+pivot3Z = pivot3 (zVector3 :: Vector3 R)
+
+-- A geometry plus its a rotated-by-pi version.
+andFlip3 :: (MatrixComponent s, Floating s, Real s) =>
+            Vector3 s -> Filter3
+andFlip3 axis g = g `mappend` (rotate3 pi axis *% g)
diff --git a/src/Graphics/FieldTrip/Image.hs b/src/Graphics/FieldTrip/Image.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/Image.hs
@@ -0,0 +1,46 @@
+----------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FieldTrip.Image
+-- Copyright   :  (c) Conal Elliott 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net
+-- Stability   :  experimental
+-- 
+-- 2D imagery
+----------------------------------------------------------------------
+
+module Graphics.FieldTrip.Image where
+
+import Data.Function (on)
+import Control.Applicative
+
+-- import Graphics.Rendering.OpenGL (Color4)
+
+import Data.VectorSpace
+import Graphics.FieldTrip.Misc
+import Graphics.FieldTrip.Color
+
+-- These types can be generalized to other scalar types, at the cost of
+-- lots of type constraints.
+
+type Image o = (R,R) -> o
+
+type ImageC = Image Col
+type Region = Image Bool
+
+over :: Binop ImageC
+over = liftA2 overC
+
+smallFrac :: R -> Bool
+smallFrac = (< 1/2) . fracPart
+
+rings :: Region
+rings = smallFrac . magnitude
+
+checker :: Region
+-- checker (x,y) = smallFrac x == smallFrac y
+
+checker = uncurry ((==) `on` smallFrac)
+
+-- TODO: 
diff --git a/src/Graphics/FieldTrip/Material.hs b/src/Graphics/FieldTrip/Material.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/Material.hs
@@ -0,0 +1,78 @@
+{-# OPTIONS_GHC -Wall #-}
+module Graphics.FieldTrip.Material
+  ( Material(..)
+  , setAmbient , setDiffuse , setSpecular , setEmission , setShininess
+  , plastic, flat
+  , defaultMat, bluePlastic
+
+  , material
+  ) where
+
+import Graphics.Rendering.OpenGL
+import Graphics.FieldTrip.Misc
+import Graphics.FieldTrip.Color
+
+data Material = Mat
+  { ambientM   :: Col
+  , diffuseM   :: Col
+  , specularM  :: Col
+  , emissionM  :: Col
+  , shininessM :: R   -- Between 0 and 1
+  } deriving Show
+
+defaultMat :: Material
+defaultMat = Mat { ambientM   = rgba 0.2 0.2 0.2 1.0
+                 , diffuseM   = rgba 0.8 0.8 0.8 1.0
+                 , specularM  = rgba 0.0 0.0 0.0 1.0
+                 , emissionM  = rgba 0.0 0.0 0.0 1.0
+                 , shininessM = 0
+                 }
+
+setAmbient :: Col -> Material -> Material
+setAmbient c m = m{ ambientM=c }
+
+setDiffuse :: Col -> Material -> Material
+setDiffuse c m = m{ diffuseM=c }
+
+setSpecular :: Col -> Material -> Material
+setSpecular c m = m{ specularM=c }
+
+setEmission :: Col -> Material -> Material
+setEmission c m = m{ emissionM=c }
+
+setShininess :: R -> Material -> Material
+setShininess c m = m{ shininessM=c }
+
+polishedPlastic :: Material-> Material
+polishedPlastic = \m -> m { specularM = (rgba 1.0 1.0 1.0 1.0)
+                          , emissionM = (rgba 0.0 0.0 0.0 1.0)
+                          , shininessM = (70.0/128.0)
+                          }
+
+-- Alternate defn.
+-- polishedPlastic = setSpecular (rgba 1.0 1.0 1.0 1.0)
+--                 . setEmission (rgba 0.0 0.0 0.0 1.0)
+--                 . setShininess (70.0/128.0)
+--
+-- What do we like better, point free or clear nonsequentiality?
+
+setAmbDiff :: Col -> Material -> Material
+setAmbDiff c = \m -> m { ambientM = c
+                       , diffuseM = c
+                       }
+
+bluePlastic :: Material
+bluePlastic = plastic blue
+
+plastic :: Col -> Material
+plastic = polishedPlastic . flat
+
+flat :: Col -> Material
+flat = flip setAmbDiff defaultMat
+
+material :: Material -> IO()
+material m = do materialAmbient Front $= ambientM m
+                materialDiffuse Front $= diffuseM m
+                materialSpecular Front $= specularM m
+                materialEmission Front $= emissionM m
+                materialShininess Front $= (shininessM m)*128.0
diff --git a/src/Graphics/FieldTrip/Misc.hs b/src/Graphics/FieldTrip/Misc.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/Misc.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FieldTrip.Misc
+-- Copyright   :  (c) Conal Elliott 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net
+-- Stability   :  experimental
+-- 
+-- Miscellany for FieldTrip graphics
+----------------------------------------------------------------------
+
+module Graphics.FieldTrip.Misc
+  (
+    R, fracPart, Unop, Binop, logMemo
+  ) where
+
+import Data.MemoTrie
+
+-- | Values commonly used for coordinates, coefficients, etc.
+type R = Float
+
+-- | Fractional portion, @x - floor x@
+fracPart :: R -> R
+fracPart x = x - fromIntegral (floor x :: Int)
+
+-- | Unary operations
+type Unop  a = a -> a
+
+-- | Binary operations
+type Binop a = a -> a -> a
+
+-- | Memoize an approximation to a given function, discretizing its domain
+-- by scaling.  An input @x@ discretizes into @round (logBase base x)@.
+logMemo :: forall s a. (Floating s, RealFrac s) => s -> (s->a) -> (s->a)
+logMemo base f = memo (f . unapprox) . approx
+ where
+   approx :: s -> Int
+   approx = round . logBase base
+   unapprox :: Int -> s
+   unapprox = (base **) . fromIntegral
diff --git a/src/Graphics/FieldTrip/Normal3.hs b/src/Graphics/FieldTrip/Normal3.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/Normal3.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE BangPatterns, TypeOperators, ScopedTypeVariables
+           , TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses
+  #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FieldTrip.Normal3
+-- Copyright   :  (c) Conal Elliott 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net
+-- Stability   :  experimental
+-- 
+-- Normals and Vertex/normal pairs
+----------------------------------------------------------------------
+
+module Graphics.FieldTrip.Normal3
+  (
+    VN(..), VN3, vectorToNormal3
+  ) where
+
+import Graphics.Rendering.OpenGL hiding (normal)
+import qualified Graphics.Rendering.OpenGL as G
+
+import Graphics.FieldTrip.Point3
+import Graphics.FieldTrip.Vector3
+
+
+-- What do I want here?  For displacement mapping, I'll need 'normal' to
+-- compute a tower.  For shading, I'll use the value part of the normal
+-- and ignore the rest.
+
+-- It probably makes more sense to have 'Cross' be the class.  Define
+-- @normal = normalized . cross@.  What are some 'Cross' instances?
+-- Instead of a pair of 3-vectors, start with a @V2 s :> V3 s@ and a @s :>
+-- V2 s@.
+
+-- Hm.  I'll want to use tuples for parametric surfaces but vectors for
+-- rendering.  Do I *really* want OpenGL vectors instead of tuples?
+-- Tuples would get converted to OpenGL vectors, vertices, and normals in
+-- IO generation anyway.
+
+-- | Treat a vector as a normal
+vectorToNormal3 :: Vector3 s -> Normal3 s
+vectorToNormal3 (Vector3 x y z) = Normal3 x y z
+
+-- | Vertex and normal
+data VN v n = VN !v !n
+
+instance (Vertex v, Normal n) => Vertex (VN v n)
+  where
+    vertex (VN v n) = G.normal n >> vertex v
+    vertexv = error "vertexv: undefined on VN"
+
+-- | 3D vertex/normal pair
+type VN3 s = VN (Point3 s) (Normal3 s)
diff --git a/src/Graphics/FieldTrip/ParamSurf.hs b/src/Graphics/FieldTrip/ParamSurf.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/ParamSurf.hs
@@ -0,0 +1,180 @@
+{-# LANGUAGE Rank2Types, TypeOperators, FlexibleContexts #-}
+{-# OPTIONS_GHC -Wall #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FieldTrip.ParamSurf
+-- Copyright   :  (c) Conal Elliott 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net
+-- Stability   :  experimental
+-- 
+-- Parametric surfaces with automatic normals
+----------------------------------------------------------------------
+
+module Graphics.FieldTrip.ParamSurf where
+
+import Control.Applicative
+
+import Data.NumInstances ()
+import Data.VectorSpace
+import Data.Cross
+
+
+type HeightField s = Two s -> One s
+type Surf        s = Two s -> Three s
+
+type USurf = forall s. Floating s => Surf s
+
+
+type Curve2 s = One s -> Two s
+type Curve3 s = One s -> Three s
+
+type Warp1 s = One   s -> One   s
+type Warp2 s = Two   s -> Two   s
+type Warp3 s = Three s -> Three s
+
+mul2pi :: Floating s => s -> s
+mul2pi = (* (2*pi))
+
+-- | Trig functions with unit period ([-1/2,1/2])
+cosU, sinU :: Floating s => s -> s
+cosU = cos . mul2pi
+sinU = sin . mul2pi
+
+
+-- | Turn a height field into a surface
+hfSurf :: HeightField s -> Surf s
+hfSurf field = \ (u,v) -> (u, v, field (u,v))
+
+-- | Like 'hfSurf' but for curve construction
+fcurve :: Warp1 s -> Curve2 s
+fcurve f = \ u -> (u, f u)
+
+-- | Unit circle.
+circle :: Floating s => Curve2 s
+circle = liftA2 (,) cosU sinU
+
+-- | Half semi circle, with theta in [-pi/2,pi/2]
+semiCircle :: Floating s => Curve2 s
+semiCircle = circle . (/ 2)
+
+-- | Torus, given radius of sweep circle and cross section
+torus :: (Floating s, VectorSpace s s) => s -> s -> Surf s
+-- torus sr cr = revolve (\ s -> (sr,0) ^+^ cr *^ circle s)
+torus sr cr = revolve (const (sr,0) ^+^ cr *^ circle)
+
+-- Surface of revolution, formed by rotation around Z axis.  The curve is
+-- parameterized by u, and the rotation by v.  In this generalized
+-- version, we have not a single curve, but a function from v to curves.
+revolveG :: Floating s => (s -> Curve2 s) -> Surf s
+revolveG curveF = \ (u,v) -> onXY (rotate (-2*pi*v)) (addY (curveF v) u)
+
+revolve :: Floating s => Curve2 s -> Surf s
+revolve curve = revolveG (const curve)
+
+-- A sphere is a revolved semi-circle
+sphere1 :: Floating s => Surf s
+sphere1 = revolve semiCircle
+
+
+-- | Profile product.
+profile :: Num s => Curve2 s -> Curve2 s -> Surf s
+profile curve prof (u,v) = (cx*px,cy*px,py)
+ where
+   (cx,cy) = curve u
+   (px,py) = prof  v
+
+-- More spheres
+sphere2,sphere3 :: Floating s => Surf s
+sphere2 = profile circle semiCircle
+sphere3 = profile semiCircle circle
+
+-- | Frustrum, given base & cap radii and height.
+frustrum :: (Floating s, VectorSpace s s) => s -> s -> s -> Surf s
+frustrum baseR topR h = profile circle rad
+ where
+   rad t = (lerp baseR topR (t + 1/2), h*t)
+
+-- | Unit cylinder.  Unit height and radii
+ucylinder :: (Floating s, VectorSpace s s) => Surf s
+ucylinder = profile circle (const 1)
+
+
+-- | Given a combining op and two curves, make a surface.  A sort of
+-- Cartesian product with combination.
+cartF :: (a -> b -> c) -> (u -> a) -> (v -> b) -> ((u,v) -> c)
+cartF op f g = \ (u,v) -> f u `op` g v
+
+-- Sweep a basis curve by a sweep curve.  Warning: does not reorient the
+-- basis curve as cross-section.  TODO: Frenet frame.
+sweep :: VectorSpace s s' => Curve3 s -> Curve3 s -> Surf s
+sweep = cartF (^+^)
+
+
+-- | One period, unit height eggcrate
+eggcrateH :: Floating s => HeightField s
+eggcrateH = cartF (*) cosU sinU
+
+revolveH :: (Floating s, InnerSpace s s) => Warp1 s -> HeightField s
+revolveH = (. magnitude)
+
+rippleH :: (Floating s, InnerSpace s s) => HeightField s
+rippleH = revolveH sinU
+
+-- | Simple ripply pond shape
+ripple :: Floating s => Surf s
+ripple = -- onXY' (2 *^) $
+         revolve (const (0.5,0) - fcurve sinU)
+
+-- | Apply a displacement map at a value
+
+displaceV :: (InnerSpace v s, Floating s, HasNormal v) =>
+             v -> s -> v
+displaceV v s = v ^+^ s *^ normal v
+
+-- | Apply a displacement map to a function (e.g., 'Curve2' or 'Surf') or
+-- other container.
+displace :: (InnerSpace v s, Floating s, HasNormal v, Applicative f) =>
+            f v -> f s -> f v
+displace = liftA2 displaceV
+
+
+
+---- Misc
+
+rotate :: Floating s => s -> Warp2 s
+rotate theta = \ (x,y) -> (x * c - y * s, y * c + x * s)
+ where c = cos theta
+       s = sin theta
+
+addX, addY, addZ :: Num s => (a -> Two s) -> (a -> Three s)
+addX = fmap (\ (y,z) -> (0,y,z))
+addY = fmap (\ (x,z) -> (x,0,z))
+addZ = fmap (\ (x,y) -> (x,y,0))
+
+addYZ,addXZ,addXY :: Num s => (a -> One s) -> (a -> Three s)
+addYZ = fmap (\ x -> (x,0,0))
+addXZ = fmap (\ y -> (0,y,0))
+addXY = fmap (\ z -> (0,0,z))
+
+onX,onY,onZ :: Warp1 s -> Warp3 s
+onX f (x,y,z) = (f x, y, z)
+onY f (x,y,z) = (x, f y, z)
+onZ f (x,y,z) = (x, y, f z)
+
+onXY,onYZ,onXZ :: Warp2 s -> Warp3 s
+onXY f (x,y,z) = (x',y',z ) where (x',y') = f (x,y)
+onXZ f (x,y,z) = (x',y ,z') where (x',z') = f (x,z)
+onYZ f (x,y,z) = (x ,y',z') where (y',z') = f (y,z)
+
+
+onX',onY',onZ' :: Warp1 s -> (a -> Three s) -> (a -> Three s)
+onX' = fmap fmap onX
+onY' = fmap fmap onY
+onZ' = fmap fmap onZ
+
+onXY',onXZ',onYZ' :: Warp2 s -> (a -> Three s) -> (a -> Three s)
+onXY' = fmap fmap onXY
+onXZ' = fmap fmap onXZ
+onYZ' = fmap fmap onYZ
diff --git a/src/Graphics/FieldTrip/Point2.hs b/src/Graphics/FieldTrip/Point2.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/Point2.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}  -- Vertex2
+----------------------------------------------------------------------
+-- |
+-- Module      :  Point3
+-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net, andygill@ku.edu
+-- Stability   :  experimental
+-- 
+-- Points in 3D
+----------------------------------------------------------------------
+
+module Graphics.FieldTrip.Point2
+  (
+    Point2, point2, origin2, Vertex2(..)
+  , point2Polar
+  , point2PolarCoords
+  ) where
+
+import Graphics.Rendering.OpenGL (Vertex2(..))
+
+import Data.VectorSpace
+import Data.AffineSpace
+import Graphics.FieldTrip.Vector2
+
+-- | Synonym for Vertex2, a 2D point, parameterized over coordinate type.
+type Point2 = Vertex2
+
+-- | Construct a 2D point in rectangular coordinates.
+point2 :: s -> s -> Vertex2 s
+point2 = Vertex2
+
+origin2 :: Num s => Point2 s
+origin2 = point2 0 0
+
+-- or substitute zeroV for 0 above to relax Num s to VectorSpace s s
+
+-- -- | 2D point, parameterized over coordinate type.
+-- data Point2 s = Point2 !s !s deriving (Eq, Show)
+
+-- UndecidableInstances because "the Coverage Condition fails" below
+
+instance VectorSpace u s => AffineSpace (Vertex2 u) (Vector2 u) s where
+  Vertex2 u v .-. Vertex2 u' v' = Vector2 (u ^-^ u') (v ^-^ v')
+  Vertex2 u v .+^ Vector2 dx dy = Vertex2 (u ^+^ dx) (v ^+^ dy)
+
+vToP :: Vector2 s -> Point2 s
+vToP (Vector2 u v) = Vertex2 u v
+
+pToV :: Point2 s -> Vector2 s
+pToV (Vertex2 u v) = Vector2 u v
+
+-- | Vector from polar coordinates.  See also 'vectorPolarCoords'.
+point2Polar :: Floating s => s -> s -> Point2 s
+point2Polar = (fmap.fmap) vToP vector2Polar
+
+-- | Polar coordinates of a point.  See also 'point2Polar'.
+point2PolarCoords :: (InnerSpace s s, Floating s) => Point2 s -> (s,s)
+point2PolarCoords = vector2PolarCoords . pToV
diff --git a/src/Graphics/FieldTrip/Point3.hs b/src/Graphics/FieldTrip/Point3.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/Point3.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}  -- Vertex3
+----------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FieldTrip.Point3
+-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net, andygill@ku.edu
+-- Stability   :  experimental
+-- 
+-- Points in 3D
+----------------------------------------------------------------------
+
+module Graphics.FieldTrip.Point3
+  (
+    Point3, point3, origin3, Vertex3(..)
+  , point3Spherical
+  , point3SphericalCoords
+  ) where
+
+import Graphics.Rendering.OpenGL (Vertex3(..))
+
+import Data.VectorSpace
+import Data.AffineSpace
+import Graphics.FieldTrip.Vector3
+
+-- | Synonym for Vertex3, a 3D point, parameterized over coordinate type.
+type Point3 = Vertex3
+
+-- | Construct a 3D point in rectangular coordinates.
+point3 :: s -> s -> s -> Vertex3 s
+point3 = Vertex3
+
+origin3 :: Num s => Point3 s
+origin3 = point3 0 0 0
+
+-- or substitute zeroV for 0 above to relax Num s to VectorSpace s s
+
+-- -- | 3D point, parameterized over coordinate type.
+-- data Point3 s = Point3 !s !s !s deriving (Eq, Show)
+
+-- UndecidableInstances because "the Coverage Condition fails" below
+
+instance VectorSpace u s => AffineSpace (Vertex3 u) (Vector3 u) s where
+  Vertex3 u v w .-. Vertex3 u' v' w' = Vector3 (u ^-^ u') (v ^-^ v') (w ^-^ w')
+  Vertex3 u v w .+^ Vector3 dx dv dw = Vertex3 (u ^+^ dx) (v ^+^ dv) (w ^+^ dw)
+
+vToP :: Vector3 s -> Point3 s
+vToP (Vector3 u v w) = Vertex3 u v w
+
+pToV :: Point3 s -> Vector3 s
+pToV (Vertex3 u v w) = Vector3 u v w
+
+-- | Vector from spherical coordinates.  See also 'vectorSphericalCoords'.
+point3Spherical :: Floating s => s -> s -> s -> Point3 s
+point3Spherical = (fmap.fmap.fmap) vToP vector3Spherical
+
+-- | Spherical coordinates of a point.  See also 'point3Spherical'.
+point3SphericalCoords :: (InnerSpace s s, Floating s) => Point3 s -> (s,s,s)
+point3SphericalCoords = vector3SphericalCoords . pToV
diff --git a/src/Graphics/FieldTrip/Render.hs b/src/Graphics/FieldTrip/Render.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/Render.hs
@@ -0,0 +1,53 @@
+{-# OPTIONS_GHC -Wall #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FieldTrip.Render
+-- Copyright   :  (c) Conal Elliott 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net
+-- Stability   :  experimental
+-- 
+-- Misc rendering-related
+----------------------------------------------------------------------
+
+module Graphics.FieldTrip.Render
+  (
+    ErrorBound, MaterialTrans
+  , GContext(..), defaultGC, onErr
+  , enableNormals
+  , Renderer
+  ) where
+
+
+import Graphics.FieldTrip.Misc (R,Unop)
+import Graphics.FieldTrip.Material (Material)
+import Graphics.FieldTrip.Color (Col)
+
+-- | For use in dynamically approximating curved surfaces
+type ErrorBound = R
+
+-- | A transformation on materials.  Accumulated during rendering.
+type MaterialTrans = Unop Material
+
+-- | Rendering context for geometry
+data GContext = GC { gcErr        :: ErrorBound
+		   , gcMaterialTrans :: MaterialTrans 
+		   , gcNormals    :: Maybe Col
+		   }
+
+-- | Default graphics context
+defaultGC :: GContext
+defaultGC = GC { gcErr = 0.01, gcMaterialTrans = id, gcNormals = Nothing }
+
+-- | Modify the error-bound in a 'GContext'
+onErr :: Unop ErrorBound -> Unop GContext
+onErr f gc = gc { gcErr = f (gcErr gc) }
+
+
+-- | Turn on visible normals.
+enableNormals :: Col -> GContext -> GContext
+enableNormals col gc = gc { gcNormals = Just col }
+
+-- | renderer
+type Renderer = GContext -> IO ()
diff --git a/src/Graphics/FieldTrip/Transform.hs b/src/Graphics/FieldTrip/Transform.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/Transform.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
+{-# OPTIONS_GHC -Wall #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Transform
+-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net, andygill@ku.edu
+-- Stability   :  experimental
+-- 
+-- General transform class
+----------------------------------------------------------------------
+
+module Graphics.FieldTrip.Transform (Transform(..), Invertible(..)) where
+
+import Control.Arrow ((***))
+-- import Control.Applicative (liftA2)
+
+infixr 7 *%         -- transform application
+
+-- | General transform class
+class Transform xf a where
+  -- | Transform a value
+  (*%) ::  xf -> a -> a
+
+
+instance (Transform xf a, Transform xf b) => Transform xf (a,b) where
+  (*%) xf = (*%) xf *** (*%) xf
+
+-- Alternative definitions:
+--   xf *% (a,b) = (xf *% a, xf *% b)
+--   (*%) = liftA2 (***) (*%) (*%)
+
+instance (Transform xf a, Transform xf b, Transform xf c)
+    => Transform xf (a,b,c) where
+  xf *% (a,b,c) = (xf *% a, xf *% b, xf *% c)
+
+instance (Transform xf a, Transform xf b, Transform xf c, Transform xf d)
+    => Transform xf (a,b,c,d) where
+  xf *% (a,b,c,d) = (xf *% a, xf *% b, xf *% c, xf *% d)
+
+-- | Invertible transformations
+class Invertible xf where
+  inverse :: xf -> xf
+
+instance (Invertible xf, Transform xf a, Transform xf b)
+    => Transform xf (a -> b) where
+  xf *% f = (xf *%) . f . (inverse xf *%)
+
diff --git a/src/Graphics/FieldTrip/Transform2.hs b/src/Graphics/FieldTrip/Transform2.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/Transform2.hs
@@ -0,0 +1,74 @@
+----------------------------------------------------------------------
+-- |
+-- Module      :  Transform2
+-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net, andygill@ku.edu
+-- Stability   :  experimental
+-- 
+-- 3D transforms
+----------------------------------------------------------------------
+
+module Graphics.FieldTrip.Transform2 
+  (
+    Transform2
+  , translate2, rotate2, scale2, uscale2
+  , tweakMatrix2, tweakError2
+  , toT3
+  ) where
+
+import Data.Monoid
+
+import Graphics.Rendering.OpenGL.GL.CoordTrans
+
+import Data.VectorSpace (AdditiveGroup)
+
+import Graphics.FieldTrip.Vector2
+import Graphics.FieldTrip.Vector3
+import Graphics.FieldTrip.Transform
+import Graphics.FieldTrip.Transform3
+import Graphics.FieldTrip.Render (ErrorBound)
+
+-- | 3D affine transform
+newtype Transform2 s = T2 { toT3 :: Transform3 s }
+
+instance (Fractional s, AdditiveGroup s) => Invertible (Transform2 s) where
+  inverse (T2 xf3) = T2 (inverse xf3)
+
+-- | Translation (motion) in 3D
+translate2 :: Num s => Vector2 s -> Transform2 s
+translate2 (Vector2 dx dy) = T2 (translate3 (Vector3 dx dy 0))
+
+-- | Rotation in 3D, with angle @theta@ in radians.
+rotate2 :: Num s => s -> Transform2 s
+rotate2 theta = T2 (rotate3 theta zVector3)
+
+-- | Scaling in 3D
+scale2 :: Num s => s -> s -> Transform2 s
+scale2 sx sy = T2 (scale3 sx sy 1)
+
+-- | Uniform scale in 2D.
+uscale2 :: Num s => s -> Transform2 s
+uscale2 s = scale2 s s
+
+instance Monoid (Transform2 s) where
+  mempty  = T2 mempty
+  T2 o `mappend` T2 i = T2 (o `mappend` i)
+
+-- TODO: optimize mappend
+
+-- instance Transform (Transform2 s) (Point2 s) where
+--   xf *% p = ...
+
+-- instance Transform (Transform2 s) (Vector2 s) where
+--   xf *% p = ...
+
+-- | Change the matrix state, according to the given transform.
+tweakMatrix2 :: (Floating s, MatrixComponent s) => Transform2 s -> IO ()
+tweakMatrix2 = tweakMatrix3 . toT3
+
+-- | Change the required upper error bound, to one that applies before
+-- transforming.  Hack for now.
+tweakError2 :: (Real s, Fractional s) => Transform2 s -> ErrorBound -> ErrorBound
+tweakError2 = tweakError3 . toT3
diff --git a/src/Graphics/FieldTrip/Transform3.hs b/src/Graphics/FieldTrip/Transform3.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/Transform3.hs
@@ -0,0 +1,102 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}
+{-# OPTIONS_GHC -Wall #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FieldTrip.Transform3
+-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net, andygill@ku.edu
+-- Stability   :  experimental
+-- 
+-- 3D transforms
+----------------------------------------------------------------------
+
+module Graphics.FieldTrip.Transform3
+  (
+    Transform3(..)
+  , translate3, rotate3, scale3, uscale3
+  , tweakMatrix3, tweakError3
+  ) where
+
+import Data.Monoid
+
+import Data.VectorSpace (AdditiveGroup,negateV)
+import Graphics.Rendering.OpenGL
+
+import Graphics.FieldTrip.Vector3
+import Graphics.FieldTrip.Render (ErrorBound)
+
+import Graphics.FieldTrip.Transform
+
+-- | 3D affine transform
+data Transform3 s =
+    Identity3
+  | Translate3 (Vector3 s)
+  | Rotate3    s (Vector3 s)            -- ^ angle (radians) and axis
+  | Scale3     s s s
+  | Compose3   (Transform3 s) (Transform3 s) -- outer and inner
+  deriving (Eq,Show)
+
+instance (Fractional s, AdditiveGroup s) => Invertible (Transform3 s) where
+  inverse Identity3 = Identity3
+  inverse (Translate3 v) = Translate3 (negateV v)
+  inverse (Rotate3 a axis) = Rotate3 (-a) axis
+  inverse (Scale3 r s t) = Scale3 (recip r) (recip s) (recip t)
+  inverse (Compose3 outer inner) =
+    Compose3 (inverse inner) (inverse outer)
+
+-- | Translation (motion) in 3D
+translate3 :: Vector3 s -> Transform3 s
+translate3 = Translate3
+
+-- | Rotation in 3D, with angle in radians.
+rotate3 :: s -> Vector3 s -> Transform3 s
+rotate3 = Rotate3
+
+-- | Scaling in 3D
+scale3 :: s -> s -> s -> Transform3 s
+scale3 = Scale3
+
+-- | Uniform scale in 3D.
+uscale3 :: s -> Transform3 s
+uscale3 s = scale3 s s s
+
+instance Monoid (Transform3 s) where
+  mempty  = Identity3
+  mappend = Compose3
+
+
+-- TODO: optimize mappend
+
+-- instance Transform (Transform3 s) (Point3 s) where
+--   xf *% p = ...
+
+-- instance Transform (Transform3 s) (Vector3 s) where
+--   xf *% v = ...
+
+-- instance Transform (Transform3 s) (Normal3 s) where
+--   xf *% n = ...
+
+
+-- | Change the matrix state, according to the given transform.
+tweakMatrix3 :: (Floating s, MatrixComponent s) => Transform3 s -> IO ()
+tweakMatrix3 Identity3        = return ()
+tweakMatrix3 (Translate3 vec) = translate vec
+tweakMatrix3 (Rotate3 r vec ) = rotate (r * (180/pi)) vec
+tweakMatrix3 (Scale3  x y z ) = scale x y z
+tweakMatrix3 (Compose3 o i)   = tweakMatrix3 o >> tweakMatrix3 i
+
+-- Error bounds.  Needs to be worked through carefully.  My treatment
+-- doesn't yet consider the effect of perspective viewing on Translate3,
+-- which is considerable.
+
+-- | Change the required upper error bound, to one that applies before
+-- transforming.  Hack for now.
+tweakError3 :: (Real s, Fractional s) => Transform3 s -> ErrorBound -> ErrorBound
+tweakError3 (Scale3  x y z ) = (/ toBound (abs x `max` abs y `max` abs z))  -- guess
+tweakError3 (Compose3 o i)   = tweakError3 o . tweakError3 i
+tweakError3 _                = id
+
+toBound :: (Real s, Fractional s) => s -> ErrorBound
+toBound = fromRational . toRational
diff --git a/src/Graphics/FieldTrip/Vector2.hs b/src/Graphics/FieldTrip/Vector2.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/Vector2.hs
@@ -0,0 +1,119 @@
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses
+           , UndecidableInstances, TypeOperators, TypeSynonymInstances
+           , TypeFamilies
+  #-}
+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}  -- Vector2
+----------------------------------------------------------------------
+-- |
+-- Module      :  Vector2
+-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net, andygill@ku.edu
+-- Stability   :  experimental
+-- 
+-- Vectors in 2D.  Uses the OpenGL 'Vector2' type, for convenience and
+-- efficiency.
+----------------------------------------------------------------------
+
+module Graphics.FieldTrip.Vector2 
+  (
+   Vector2(..), vector2x, vector2y
+  , xVector2, yVector2
+  , vector2Polar
+  , vector2PolarCoords
+  , vector2D, unvector2D
+  ) where
+
+import Control.Applicative
+
+import Graphics.Rendering.OpenGL.GL.CoordTrans (Vector2(..))
+
+import Data.VectorSpace
+import Data.MemoTrie
+import Data.Basis
+import Data.Derivative
+import Data.Cross
+
+-- | The unit vector in the positive X direction.
+xVector2 :: Num s => Vector2 s
+xVector2 = Vector2 1 0
+
+-- | The unit vector in the positive Y direction.
+yVector2 :: Num s => Vector2 s
+yVector2 = Vector2 0 1
+
+vector2x, vector2y :: Vector2 s -> s
+vector2x (Vector2 x _) = x
+vector2y (Vector2 _ y) = y
+
+-- | Vector from polar coordinates.  See also 'vector2PolarCoords'.
+vector2Polar :: Floating s => s -> s -> Vector2 s
+vector2Polar rho theta = Vector2 (rho * cos theta) (rho * sin theta)
+
+-- | Polar coordinates of a vector.  See also 'vector2Polar'.
+vector2PolarCoords :: (InnerSpace s s, Floating s) => Vector2 s -> (s,s)
+vector2PolarCoords v@(Vector2 x y) = (rho, theta)
+ where
+   rho   = magnitude v
+   theta = atan (y/x)  -- in case (==) is not defined, as in (a:>b)
+           -- if x == 0 then 0 else atan (y/x)
+
+
+instance Functor Vector2 where
+  fmap f (Vector2 x y)          = Vector2 (f x) (f y)
+
+instance Applicative Vector2 where
+  pure x                        = Vector2 x x
+  Vector2 f g <*> Vector2 x y   = Vector2 (f x) (g y)
+
+
+-- TODO: is UndecidableInstances still necessary?
+
+instance AdditiveGroup u => AdditiveGroup (Vector2 u) where
+  zeroV                         = Vector2 zeroV zeroV
+  Vector2 u v ^+^ Vector2 u' v' = Vector2 (u^+^u') (v^+^v')
+  negateV (Vector2 u v)         = Vector2 (negateV u) (negateV v)
+
+instance (VectorSpace u s) => VectorSpace (Vector2 u) s where
+  s *^ Vector2 u v            = Vector2 (s*^u) (s*^v)
+
+instance (InnerSpace u s, AdditiveGroup s)
+    => InnerSpace (Vector2 u) s where
+  Vector2 u v <.> Vector2 u' v' = u<.>u' ^+^ v<.>v'
+
+instance HasBasis u s => HasBasis (Vector2 u) s where
+  type Basis (Vector2 u) = Basis (u,u)
+  basisValue             = toV2 . basisValue
+  decompose              = decompose  . fromV2
+  decompose'             = decompose' . fromV2
+
+toV2 :: (u,u) -> Vector2 u
+toV2 (u,v) = Vector2 u v
+
+fromV2 :: Vector2 u -> (u,u)
+fromV2 (Vector2 u v) = (u,v)
+
+
+instance Num s => HasCross2 (Vector2 s) where
+  cross2 (Vector2 x y) = Vector2 (-y) x  -- or @Vector2 (-y) x@?
+
+
+-- instance (Num s, LMapDom s s) => HasNormal (s :> Vector2 s) where
+--   normalVec v = cross2 (derivativeAt v 1)
+
+instance HasNormal (Float :> Vector2 Float) where
+  normalVec v = cross2 (derivative v `untrie` ())
+
+-- instance HasNormal (One Double :> Two Double) where
+--   normalVec v = cross2 (derivative v `untrie` ())
+
+
+
+vector2D :: (HasBasis a s, HasTrie (Basis a), VectorSpace s s) =>
+            Two (a :> s) -> a :> (Vector2 s)
+vector2D (u,v) = liftD2 Vector2 u v
+
+unvector2D :: (HasBasis a s, HasTrie (Basis a), VectorSpace s s) =>
+              a :> (Vector2 s) -> Two (a :> s)
+unvector2D d = (vector2x <$>> d, vector2y <$>> d)
diff --git a/src/Graphics/FieldTrip/Vector3.hs b/src/Graphics/FieldTrip/Vector3.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/Vector3.hs
@@ -0,0 +1,179 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts
+           , UndecidableInstances, TypeOperators
+           , TypeFamilies, TypeSynonymInstances
+  #-}
+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
+----------------------------------------------------------------------
+-- |
+-- Module      :  Vector3
+-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net, andygill@ku.edu
+-- Stability   :  experimental
+-- 
+-- Vectors in 3D.  Uses the OpenGL 'Vector3' type, for convenience and
+-- efficiency.
+----------------------------------------------------------------------
+
+module Graphics.FieldTrip.Vector3 
+  (
+   Vector3(..)
+  , xVector3, yVector3, zVector3
+  , vector3x, vector3y, vector3z
+  , vector3Spherical
+  , vector3SphericalCoords
+  , vector3D, unvector3D, cross3
+  ) where
+
+import Control.Applicative
+
+import Graphics.Rendering.OpenGL (Vector3(..))
+
+import Data.VectorSpace
+import Data.MemoTrie
+import Data.Basis
+import Data.Derivative
+import Data.Cross
+
+import Graphics.FieldTrip.Vector2
+
+-- type V3 = Vector3 Double
+
+-- | The unit vector in the positive X direction.
+xVector3 :: Num s => Vector3 s
+xVector3 = Vector3 1 0 0
+
+-- | The unit vector in the positive Y direction.
+yVector3 :: Num s => Vector3 s
+yVector3 = Vector3 0 1 0
+
+-- | The unit vector in the positive Z direction.
+zVector3 :: Num s => Vector3 s
+zVector3 = Vector3 0 0 1
+
+vector3x, vector3y, vector3z :: Vector3 s -> s
+vector3x (Vector3 x _ _) = x
+vector3y (Vector3 _ y _) = y
+vector3z (Vector3 _ _ z) = z
+
+-- vector3RectCoords :: Vector3 -> (R,R,R)
+-- vector3RectCoords (Vector3 x y z) = (x,y,z)
+
+-- | Vector from spherical coordinates.  See also 'vector2SphericalCoords'.
+vector3Spherical :: Floating s => s -> s -> s -> Vector3 s
+vector3Spherical rho theta phi =
+  Vector3 (rho * sinPhi * cosTheta)
+          (rho * sinPhi * sinTheta)
+          (rho * cosPhi)
+ where
+   cosTheta = cos theta; cosPhi = cos phi
+   sinTheta = sin theta; sinPhi = sin phi 
+
+-- | Spherical coordinates of a vector.  See also 'vector2Spherical'.
+vector3SphericalCoords :: (InnerSpace s s, Floating s) => Vector3 s -> (s,s,s)
+vector3SphericalCoords v@(Vector3 x y z) = (rho, theta, phi)
+ where
+   rho   = magnitude v
+   theta = atan (y/x)  -- in case (==) is not defined, as in (a:>b)
+           -- if x == 0 then 0 else atan (y/x)
+   phi   = acos (z / rho)
+
+instance Functor Vector3 where
+  fmap f (Vector3 x y z) = Vector3 (f x) (f y) (f z)
+
+instance Applicative Vector3 where
+  pure x = Vector3 x x x
+  Vector3 f g h <*> Vector3 x y z = Vector3 (f x) (g y) (h z)
+
+
+instance AdditiveGroup u => AdditiveGroup (Vector3 u) where
+  zeroV                   = Vector3 zeroV zeroV zeroV
+  Vector3 u v w ^+^ Vector3 u' v' w'
+                          = Vector3 (u^+^u') (v^+^v') (w^+^w')
+  negateV (Vector3 u v w) = Vector3 (negateV u) (negateV v) (negateV w)
+
+instance VectorSpace u s => VectorSpace (Vector3 u) s where
+  s *^ Vector3 u v w    = Vector3 (s*^u) (s*^v) (s*^w)
+
+instance (InnerSpace u s, AdditiveGroup s)
+    => InnerSpace (Vector3 u) s where
+  Vector3 u v w <.> Vector3 u' v' w' = u<.>u' ^+^ v<.>v' ^+^ w<.>w'
+
+instance HasBasis u s => HasBasis (Vector3 u) s where
+  type Basis (Vector3 u) = Basis (u,u,u)
+  basisValue             = toV3 . basisValue
+  decompose              = decompose  . fromV3
+  decompose'             = decompose' . fromV3
+
+toV3 :: (u,u,u) -> Vector3 u
+toV3 (u,v,w) = Vector3 u v w
+
+fromV3 :: Vector3 u -> (u,u,u)
+fromV3 (Vector3 u v w) = (u,v,w)
+
+instance ( Num s, VectorSpace s s
+         , HasBasis s s, HasTrie (Basis s), Basis s ~ () )
+         => HasNormal (Vector2 s :> Vector3 s) where
+  normalVec v = d (Left ()) `cross3` d (Right ())
+   where
+     d = untrie (derivative v)
+
+-- Above doesn't seem to work in ghc 6.8.  So use explicit instances for
+-- 'Float' & 'Double'.  Revisit.
+
+-- instance HasNormal (Vector2 Float :> Vector3 Float) where
+--   normalVec v = d (Left ()) `cross3` d (Right ())
+--    where
+--      d = untrie (derivative v)
+
+-- instance HasNormal (Vector2 Double :> Vector3 Double) where
+--   normalVec v = d (Left ()) `cross3` d (Right ())
+--    where
+--      d = untrie (derivative v)
+
+instance Num s => HasCross3 (Vector3 s) where
+  Vector3 ax ay az `cross3` Vector3 bx by bz =
+    Vector3 (ay * bz - az * by)
+            (az * bx - ax * bz)
+            (ax * by - ay * bx)
+
+-- instance (Num s, VectorSpace s s) => HasCross (Vector3 (Vector2 s :> s)) where
+--   cross = unvector3F . cross . vector3F
+
+-- vector3F :: (Applicative f) => Vector3 (f s) -> f (Vector3 s)
+-- vector3F (Vector3 u v w) = liftA3 Vector3 u v w
+
+-- unvector3F :: (Functor f) => f (Vector3 s) -> Vector3 (f s)
+-- unvector3F d = Vector3 (vector3x <$> d) (vector3y <$> d) (vector3z <$> d)
+
+-- instance (Num s, LMapDom s s) => HasNormal (Three (Vector2 s :> s)) where
+--   normalVec = unvector3D . normalVec . vector3D
+
+-- instance ( Num s, VectorSpace s s, HasBasis s s, HasTrie (Basis s)
+--          , HasNormal (Vector2 s :> Vector3 s)
+--          , HasBasis (Vector2 s) s, HasTrie (Basis (Vector2 s)))
+--          => HasNormal (Vector3 (Vector2 s :> s)) where
+--   normalVec v = d (Left ()) `cross3` d (Right ())
+--    where
+--      d = untrie (derivative v)
+
+-- instance (Num s, VectorSpace s s, HasBasis s s, HasTrie (Basis s)) =>
+--          HasNormal (Three (Vector2 s :> s)) where
+--   normalVec = unvector3D . normalVec . vector3D
+
+-- sigh.  try the instance above when we're on ghc-6.9
+
+instance HasNormal (Three (Vector2 Float :> Float)) where
+  normalVec = unvector3D . normalVec . vector3D
+
+instance HasNormal (Three (Vector2 Double :> Double)) where
+  normalVec = unvector3D . normalVec . vector3D
+
+vector3D :: (VectorSpace s s, HasTrie (Basis a)) =>
+            Three (a :> s) -> a :> (Vector3 s)
+vector3D (u,v,w) = liftD3 Vector3 u v w
+
+unvector3D :: (VectorSpace s s, HasTrie (Basis a)) =>
+              a :> (Vector3 s) -> Three (a :> s)
+unvector3D d = (vector3x <$>> d, vector3y <$>> d, vector3z <$>> d)
diff --git a/src/Graphics/FieldTrip/Vertex.hs b/src/Graphics/FieldTrip/Vertex.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/FieldTrip/Vertex.hs
@@ -0,0 +1,61 @@
+----------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FieldTrip.Vertex
+-- Copyright   :  (c) Conal Elliott 2008
+-- License     :  BSD3
+-- 
+-- Maintainer  :  conal@conal.net
+-- Stability   :  experimental
+-- 
+-- Experiment with vertex specs
+----------------------------------------------------------------------
+
+-- I'm torn about using this coding trick.  HOpenGL has a 'Vertex'
+-- class.  I added instances for normals and colors, and for pairs.  Then
+-- surfaces over any nested pairing of such things can be rendered.
+-- Moreover, one can do interpolation and differentiation generically, if
+-- the components support those operations.  However, it's not really
+-- safe, given the order-sensitivity of processing of these components, and
+-- specifically that the real vertex must come last.  Perhaps provide a
+-- type of vertex-with-adornment, and give it a 'VectorSpace' instance.  I
+-- could play the tuple game on the adornments.  Even represent the
+-- vertex-with-adornment as a newtype around a pair, deriving the
+-- 'VectorSpace' instance.
+
+
+module Graphics.FieldTrip.Vertex where
+
+import Graphics.Rendering.OpenGL
+
+
+-- Pairs as vertices, processed left-to-right.
+-- The real vertex then must be given last!
+
+instance (Vertex v, Vertex v') => Vertex (v,v')
+  where
+    vertex (v,v') = vertex v >> vertex v'
+    vertexv = error "vertexv: undefined on pairs"
+
+
+newtype NormalV n = NormalV n
+
+instance Normal n => Vertex (NormalV n)
+  where
+    vertex (NormalV n) = normal n
+    vertexv = error "vertexv: undefined on NormalV"
+
+
+newtype ColorV n = ColorV n
+
+instance Color n => Vertex (ColorV n)
+  where
+    vertex (ColorV n) = color n
+    vertexv = error "vertexv: undefined on ColorV"
+
+
+-- The pairing trick provides 'VectorSpace' and 'Num' operations for free,
+-- including derivatives and interpolation.  I think we could get a lot of
+-- genericity out of this trick.
+-- 
+-- However, it's not really safe, given the order-senstivity, and
+-- specifically that the real vertex must come last.