From bd8ef3f416759be08e81b31f8b54b2bd73c5fe85 Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Thu, 29 Jul 2021 23:42:27 +0200
Subject: [PATCH] Mid strictifying

---
 src/Dodge/Data.hs                 |  28 +++---
 src/Dodge/Default/Wall.hs         |  13 +--
 src/Dodge/LevelGen/StaticWalls.hs | 144 +++++++++++++++---------------
 src/Dodge/LevelGen/Switch.hs      |   9 +-
 src/Dodge/LightSources.hs         |  22 ++---
 src/Dodge/Picture.hs              |  10 +--
 src/Dodge/RandomHelp.hs           |  10 +--
 src/Dodge/Render/MenuScreen.hs    |   5 +-
 src/Geometry.hs                   |  32 +++----
 src/Geometry/Data.hs              |  23 ++++-
 src/Geometry/Intersect.hs         |  55 ++++++------
 src/Geometry/Vector.hs            |  55 ++++++------
 src/Geometry/Vector3D.hs          |  55 ++++++------
 src/MatrixHelper.hs               |  18 ++--
 src/Picture.hs                    | 117 ++++++++++++------------
 src/Picture/Data.hs               |  25 ++++--
 src/Polyhedra.hs                  |  18 ++--
 src/Polyhedra/Geodesic.hs         |   2 +-
 src/Preload/Render.hs             |   9 +-
 src/Render.hs                     |   2 +-
 src/Shader/Poke.hs                |  18 ++--
 src/Tile.hs                       |  14 +--
 22 files changed, 359 insertions(+), 325 deletions(-)

diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs
index 4644275a3..b6cb0eaf7 100644
--- a/src/Dodge/Data.hs
+++ b/src/Dodge/Data.hs
@@ -708,17 +708,17 @@ makeLenses ''Action
 makeLenses ''CrGroupParams
 
 numColor :: Int -> Color
-numColor 0  = (1,0,0,1) 
-numColor 1  = (0,1,0,1) 
-numColor 2  = (0,0,1,1) 
-numColor 3  = (1,1,0,1)  
-numColor 4  = (0,1,1,1) 
-numColor 5  = (1,0,1,1)  
-numColor 6  = (1,0,0.5,1) 
-numColor 7  = (0.5,0,1,1)  
-numColor 8  = (0,0.5,1,1) 
-numColor 9  = (0,1,0.5,1) 
-numColor 10 = (0.5,1,0,1)
-numColor 11 = (1,0.5,0,1)  
-numColor 12  = (1,1,1,1) 
-numColor _ = (1,1,1,1) 
+numColor 0  = toV4 (1,0,0,1) 
+numColor 1  = toV4 (0,1,0,1) 
+numColor 2  = toV4 (0,0,1,1) 
+numColor 3  = toV4 (1,1,0,1)  
+numColor 4  = toV4 (0,1,1,1) 
+numColor 5  = toV4 (1,0,1,1)  
+numColor 6  = toV4 (1,0,0.5,1) 
+numColor 7  = toV4 (0.5,0,1,1)  
+numColor 8  = toV4 (0,0.5,1,1) 
+numColor 9  = toV4 (0,1,0.5,1) 
+numColor 10 = toV4 (0.5,1,0,1)
+numColor 11 = toV4 (1,0.5,0,1)  
+numColor 12 = toV4 (1,1,1,1) 
+numColor _  = toV4 (1,1,1,1) 
diff --git a/src/Dodge/Default/Wall.hs b/src/Dodge/Default/Wall.hs
index 2972a75be..15d313fe2 100644
--- a/src/Dodge/Default/Wall.hs
+++ b/src/Dodge/Default/Wall.hs
@@ -3,10 +3,11 @@ module Dodge.Default.Wall
 import Dodge.Data
 import Picture
 import qualified DoubleStack as DS
+import Geometry.Data
 {- Indestructible wall.  -}
 defaultWall :: Wall
 defaultWall = Wall 
