diff --git a/src/Picture.hs b/src/Picture.hs
index d216ec0b4..8f0f26bac 100644
--- a/src/Picture.hs
+++ b/src/Picture.hs
@@ -1,373 +1,13 @@
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE BangPatterns  #-}
+--{-# LANGUAGE TupleSections #-}
+--{-# LANGUAGE BangPatterns  #-}
 module Picture
     ( module Picture.Data
+    , module Picture.Base
+    , module Picture.Composite
     , module Color
-    , blank
-    , polygon
-    , polygonWire
-    , polygonZ
-    , polygonCol
-    , poly3
-    , poly3Col
-    , bezierQuad
-    , arc
-    , arcSolid
-    , thickArc
-    , thickCircle
-    , thickLine
-    , lineThick
-    , thickLineCol
-    , circleSolid
-    , circleSolidCol
-    , circle
-    , line
-    , lineCol
-    , text
-    , centerText
-    , stackText
-    , pictures
-    , concatMapPic
-    , appendPic
-    , tranRot
-    , translate
-    , translate3
-    , rotate
-    , scale
-    , color
-    , zeroZ
-    , setDepth
-    , addDepth
-    , setLayer
-    , mirroryz
-    , mirrorxz
     )
   where
-import Geometry
 import Picture.Data
+import Picture.Base
+import Picture.Composite
 import Color
-
-blank :: Picture
-{-# INLINE blank #-}
-blank = []
-
-polygonWire :: [Point2] -> Picture
-{-# INLINE polygonWire #-}
-polygonWire ps = line (ps ++ [head ps])
-
--- | Expects clockwise input.
-polygon :: [Point2] -> Picture
-{-# INLINE polygon #-}
-polygon = map f . polyToTris
-  where
-    f (V2 x y) = Verx (V3 x y 0) black [] BottomLayer polyNum
-
-polygonZ :: [Point2] -> Float -> Picture
-{-# INLINE polygonZ #-}
-polygonZ ps z = map (f . zeroZ) $ polyToTris ps
-  where
-    f pos = Verx pos black [z] BottomLayer polyzNum
-
-polygonCol :: [(Point2,RGBA)] -> Picture
-{-# INLINE polygonCol #-}
-polygonCol = polyToTris . map f
-  where
-    f (V2 x y,col) = Verx (V3 x y 0) col [] BottomLayer polyNum
-
-poly3 :: [Point3] -> Picture
-{-# INLINE poly3 #-}
-poly3 = poly3Col . map (, black)
-
-poly3Col :: [(Point3,RGBA)] -> Picture
-{-# INLINE poly3Col #-}
-poly3Col = map f . polyToTris
-  where
-    f (pos,col) = Verx pos col [] BottomLayer polyNum
-
--- note that much of work computing the width of the bezier curve is done here
-bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture
-bezierQuad cola colc ra rc a b c 
-    | a == b && b == c = blank
-    | a == b || b == c = bezierQuad cola colc ra rc a (0.5 *.* (a +.+ c)) c
-    | otherwise = bzhelp
-        [(aIn, cola, V2 (fa aIn) (fc aIn) , V2 1        0         )
-        ,(aIn, cola, V2 (fa aIn) (fc aIn) , V2 1        0         )
-        ,(cIn, colc, V2 (fa cIn) (fc cIn) , V2 0        1         )
-        ,( aX, cola, V2 1        0        , V2 (fa' aX) (fc' aX)  )
-        ,( cX, colc, V2 0        1        , V2 (fa' cX) (fc' cX)  )
-        ,( bX, colb, V2 0        0        , V2 (fa' bX) (fc' bX)  )
-        ,( bX, colb, V2 0        0        , V2 (fa' bX) (fc' bX)  )
-        ]
-  where 
-    colb = mixColors 0.5 0.5 cola colc
-    b2a | isLHS a b c = a -.- b
-        | otherwise   = b -.- a
-    aRadVec = 0.5 * ra *.* normalizeV (vNormal b2a)
-    aX  = a -.- aRadVec
-    aIn = a +.+ aRadVec
-    b2c | isLHS a b c = b -.- c
-        | otherwise   = c -.- b
-    cRadVec = 0.5 * rc *.* normalizeV (vNormal b2c)
-    cX  = c -.- cRadVec
-    cIn = c +.+ cRadVec
-    bRadVec = 0.25 * (ra + rc) *.* normalizeV (a +.+ b -.- 2 *.* c)
-    bX  = b +.+ bRadVec
-    bIn = b -.- bRadVec
-    fa = extrapolate aX cX bX 
-    fc = extrapolate cX aX bX
-    fa' = extrapolate aIn cIn bIn
-    fc' = extrapolate cIn aIn bIn
-
-bzhelp :: [(Point2, Point4, Point2, Point2)] -> Picture
-bzhelp = map f
-  where
-    f (V2 x y,col,V2 a b,V2 c d) = Verx (V3 x y 0) col [a,b,c,d] BottomLayer bezNum
-
--- given a one and two zeros of a linear function over x and y,
--- determine the function
--- so if f(ox,oy) = 1 and f(ax,ay) = f(bx,by) = 0, determines f
-extrapolate :: Point2 -> Point2 -> Point2 -> Point2 -> Float
-extrapolate (V2 ox oy) (V2 ax ay) (V2 bx by) (V2 x y) = 
-    (       x * ( ay - by )
-        +   y * ( bx - ax )
-        +   (ax * by - bx * ay)
-    ) 
-    / 
-    (       ox * ( ay - by )
-        +   ax * ( by - oy )
-        +   bx * ( oy - ay )
-    )
-
-color :: RGBA -> Picture -> Picture
-{-# INLINE color #-}
-color c = map $ overCol (const c)
-
-translateH :: Float -> Float -> Point3 -> Point3
-{-# INLINE translateH #-}
-translateH !a !b (V3 x y z) = V3 (x+a) (y+b) z
-
-translate :: Float -> Float -> Picture -> Picture
-{-# INLINE translate #-}
-translate x = map . overPos . translateH x
-
-translate3 :: Point3 -> Picture -> Picture
-{-# INLINE translate3 #-}
-translate3 = map . overPos . (+.+.+)
-
-tranRot :: V2 Float -> Float -> Picture -> Picture
-{-# INLINE tranRot #-}
-tranRot (V2 x y) r = map $ overPos (translateH x y . rotate3 r)
-
-setDepth :: Float -> Picture -> Picture
-{-# INLINE setDepth #-}
---setDepth d = map $ second $ overPos (\(x,y,_) -> (x,y,d))
-setDepth d = map $ overPos (\(V3 x y _) -> V3 x y d)
-
-addDepth :: Float -> Picture -> Picture
-{-# INLINE addDepth #-}
---addDepth d = map $ second $ overPos (\(x,y,z) -> (x,y,z+d))
-addDepth d = map $ overPos (\(V3 x y z) -> V3 x y (z+d))
-
--- TODO change the Int here to a dedicated type
-setLayer :: Layer -> Picture -> Picture
-{-# INLINE setLayer #-}
-setLayer i = map f
-  where
-    f v = v {_vxLayer = i}
-
-scale3 :: Float -> Float -> Point3 -> Point3
-{-# INLINE scale3 #-}
-scale3 a b (V3 x y z) = V3 (x*a) (y*b) z
-
-scale :: Float -> Float -> Picture -> Picture
-{-# INLINE scale #-}
-scale x = map . overPos . scale3 x
-
-rotate :: Float -> Picture -> Picture
-{-# INLINE rotate #-}
-rotate = map . overPos . rotate3
-
-concatMapPic :: Foldable t => (a -> Picture) -> t a -> Picture
-{-# INLINE concatMapPic #-}
-concatMapPic = concatMap
-
-appendPic :: Picture -> Picture -> Picture
-{-# INLINE appendPic #-}
-appendPic = (++)
-
-pictures :: Foldable t => t Picture -> Picture
-{-# INLINABLE pictures #-}
-pictures = concat
-
-makeArc :: Float -> Point2 -> [Point2]
-{-# INLINE makeArc #-}
-makeArc rad (V2 a b) = map (`rotateV` V2 0 rad) angles
-  where 
-    angles = [a,a+step.. b]
-    step = pi * 0.2
-
-circleSolid :: Float -> Picture
-{-# INLINE circleSolid #-}
-circleSolid = circleSolidCol white white
-
-circleSolidCol :: Color -> Color -> Float -> Picture
-{-# INLINE circleSolidCol #-}
-circleSolidCol colC colE r = map f
-    [(V3 (-r)   r  0, colC)
-    ,(V3 (-r) (-r) 0, colE)
-    ,(V3   r  (-r) 0, black)
-    ]
-  where
-    f (pos,col) = Verx pos col [] BottomLayer ellNum
-
-circle :: Float -> Picture
-{-# INLINE circle #-}
-circle rad = thickArc 0 (2*pi) rad 1
-
-centerText :: String -> Picture
-{-# INLINE centerText #-}
-centerText s = translate (50 * (negate . fromIntegral $ length s - 1)) 0 $ text s
-
-stackText :: [String] -> Picture
-{-# INLINE stackText #-}
-stackText = mconcat . zipWith (\y s -> translate 0 y $ centerText s) [0,100..]
-
-text :: String -> Picture
-{-# INLINE text #-}
-text = map f . stringToList
-  where
-    f (pos,col,V2 a b) = Verx pos col [a,b] BottomLayer textNum
-
-line :: [Point2] -> Picture
-{-# INLINE line #-}
-line = thickLine 1
-
-lineCol :: [(Point2,RGBA)] -> Picture
-{-# INLINE lineCol #-}
-lineCol = thickLineCol 1
-
-lineThick :: Float -> [Point2] -> Picture
-{-# INLINE lineThick #-}
-lineThick t = pictures . f
-  where 
-    f (x:y:ys) 
-      | x == y      = f (x:ys)
-      | otherwise   = polygon [x +.+ n x y, x -.- n x y, y -.- n x y, y +.+ n x y] : f (y:ys)
-    f _             = []
-    n a b = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b))
-
-thickLine :: Float -> [Point2] -> Picture
-{-# INLINE thickLine #-}
-thickLine t = pictures . f
-  where 
-    f (x:y:ys)
-      | x == y      = f (x:ys)
-      | otherwise   = polygon [x +.+ n, x -.- n, y -.- n, y +.+ n] : f (y:ys)
-      where
-        n = (t*0.5) *.* errorNormalizeV 42 (vNormal (x -.- y))
-    f _             = []
-
-thickLineCol :: Float -> [(Point2,RGBA)] -> Picture
-{-# INLINE thickLineCol #-}
-thickLineCol t = pictures . f
-  where 
-    f ((x,c):(y,c'):ys) 
-      | x == y      = f ((x,c):ys)
-      | otherwise   = polygonCol 
-        [(x +.+ n x y,c)
-        ,(x -.- n x y,c)
-        ,(y -.- n x y,c')
-        ,(y +.+ n x y,c')
-        ] : f ((y,c'):ys)
-    f _             = []
-    n a b = (t*0.5) *.* squashNormalizeV (vNormal (a -.- b))
-
-thickCircle :: Float -> Float -> Picture
-{-# INLINE thickCircle #-}
-thickCircle = thickArc 0 (2*pi)
-
-arcSolid
-    :: Float -- ^ Start angle
-    -> Float -- ^ End angle
-    -> Float -- ^ Radius
-    -> Picture
-{-# INLINE arcSolid #-}
-arcSolid startA endA rad = polygon $ V2 0 0 : makeArc rad (V2 startA endA)
-
-arc
-    :: Float -- ^ Start angle
-    -> Float -- ^ End angle
-    -> Float -- ^ Radius
-    -> Picture
-arc startA endA rad = thickArc startA endA rad 1
-{-# INLINE arc #-}
-
-thickArc :: Float -> Float -> Float -> Float -> Picture
-{-# INLINE thickArc #-}
-thickArc startA endA rad wdth
-    | endA - startA > (pi/ 2) = pictures 
-        [ thickArc (startA + pi/2) endA rad wdth
-        , thickArcHelp startA (startA + pi/2) r w
-        ]
-    | otherwise = thickArcHelp startA endA r w
-  where
-    r = rad + 0.5 * wdth
-    w = 1 - wdth / r
-
-thickArcHelp :: Float -> Float -> Float -> Float -> Picture
-{-# INLINE thickArcHelp #-}
-thickArcHelp startA endA rad wdth = map f
-    [  (V3 0 0 0,black,V3 0 0 wdth)
-    ,(V3 xa ya 0,black,V3 1 0 wdth)
-    ,(V3 xb yb 0,black,V3 1 1 wdth)
-    ,  (V3 0 0 0,black,V3 0 0 wdth)
-    ,(V3 xb yb 0,black,V3 1 1 wdth)
-    ,(V3 xc yc 0,black,V3 0 1 wdth)
-    ]
-  where
-    (V2 xa ya) = rotateV startA (V2 rad 0)
-    (V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * sqrt 2) 0)
-    --(V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * 2) 0)
-    (V2 xc yc) = rotateV endA (V2 rad 0)
-    f (pos,col,V3 a b c) = Verx pos col [a,b,c] BottomLayer arcNum
-
-
--- Currently the lens version is much slower
-overPos :: (Point3 -> Point3) -> Verx -> Verx
-{-# INLINE overPos #-}
---overPos = over vxPos
-overPos f vx = vx {_vxPos = f (_vxPos vx)}
-
-overCol :: (Point4 -> Point4) -> Verx -> Verx
-{-# INLINE overCol #-}
-overCol f vx = vx {_vxCol = f (_vxCol vx)}
-
--- no premature optimisation, consider changing to use texture arrays
-stringToList :: String -> [(Point3,Point4,Point2)]
-{-# INLINE stringToList #-}
-stringToList = concatMap (uncurry charToTuple) . zip [0,0.9*dimText ..]
-  where
-    dimText = 100
-
-charToTuple :: Float -> Char -> [(Point3,Point4,Point2)]
-{-# INLINE charToTuple #-}
-charToTuple x c = 
-    [(V3 (x-50) (-100) 0, white,V2 offset     1)
-    ,(V3 (x-50)   100  0, white,V2 offset     0)
-    ,(V3 (x+50)   100  0, white,V2 (offset+1) 0)
-    ,(V3 (x-50) (-100) 0, white,V2  offset    1)
-    ,(V3 (x+50) (-100) 0, white,V2 (offset+1) 1)
-    ,(V3 (x+50)   100  0, white,V2 (offset+1) 0)
-    ]
-  where 
-    offset = fromIntegral (fromEnum c) - 32
-
-mirrorxz :: Picture -> Picture
-mirrorxz = map (overPos flipy)
-  where
-    flipy (V3 x y z) = V3 x (negate y) z
-
-mirroryz :: Picture -> Picture
-mirroryz = map (overPos flipx)
-  where
-    flipx (V3 x y z) = V3 (negate x) y z
diff --git a/src/Picture/Base.hs b/src/Picture/Base.hs
new file mode 100644
index 000000000..b04e5719a
--- /dev/null
+++ b/src/Picture/Base.hs
@@ -0,0 +1,373 @@
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE BangPatterns  #-}
+module Picture.Base
+    ( module Picture.Data
+    , module Color
+    , blank
+    , polygon
+    , polygonWire
+    , polygonZ
+    , polygonCol
+    , poly3
+    , poly3Col
+    , bezierQuad
+    , arc
+    , arcSolid
+    , thickArc
+    , thickCircle
+    , thickLine
+    , lineThick
+    , thickLineCol
+    , circleSolid
+    , circleSolidCol
+    , circle
+    , line
+    , lineCol
+    , text
+    , centerText
+    , stackText
+    , pictures
+    , concatMapPic
+    , appendPic
+    , tranRot
+    , translate
+    , translate3
+    , rotate
+    , scale
+    , color
+    , zeroZ
+    , setDepth
+    , addDepth
+    , setLayer
+    , mirroryz
+    , mirrorxz
+    )
+  where
+import Geometry
+import Picture.Data
+import Color
+
+blank :: Picture
+{-# INLINE blank #-}
+blank = []
+
+polygonWire :: [Point2] -> Picture
+{-# INLINE polygonWire #-}
+polygonWire ps = line (ps ++ [head ps])
+
+-- | Expects clockwise input.
+polygon :: [Point2] -> Picture
+{-# INLINE polygon #-}
+polygon = map f . polyToTris
+  where
+    f (V2 x y) = Verx (V3 x y 0) black [] BottomLayer polyNum
+
+polygonZ :: [Point2] -> Float -> Picture
+{-# INLINE polygonZ #-}
+polygonZ ps z = map (f . zeroZ) $ polyToTris ps
+  where
+    f pos = Verx pos black [z] BottomLayer polyzNum
+
+polygonCol :: [(Point2,RGBA)] -> Picture
+{-# INLINE polygonCol #-}
+polygonCol = polyToTris . map f
+  where
+    f (V2 x y,col) = Verx (V3 x y 0) col [] BottomLayer polyNum
+
+poly3 :: [Point3] -> Picture
+{-# INLINE poly3 #-}
+poly3 = poly3Col . map (, black)
+
+poly3Col :: [(Point3,RGBA)] -> Picture
+{-# INLINE poly3Col #-}
+poly3Col = map f . polyToTris
+  where
+    f (pos,col) = Verx pos col [] BottomLayer polyNum
+
+-- note that much of work computing the width of the bezier curve is done here
+bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture
+bezierQuad cola colc ra rc a b c 
+    | a == b && b == c = blank
+    | a == b || b == c = bezierQuad cola colc ra rc a (0.5 *.* (a +.+ c)) c
+    | otherwise = bzhelp
+        [(aIn, cola, V2 (fa aIn) (fc aIn) , V2 1        0         )
+        ,(aIn, cola, V2 (fa aIn) (fc aIn) , V2 1        0         )
+        ,(cIn, colc, V2 (fa cIn) (fc cIn) , V2 0        1         )
+        ,( aX, cola, V2 1        0        , V2 (fa' aX) (fc' aX)  )
+        ,( cX, colc, V2 0        1        , V2 (fa' cX) (fc' cX)  )
+        ,( bX, colb, V2 0        0        , V2 (fa' bX) (fc' bX)  )
+        ,( bX, colb, V2 0        0        , V2 (fa' bX) (fc' bX)  )
+        ]
+  where 
+    colb = mixColors 0.5 0.5 cola colc
+    b2a | isLHS a b c = a -.- b
+        | otherwise   = b -.- a
+    aRadVec = 0.5 * ra *.* normalizeV (vNormal b2a)
+    aX  = a -.- aRadVec
+    aIn = a +.+ aRadVec
+    b2c | isLHS a b c = b -.- c
+        | otherwise   = c -.- b
+    cRadVec = 0.5 * rc *.* normalizeV (vNormal b2c)
+    cX  = c -.- cRadVec
+    cIn = c +.+ cRadVec
+    bRadVec = 0.25 * (ra + rc) *.* normalizeV (a +.+ b -.- 2 *.* c)
+    bX  = b +.+ bRadVec
+    bIn = b -.- bRadVec
+    fa = extrapolate aX cX bX 
+    fc = extrapolate cX aX bX
+    fa' = extrapolate aIn cIn bIn
+    fc' = extrapolate cIn aIn bIn
+
+bzhelp :: [(Point2, Point4, Point2, Point2)] -> Picture
+bzhelp = map f
+  where
+    f (V2 x y,col,V2 a b,V2 c d) = Verx (V3 x y 0) col [a,b,c,d] BottomLayer bezNum
+
+-- given a one and two zeros of a linear function over x and y,
+-- determine the function
+-- so if f(ox,oy) = 1 and f(ax,ay) = f(bx,by) = 0, determines f
+extrapolate :: Point2 -> Point2 -> Point2 -> Point2 -> Float
+extrapolate (V2 ox oy) (V2 ax ay) (V2 bx by) (V2 x y) = 
+    (       x * ( ay - by )
+        +   y * ( bx - ax )
+        +   (ax * by - bx * ay)
+    ) 
+    / 
+    (       ox * ( ay - by )
+        +   ax * ( by - oy )
+        +   bx * ( oy - ay )
+    )
+
+color :: RGBA -> Picture -> Picture
+{-# INLINE color #-}
+color c = map $ overCol (const c)
+
+translateH :: Float -> Float -> Point3 -> Point3
+{-# INLINE translateH #-}
+translateH !a !b (V3 x y z) = V3 (x+a) (y+b) z
+
+translate :: Float -> Float -> Picture -> Picture
+{-# INLINE translate #-}
+translate x = map . overPos . translateH x
+
+translate3 :: Point3 -> Picture -> Picture
+{-# INLINE translate3 #-}
+translate3 = map . overPos . (+.+.+)
+
+tranRot :: V2 Float -> Float -> Picture -> Picture
+{-# INLINE tranRot #-}
+tranRot (V2 x y) r = map $ overPos (translateH x y . rotate3 r)
+
+setDepth :: Float -> Picture -> Picture
+{-# INLINE setDepth #-}
+--setDepth d = map $ second $ overPos (\(x,y,_) -> (x,y,d))
+setDepth d = map $ overPos (\(V3 x y _) -> V3 x y d)
+
+addDepth :: Float -> Picture -> Picture
+{-# INLINE addDepth #-}
+--addDepth d = map $ second $ overPos (\(x,y,z) -> (x,y,z+d))
+addDepth d = map $ overPos (\(V3 x y z) -> V3 x y (z+d))
+
+-- TODO change the Int here to a dedicated type
+setLayer :: Layer -> Picture -> Picture
+{-# INLINE setLayer #-}
+setLayer i = map f
+  where
+    f v = v {_vxLayer = i}
+
+scale3 :: Float -> Float -> Point3 -> Point3
+{-# INLINE scale3 #-}
+scale3 a b (V3 x y z) = V3 (x*a) (y*b) z
+
+scale :: Float -> Float -> Picture -> Picture
+{-# INLINE scale #-}
+scale x = map . overPos . scale3 x
+
+rotate :: Float -> Picture -> Picture
+{-# INLINE rotate #-}
+rotate = map . overPos . rotate3
+
+concatMapPic :: Foldable t => (a -> Picture) -> t a -> Picture
+{-# INLINE concatMapPic #-}
+concatMapPic = concatMap
+
+appendPic :: Picture -> Picture -> Picture
+{-# INLINE appendPic #-}
+appendPic = (++)
+
+pictures :: Foldable t => t Picture -> Picture
+{-# INLINABLE pictures #-}
+pictures = concat
+
+makeArc :: Float -> Point2 -> [Point2]
+{-# INLINE makeArc #-}
+makeArc rad (V2 a b) = map (`rotateV` V2 0 rad) angles
+  where 
+    angles = [a,a+step.. b]
+    step = pi * 0.2
+
+circleSolid :: Float -> Picture
+{-# INLINE circleSolid #-}
+circleSolid = circleSolidCol white white
+
+circleSolidCol :: Color -> Color -> Float -> Picture
+{-# INLINE circleSolidCol #-}
+circleSolidCol colC colE r = map f
+    [(V3 (-r)   r  0, colC)
+    ,(V3 (-r) (-r) 0, colE)
+    ,(V3   r  (-r) 0, black)
+    ]
+  where
+    f (pos,col) = Verx pos col [] BottomLayer ellNum
+
+circle :: Float -> Picture
+{-# INLINE circle #-}
+circle rad = thickArc 0 (2*pi) rad 1
+
+centerText :: String -> Picture
+{-# INLINE centerText #-}
+centerText s = translate (50 * (negate . fromIntegral $ length s - 1)) 0 $ text s
+
+stackText :: [String] -> Picture
+{-# INLINE stackText #-}
+stackText = mconcat . zipWith (\y s -> translate 0 y $ centerText s) [0,100..]
+
+text :: String -> Picture
+{-# INLINE text #-}
+text = map f . stringToList
+  where
+    f (pos,col,V2 a b) = Verx pos col [a,b] BottomLayer textNum
+
+line :: [Point2] -> Picture
+{-# INLINE line #-}
+line = thickLine 1
+
+lineCol :: [(Point2,RGBA)] -> Picture
+{-# INLINE lineCol #-}
+lineCol = thickLineCol 1
+
+lineThick :: Float -> [Point2] -> Picture
+{-# INLINE lineThick #-}
+lineThick t = pictures . f
+  where 
+    f (x:y:ys) 
+      | x == y      = f (x:ys)
+      | otherwise   = polygon [x +.+ n x y, x -.- n x y, y -.- n x y, y +.+ n x y] : f (y:ys)
+    f _             = []
+    n a b = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b))
+
+thickLine :: Float -> [Point2] -> Picture
+{-# INLINE thickLine #-}
+thickLine t = pictures . f
+  where 
+    f (x:y:ys)
+      | x == y      = f (x:ys)
+      | otherwise   = polygon [x +.+ n, x -.- n, y -.- n, y +.+ n] : f (y:ys)
+      where
+        n = (t*0.5) *.* errorNormalizeV 42 (vNormal (x -.- y))
+    f _             = []
+
+thickLineCol :: Float -> [(Point2,RGBA)] -> Picture
+{-# INLINE thickLineCol #-}
+thickLineCol t = pictures . f
+  where 
+    f ((x,c):(y,c'):ys) 
+      | x == y      = f ((x,c):ys)
+      | otherwise   = polygonCol 
+        [(x +.+ n x y,c)
+        ,(x -.- n x y,c)
+        ,(y -.- n x y,c')
+        ,(y +.+ n x y,c')
+        ] : f ((y,c'):ys)
+    f _             = []
+    n a b = (t*0.5) *.* squashNormalizeV (vNormal (a -.- b))
+
+thickCircle :: Float -> Float -> Picture
+{-# INLINE thickCircle #-}
+thickCircle = thickArc 0 (2*pi)
+
+arcSolid
+    :: Float -- ^ Start angle
+    -> Float -- ^ End angle
+    -> Float -- ^ Radius
+    -> Picture
+{-# INLINE arcSolid #-}
+arcSolid startA endA rad = polygon $ V2 0 0 : makeArc rad (V2 startA endA)
+
+arc
+    :: Float -- ^ Start angle
+    -> Float -- ^ End angle
+    -> Float -- ^ Radius
+    -> Picture
+arc startA endA rad = thickArc startA endA rad 1
+{-# INLINE arc #-}
+
+thickArc :: Float -> Float -> Float -> Float -> Picture
+{-# INLINE thickArc #-}
+thickArc startA endA rad wdth
+    | endA - startA > (pi/ 2) = pictures 
+        [ thickArc (startA + pi/2) endA rad wdth
+        , thickArcHelp startA (startA + pi/2) r w
+        ]
+    | otherwise = thickArcHelp startA endA r w
+  where
+    r = rad + 0.5 * wdth
+    w = 1 - wdth / r
+
+thickArcHelp :: Float -> Float -> Float -> Float -> Picture
+{-# INLINE thickArcHelp #-}
+thickArcHelp startA endA rad wdth = map f
+    [  (V3 0 0 0,black,V3 0 0 wdth)
+    ,(V3 xa ya 0,black,V3 1 0 wdth)
+    ,(V3 xb yb 0,black,V3 1 1 wdth)
+    ,  (V3 0 0 0,black,V3 0 0 wdth)
+    ,(V3 xb yb 0,black,V3 1 1 wdth)
+    ,(V3 xc yc 0,black,V3 0 1 wdth)
+    ]
+  where
+    (V2 xa ya) = rotateV startA (V2 rad 0)
+    (V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * sqrt 2) 0)
+    --(V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * 2) 0)
+    (V2 xc yc) = rotateV endA (V2 rad 0)
+    f (pos,col,V3 a b c) = Verx pos col [a,b,c] BottomLayer arcNum
+
+
+-- Currently the lens version is much slower
+overPos :: (Point3 -> Point3) -> Verx -> Verx
+{-# INLINE overPos #-}
+--overPos = over vxPos
+overPos f vx = vx {_vxPos = f (_vxPos vx)}
+
+overCol :: (Point4 -> Point4) -> Verx -> Verx
+{-# INLINE overCol #-}
+overCol f vx = vx {_vxCol = f (_vxCol vx)}
+
+-- no premature optimisation, consider changing to use texture arrays
+stringToList :: String -> [(Point3,Point4,Point2)]
+{-# INLINE stringToList #-}
+stringToList = concatMap (uncurry charToTuple) . zip [0,0.9*dimText ..]
+  where
+    dimText = 100
+
+charToTuple :: Float -> Char -> [(Point3,Point4,Point2)]
+{-# INLINE charToTuple #-}
+charToTuple x c = 
+    [(V3 (x-50) (-100) 0, white,V2 offset     1)
+    ,(V3 (x-50)   100  0, white,V2 offset     0)
+    ,(V3 (x+50)   100  0, white,V2 (offset+1) 0)
+    ,(V3 (x-50) (-100) 0, white,V2  offset    1)
+    ,(V3 (x+50) (-100) 0, white,V2 (offset+1) 1)
+    ,(V3 (x+50)   100  0, white,V2 (offset+1) 0)
+    ]
+  where 
+    offset = fromIntegral (fromEnum c) - 32
+
+mirrorxz :: Picture -> Picture
+mirrorxz = map (overPos flipy)
+  where
+    flipy (V3 x y z) = V3 x (negate y) z
+
+mirroryz :: Picture -> Picture
+mirroryz = map (overPos flipx)
+  where
+    flipx (V3 x y z) = V3 (negate x) y z
diff --git a/src/Picture/Composite.hs b/src/Picture/Composite.hs
new file mode 100644
index 000000000..b007742fb
--- /dev/null
+++ b/src/Picture/Composite.hs
@@ -0,0 +1,16 @@
+module Picture.Composite where
+import Picture.Data
+import Picture.Base
+import Geometry
+--import Color
+
+arrowPath :: [Point2] -> Picture
+arrowPath xs = mconcat $ zipWith arrow xs $ tail xs
+
+arrow :: Point2 -> Point2 -> Picture
+arrow a b = line [a,b]
+    <> line [b +.+ n -.- v,b]
+    <> line [b -.- n -.- v,b]
+  where
+    v = 5 *.* normalizeV (b -.- a)
+    n = vNormal v