diff --git a/Glome.hs b/Glome.hs
--- a/Glome.hs
+++ b/Glome.hs
@@ -21,20 +21,30 @@
 
 maxdepth = 3 -- recursion depth for reflection/refraction
 
--- compute ray, invoke trace function, return color
-get_color :: Flt -> Flt -> Scene -> (Scene.Color,Flt)
-get_color x y scn = 
- let (Scene sld lights (Camera pos fwd up right) dtex bgcolor) = scn
+get_rayint :: Flt -> Flt -> Scene -> (Scene.ColorA, [Tag], Rayint Tag M)
+get_rayint x y scn = 
+ let (sld, lights, (Camera pos fwd up right), shader) = scn
      dir = vnorm $ vadd3 fwd (vscale right (-x)) (vscale up y)
      ray = (Ray pos dir) 
  in
-  ((Trace.trace scn ray infinity maxdepth),0)
+    Trace.trace lights shader sld ray infinity maxdepth
 
-get_color' :: Flt -> Flt -> Scene -> (Scene.Color,Flt)
+
+get_color x y scn =
+  let (color, tags, ri) = get_rayint x y scn
+  in (color, 0)                    
+
+get_color' :: Flt -> Flt -> Scene -> (Scene.ColorA,Flt)
 get_color' x y _ =
-  (Scene.Color x y (x+y), 0)
+  (Scene.ColorA x y (x+y) 1, 0)
 
+
+get_tags x y scn =
+  let (color, tags, ri) = get_rayint x y scn
+  in tags
+
 -- compute a 2x2 packet of four rays from corners of box
+{-
 get_packet :: Flt -> Flt -> Flt -> Flt -> Scene -> PacketColor
 get_packet x1 y1 x2 y2 scn =
  let (Scene sld lights (Camera pos fwd up right) dtex bgcolor) = scn
@@ -47,6 +57,7 @@
      ray3 = Ray pos dir3
      ray4 = Ray pos dir4
  in trace_packet scn ray1 ray2 ray3 ray4 infinity maxdepth
+-}
 
 cap1 :: Flt -> Flt
 cap1 x
@@ -76,10 +87,6 @@
     else error "setPixel32 -- bad coordinate"
  where offset = y * (fromIntegral $ surfaceGetPitch surf `div` 4) + x
 
-{-
-renderTile :: Rect -> Surface -> IO ()
-renderTile (Rect xmin xmax width height) (surf = do
-  -}
 
 -- r g b debug index
 data Tile = Tile Rect (UV.Vector (Flt, Flt, Flt, Flt))
@@ -90,6 +97,7 @@
 
 -- We pass in the Rect for the whole image, and a sub-Rect for the tile
 -- we want to render.
+-- We throw away the alpha value here.
 renderTile :: Rect -> Rect -> Scene -> Tile
 renderTile (Rect _ _ width height) t@(Rect xtmin ytmin twidth theight) scene =
   let widthf = fromIntegral width
@@ -99,7 +107,7 @@
             yf = fromIntegral $ ytmin + (div i twidth)
             xcoord = (((xf/widthf)*2)-1) * (widthf/heightf)
             ycoord = -(((yf/heightf)*2)-1)
-            (Scene.Color r g b, d) = get_color xcoord ycoord scene
+            (ColorA r g b _, d) = get_color xcoord ycoord scene
             --(r,g,b,d) = (0.5, 0, 0, 0)
         in
           (r, g, b, d)
@@ -156,19 +164,39 @@
           heightf = fromIntegral height
           xcoord = (((xf/widthf)*2)-1) * (widthf/heightf)
           ycoord = -(((yf/heightf)*2)-1)
-          (Scene.Color r g b, d) = get_color xcoord ycoord scene
+          (ColorA r g b _, d) = get_color xcoord ycoord scene
       in
         do _ <- fillRect surf (Just (Rect x y 1 1)) (rgbf r g b)
            return ()
                        )
                      )
 