-    { _wlLine = ((0,0),(50,0))
+    { _wlLine = ((V2 0 0),(V2 50 0))
     , _wlID = 0
     , _wlColor = greyN 0.6
     , _wlSeen = False
@@ -15,7 +16,7 @@ defaultWall = Wall
 {- Indestructible see-through wall.  -}
 defaultCrystalWall :: Wall
 defaultCrystalWall = Wall 
-    { _wlLine = ((0,0),(50,0))
+    { _wlLine = ((V2 0 0),(V2 50 0))
     , _wlID = 0
     , _wlColor = withAlpha 0.5 aquamarine
     , _wlSeen = False
@@ -25,26 +26,26 @@ defaultCrystalWall = Wall
 Pathable.  -}
 defaultAutoDoor :: Wall
 defaultAutoDoor = Door 
-    { _wlLine = ((0,0),(50,0))
+    { _wlLine = ((V2 0 0),(V2 50 0))
     , _wlID = 0
     , _doorMech = id
     , _wlColor = light $ dim $ dim $ dim yellow
     , _wlSeen = False
     , _wlIsSeeThrough = False
     , _doorPathable = True
-    , _drPositions = DS.singleton ((0,0),(50,0))
+    , _drPositions = DS.singleton ((V2 0 0),(V2 50 0))
     }
 {-
 Non-pathable door.
  -}
 defaultDoor :: Wall
 defaultDoor = Door 
-    { _wlLine = ((0,0),(50,0))
+    { _wlLine = ((V2 0 0),(V2 50 0))
     , _wlID = 0
     , _doorMech = id
     , _wlColor = light $ dim $ dim $ dim yellow
     , _wlSeen = False
     , _wlIsSeeThrough = False
     , _doorPathable = False
-    , _drPositions = DS.singleton ((0,0),(50,0))
+    , _drPositions = DS.singleton ((V2 0 0),(V2 50 0))
     }
diff --git a/src/Dodge/LevelGen/StaticWalls.hs b/src/Dodge/LevelGen/StaticWalls.hs
index d94ba9473..8e40f8ab5 100644
--- a/src/Dodge/LevelGen/StaticWalls.hs
+++ b/src/Dodge/LevelGen/StaticWalls.hs
@@ -6,11 +6,13 @@ module Dodge.LevelGen.StaticWalls
     where
 import Dodge.Data
 import Geometry
+import Geometry.Data
 import FoldableHelp
 
 --import Control.Lens
 import Data.List
 import Data.Maybe
+import Data.Bifunctor
 -- | Describe a wall as two points.
 -- Order is important: the wall face is to the left of the line going from 
 -- 'fst' to 'snd'.
@@ -136,7 +138,7 @@ cutPoly qs wls =
 expandPolyBy :: Float -> [Point2] -> [Point2]
 expandPolyBy x ps = map f ps
   where
-    cp = 1/fromIntegral (length ps) *.* foldr (+.+) (0,0) ps
+    cp = 1/fromIntegral (length ps) *.* foldr (+.+) (V2 0 0) ps
     f p = p +.+ x *.* (p -.- cp)
     --f p = p +.+ x *.* normalizeV (p -.- cp)
 -- | Given a polygon expressed as a list of points and a collection of walls,
@@ -231,20 +233,20 @@ findWallsInPolygon ps = filter cond
     cond wall = pointInOrOnPolygon (0.5 *.* uncurry (+.+) wall) ps
 
 brokenWalls :: [(Point2,Point2)]
-brokenWalls = 
+brokenWalls = map (first toV2 . second toV2)
     [((330.12192,3032.2456),(190.52365,2995.8352)),((190.52365,2995.8352),(203.94716,2945.9377)),((214.33855,2907.311),(230.12193,2859.0405)),((230.12193,2859.0405),(366.7245,2895.643)),((366.7245,2895.643),(330.12192,3032.2456)),((366.7245,2895.643),(230.12193,2859.0405)),((230.12193,2859.0405),(266.7245,2722.438)),((266.7245,2722.438),(403.32703,2759.0405)),((403.32703,2759.0405),(503.32703,2932.2456)),((466.72446,3068.8481),(330.12192,3032.2456)),((330.12192,3032.2456),(366.7245,2895.643)),((503.32703,2932.2456),(466.72446,3068.8481)),((203.94716,2945.9377),(145.99155,2930.4084)),((156.38292,2891.7817),(214.33855,2907.311)),((107.47222,2920.979),(34.06077,2901.2295)),((34.06077,2901.2295),(52.571453,2832.4224)),((70.17772,2796.55),(174.45558,2824.6025)),((174.45558,2824.6025),(156.38292,2891.7817)),((100.76944,2955.4202),(107.47222,2920.979)),((145.99155,2930.4084),(140.79587,2949.722)),((52.571453,2832.4224),(35.882084,2827.9504)),((31.745949,2785.4312),(70.17772,2796.55)),((88.14497,3002.5354),(100.76944,2955.4202)),((140.79587,2949.722),(120.21855,3027.0303)),((35.882084,2827.9504),(-22.07344,2812.4214)),((-31.039248,2768.608),(31.745949,2785.4312)),((-261.32483,3408.5737),(-303.9881,3451.237)),((-303.9881,3451.237),(-332.27234,3422.9526)),((-332.27234,3422.9526),(-289.84595,3380.5264)),((-261.56174,3352.242),(88.14497,3002.5354)),((120.21855,3027.0303),(-233.27742,3380.5264)),((-289.84595,3380.5264),(-332.2724,3338.0999)),((-332.2724,3338.0999),(-303.9881,3309.8157)),((-303.9881,3309.8157),(-261.56174,3352.242)),((-22.07344,2812.4214),(-89.68823,2794.304)),((-79.335526,2755.667),(-31.039248,2768.608)),((-210.16953,3456.4133),(-261.32483,3408.5737)),((-233.27742,3380.5264),(-194.64026,3419.1633)),((-128.32533,2783.9514),(-200.79468,3054.4106)),((-200.79468,3054.4106),(-780.35016,2899.1191)),((-780.35016,2899.1191),(-625.05865,2319.5635)),((-625.05865,2319.5635),(-45.503174,2474.855)),((-45.503174,2474.855),(-117.97253,2745.3142)),((-89.68823,2794.304),(-128.32533,2783.9514)),((-117.97253,2745.3142),(-79.335526,2755.667)),((-178.49438,3590.2566),(-241.50847,3573.372)),((-241.50847,3573.372),(-210.16953,3456.4133)),((-194.64026,3419.1633),(-136.80266,3434.6611)),((-98.165634,3445.014),(-139.85736,3600.6094)),((-92.98925,3425.6953),(-98.165634,3445.014)),((-136.80266,3434.6611),(-127.74397,3400.8535)),((-187.553,3624.064),(-178.49438,3590.2566)),((-139.85736,3600.6094),(-148.91603,3634.4167)),((-127.74397,3400.8535),(-111.20285,3339.121)),((-78.55679,3371.8325),(-92.98925,3425.6953)),((-349.5008,4383.0093),(-388.13782,4372.6563)),((-388.13782,4372.6563),(-485.18823,3653.0168)),((-485.18823,3653.0168),(-477.42368,3624.039)),((-477.42368,3624.039),(-206.96445,3696.5085)),((-168.32744,3706.861),(102.131805,3779.3306)),((102.131805,3779.3306),(94.36725,3808.308)),((94.36725,3808.308),(-349.5008,4383.0093)),((-206.96445,3696.5085),(-187.553,3624.064)),((-148.91603,3634.4167),(-168.32744,3706.861)),((299.35522,3346.2668),(97.2383,3547.9797)),((97.2383,3547.9797),(-78.55679,3371.8325)),((-111.20285,3339.121),(116.74672,3110.6904)),((116.74672,3110.6904),(320.08704,3314.438)),((352.084,3395.578),(299.35522,3346.2668)),((320.08704,3314.438),(367.6133,3358.328)),((495.06226,3666.979),(293.8115,3613.054)),((293.8115,3613.054),(352.084,3395.578)),((367.6133,3358.328),(563.6875,3410.866)),((563.6875,3410.866),(495.06226,3666.979))]
 
-intersectingBrokenWalls :: [(Point2,Point2)]
-intersectingBrokenWalls = filter (uncurry test) brokenWalls
-  where
-    polyPairs = zip brokenPoly (tail brokenPoly ++ [head brokenPoly])
-    test a b = any (isJust . uncurry (myIntersectSegSeg a b)) polyPairs
+--intersectingBrokenWalls :: [(Point2,Point2)]
+--intersectingBrokenWalls = filter (uncurry test) brokenWalls
+--  where
+--    polyPairs = zip brokenPoly (tail brokenPoly ++ [head brokenPoly])
+--    test a b = any (isJust . uncurry (myIntersectSegSeg a b)) polyPairs
 
-brokenPoly :: [Point2]
-brokenPoly = [(434.66675,2833.3225),(503.9488,2793.3225),(523.9488,2827.9636),(454.66675,2867.9636)]
+--brokenPoly :: [Point2]
+--brokenPoly = [(434.66675,2833.3225),(503.9488,2793.3225),(523.9488,2827.9636),(454.66675,2867.9636)]
 
-iBWall :: (Point2,Point2)
-iBWall = ((403.32703,2759.0405),(503.32703,2932.2456))
+--iBWall :: (Point2,Point2)
+--iBWall = ((403.32703,2759.0405),(503.32703,2932.2456))
 
 expandToSquare :: (Point2,Point2) -> [(Point2,Point2)]
 expandToSquare (a,b) = [(a,b),(b,c),(c,d),(d,a)]
@@ -253,65 +255,65 @@ expandToSquare (a,b) = [(a,b),(b,c),(c,d),(d,a)]
     c = b +.+ vNormal v
     d = a +.+ vNormal v
 
-minWalls :: [(Point2,Point2)]
-minWalls = expandToSquare iBWall
+--minWalls :: [(Point2,Point2)]
+--minWalls = expandToSquare iBWall
 
-brokenZs :: [Point2]
-brokenCwals :: [WallP]
-(brokenZs,brokenCwals) = cutWallsWithPoints brokenPoly brokenWalls
+--brokenZs :: [Point2]
+--brokenCwals :: [WallP]
+--(brokenZs,brokenCwals) = cutWallsWithPoints brokenPoly brokenWalls
 
-minZs :: [Point2]
-minCwals :: [WallP]
-(minZs,minCwals) = cutWallsWithPoints brokenPoly minWalls
-
-brokenRs :: [Point2]
-brokenRs = orderPolygon $ nub $ minZs ++ brokenPoly
-
-brokenAfterRemovedWalls :: [WallP]
-brokenAfterRemovedWalls = removeWallsInPolygon (orderPolygon brokenPoly) brokenCwals
-minAfterRemovedWalls :: [WallP]
-minAfterRemovedWalls = removeWallsInPolygon (orderPolygon brokenPoly) minCwals
-
-brokenRemovedWalls :: [WallP]
-brokenRemovedWalls = findWallsInPolygon (orderPolygon brokenPoly) brokenCwals
-minRemovedWalls :: [WallP]
-minRemovedWalls = findWallsInPolygon (orderPolygon brokenPoly) minCwals
-
-addedPolyWalls :: [Point2] -> [WallP] -> [WallP]
-addedPolyWalls ps wls = addPolyWalls ps wls \\ wls
-
-brokenAddedWalls :: [WallP]
-brokenAddedWalls = addedPolyWalls brokenRs brokenAfterRemovedWalls
-minAddedWalls :: [WallP]
-minAddedWalls = addedPolyWalls brokenRs minAfterRemovedWalls
-
-brokenAdd :: WallP
-brokenAdd = head brokenAddedWalls
-
-findShadowWall :: WallP -> [WallP] -> Maybe WallP
-findShadowWall (p1,p2) wls = safeMinimumOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
-  where 
-    p3 = 0.5 *.* (p1 +.+ p2)
-    p4 = p3 +.+ 10000 *.* rotateV (negate $ pi/4) (vNormal (p2 -.- p1))
-    f = uncurry $ myIntersectSegSeg p3 p4
-
-findShadowWalls :: WallP -> [WallP] -> [WallP]
-findShadowWalls (p1,p2) wls = hitWls
-  where 
-    hitWls = sortOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
-    p3 = 0.5 *.* (p1 +.+ p2)
-    p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
-    f = uncurry $ myIntersectSegSeg p3 p4
-
-addWallDebug :: WallP -> [WallP] -> [WallP]
-addWallDebug (p1,p2) wls =
-    case maybeWs of 
-        Just ws -> if uncurry isLHS ws p3
-            then wls
-            else (p1,p2) : wls
-        Nothing -> (p1,p2) : wls
-  where 
-    maybeWs = safeMinimumOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
-    p3 = 0.5 *.* (p1 +.+ p2)
-    p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
-    f = uncurry $ myIntersectSegSeg p3 p4
+--minZs :: [Point2]
+--minCwals :: [WallP]
+--(minZs,minCwals) = cutWallsWithPoints brokenPoly minWalls
+--
+--brokenRs :: [Point2]
+--brokenRs = orderPolygon $ nub $ minZs ++ brokenPoly
+--
+--brokenAfterRemovedWalls :: [WallP]
+--brokenAfterRemovedWalls = removeWallsInPolygon (orderPolygon brokenPoly) brokenCwals
+--minAfterRemovedWalls :: [WallP]
+--minAfterRemovedWalls = removeWallsInPolygon (orderPolygon brokenPoly) minCwals
+--
+--brokenRemovedWalls :: [WallP]
+--brokenRemovedWalls = findWallsInPolygon (orderPolygon brokenPoly) brokenCwals
+--minRemovedWalls :: [WallP]
+--minRemovedWalls = findWallsInPolygon (orderPolygon brokenPoly) minCwals
+--
+--addedPolyWalls :: [Point2] -> [WallP] -> [WallP]
+--addedPolyWalls ps wls = addPolyWalls ps wls \\ wls
+--
+--brokenAddedWalls :: [WallP]
+--brokenAddedWalls = addedPolyWalls brokenRs brokenAfterRemovedWalls
+--minAddedWalls :: [WallP]
+--minAddedWalls = addedPolyWalls brokenRs minAfterRemovedWalls
+--
+--brokenAdd :: WallP
+--brokenAdd = head brokenAddedWalls
+--
+--findShadowWall :: WallP -> [WallP] -> Maybe WallP
+--findShadowWall (p1,p2) wls = safeMinimumOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
+--  where 
+--    p3 = 0.5 *.* (p1 +.+ p2)
+--    p4 = p3 +.+ 10000 *.* rotateV (negate $ pi/4) (vNormal (p2 -.- p1))
+--    f = uncurry $ myIntersectSegSeg p3 p4
+--
+--findShadowWalls :: WallP -> [WallP] -> [WallP]
+--findShadowWalls (p1,p2) wls = hitWls
+--  where 
+--    hitWls = sortOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
+--    p3 = 0.5 *.* (p1 +.+ p2)
+--    p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
+--    f = uncurry $ myIntersectSegSeg p3 p4
+--
+--addWallDebug :: WallP -> [WallP] -> [WallP]
+--addWallDebug (p1,p2) wls =
+--    case maybeWs of 
+--        Just ws -> if uncurry isLHS ws p3
+--            then wls
+--            else (p1,p2) : wls
+--        Nothing -> (p1,p2) : wls
+--  where 
+--    maybeWs = safeMinimumOn (dist p3 . fromJust . f) $ filter (isJust . f) wls
+--    p3 = 0.5 *.* (p1 +.+ p2)
+--    p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
+--    f = uncurry $ myIntersectSegSeg p3 p4
diff --git a/src/Dodge/LevelGen/Switch.hs b/src/Dodge/LevelGen/Switch.hs
index 22c355b59..a24a911bf 100644
--- a/src/Dodge/LevelGen/Switch.hs
+++ b/src/Dodge/LevelGen/Switch.hs
@@ -5,6 +5,7 @@ import Dodge.SoundLogic
 import Dodge.Picture.Layer
 import Picture
 import Geometry
+import Geometry.Data
 
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
@@ -14,7 +15,7 @@ makeButton
     -> Button
 makeButton c eff = Button
     { _btPict = setLayer 0 . onLayer WlLayer $ color c $ polygon $ rectNSEW 5 (-5) 10 (-10)
-    , _btPos = (0,0)
+    , _btPos = (V2 0 0)
     , _btRot = 0
     , _btEvent = \b w -> eff . over buttons (IM.adjust turnOn (_btID b))
 --                                . set (buttons . ix (_btID b) . btPict) 
@@ -38,7 +39,7 @@ makeSwitch
     -> Button
 makeSwitch c effOn effOff = Button
     { _btPict = offPict
-    , _btPos = (0,0)
+    , _btPos = (V2 0 0)
     , _btRot = 0
     , _btEvent = flipSwitch
     , _btID = 0
@@ -53,11 +54,11 @@ makeSwitch c effOn effOff = Button
         _ -> error "Trying to switch a button with no label"
     offPict = setLayer 0 . onLayer WlLayer $ color c $ pictures [--translate (-8) 4 $ circleSolid 5
                               polygon $ rectNSEW (-2) (-5) (-10) 10
-                              ,polygon [(-2,-5),(-10,4),(-6,4),(2,-5)]
+                              ,polygon $ map toV2 [(-2,-5),(-10,4),(-6,4),(2,-5)]
                              ]
     onPict  = setLayer 0 . onLayer WlLayer $ color c $ pictures [--translate (8) 4 $ circleSolid 5
                               polygon $ rectNSEW (-2) (-5) (-10) 10
-                              ,polygon [(-2,-5), (6,4),( 10,4),(2,-5)]
+                              ,polygon $ map toV2 [(-2,-5), (6,4),( 10,4),(2,-5)]
                              ]
     turnOn :: Button -> Button
     turnOn bt = bt 
diff --git a/src/Dodge/LightSources.hs b/src/Dodge/LightSources.hs
index edfd434d6..b2cdd061a 100644
--- a/src/Dodge/LightSources.hs
+++ b/src/Dodge/LightSources.hs
@@ -10,9 +10,9 @@ import Geometry.Data
 --import qualified Data.IntMap.Strict as IM
 
 lightAt :: Point3 -> Int -> LightSource
-lightAt (x,y,z) i = 
+lightAt (V3 x y z) i = 
     LS {_lsID = i
-       ,_lsPos = (x,y,z)
+       ,_lsPos = (V3 x y z)
        ,_lsDir = 0
        ,_lsRad = 700
        ,_lsIntensity = 0.75
@@ -20,18 +20,18 @@ lightAt (x,y,z) i =
 basicLS :: PSType
 basicLS = PutLS ls dec
   where 
-    ls = lightAt (0,0,0) 0
+    ls = lightAt (V3 0 0 0) 0
     dec = onLayer PtLayer $ color white $ circleSolid 8
 
 tLightFade :: Int -> Float -> (Int -> Float) -> Point2 -> TempLightSource
-tLightFade 0 rmax intensityF (x,y) = TLS 
-    { _tlsPos = (x,y,0)
+tLightFade 0 rmax intensityF (V2 x y) = TLS 
+    { _tlsPos = (V3 x y 0)
     , _tlsRad = rmax
     , _tlsIntensity = intensityF 0
     , _tlsUpdate = \w _ -> (w, Nothing)
     }
-tLightFade i rmax intensityF p@(x,y) = TLS 
-    { _tlsPos = (x,y,0)
+tLightFade i rmax intensityF p@(V2 x y) = TLS 
+    { _tlsPos = (V3 x y 0)
     , _tlsRad = rmax
     , _tlsIntensity = intensityF i
     , _tlsUpdate = \w _ -> (w, Just $ tLightFade (i-1) rmax intensityF p)
@@ -43,14 +43,14 @@ tLightRad
     -> Float -- ^ minimal radius (unused)
     -> Point2 
     -> TempLightSource
-tLightRad 0 rmax _ (x,y) = TLS 
-    { _tlsPos = (x,y,0)
+tLightRad 0 rmax _ (V2 x y) = TLS 
+    { _tlsPos = (V3 x y 0)
     , _tlsRad = rmax
     , _tlsIntensity = 0.5
     , _tlsUpdate = \w _ -> (w, Nothing)
     }
-tLightRad i rmax rmin p@(x,y) = TLS 
-    { _tlsPos = (x,y,0)
+tLightRad i rmax rmin p@(V2 x y) = TLS 
+    { _tlsPos = (V3 x y 0)
     , _tlsRad = rmax
     , _tlsIntensity = 0.5
     , _tlsUpdate = \w _ -> (w, Just $ tLightRad (i-1) rmax rmin p)
diff --git a/src/Dodge/Picture.hs b/src/Dodge/Picture.hs
index 5ee23f26a..d3ce87168 100644
--- a/src/Dodge/Picture.hs
+++ b/src/Dodge/Picture.hs
@@ -36,21 +36,21 @@ wedgeOfThickness :: Float -> Point2 -> Point2 -> Picture
 wedgeOfThickness t x y 
     | x == y    = blank
     | otherwise = pictures 
-        [uncurry translate x $ circleSolid (0.5*t)
+        [uncurryV translate x $ circleSolid (0.5*t)
         ,polygon [x +.+ n x y, x -.- n x y, y]
         ]
   where 
     n a b = (t*0.5) *.* errorNormalizeV 4200 (vNormal (a -.- b))
 
 verticalPipe :: Float -> Color -> Point2 -> Float -> Float -> Picture
-verticalPipe w col (xx,xy) za zb = pictures $ map (poly3Col . f) ps
+verticalPipe w col (V2 xx xy) za zb = pictures $ map (poly3Col . f) ps
   where
-    x = (xx,xy,0)
-    xs = map (\(a,b) -> x +.+.+ (a,b,za)) [(w,0),(0,w),(-w,0),(0,-w)]
+    x = (V3 xx xy 0)
+    xs = map (\(V2 a b) -> x +.+.+ (V3 a b za)) (map toV2 [(w,0),(0,w),(-w,0),(0,-w)])
     ps = zip xs (tail xs ++ [head xs])
     f (a,b) = map f' [a,b,g b,g a]
     g :: Point3 -> Point3
-    g (a,b,_) = (a,b,zb)
+    g (V3 a b _) = (V3 a b zb)
     f' a = (a,col)
 
 expandLine :: Point3 -> Point3 -> Point3 -> [Point3]
diff --git a/src/Dodge/RandomHelp.hs b/src/Dodge/RandomHelp.hs
index af493a08c..4c211fd69 100644
--- a/src/Dodge/RandomHelp.hs
+++ b/src/Dodge/RandomHelp.hs
@@ -73,15 +73,15 @@ randOnUnitSphere :: RandomGen g => State g Point3
 randOnUnitSphere = do
     z <- state $ randomR (negate 1,1)
     longitude <- state $ randomR (0, 2*pi)
-    let (x,y) = sqrt (1 - z^(2::Int)) *.* unitVectorAtAngle longitude
-    return (x,y,z)
+    let (V2 x y) = sqrt (1 - z^(2::Int)) *.* unitVectorAtAngle longitude
+    return (V3 x y z)
 
 randOnHemisphere :: RandomGen g => State g Point3
 randOnHemisphere = do
     z <- state $ randomR (0,1)
     longitude <- state $ randomR (0, 2*pi)
-    let (x,y) = sqrt (1 - z^(2::Int)) *.* unitVectorAtAngle longitude
-    return (x,y,z)
+    let (V2 x y) = sqrt (1 - z^(2::Int)) *.* unitVectorAtAngle longitude
+    return (V3 x y z)
 
 randInHemisphere :: RandomGen g => State g Point3
 randInHemisphere = do
@@ -92,7 +92,7 @@ randInHemisphere = do
 randInRect :: RandomGen g => Float -> Float -> State g Point2
 randInRect w h = do x <- state $ randomR (0,w)
                     y <- state $ randomR (0,h)
-                    return (x,y)
+                    return (V2 x y)
 
 maybeTakeOne :: RandomGen g => [a] -> State g (Maybe a)
 maybeTakeOne [] = return Nothing
diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs
index 384a12622..bd719fb22 100644
--- a/src/Dodge/Render/MenuScreen.hs
+++ b/src/Dodge/Render/MenuScreen.hs
@@ -11,6 +11,7 @@ import Dodge.Config.Data
 --import Dodge.Base (halfWidth,halfHeight)
 import Picture
 import Geometry
+import Geometry.Data
 
 menuScreen 
     :: Configuration 
@@ -108,8 +109,8 @@ controlsList = pictures $ concat $ zipWith butAndEff
 screenBox 
     :: Float    -- ^ Half screen width
     -> Float    -- ^ Half screen height
-    -> [(Float,Float)]
-screenBox halfW halfH = 
+    -> [Point2]
+screenBox halfW halfH = map toV2
     [  (halfW, halfH)
     , (-halfW, halfH)
     , (-halfW,-halfH)
diff --git a/src/Geometry.hs b/src/Geometry.hs
index d0aabc1df..1f0910bec 100644
--- a/src/Geometry.hs
+++ b/src/Geometry.hs
@@ -53,13 +53,13 @@ closestPointOnLineParam !a !b !p
     = (p -.- a) `dotV` (b -.- a) / (b -.- a) `dotV` (b -.- a)
 -- | Draw a rectangle based on maximal N E S W values.
 rectNESW :: Float -> Float -> Float -> Float -> [Point2]
-rectNESW !a !b !c !d = [(b,a),(b,c),(d,c),(d,a) ]
+rectNESW !a !b !c !d = [(V2 b a),(V2 b c),(V2 d c),(V2 d a) ]
 -- | Draw a rectangle based on maximal N S E W values.
 rectNSEW :: Float -> Float -> Float -> Float -> [Point2]
 rectNSEW !n !s !e !w = rectNESW n e s w
 -- | Draw a rectangle based on maximal N S W E values.
 rectNSWE :: Float -> Float -> Float -> Float -> [Point2]
-rectNSWE !n !s !w !e = [ (w,n), (w,s), (e,s), (e,n)]
+rectNSWE !n !s !w !e = [ (V2 w n), (V2 w s), (V2 e s), (V2 e n)]
 -- | Draw a rectangle around the origin with given height and width
 rectWdthHght :: Float -> Float -> [Point2]
 rectWdthHght w h = rectNSWE h (-h) (-w) w
@@ -83,12 +83,12 @@ errorPointInPolygon !i !p xs
     | otherwise = error $ "errorPointInPolygon "++ show i
 -- | Debug version of 'normalizeV'.
 errorNormalizeV :: Int -> Point2 -> Point2
-errorNormalizeV !i (0,0) = error $ "problem with function: errorNormalizeV "++show i
+errorNormalizeV !i (V2 0 0) = error $ "problem with function: errorNormalizeV "++show i
 errorNormalizeV _ !p = normalizeV p
 -- | Debug version of 'angleVV'.
 errorAngleVV :: Int -> Point2 -> Point2 -> Float
-errorAngleVV !i (0,0) _ = error $ "problem with function: errorAngleVV "++show i
-errorAngleVV !i _ (0,0) = error $ "problem with function: errorAngleVV "++show i
+errorAngleVV !i (V2 0 0) _ = error $ "problem with function: errorAngleVV "++show i
+errorAngleVV !i _ (V2 0 0) = error $ "problem with function: errorAngleVV "++show i
 errorAngleVV _  !p !p' = angleVV p p'
 -- | Debug version of 'isLHS'.
 errorIsLHS :: Int -> Point2 -> Point2 -> Point2 -> Bool
@@ -114,9 +114,9 @@ isLHS
     -> Bool
 {-# INLINE isLHS #-}
 isLHS 
-    (x,y)      
-    (x',y')   
-    (x'',y'') 
+    (V2 x y)      
+    (V2 x' y')   
+    (V2 x'' y'') 
     | (x,y) == (x',y')  = False
     | otherwise = a1 * b2 - a2 * b1 > 0
   where 
@@ -133,9 +133,9 @@ isRHS
     -> Bool
 {-# INLINE isRHS #-}
 isRHS 
-    (x,y)       
-    (x',y')    
-    (x'',y'')  
+    (V2 x y)       
+    (V2 x' y')    
+    (V2 x'' y'')  
     | (x,y) == (x',y')  = False
     | otherwise = a1 * b2 - a2 * b1 < 0
   where 
@@ -166,7 +166,7 @@ addPointPolygon p ps
     | otherwise = orderPolygon $ p : ps
 -- | Creates the convex hull of a set of points.
 convexHull :: [Point2] -> [Point2]
-convexHull (x:y:z:xs) = grahamScan $ orderAroundFirst $ sortOn (\(a,b) -> (b,a)) (x:y:z:xs)
+convexHull (x:y:z:xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b,a)) (x:y:z:xs)
 convexHull _ = error "Tried to create the convex hull of two or fewer points"
 
 grahamScan :: [Point2] -> [Point2]
@@ -259,10 +259,10 @@ polyToTris _ = []
 
 -- | Return n equidistant points on a circle with a radius of 600.
 nRays :: Int -> [Point2]
-nRays n = take n $ iterate (rotateV (2*pi/fromIntegral n)) (600,0)
+nRays n = take n $ iterate (rotateV (2*pi/fromIntegral n)) (V2 600 0)
 -- | Return n equidistant points on a circle with a radius of x.
 nRaysRad :: Int -> Float -> [Point2]
-nRaysRad n x = take n $ iterate (rotateV (2*pi/fromIntegral n)) (x,0)
+nRaysRad n x = take n $ iterate (rotateV (2*pi/fromIntegral n)) (V2 x 0)
 -- | Test whether an angle is to the left of another angle, according to the
 -- smallest change in rotation between them.
 -- This appears to sometimes fail if the angles are not normalized.
@@ -366,7 +366,7 @@ reflectInParam :: Float -> Point2 -> Point2 -> Point2
 reflectInParam x line vec = 
     let angle = 2 * angleBetween line vec
         rAng = rotateV angle vec
-        p = x *.* errorClosestPointOnLine 3 (0,0) (vNormal line) rAng
+        p = x *.* errorClosestPointOnLine 3 (V2 0 0) (vNormal line) rAng
     in  rAng -.- p
 --reflectIn' :: Point2 -> Point2 -> Point2 -> Point2 -> Point2
 --reflectIn' l1 l2 v1 v2 = v1 +.+ reflectIn (l1 -.- l2) (v2 -.- v1)
@@ -497,4 +497,4 @@ pointIsInCone
 pointIsInCone c (rightp,leftp) p = isLHS c rightp p && isLHS leftp c p
 -- | TODO: implement using Control.Foldl
 centroid :: Foldable t => t Point2 -> Point2
-centroid xs = 1 / fromIntegral (length xs) *.* foldl' (+.+) (0,0) xs
+centroid xs = 1 / fromIntegral (length xs) *.* foldl' (+.+) (V2 0 0) xs
diff --git a/src/Geometry/Data.hs b/src/Geometry/Data.hs
index 68a9f27bf..1bc68fe0d 100644
--- a/src/Geometry/Data.hs
+++ b/src/Geometry/Data.hs
@@ -2,8 +2,25 @@ module Geometry.Data
     ( Point2 
     , Point3 
     , Point4 
+    , V2 (..)
+    , V3 (..)
+    , V4 (..)
+    , toV2
+    , toV3
+    , toV4
+    , uncurryV
     )
     where
-type Point2 = (Float,Float)
-type Point3 = (Float,Float,Float)
-type Point4 = (Float,Float,Float,Float)
+import Linear.V2
+import Linear.V3
+import Linear.V4
+type Point2 = V2 Float
+type Point3 = V3 Float
+type Point4 = V4 Float
+
+toV2 (a,b)      = V2 a b
+toV3 (a,b,c)    = V3 a b c
+toV4 (a,b,c,d)  = V4 a b c d
+
+uncurryV :: (a -> a -> b) -> V2 a -> b
+uncurryV f (V2 x y) = f x y
diff --git a/src/Geometry/Intersect.hs b/src/Geometry/Intersect.hs
index bbc1ba881..48cc57ced 100644
--- a/src/Geometry/Intersect.hs
+++ b/src/Geometry/Intersect.hs
@@ -11,22 +11,22 @@ import Data.Maybe (isNothing)
 -- | If two lines intersect, return 'Just' that point.
 intersectLineLine' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectLineLine' #-}
-intersectLineLine' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
+intersectLineLine' (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
     | den == 0 = Nothing
-    | otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
+    | otherwise = Just $ V2 (x1 + (x2-x1)*t'/den) (y1 + (y2-y1)*t'/den)
   where 
     den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
     t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
 -- | If two segments intersect, return 'Just' that point.
 intersectSegSeg' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectSegSeg' #-}
-intersectSegSeg' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
+intersectSegSeg' (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
     | den == 0 = Nothing
     | den > 0 && (t' < 0 || u' < 0 || t' > den || u' > den)
         = Nothing
     | den < 0 && (t' > 0 || u' > 0 || t' < den || u' < den)
         = Nothing
-    | otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
+    | otherwise = Just $ V2 (x1 + (x2-x1)*t'/den) (y1 + (y2-y1)*t'/den)
   where 
     den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
     t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
@@ -35,13 +35,13 @@ intersectSegSeg' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
 -- extending infinitely in one direction.
 intersectSegLineFrom' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectSegLineFrom' #-}
-intersectSegLineFrom' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
+intersectSegLineFrom' (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
     | den == 0 = Nothing
     | den > 0 && ( t' < 0 || u' < 0 || t' > den )
         = Nothing
     | den < 0 && ( t' > 0 || u' > 0 || t' < den )
         = Nothing
-    | otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
+    | otherwise = Just $ V2 (x1 + (x2-x1)*t'/den) (y1 + (y2-y1)*t'/den)
   where 
     den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
     t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
@@ -49,13 +49,13 @@ intersectSegLineFrom' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
 -- | Similar to 'intersectSegLineFrom'', but this version is probably not correct...
 intersectSegLineext :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectSegLineext #-}
-intersectSegLineext (x1,y1) (x2,y2) (x3,y3) (x4,y4)
+intersectSegLineext (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
     | den == 0 = Nothing
     | den > 0 && ( t' < 0 || u' < den || t' > den )
         = Nothing
     | den < 0 && ( t' > 0 || u' > - den || t' < den )
         = Nothing
-    | otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
+    | otherwise = Just $ V2 (x1 + (x2-x1)*t'/den) (y1 + (y2-y1)*t'/den)
   where 
     den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
     t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
@@ -63,13 +63,13 @@ intersectSegLineext (x1,y1) (x2,y2) (x3,y3) (x4,y4)
 -- | Intersect a segment with a line.
 intersectSegLine' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectSegLine' #-}
-intersectSegLine' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
+intersectSegLine' (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
     | den == 0 = Nothing
     | den > 0 && (t' < 0 || t' > den)
         = Nothing
     | den < 0 && (t' > 0 || t' < den)
         = Nothing
-    | otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
+    | otherwise = Just $ V2 (x1 + (x2-x1)*t'/den) ( y1 + (y2-y1)*t'/den)
   where 
     den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
     t'  = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
@@ -87,10 +87,10 @@ myIntersectSegSeg
     -> Point2
     -> Point2
     -> Maybe Point2
-myIntersectSegSeg a@(ax,ay) b@(bx,by) c@(cx,cy) d@(dx,dy) = case ratIntersectLineLine a b c d of
+myIntersectSegSeg a@(V2 ax ay) b@(V2 bx by) c@(V2 cx cy) d@(V2 dx dy) = case ratIntersectLineLine a b c d of
     Nothing    -> Nothing
-    Just (x,y) -> if inbetween x && inbetween' y 
-        then Just (x,y)
+    Just (V2 x y) -> if inbetween x && inbetween' y 
+        then Just (V2 x y)
         else Nothing
   where 
     inbetween  x = ((ax <= x && x <= bx) || (bx <= x && x <= ax)) 
@@ -98,28 +98,28 @@ myIntersectSegSeg a@(ax,ay) b@(bx,by) c@(cx,cy) d@(dx,dy) = case ratIntersectLin
     inbetween' y = ((ay <= y && y <= by) || (by <= y && y <= ay)) 
         &&  ((cy <= y && y <= dy) || (dy <= y && y <= cy))
 -- | Polymorphic intersection of fractional line points.
-myIntersectLineLine :: (Eq a,Fractional a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Maybe (a,a)
-myIntersectLineLine a@(ax,_) b c@(cx,_) d
-    | isNothing (linGrad a b) = (ax ,) <$> axisInt (c *-* (ax,0)) (d *-* (ax,0))
-    | isNothing (linGrad c d) = (cx ,) <$> axisInt (a *-* (cx,0)) (b *-* (cx,0))
+myIntersectLineLine :: (Eq a,Fractional a) => V2 a -> V2 a -> V2 a -> V2 a -> Maybe (V2 a)
+myIntersectLineLine a@(V2 ax _) b c@(V2 cx _) d
+    | isNothing (linGrad a b) = (V2 ax) <$> axisInt (c *-* (V2 ax 0)) (d *-* (V2 ax 0))
+    | isNothing (linGrad c d) = (V2 cx) <$> axisInt (a *-* (V2 cx 0)) (b *-* (V2 cx 0))
     | otherwise              
         = case linGrad a b ^-^ linGrad c d of
             Just 0 -> Nothing
-            _      -> liftA2 (,) newx ((linGrad a b ^*^ newx) ^+^ axisInt a b)
+            _      -> liftA2 (V2) newx ((linGrad a b ^*^ newx) ^+^ axisInt a b)
   where 
     (^-^) = liftA2 (-)
     (^+^) = liftA2 (+)
     (^/^) = liftA2 (/)
     (^*^) = liftA2 (*)
     newx  = (axisInt c d ^-^ axisInt a b) ^/^ (linGrad a b ^-^ linGrad c d)
-    (*-*) (ax',ay) (bx,by) = (ax'-bx,ay-by)
+    (*-*) (V2 ax' ay) (V2 bx by) = V2 (ax'-bx) (ay-by)
 -- | Transforms floating points to rationals then performs line intersection.
 ratIntersectLineLine :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 ratIntersectLineLine a b c d = toNumPoint2 
     <$> myIntersectLineLine (toRatPoint2 a) (toRatPoint2 b) (toRatPoint2 c) (toRatPoint2 d)
   where 
-    toRatPoint2 (x,y) = (toRational x, toRational y)
-    toNumPoint2 (x,y) = (fromRational x, fromRational y)
+    toRatPoint2 (V2 x y) = V2 (toRational x)  (toRational y)
+    toNumPoint2 (V2 x y) = V2 (fromRational x)  (fromRational y)
 {- | Round the floats within a 'Point2' to the nearest integer.
 __Examples__
 Rounding jumps after intervals of .5:
@@ -134,18 +134,15 @@ but is symmetric around 0:
 
 -}
 roundPoint2 :: Point2 -> Point2
-roundPoint2 (x,y) = (fromIntegral (round x :: Int),fromIntegral (round y :: Int))
+roundPoint2 (V2 x y) = V2 (fromIntegral (round x :: Int)) (fromIntegral (round y :: Int))
 -- | Given two points, finds the linear gradient if it is non-infinite.
-linGrad :: (Eq a,Fractional a) => (a,a) -> (a,a) -> Maybe a
-linGrad (x,y) (a,b) 
+linGrad :: (Eq a,Fractional a) => V2 a -> V2 a -> Maybe a
+linGrad (V2 x y) (V2 a b) 
     | x-a == 0  = Nothing
     | otherwise = Just $ (y-b)/(x-a)
 -- | Given two points, finds the intersection with the y axis if it exists.
-axisInt :: (Eq a,Fractional a) => (a,a) -> (a,a) -> Maybe a
-axisInt p (a,b) =  pure b ^-^ (pure a ^*^ linGrad p (a,b))
-  where 
-    (^-^) = liftA2 (-)
-    (^*^) = liftA2 (*)
+axisInt :: (Eq a,Fractional a) => V2 a -> V2 a -> Maybe a
+axisInt p (V2 a b) =  fmap (\lg -> b - (a*lg)) $ linGrad p (V2 a b)
 -- | Placeholder, undefined.
 intersectSegsSeg :: [Point2] -> Point2 -> Point2 -> Maybe Point2
 intersectSegsSeg = undefined
diff --git a/src/Geometry/Vector.hs b/src/Geometry/Vector.hs
index ef0d59663..f873cb3b1 100644
--- a/src/Geometry/Vector.hs
+++ b/src/Geometry/Vector.hs
@@ -5,7 +5,7 @@ import Geometry.Data
 {- | Moves from two to three dimensions, adding zero in z direction.  -}
 zeroZ :: Point2 -> Point3
 {-# INLINE zeroZ #-}
-zeroZ (x,y) = (x,y,0)
+zeroZ (V2 x y) = V3 x y 0
 
 infixl 6 +.+, -.-
 infixl 7 *.*
@@ -13,27 +13,29 @@ infixl 7 *.*
 {- | 2D coordinate-wise addition.  -}
 (+.+) :: Point2 -> Point2 -> Point2
 {-# INLINE (+.+) #-}
-(x1, y1) +.+ (x2, y2) =
-  let
-    !x = x1 + x2
-    !y = y1 + y2
-  in (x, y)
+(+.+) = (+)
+--(x1, y1) +.+ (x2, y2) =
+--  let
+--    !x = x1 + x2
+--    !y = y1 + y2
+--  in (x, y)
 {- | 2D coordinate-wise subtraction.  -}
 (-.-) :: Point2 -> Point2 -> Point2
 {-# INLINE (-.-) #-}
-(x1, y1) -.- (x2, y2) =
-  let
-    !x = x1 - x2
-    !y = y1 - y2
-  in (x, y)
+(-.-) = (-)
+--(x1, y1) -.- (x2, y2) =
+--  let
+--    !x = x1 - x2
+--    !y = y1 - y2
+--  in (x, y)
 {- | 2D scalar multiplication.  -}
 (*.*) :: Float -> Point2 -> Point2
 {-# INLINE (*.*) #-}
-a *.* (x2, y2) =
+a *.* V2 x2 y2 =
   let
     !x = a * x2
     !y = a * y2
-  in (x, y)
+  in V2 x y
 
 {- | Normalize a vector to length 1.  -}
 normalizeV :: Point2 -> Point2
@@ -53,31 +55,30 @@ angleVV a b
 safeAngleVV :: Point2 -> Point2 -> Float
 {-# INLINE safeAngleVV #-}
 safeAngleVV a b
-    | a == (0,0) || b == (0,0) = 0
+    | a == V2 0 0 || b == V2 0 0 = 0
     | otherwise                = angleVV a b
 {- | Dot product.  -}
 dotV :: Point2 -> Point2 -> Float
 {-# INLINE dotV #-}
-dotV (x,y) (z,w) = x*z + y*w
+dotV (V2 x y) (V2 z w) = x*z + y*w
 {- | Given vector, returns the angle, anticlockwise from +ve x-axis, in radians.  -}
 argV :: Point2 -> Float
 {-# INLINE argV #-}
-argV (x,y) = normalizeAngle $ atan2 y x
+argV (V2 x y) = normalizeAngle $ atan2 y x
 {- | Determinant of the matrix formed by two vectors.  -}
 detV :: Point2 -> Point2 -> Float
 {-# INLINE detV #-}
-detV (x1, y1) (x2, y2) = x1 * y2 - y1 * x2
+detV (V2 x1 y1) (V2 x2 y2) = x1 * y2 - y1 * x2
 {- | Given an angle in radians, anticlockwise from +ve x-axis, 
  - returns the corresponding unit vector.  -}
 unitVectorAtAngle :: Float -> Point2
 {-# INLINE unitVectorAtAngle #-}
-unitVectorAtAngle r = (cos r, sin r)
+unitVectorAtAngle r = V2 (cos r) (sin r)
 -- | Rotate a vector by an angle (in radians). +ve angle is counter-clockwise.
 rotateV :: Float -> Point2 -> Point2
-rotateV r (x, y) =
-    (  x * cos r - y * sin r
-    ,  x * sin r + y * cos r
-    )
+rotateV r (V2 x y) = V2
+    (x * cos r - y * sin r)
+    (x * sin r + y * cos r)
 {-# INLINE rotateV #-}
 -- | Convert degrees to radians
 degToRad :: Float -> Float
@@ -97,23 +98,23 @@ normalizeAngle f = f - 2 * pi * floor' (f / (2 * pi))
 {- | Rotate vector by pi/2 clockwise.  -}
 vNormal :: Point2 -> Point2
 {-# INLINE vNormal #-}
-vNormal (x,y) = (y,-x)
+vNormal (V2 x y) = V2 y (negate x)
 {- | Negate a vector.  -}
 vInverse :: Point2 -> Point2
-vInverse (x,y) = (-x,-y)
+vInverse (V2 x y) = V2 (-x) (-y)
 {- | Normalize a vector safely: on (0,0) return (0,0).  -}
 safeNormalizeV :: Point2 -> Point2
 {-# INLINE safeNormalizeV #-}
-safeNormalizeV (0,0) = (0,0)
+safeNormalizeV (V2 0 0) = V2 0 0
 safeNormalizeV p = (1/magV p ) *.* p
 {- | Magnitude of a vector.  -}
 magV :: Point2 -> Float
 {-# INLINE magV #-}
-magV (x,y) = sqrt $ x^(2::Int) + y^(2::Int)
+magV (V2 x y) = sqrt $ x^(2::Int) + y^(2::Int)
 {- | Magnitude of the cross product of two vectors.
 Identical to detV.  -}
 crossV :: Point2 -> Point2 -> Float
-crossV (ax,ay) (bx,by) = ax*by - ay*bx
+crossV (V2 ax ay) (V2 bx by) = ax*by - ay*bx
 {- | TO CHECK Orthographic projection of one vector onto another. -}
 projV :: Point2 -> Point2 -> Point2
 projV fromv onv 
diff --git a/src/Geometry/Vector3D.hs b/src/Geometry/Vector3D.hs
index ff52a1343..6abefeff2 100644
--- a/src/Geometry/Vector3D.hs
+++ b/src/Geometry/Vector3D.hs
@@ -12,55 +12,56 @@ infixl 7 *.*.*
 {- | 3D coordinate-wise addition.  -}
 (+.+.+) :: Point3 -> Point3 -> Point3
 {-# INLINE (+.+.+) #-}
-(x1, y1, z1) +.+.+ (x2, y2, z2) =
-  let
-    !x = x1 + x2
-    !y = y1 + y2
-    !z = z1 + z2
-  in (x, y, z)
+(+.+.+) = (+)
+--(x1, y1, z1) +.+.+ (x2, y2, z2) =
+--  let
+--    !x = x1 + x2
+--    !y = y1 + y2
+--    !z = z1 + z2
+--  in (x, y, z)
 {- | 3D coordinate-wise subtraction.  -}
 (-.-.-) :: Point3 -> Point3 -> Point3
 {-# INLINE (-.-.-) #-}
-(x1, y1, z1) -.-.- (x2, y2, z2) =
-  let
-    !x = x1 - x2
-    !y = y1 - y2
-    !z = z1 - z2
-  in (x, y, z)
+(-.-.-) = (-)
+--(x1, y1, z1) -.-.- (x2, y2, z2) =
+--  let
+--    !x = x1 - x2
+--    !y = y1 - y2
+--    !z = z1 - z2
+--  in (x, y, z)
 {- | 3D scalar multiplication.  -}
 (*.*.*) :: Float -> Point3 -> Point3
 {-# INLINE (*.*.*) #-}
-a *.*.* (x2, y2, z2) =
+a *.*.* (V3 x2 y2 z2) =
   let
     !x = a * x2
     !y = a * y2
     !z = a * z2
-  in (x, y, z)
+  in V3 x y z
 
 crossProd :: Point3 -> Point3 -> Point3
-crossProd (x,y,z) (a,b,c) = 
-    ( y * c - z * b
-    , z * a - x * c
-    , x * b - y * a
-    )
+crossProd (V3 x y z) (V3 a b c) = V3
+    ( y * c - z * b)
+    ( z * a - x * c)
+    ( x * b - y * a)
 
 rotate3 :: Float -> Point3 -> Point3
 {-# INLINE rotate3 #-}
-rotate3 a (x,y,z) = (x',y',z)
+rotate3 a (V3 x y z) = V3 x' y' z
   where 
-    (x',y') = rotateV a (x,y)
+    (V2 x' y') = rotateV a (V2 x y)
 
 magV3 :: Point3 -> Float
-magV3 (x,y,z) = sqrt $ x^i + y^i + z^i
+magV3 (V3 x y z) = sqrt $ x^i + y^i + z^i
   where
     i = 2 :: Int
 
 normalizeV3 :: Point3 -> Point3
-normalizeV3 (0,0,0) = (0,0,0)
+normalizeV3 (V3 0 0 0) = V3 0 0 0
 normalizeV3 p = (1 / magV3 p) *.*.* p
 
 addZ :: Float -> Point2 -> Point3
-addZ z (x,y) = (x,y,z)
+addZ z (V2 x y) = V3 x y z
 
 orderAround3
     :: Point3 -- ^ Vector to order around
@@ -70,16 +71,16 @@ orderAround3 v ps = sortOn (argV . prj) ps
   where
     xdir = crossProd v (head ps)
     ydir = crossProd v xdir
-    prj p = (dotV3 xdir p, dotV3 ydir p)
+    prj p = V2 (dotV3 xdir p) (dotV3 ydir p)
 
 vCen3 :: [Point3] -> Point3
-vCen3 ps = (1 / fromIntegral (length ps)) *.*.* foldr (+.+.+) (0,0,0) ps 
+vCen3 ps = (1 / fromIntegral (length ps)) *.*.* foldr (+.+.+) (V3 0 0 0) ps 
 
 dotV3
     :: Point3
     -> Point3
     -> Float
-dotV3 (x,y,z) (a,b,c) = x*a + y*b + z*c
+dotV3 (V3 x y z) (V3 a b c) = x*a + y*b + z*c
 
 projV3
     :: Point3
diff --git a/src/MatrixHelper.hs b/src/MatrixHelper.hs
index ea6870b91..77d841254 100644
--- a/src/MatrixHelper.hs
+++ b/src/MatrixHelper.hs
@@ -16,16 +16,16 @@ perspectiveMatrixb
     -> Point2       -- ^ Window size
     -> Point2       -- ^ View froms
     -> [GLfloat]
-perspectiveMatrixb rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
+perspectiveMatrixb rot zoom (V2 tranx trany) (V2 winx winy) (V2 viewFromx viewFromy) =
     concatMap vToL 
     . vToL
     . lmt 
-    $ scaleMat (2*zoom/winx,2*zoom/winy)
+    $ scaleMat (V2 (2*zoom/winx) (2*zoom/winy))
     -- $ scaleMat (2/winx,2/winy)
         !*! rotMatr (-rot)
-        !*! transMat (viewFromx-tranx,viewFromy-trany)
+        !*! transMat (V2 (viewFromx-tranx) (viewFromy-trany))
         !*! perMat (zoom * 0.4)
-        !*! transMat (-viewFromx,-viewFromy)
+        !*! transMat (V2 (-viewFromx) (-viewFromy))
         !*! vertScale 
         !*! vertTrans 20
        -- !*! vertTrans 80
@@ -36,12 +36,12 @@ isoMatrix
     -> Point2       -- ^ Translation
     -> Point2       -- ^ Window size
     -> [GLfloat]
-isoMatrix rot zoom (tranx,trany) (winx,winy) = concatMap vToL 
+isoMatrix rot zoom (V2 tranx trany) (V2 winx winy) = concatMap vToL 
     . vToL 
     . lmt 
-    $ scaleMat (2*zoom/winx,2*zoom/winy)
+    $ scaleMat (V2 (2*zoom/winx) (2*zoom/winy))
         !*! rotMatr (-rot)
-        !*! transMat (-tranx,-trany)
+        !*! transMat (V2 (-tranx) (-trany))
 
 lmt :: V4 (V4 a) -> V4 (V4 a)
 lmt = Linear.Matrix.transpose
@@ -57,7 +57,7 @@ perMat x = V4
     (V4 0 0 x 1)
 
 scaleMat :: Point2 -> V4 (V4 Float)
-scaleMat (x,y) = V4
+scaleMat (V2 x y) = V4
     (V4 x 0 0 0)
     (V4 0 y 0 0)
     (V4 0 0 1 0) 
@@ -71,7 +71,7 @@ rotMatr a = V4
     (V4 0       0          0 1)
 
 transMat :: Point2 -> V4 (V4 Float)
-transMat (x,y) = V4 
+transMat (V2 x y) = V4 
     (V4 1 0 0 x)
     (V4 0 1 0 y)
     (V4 0 0 1 0)
diff --git a/src/Picture.hs b/src/Picture.hs
index 074e3a335..2041523b1 100644
--- a/src/Picture.hs
+++ b/src/Picture.hs
@@ -63,7 +63,7 @@ import Picture.Data
 import Control.Lens
 
 black :: RGBA
-black = (0,0,0,1)
+black = (V4 0 0 0 1)
 
 --zl :: RenderType -> [(Int,RenderType)]
 --zl rt = [(0,rt)]
@@ -84,7 +84,7 @@ polygonCol :: [(Point2,RGBA)] -> Picture
 {-# INLINE polygonCol #-}
 polygonCol vs = map f $ polyToTris vs
   where
-    f ((x,y),col) = Verx (x,y,0) col PolyV 0
+    f ((V2 x y),col) = Verx (V3 x y 0) col PolyV 0
 
 poly3 :: [Point3] -> Picture
 {-# INLINE poly3 #-}
@@ -103,13 +103,13 @@ bezierQuad cola colc ra rc a b c
     | a == b || b == c = bezierQuad cola colc ra rc a (0.5 *.* (a +.+ c)) c
     | otherwise = bzhelp
         [-- ( (0,0) , cola, (0,0), (0,0) )
-         (aIn, cola, (fa aIn,fc aIn) , (1,0) )
-        ,(aIn, cola, (fa aIn,fc aIn) , (1,0) )
-        ,(cIn, colc, (fa cIn,fc cIn) , (0,1) )
-        ,( aX, cola, (1,0) , (fa' aX,fc' aX)  )
-        ,( cX, colc, (0,1) , (fa' cX,fc' cX)  )
-        ,( bX, colb, (0,0) , (fa' bX,fc' bX)  )
-        ,( bX, colb, (0,0) , (fa' bX,fc' bX)  )
+         (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
@@ -131,16 +131,16 @@ bezierQuad cola colc ra rc a b c
     fa' = extrapolate aIn cIn bIn
     fc' = extrapolate cIn aIn bIn
 
-bzhelp :: [(Point2, Point4, (Float, Float), (Float, Float))] -> Picture
+bzhelp :: [(Point2, Point4, Point2, Point2)] -> Picture
 bzhelp = map f
   where
-    f ((x,y),col,(a,b),(c,d)) = Verx (x,y,0) col (BezV (a,b,c,d)) 0
+    f ((V2 x y),col,(V2 a b),(V2 c d)) = Verx (V3 x y 0) col (BezV (V4 a b c d)) 0
 
 -- 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 (ox,oy) (ax,ay) (bx,by) (x,y) = 
+extrapolate (V2 ox oy) (V2 ax ay) (V2 bx by) (V2 x y) = 
     (       x * ( ay - by )
         +   y * ( bx - ax )
         +   (ax * by - bx * ay)
@@ -157,7 +157,7 @@ color c = map $ overCol (const c)
 
 translate3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE translate3 #-}
-translate3 a b (x,y,z) = (x+a,y+b,z)
+translate3 a b (V3 x y z) = V3 (x+a) (y+b) z
 
 translate :: Float -> Float -> Picture -> Picture
 --{-# INLINE translate #-}
@@ -167,12 +167,12 @@ translate x y = map $ overPos (translate3 x y)
 setDepth :: Float -> Picture -> Picture
 --{-# INLINE setDepth #-}
 --setDepth d = map $ second $ overPos (\(x,y,_) -> (x,y,d))
-setDepth d = map $ 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 (\(x,y,z) -> (x,y,z+d))
+addDepth d = map $ overPos (\(V3 x y z) -> V3 x y (z+d))
 
 setLayer :: Int -> Picture -> Picture
 {-# INLINE setLayer #-}
@@ -182,7 +182,7 @@ setLayer i = map f
 
 scale3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE scale3 #-}
-scale3 a b (x,y,z) = (x*a,y*b,z)
+scale3 a b (V3 x y z) = (V3 (x*a) (y*b) (z))
 
 scale :: Float -> Float -> Picture -> Picture
 --{-# INLINE scale #-}
@@ -197,9 +197,9 @@ pictures :: [Picture] -> Picture
 {-# INLINE pictures #-}
 pictures = concat
 
-makeArc :: Float -> (Float,Float) -> [Point2]
+makeArc :: Float -> Point2 -> [Point2]
 {-# INLINE makeArc #-}
-makeArc rad (a,b) = map (`rotateV` (0,rad)) angles
+makeArc rad (V2 a b) = map (`rotateV` (V2 0 rad)) angles
   where 
     angles = [a,a+step.. b]
     step = pi * 0.2
@@ -211,9 +211,9 @@ circleSolid = circleSolidCol white white
 circleSolidCol :: Color -> Color -> Float -> Picture
 {-# INLINE circleSolidCol #-}
 circleSolidCol colC colE r = map f
-    [( (-r, r,0), colC)
-    ,( (-r,-r,0), colE)
-    ,( ( r,-r,0), black)
+    [( (V3 (-r) ( r) (0)), colC)
+    ,( (V3 (-r) (-r) (0)), colE)
+    ,( (V3 ( r) (-r) (0)), black)
     ]
   where
     f (pos,col) = Verx pos col EllV 0
@@ -273,7 +273,7 @@ arcSolid
     -> Float -- ^ Radius
     -> Picture
 {-# INLINE arcSolid #-}
-arcSolid startA endA rad = polygon $ (0,0) : makeArc rad (startA,endA)
+arcSolid startA endA rad = polygon $ (V2 0 0) : makeArc rad (V2 startA endA)
 
 arc
     :: Float -- ^ Start angle
@@ -297,60 +297,61 @@ thickArc startA endA rad wdth
 
 thickArcHelp :: Float -> Float -> Float -> Float -> [Verx]
 thickArcHelp startA endA rad wdth = map f 
-    [(  (0,0,0),black,(0,0,wdth))
-    ,((xa,ya,0),black,(1,0,wdth))
-    ,((xb,yb,0),black,(1,1,wdth))
-    ,(  (0,0,0),black,(0,0,wdth))
-    ,((xb,yb,0),black,(1,1,wdth))
-    ,((xc,yc,0),black,(0,1,wdth))
+    [(  (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
-    (xa,ya) = rotateV startA (rad,0)
-    (xb,yb) = rotateV (0.5 * (startA + endA)) (rad * sqrt 2,0)
-    (xc,yc) = rotateV endA (rad,0)
+    (V2 xa ya) = rotateV startA (V2 rad 0)
+    (V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * sqrt 2) (0))
+    (V2 xc yc) = rotateV endA (V2 rad 0)
     f (pos,col,val) = Verx pos col (ArcV val) 0
 
 withAlpha :: Float -> RGBA -> RGBA
 {-# INLINE withAlpha #-}
-withAlpha a (x,y,z,a') = (x,y,z,a*a')
+withAlpha a (V4 x y z a') = (V4 x y z (a*a'))
 
 red,green,blue,yellow,cyan,magenta,rose,violet,azure,aquamarine,chartreuse,orange,white::Color
-red       = (1,0,0,1) 
-green     = (0,1,0,1) 
-blue      = (0,0,1,1) 
-yellow    = (1,1,0,1)  
-cyan      = (0,1,1,1) 
-magenta   = (1,0,1,1)  
-rose      = (1,0,0.5,1) 
-violet    = (0.5,0,1,1)  
-azure     = (0,0.5,1,1) 
-aquamarine= (0,1,0.5,1) 
-chartreuse= (0.5,1,0,1)
-orange    = (1,0.5,0,1)  
-white     = (1,1,1,1) 
+red       = toV4 (1,0,0,1) 
+green     = toV4 (0,1,0,1) 
+blue      = toV4 (0,0,1,1) 
+yellow    = toV4 (1,1,0,1)  
+cyan      = toV4 (0,1,1,1) 
+magenta   = toV4 (1,0,1,1)  
+rose      = toV4 (1,0,0.5,1) 
+violet    = toV4 (0.5,0,1,1)  
+azure     = toV4 (0,0.5,1,1) 
+aquamarine= toV4 (0,1,0.5,1) 
+chartreuse= toV4 (0.5,1,0,1)
+orange    = toV4 (1,0.5,0,1)  
+white     = toV4 (1,1,1,1) 
+
 
 mixColors :: Float -> Float -> Color -> Color -> Color
-mixColors rata ratb (r0,g0,b0,a0) (r2,g2,b2,a2) = 
+mixColors rata ratb (V4 r0 g0 b0 a0) (V4 r2 g2 b2 a2) = 
     let fullrat = rata + ratb
         normrata = rata / fullrat
         normratb = ratb / fullrat
         f x y = sqrt $ normrata * x^(2::Int) + normratb * y^(2::Int)
-    in  (f r0 r2 , f g0 g2 , f b0 b2 , normrata * a0 + normratb * a2)
+    in  (V4 (f r0 r2 ) ( f g0 g2 ) ( f b0 b2 ) ( normrata * a0 + normratb * a2))
 
 light :: Color -> Color
-light (r,g,b,a) = (r+0.2,g+0.2,b+0.2,a)
+light (V4 r g b a) = (V4 (r+0.2) (g+0.2) (b+0.2) (a))
 
 dark :: Color -> Color
-dark (r,g,b,a) = (r-0.2,g-0.2,b-0.2,a)
+dark (V4 r g b a) = (V4 (r-0.2) (g-0.2) (b-0.2) (a))
         
 dim :: Color -> Color
-dim (r,g,b,a) = (r/1.2,g/1.2,b/1.2,a)
+dim (V4 r g b a) = (V4 (r/1.2) (g/1.2) (b/1.2) (a))
 
 bright :: Color -> Color
-bright (r,g,b,a) = (r*1.2,g*1.2,b*1.2,a)
+bright (V4 r g b a) = (V4 (r*1.2) (g*1.2) (b*1.2) (a))
 
 greyN :: Float -> Color
-greyN x = (x,x,x,1)
+greyN x = toV4 (x,x,x,1)
 
 overPos :: (Point3 -> Point3) -> Verx -> Verx
 {-# INLINE overPos #-}
@@ -370,12 +371,12 @@ stringToList s = concatMap (uncurry charToTuple) $ zip [0,0.9*dimText ..] s
 charToTuple :: Float -> Char -> [(Point3,Point4,Point2)]
 {-# INLINE charToTuple #-}
 charToTuple x c = 
-    [((x-50,-100,0),    white,(offset,1))
-    ,((x-50,100,0),     white,(offset,0))
-    ,((x+50,100,0),   white,(offset+1,0))
-    ,((x-50,-100,0),    white,(offset,1))
-    ,((x+50,-100,0),  white,(offset+1,1))
-    ,((x+50,100,0),   white,(offset+1,0))
+    [((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
diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs
index 9245615b3..c8796ea27 100644
--- a/src/Picture/Data.hs
+++ b/src/Picture/Data.hs
@@ -49,8 +49,8 @@ data RenderType
   deriving Generic
 instance NFData RenderType
 
-type RGBA = (Float,Float,Float,Float)
-type Color = (Float,Float,Float,Float)
+type RGBA = Point4
+type Color = Point4
 
 data FTree a
     = FBranch (a -> a) (FTree a)
@@ -103,15 +103,24 @@ instance Functor (RTree a) where
     fmap f (RBranches i ts) = RBranches i $ fmap (fmap f) ts
     fmap f (RLeaf x)      = RLeaf (f x)
 
-flat2 :: (a,a) -> [a]
-flat2 (x,y) = [x,y]
-flat3 :: (a,a,a) -> [a]
-flat3 (x,y,z) = [x,y,z]
-flat4 :: (a,a,a,a) -> [a]
-flat4 (x,y,z,w) = [x,y,z,w]
+flat2 :: V2 a -> [a]
+flat2 (V2 x y) = [x,y]
+flat3 :: V3 a -> [a]
+flat3 (V3 x y z) = [x,y,z]
+flat4 :: V4 a -> [a]
+flat4 (V4 x y z w) = [x,y,z,w]
 {-# INLINE flat2 #-}
 {-# INLINE flat3 #-}
 {-# INLINE flat4 #-}
+tflat2 :: (a,a) -> [a]
+tflat2 (x,y) = [x,y]
+tflat3 :: (a,a,a) -> [a]
+tflat3 (x,y,z) = [x,y,z]
+tflat4 :: (a,a,a,a) -> [a]
+tflat4 (x,y,z,w) = [x,y,z,w]
+{-# INLINE tflat2 #-}
+{-# INLINE tflat3 #-}
+{-# INLINE tflat4 #-}
 
 type Picture = [Verx]
 
diff --git a/src/Polyhedra.hs b/src/Polyhedra.hs
index 6451cf7c5..53d84378f 100644
--- a/src/Polyhedra.hs
+++ b/src/Polyhedra.hs
@@ -15,7 +15,7 @@ import Control.Lens
 translateXY :: Float -> Float -> Polyhedra -> Polyhedra
 translateXY x y = pyFaces %~ map (map $ first tran)
   where
-    tran (a,b,c) = (a+x,b+y,c)
+    tran (V3 a b c) = (V3 (a+x) (b+y) (c))
 
 rotateXY :: Float -> Polyhedra -> Polyhedra
 rotateXY a = over pyFaces $ map $ map $ first $ rotate3 a
@@ -49,7 +49,7 @@ faceEdges xs = zipWith addNormal xs (tail xs ++ [head xs])
 
 rhombus :: Point3 -> Point3 -> [Point3]
 rhombus a b = 
-    [(0,0,0)
+    [(V3 0 0 0)
     ,a
     ,a +.+.+ b
     ,b
@@ -58,16 +58,16 @@ rhombus a b =
 boxXYZ :: Float -> Float -> Float -> [[Point3]]
 boxXYZ x y z = 
     [ bottomFace
-    , map (+.+.+ (0,0,z)) $ reverse bottomFace
+    , map (+.+.+ (V3 0 0 z)) $ reverse bottomFace
     , frontFace
-    , map (+.+.+ (0,y,0)) $ reverse frontFace
+    , map (+.+.+ (V3 0 y 0)) $ reverse frontFace
     , sideFace
-    , map (+.+.+ (x,0,0)) $ reverse sideFace
+    , map (+.+.+ (V3 x 0 0)) $ reverse sideFace
     ]
   where
-    bottomFace = rhombus (0,y,0) (x,0,0) 
-    frontFace  = rhombus (x,0,0) (0,0,z)
-    sideFace   = rhombus (0,0,z) (0,y,0)
+    bottomFace = rhombus (V3 0 y 0) (V3 x 0 0) 
+    frontFace  = rhombus (V3 x 0 0) (V3 0 0 z)
+    sideFace   = rhombus (V3 0 0 z) (V3 0 y 0)
 boxABC :: Point3 -> Point3 -> Point3 -> [[Point3]]
 boxABC a b c =
     [ faceNC
@@ -98,7 +98,7 @@ polyToEdges = constructEdges . map (map fst) . _pyFaces
 
 -- rendering for silhouette
 polyToRender :: Polyhedra -> [RenderType]
-polyToRender = map (Render3 . flat4) . polyToEdges
+polyToRender = map (Render3 . tflat4) . polyToEdges
 -- rendering for shape
 polyToGeoRender :: Polyhedra -> [RenderType]
 polyToGeoRender = map (Render3 . polyToTris . map fst) . _pyFaces
diff --git a/src/Polyhedra/Geodesic.hs b/src/Polyhedra/Geodesic.hs
index 0e1ed76ef..ca4e903d8 100644
--- a/src/Polyhedra/Geodesic.hs
+++ b/src/Polyhedra/Geodesic.hs
@@ -10,7 +10,7 @@ import qualified Data.Map as M
 
 icosahedronPoints :: [Point3]
 icosahedronPoints = concat
-    [ [(0,one,gr),(one, gr, 0),(gr, 0, one)]
+    [ [V3 0 one gr, V3 one gr 0, V3 gr 0 one]
     | one <- [-1,1]
     , gr  <- [negate (1 + sqrt 5)/2, (1 + sqrt 5)/2 ]
     ]
diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs
index 19f58d921..818d2ec4a 100644
--- a/src/Preload/Render.hs
+++ b/src/Preload/Render.hs
@@ -12,6 +12,7 @@ import Shader.Compile
 import Shader.AuxAddition
 import Shader.Parameters
 import Data.Preload.Render
+import Geometry.Data
 
 import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
 import Graphics.GL.Core43
@@ -229,19 +230,19 @@ poke3 (Render3 vs) = map flat3 vs
 poke3 _ = undefined
 
 pokeWPStrat :: RenderType -> [[Float]]
-pokeWPStrat Render22{_unRender22 = ((x,y),(z,w))} = [[x,y,z,w]]
+pokeWPStrat Render22{_unRender22 = ((V2 x y),(V2 z w))} = [[x,y,z,w]]
 pokeWPStrat _ = undefined
 
 pokeRadDist :: RenderType -> [[Float]]
-pokeRadDist Render2221{_unRender2221 = ((a,b),(c,d),(e,f),g)} = [[a,b,c,d,e,f,g]]
+pokeRadDist Render2221{_unRender2221 = (V2 a b,V2 c d,V2 e f,g)} = [[a,b,c,d,e,f,g]]
 pokeRadDist _ = undefined
 
 pokeWPColStrat :: RenderType -> [[Float]]
-pokeWPColStrat Render22x4{_unRender22x4=(((x,y),(z,w)),(r,g,b,a))} = [[x,y,z,w,r,g,b,a]]
+pokeWPColStrat Render22x4{_unRender22x4=((V2 x y,V2 z w),V4 r g b a)} = [[x,y,z,w,r,g,b,a]]
 pokeWPColStrat _ = undefined
 
 poke33 :: RenderType -> [[Float]]
-poke33 Render3x3{_unRender3x3=((x,y,z),(a,b,c))} = [[x,y,z,a,b,c]]
+poke33 Render3x3{_unRender3x3=(V3 x y z,V3 a b c)} = [[x,y,z,a,b,c]]
 poke33 _ = undefined
 
 isPolyV, isArcV, isEllV, isTextV, isBezV, isPolyzV :: VertexType -> Bool
diff --git a/src/Render.hs b/src/Render.hs
index bbef676b9..255a85e24 100644
--- a/src/Render.hs
+++ b/src/Render.hs
@@ -57,7 +57,7 @@ createLightMap pdata lightPoints nWalls nSils nsurfVs = do
     blendFunc $= (Zero, OneMinusSrcAlpha)
     stencilTest $= Enabled
     depthFunc $= Just Lequal
-    forM_ lightPoints $ \((x,y,z),r,lum) -> do
+    forM_ lightPoints $ \((V3 x y z),r,lum) -> do
         -- stencil out shadows
         colorMask $= Color4 Disabled Disabled Disabled Disabled
         clear [StencilBuffer]
diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs
index c5bbca09c..6164ed130 100644
--- a/src/Shader/Poke.hs
+++ b/src/Shader/Poke.hs
@@ -66,19 +66,19 @@ pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType} = case t
         >> pokeElemOff thePtr 7 x
       where
         thePtr = plusPtr (_vboPtr $ _psPolyz vbos) (_psPolyz offsets * 8 * floatSize)
-    BezV (x,y,z,w)  -> poke34 thePtr thePos theCol
+    BezV (V4 x y z w)  -> poke34 thePtr thePos theCol
         >> pokeElemOff thePtr 7 x
         >> pokeElemOff thePtr 8 y
         >> pokeElemOff thePtr 9 z
         >> pokeElemOff thePtr 10 w
       where
         thePtr = plusPtr (_vboPtr $ _psBez vbos)  (_psBez offsets * 11 * floatSize)
-    TextV (x,y)     -> poke34 thePtr thePos theCol
+    TextV (V2 x y)     -> poke34 thePtr thePos theCol
         >> pokeElemOff thePtr 7 x
         >> pokeElemOff thePtr 8 y
       where
         thePtr = plusPtr (_vboPtr $ _psText vbos) (_psText offsets * 9 * floatSize)
-    ArcV (x,y,z)    -> poke34 thePtr thePos theCol
+    ArcV (V3 x y z)    -> poke34 thePtr thePos theCol
         >> pokeElemOff thePtr 7 x
         >> pokeElemOff thePtr 8 y
         >> pokeElemOff thePtr 9 z
@@ -88,7 +88,7 @@ pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType} = case t
 
 poke34 :: Ptr Float -> Point3 -> Point4 -> IO ()
 {-# INLINE poke34 #-}
-poke34 ptr (a,b,c) (d,e,f,g) = do
+poke34 ptr (V3 a b c) (V4 d e f g) = do
     pokeElemOff ptr 0 a
     pokeElemOff ptr 1 b
     pokeElemOff ptr 2 c
@@ -148,7 +148,7 @@ pokePoint33s :: Ptr Float -> [(Point3,Point3)] -> IO Int
 pokePoint33s ptr vals0 = go vals0 0
   where
     go [] n = return n
-    go ( ((a,b,c),(d,e,f)):vals) n = do
+    go ( ((V3 a b c),(V3 d e f)):vals) n = do
         pokeElemOff ptr (off 0) a
         pokeElemOff ptr (off 1) b
         pokeElemOff ptr (off 2) c
@@ -163,7 +163,7 @@ pokePoint3s :: Ptr Float -> [Point3] -> IO Int
 pokePoint3s ptr vals0 = go vals0 0
   where
     go [] n = return n
-    go ( (a,b,c):vals) n = do
+    go ( (V3 a b c):vals) n = do
         pokeElemOff ptr (off 0) a
         pokeElemOff ptr (off 1) b
         pokeElemOff ptr (off 2) c
@@ -186,19 +186,19 @@ pokeLayVerx vbos imoffsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType, _vx
         >> pokeElemOff thePtr 7 x
       where
         thePtr = plusPtr (_vboPtr $ _psPolyz vbos) ((_psPolyz offsets + layOff) * 8 * floatSize)
-    BezV (x,y,z,w)  -> poke34 thePtr thePos theCol
+    BezV (V4 x y z w)  -> poke34 thePtr thePos theCol
         >> pokeElemOff thePtr 7 x
         >> pokeElemOff thePtr 8 y
         >> pokeElemOff thePtr 9 z
         >> pokeElemOff thePtr 10 w
       where
         thePtr = plusPtr (_vboPtr $ _psBez vbos)  ((_psBez offsets + layOff) * 11 * floatSize)
-    TextV (x,y)     -> poke34 thePtr thePos theCol
+    TextV (V2 x y)     -> poke34 thePtr thePos theCol
         >> pokeElemOff thePtr 7 x
         >> pokeElemOff thePtr 8 y
       where
         thePtr = plusPtr (_vboPtr $ _psText vbos) ((_psText offsets + layOff) * 9 * floatSize)
-    ArcV (x,y,z)    -> poke34 thePtr thePos theCol
+    ArcV (V3 x y z)    -> poke34 thePtr thePos theCol
         >> pokeElemOff thePtr 7 x
         >> pokeElemOff thePtr 8 y
         >> pokeElemOff thePtr 9 z
diff --git a/src/Tile.hs b/src/Tile.hs
index 244a6d923..f2e4545dc 100644
--- a/src/Tile.hs
+++ b/src/Tile.hs
@@ -10,8 +10,11 @@ tToRender t = map Render3x3 $ polyToTris $ zip ps3 coords3
   where
     ps = _tilePoly t
     coords = map (calcTexCoord (_tileCenter t) (_tileX t) (_tileY t)) ps
-    ps3 = map (mkTrip 0) ps
-    coords3 = map (mkTrip (_tileZ t)) coords
+    ps3 = map (addToV2 0) ps
+    coords3 = map (addToV2 (_tileZ t)) coords
+
+addToV2 :: a -> V2 a -> V3 a
+addToV2 z (V2 x y) = V3 x y z
 
 mkTrip :: c -> (a,b) -> (a,b,c)
 mkTrip z (x,y) = (x,y,z)
@@ -22,10 +25,9 @@ calcTexCoord
     -> Point2   -- ^ tile (0,1)
     -> Point2   -- ^ world point
     -> Point2
-calcTexCoord cen x' y' p = 
-    ( magV (projV (p -.- cen) x) / magV x
-    , magV (projV (p -.- cen) y) / magV y
-    )
+calcTexCoord cen x' y' p = V2
+    ( magV (projV (p -.- cen) x) / magV x )
+    ( magV (projV (p -.- cen) y) / magV y )
   where
     x = x' -.- cen
     y = y' -.- cen