Mid strictifying

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) 

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))
     }

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

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 

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)

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]

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

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)