-quitHandler :: IO ()
-quitHandler = do
-  e <- waitEvent
+getTags' x y scn =
+  let xf = fromIntegral $ x
+      yf = fromIntegral $ y
+      widthf = fromIntegral xres
+      heightf = fromIntegral yres
+      xcoord = (((xf/widthf)*2)-1) * (widthf/heightf)
+      ycoord = -(((yf/heightf)*2)-1)
+  in  
+      get_tags xcoord ycoord scn
+
+runHandler :: Scene -> IO ()
+runHandler scn = do
+  e <- pollEvent
+  --e <- waitEvent
   case e of
     Quit -> return ()
-    otherwise -> quitHandler
+    MouseButtonUp x y ButtonLeft ->
+      do let ts = getTags' x y scn
+         print $ (show x) ++ " " ++ (show y) ++ ":"
+         forM_ ts print
+         runHandler scn
+    NoEvent ->
+      do delay 50
+         runHandler scn
+    otherwise -> 
+      runHandler scn
 
 main = do
   SDL.init [InitVideo, InitTimer, InitJoystick]
@@ -179,9 +207,9 @@
   img <- createRGBSurface [HWSurface] xres yres 32 0 0 0 0
 
   setupt1 <- getPOSIXTime
-  scene <- TestScene.scn
+  scene@(geom, _, _, _) <- TestScene.scn
 
-  print $ "(primitives,transforms,bounding objects): " ++ (show (primcount_scene scene))
+  print $ "(primitives,transforms,bounding objects): " ++ (show (primcount geom))
   setupt2 <- getPOSIXTime
   print $ "scene setup: " ++ (show (setupt2-setupt1))
 
@@ -197,4 +225,4 @@
   blitt2 <- getPOSIXTime
   print $ "blit: " ++ (show (blitt2-blitt1))
 
-  quitHandler
+  runHandler scene
diff --git a/GlomeView.cabal b/GlomeView.cabal
--- a/GlomeView.cabal
+++ b/GlomeView.cabal
@@ -1,5 +1,5 @@
 Name:                GlomeView
-Version:             0.2
+Version:             0.3
 Synopsis:            SDL Frontend for Glome ray tracer
 Description:         Ray Tracer capable of rendering a variety of primitives,
                      with support for CSG (difference and intersection of solids),
@@ -23,4 +23,4 @@
   Main-Is:        Glome.hs
   ghc-options: -O2 -threaded
   extensions:          BangPatterns
-  Build-Depends:       base >= 4 && < 5, time, monad-par, deepseq, random, vector, GlomeVec, GlomeTrace, SDL
+  Build-Depends:       base >= 4 && < 5, time, monad-par, deepseq, random, vector, GlomeVec >= 0.2, GlomeTrace >= 0.2, SDL
diff --git a/TestScene.hs b/TestScene.hs
--- a/TestScene.hs
+++ b/TestScene.hs
@@ -1,11 +1,19 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module TestScene (scn) where
+module TestScene (scn, Scene, Tag, T, M, SI) where
 import Data.Glome.Scene
 import Data.List hiding (group)
 import Data.Glome.Texture
+import Data.Glome.Shader
+import Data.Glome.Trace
 import System.Random
 
+type Tag   = String
+type T     = Texture Tag M
+type M     = Material Tag
+type SI    = SolidItem Tag M
+type Scene = (SI, [Light], Camera, Shader Tag M [Light] [(Color, Vec)])
+
 lights = [ light (Vec (-100) 70 (140)) (cscale (Color 1 0.8 0.8) 7000)
          , light (Vec (-3) 5 8) (cscale (Color 1.5 2 2) 10)
          ] 
@@ -32,7 +40,7 @@
                            z <- grrcp]
      pln x = (plane_offset (vnorm x) (r+(vdot (vnorm x) pos)))
  in
-  intersection ((sphere pos (1.26*r)):(map pln points))
+  tag (intersection ((sphere pos (1.26*r)):(map pln points))) "icosahedron"
 
 dodecahedron pos r =
  let gr = (1+(sqrt 5))/2 -- golden ratio, 1.618033988749895
@@ -43,7 +51,7 @@
               [Vec x y 0 | x <- n11, y <- ngrgr]
      pln x = (plane_offset (vnorm x) (r+(vdot (vnorm x) pos)))
  in
-  intersection ((sphere pos (1.26*r)):(map pln points))
+  tag (intersection ((sphere pos (1.26*r)):(map pln points))) "dodecahedron"
 
 spiral = [ ((Vec ((sin (rot n))*n) 
                  ((cos (rot n))*n) 
@@ -55,10 +63,9 @@
                     spiral 
                     (tail spiral))
 
-
 -- we branch once per year
 -- not really a plausible oak, but it's getting there
-oak :: Flt -> StdGen -> SolidItem
+oak :: Flt -> StdGen -> SI
 oak age rng = 
  if age < 0 
  then nothing
@@ -100,7 +107,7 @@
                                                                  (rotate (Vec 0 1 0) (deg 30)),
                                                                  (translate (Vec 0 seglen 0))]
                            ])
-  in tex (bih (tolist (SolidItem (flatten_transform (tree year rng))))) (t_matte (Color 0.8 0.5 0.4)) 
+  in tag (tex (bih (tolist (SolidItem (flatten_transform (tree year rng))))) (t_matte (Color 0.8 0.5 0.4))) "tree"
 
 sphereint = intersection [ (sphere (Vec (-1) 0 0) 2), 
                            (sphere (Vec 1 0 0) 2),
@@ -133,7 +140,7 @@
 chessboard =
   group
    [tex
-      (box (vec (x-(1/2)) (-1) (z-(1/2)))
+      (box (vec (x-(1/2)) (-3) (z-(1/2)))
            (vec (x+(1/2)) (f x z) (z+(1/2))))
       (tf x z) | x <- [(-3.5)..3.5], z <- [(-3.5)..3.5]]
   where
@@ -142,8 +149,39 @@
             then t_shiny_white
             else t_mottled
 
+portal height width thickness =
+  let frame =
+        tag 
+          (tex
+            (difference
+              (box (vec (-width) 0 (-thickness))
+                   (vec width height thickness))
+
+              (box (vec (thickness-width) (thickness) (-(thickness+delta)))
+                   (vec (width-thickness) (height-thickness) (thickness+delta))))
+            (t_matte (Color 0.4 0.4 0.8)))
+        "door frame"
+
+      surface =
+        (box (vec (-width) 0 (-delta))
+             (vec (width) (height-delta) delta))
+
+      xfm ray@(Ray origin dir) (RayHit depth pos norm _ _ _ _) =
+        xfm_ray (compose [ rotate vx (deg (-85))
+                         , translate (vec (8) 40 (-4))
+                         ])
+                (Ray pos (vnorm dir))
+
+
+        --Ray (vadd pos (vec 0 15 0)) (vrotate pos (Ray pos vx) (deg 90))
+
+  in group [frame,
+            tex surface (t_uniform (Warp frame geom'' lights xfm))]
+                    
+
+
 geom'' =
-  group
+  bih
    [ difference (transform chessboard [scale (vec 2 1.2 2)]) (tex (sphere (vec 4 1.5 3) 3.5) t_shiny_white)
    , tex (dodecahedron (vec (-6) 3 0) 1) t_stripe
    , tex (transform (icosahedron (Vec 4 1.5 3) 1.5) [ rotate vz (deg 11)
@@ -152,60 +190,61 @@
    , transform (oak 11.4 (mkStdGen 42)) [ scale (Vec 2 2 2), translate (vec 2 (-1) (-8))]
    , tex (difference (transform (lattice) [rotate vz (deg 23),
                                            rotate vx (deg 43),
-                                           scale (vec 3 3 3) ]) (sphere (vec 0 0 0) 17)) t_shiny_red
+                                           scale (vec 3 3 3) ]) (sphere (vec 0 0 0) 32)) t_shiny_red
+   , transform (portal 5 2 (1/3)) [ rotate vy (deg 8)
+                                  , translate (vec (-3) 0.5 (-5))]
    ]
 
 
 -- some textures
-m_shiny_white :: Material
-m_shiny_white = (Material c_white 0.3 0 0 0.7 0.8 10)
+m_shiny_white :: M
+m_shiny_white = (Surface c_white 1 0.2 0.8 0.4 10 False)
 
-m_shiny_red = (Material c_red 0.3 0 0 0.7 0.8 10)
+m_shiny_red = (Surface c_red 1 0.2 0.8 0.4 10 False)
 
-t_shiny_white :: Texture
-t_shiny_white ri = m_shiny_white
+t_shiny_white :: T
+t_shiny_white _ _ = m_shiny_white
 
-t_shiny_red _ = m_shiny_red
+t_shiny_red _ _ = m_shiny_red
 
-m_dull_gray :: Material
-m_dull_gray = (Material (Color 0.4 0.3 0.35) 0 0 0 0.2 0 1)
+m_dull_gray :: M
+m_dull_gray = (Surface (Color 0.4 0.3 0.35) 1 0.2 0.8 0 0 False)
 
-t_mottled (RayHit _ pos norm _) =
+t_mottled _ (RayHit _ pos norm _ _ _ _) =
  --let scale = (stripe (Vec 1 1 1) sine_wave) pos
  let scale = perlin (vscale pos 3)
- in if scale < 0 then error "foo"
+ in if scale < 0 then error "perlin under range"
     else if scale > 1 
-         then error "bar"
-         else m_interp m_mirror (m_matte (Color 0.15 0.3 0.5)) scale
+         then error "perlin over range"
+         else Blend m_mirror (m_matte (Color 0.15 0.3 0.5)) scale
 
 --shouldn't happen
-t_mottled RayMiss = m_shiny_white
+t_mottled _ RayMiss = m_shiny_white
 
-t_stripe (RayHit _ pos norm _) =
+t_stripe :: T
+t_stripe _ (RayHit _ pos norm _ _ _ _) =
  let scale = (stripe (Vec 4 8 5) triangle_wave) pos
- in if scale < 0 then error "foo"
+ in if scale < 0 then error "perlin under range"
     else if scale > 1 
-         then error "bar"
-         else m_interp m_shiny_white m_dull_gray scale
+         then error "perlin over range"
+         else Blend m_shiny_white m_dull_gray scale
 
 --shouldn't happen
-t_stripe RayMiss = m_shiny_white 
+t_stripe _ RayMiss = m_shiny_white 
 
-m_matte :: Color -> Material
-m_matte c = (Material c 0 0 0 1 0 2)
+m_matte :: Color -> M
+m_matte c = (Surface c 1 0.2 1 0 0 False)
 
-t_matte :: Color -> Texture
+t_matte :: Color -> T
 t_matte c = 
- (\ri -> (Material c 0 0 0 1 0 2)) 
+ (\_ _ -> m_matte c)
 
-m_mirror = (Material (Color 0.8 0.8 1) 1 0 0 0.2 0.8 1000)
+m_mirror = (Reflect 0.8)
 t_mirror = 
- (\ri -> m_mirror)
+ (\_ _ -> m_mirror)
 
 c_sky = (Color 0.4 0.5 0.8)
 
 scn :: IO Scene
-scn = return (Scene geom''
-                    lights cust_cam 
-                    (t_matte (Color 0.6 0.5 0.4)) 
-                    (Color 0.2 0.2 0.2))
+scn = return (geom'', lights, cust_cam, materialShader)
+