about summary refs log tree commit diff
path: root/users/glittershark
diff options
context:
space:
mode:
Diffstat (limited to 'users/glittershark')
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Data.hs18
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs2
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Generators.hs7
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Generators/CaveAutomata.hs3
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Generators/Dungeon.hs9
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Generators/LevelContents.hs21
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Generators/Util.hs96
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Generators/Village.hs4
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Util/Graphics.hs84
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs23
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs41
-rw-r--r--users/glittershark/xanthous/xanthous.cabal7
12 files changed, 172 insertions, 143 deletions
diff --git a/users/glittershark/xanthous/src/Xanthous/Data.hs b/users/glittershark/xanthous/src/Xanthous/Data.hs
index e2967d274fd5..c9c11b553b67 100644
--- a/users/glittershark/xanthous/src/Xanthous/Data.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Data.hs
@@ -28,6 +28,7 @@ module Xanthous.Data
   , loc
   , _Position
   , positionFromPair
+  , positionFromV2
   , addPositions
   , diffPositions
   , stepTowards
@@ -176,7 +177,7 @@ instance Num a => Group (Position' a) where
 -- | Positions convert to scalars by discarding their orientation and just
 -- measuring the length from the origin
 instance (Ord a, Num a, Scalar a) => Scalar (Position' a) where
-  scalar = fromIntegral . length . line (0, 0) . view _Position
+  scalar = fromIntegral . length . line 0 . view _Position
   fromScalar n = Position (fromScalar n) (fromScalar n)
 
 data Positioned a where
@@ -220,15 +221,18 @@ loc = iso hither yon
     hither (Position px py) = Location (px, py)
     yon (Location (lx, ly)) = Position lx ly
 
-_Position :: Iso' (Position' a) (a, a)
+_Position :: Iso' (Position' a) (V2 a)
 _Position = iso hither yon
   where
-    hither (Position px py) = (px, py)
-    yon (lx, ly) = Position lx ly
+    hither (Position px py) = (V2 px py)
+    yon (V2 lx ly) = Position lx ly
 
 positionFromPair :: (Num a, Integral i, Integral j) => (i, j) -> Position' a
 positionFromPair (i, j) = Position (fromIntegral i) (fromIntegral j)
 
+positionFromV2 :: (Num a, Integral i) => V2 i -> Position' a
+positionFromV2 (V2 xx yy) = Position (fromIntegral xx) (fromIntegral yy)
+
 -- | Add two positions
 --
 -- Operation for the additive group on positions
@@ -448,13 +452,13 @@ neighborDirections = Neighbors
 neighborPositions :: Num a => Position' a -> Neighbors (Position' a)
 neighborPositions pos = (`move` pos) <$> neighborDirections
 
-neighborCells :: Num a => (a, a) -> Neighbors (a, a)
+neighborCells :: Num a => V2 a -> Neighbors (V2 a)
 neighborCells = map (view _Position) . neighborPositions . review _Position
 
 arrayNeighbors
   :: (IArray a e, Ix i, Num i)
-  => a (i, i) e
-  -> (i, i)
+  => a (V2 i) e
+  -> V2 i
   -> Neighbors (Maybe e)
 arrayNeighbors arr center = arrLookup <$> neighborPositions (_Position # center)
   where
diff --git a/users/glittershark/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs b/users/glittershark/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs
index 5a73bd393848..19e7b0cdf086 100644
--- a/users/glittershark/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs
@@ -44,7 +44,7 @@ linesOfSight (view _Position -> pos) visionRadius em
     lines = line pos <$> radius
     entitiesOnLines :: [[(Position, Vector (EntityID, e))]]
     entitiesOnLines = lines <&> map getPositionedAt
-    getPositionedAt :: (Int, Int) -> (Position, Vector (EntityID, e))
+    getPositionedAt :: V2 Int -> (Position, Vector (EntityID, e))
     getPositionedAt p =
       let ppos = _Position # p
       in (ppos, over _2 (view positioned) <$> atPositionWithIDs ppos em)
diff --git a/users/glittershark/xanthous/src/Xanthous/Generators.hs b/users/glittershark/xanthous/src/Xanthous/Generators.hs
index 2801137b699c..ef37070b6ede 100644
--- a/users/glittershark/xanthous/src/Xanthous/Generators.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Generators.hs
@@ -39,6 +39,7 @@ import           Xanthous.Entities.Environment
 import           Xanthous.Entities.Item (Item)
 import           Xanthous.Entities.Creature (Creature)
 import           Xanthous.Game.State (SomeEntity(..))
+import           Linear.V2
 --------------------------------------------------------------------------------
 
 data Generator
@@ -91,18 +92,18 @@ parseGeneratorInput = Opt.subparser
 
 showCells :: Cells -> Text
 showCells arr =
-  let ((minX, minY), (maxX, maxY)) = bounds arr
+  let (V2 minX minY, V2 maxX maxY) = bounds arr
       showCellVal True = "x"
       showCellVal False = " "
       showCell = showCellVal . (arr !)
-      row r = foldMap (showCell . (, r)) [minX..maxX]
+      row r = foldMap (showCell . (`V2` r)) [minX..maxX]
       rows = row <$> [minY..maxY]
   in intercalate "\n" rows
 
 cellsToWalls :: Cells -> EntityMap Wall
 cellsToWalls cells = foldl' maybeInsertWall mempty . assocs $ cells
   where
-    maybeInsertWall em (pos@(x, y), True)
+    maybeInsertWall em (pos@(V2 x y), True)
       | not (surroundedOnAllSides pos) =
         let x' = fromIntegral x
             y' = fromIntegral y
diff --git a/users/glittershark/xanthous/src/Xanthous/Generators/CaveAutomata.hs b/users/glittershark/xanthous/src/Xanthous/Generators/CaveAutomata.hs
index ada201ef3d6c..be904662f3f7 100644
--- a/users/glittershark/xanthous/src/Xanthous/Generators/CaveAutomata.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Generators/CaveAutomata.hs
@@ -19,6 +19,7 @@ import           Xanthous.Util (between)
 import           Xanthous.Util.Optparse
 import           Xanthous.Data (Dimensions, width, height)
 import           Xanthous.Generators.Util
+import           Linear.V2
 --------------------------------------------------------------------------------
 
 data Params = Params
@@ -102,7 +103,7 @@ generate' params dims = do
 stepAutomata :: forall s g. MCells s -> Dimensions -> Params -> CellM g s ()
 stepAutomata cells dims params = do
   origCells <- lift $ cloneMArray @_ @(STUArray s) cells
-  for_ (range ((0, 0), (dims ^. width, dims ^. height))) $ \pos -> do
+  for_ (range (0, V2 (dims ^. width) (dims ^. height))) $ \pos -> do
     neighs <- lift $ numAliveNeighborsM origCells pos
     origValue <- lift $ readArray origCells pos
     lift . writeArray cells pos
diff --git a/users/glittershark/xanthous/src/Xanthous/Generators/Dungeon.hs b/users/glittershark/xanthous/src/Xanthous/Generators/Dungeon.hs
index 7fde0075e64f..f30713ce1182 100644
--- a/users/glittershark/xanthous/src/Xanthous/Generators/Dungeon.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Generators/Dungeon.hs
@@ -159,14 +159,14 @@ fillRoom cells room =
       V2 dimx dimy = room ^. dimensions
   in for_ [posx .. posx + dimx] $ \x ->
        for_ [posy .. posy + dimy] $ \y ->
-         lift $ writeArray cells (x, y) True
+         lift $ writeArray cells (V2 x y) True
 
-corridorBetween :: MonadRandom m => Room -> Room -> m [(Word, Word)]
+corridorBetween :: MonadRandom m => Room -> Room -> m [V2 Word]
 corridorBetween originRoom destinationRoom
   = straightLine <$> origin <*> destination
   where
-    origin = choose . NE.fromList . map toTuple =<< originEdge
-    destination = choose . NE.fromList . map toTuple =<< destinationEdge
+    origin = choose . NE.fromList =<< originEdge
+    destination = choose . NE.fromList =<< destinationEdge
     originEdge = pickEdge originRoom originCorner
     destinationEdge = pickEdge destinationRoom destinationCorner
     pickEdge room corner = choose . over both (boxEdge room) $ cornerEdges corner
@@ -188,4 +188,3 @@ corridorBetween originRoom destinationRoom
         (EQ, EQ) -> TopLeft -- should never happen
 
     destinationCorner = opposite originCorner
-    toTuple (V2 x y) = (x, y)
diff --git a/users/glittershark/xanthous/src/Xanthous/Generators/LevelContents.hs b/users/glittershark/xanthous/src/Xanthous/Generators/LevelContents.hs
index ed4cc87e79d7..8ebcc7f4da83 100644
--- a/users/glittershark/xanthous/src/Xanthous/Generators/LevelContents.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Generators/LevelContents.hs
@@ -14,13 +14,15 @@ import           Control.Monad.Random
 import           Data.Array.IArray (amap, bounds, rangeSize, (!))
 import qualified Data.Array.IArray as Arr
 import           Data.Foldable (any, toList)
+import           Linear.V2
 --------------------------------------------------------------------------------
 import           Xanthous.Generators.Util
 import           Xanthous.Random
-import           Xanthous.Data ( Position, _Position, positionFromPair
-                               , rotations, arrayNeighbors, Neighbors(..)
-                               , neighborPositions
-                               )
+import           Xanthous.Data
+                 ( positionFromV2,  Position, _Position
+                 , rotations, arrayNeighbors, Neighbors(..)
+                 , neighborPositions
+                 )
 import           Xanthous.Data.EntityMap (EntityMap, _EntityMap)
 import           Xanthous.Entities.Raws (rawsWithType, RawType)
 import qualified Xanthous.Entities.Item as Item
@@ -49,7 +51,7 @@ randomDoors cells = do
   doorRatio <- getRandomR subsetRange
   let numDoors = floor $ doorRatio * fromIntegral (length candidateCells)
       doorPositions =
-        removeAdjacent . fmap positionFromPair . take numDoors $ candidateCells
+        removeAdjacent . fmap positionFromV2 . take numDoors $ candidateCells
       doors = zip doorPositions $ repeat unlockedDoor
   pure $ _EntityMap # doors
   where
@@ -92,8 +94,9 @@ tutorialMessage cells characterPosition = do
     accessiblePositionsWithin :: Int -> Cells -> Position -> [Position]
     accessiblePositionsWithin dist valid pos =
       review _Position
-      <$> filter (\(px, py) -> not $ valid ! (fromIntegral px, fromIntegral py))
-          (circle (pos ^. _Position) dist)
+      <$> filter
+            (\pt -> not $ valid ! (fromIntegral <$> pt))
+            (circle (pos ^. _Position) dist)
 
 randomEntities
   :: forall entity raw m. (MonadRandom m, RawType raw)
@@ -116,10 +119,10 @@ randomEntities newWithType sizeRange cells =
       pure $ _EntityMap # entities
 
 randomPosition :: MonadRandom m => Cells -> m Position
-randomPosition = fmap positionFromPair . choose . impureNonNull . cellCandidates
+randomPosition = fmap positionFromV2 . choose . impureNonNull . cellCandidates
 
 -- cellCandidates :: Cells -> Cells
-cellCandidates :: Cells -> Set (Word, Word)
+cellCandidates :: Cells -> Set (V2 Word)
 cellCandidates
   -- find the largest contiguous region of cells in the cave.
   = maximumBy (compare `on` length)
diff --git a/users/glittershark/xanthous/src/Xanthous/Generators/Util.hs b/users/glittershark/xanthous/src/Xanthous/Generators/Util.hs
index e1e367007e65..88aadd5aadd9 100644
--- a/users/glittershark/xanthous/src/Xanthous/Generators/Util.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Generators/Util.hs
@@ -20,6 +20,7 @@ module Xanthous.Generators.Util
   ) where
 --------------------------------------------------------------------------------
 import           Xanthous.Prelude hiding (Foldable, toList, for_)
+--------------------------------------------------------------------------------
 import           Data.Array.ST
 import           Data.Array.Unboxed
 import           Control.Monad.ST
@@ -28,13 +29,14 @@ import           Data.Monoid
 import           Data.Foldable (Foldable, toList, for_)
 import qualified Data.Set as Set
 import           Data.Semigroup.Foldable
+import           Linear.V2
 --------------------------------------------------------------------------------
 import           Xanthous.Util (foldlMapM', maximum1, minimum1)
 import           Xanthous.Data (Dimensions, width, height)
 --------------------------------------------------------------------------------
 
-type MCells s = STUArray s (Word, Word) Bool
-type Cells = UArray (Word, Word) Bool
+type MCells s = STUArray s (V2 Word) Bool
+type Cells = UArray (V2 Word) Bool
 type CellM g s a = RandT g (ST s) a
 
 randInitialize :: RandomGen g => Dimensions -> Double -> CellM g s (MCells s)
@@ -43,28 +45,28 @@ randInitialize dims aliveChance = do
   for_ [0..dims ^. width] $ \i ->
     for_ [0..dims ^. height] $ \j -> do
       val <- (>= aliveChance) <$> getRandomR (0, 1)
-      lift $ writeArray res (i, j) val
+      lift $ writeArray res (V2 i j) val
   pure res
 
 initializeEmpty :: RandomGen g => Dimensions -> CellM g s (MCells s)
 initializeEmpty dims =
-  lift $ newArray ((0, 0), (dims ^. width, dims ^. height)) False
+  lift $ newArray (0, V2 (dims ^. width) (dims ^. height)) False
 
 numAliveNeighborsM
-  :: forall a i j m
-  . (MArray a Bool m, Ix (i, j), Integral i, Integral j)
-  => a (i, j) Bool
-  -> (i, j)
+  :: forall a i m
+  . (MArray a Bool m, Ix i, Integral i)
+  => a (V2 i) Bool
+  -> V2 i
   -> m Word
-numAliveNeighborsM cells (x, y) = do
+numAliveNeighborsM cells (V2 x y) = do
   cellBounds <- getBounds cells
   getSum <$> foldlMapM'
     (fmap (Sum . fromIntegral . fromEnum) . boundedGet cellBounds)
     neighborPositions
 
   where
-    boundedGet :: ((i, j), (i, j)) -> (Int, Int) -> m Bool
-    boundedGet ((minX, minY), (maxX, maxY)) (i, j)
+    boundedGet :: (V2 i, V2 i) -> (Int, Int) -> m Bool
+    boundedGet (V2 minX minY, V2 maxX maxY) (i, j)
       | x <= minX
         || y <= minY
         || x >= maxX
@@ -73,23 +75,23 @@ numAliveNeighborsM cells (x, y) = do
       | otherwise =
         let nx = fromIntegral $ fromIntegral x + i
             ny = fromIntegral $ fromIntegral y + j
-        in readArray cells (nx, ny)
+        in readArray cells $ V2 nx ny
 
 numAliveNeighbors
-  :: forall a i j
-  . (IArray a Bool, Ix (i, j), Integral i, Integral j)
-  => a (i, j) Bool
-  -> (i, j)
+  :: forall a i
+  . (IArray a Bool, Ix i, Integral i)
+  => a (V2 i) Bool
+  -> V2 i
   -> Word
-numAliveNeighbors cells (x, y) =
+numAliveNeighbors cells (V2 x y) =
   let cellBounds = bounds cells
   in getSum $ foldMap
       (Sum . fromIntegral . fromEnum . boundedGet cellBounds)
       neighborPositions
 
   where
-    boundedGet :: ((i, j), (i, j)) -> (Int, Int) -> Bool
-    boundedGet ((minX, minY), (maxX, maxY)) (i, j)
+    boundedGet :: (V2 i, V2 i) -> (Int, Int) -> Bool
+    boundedGet (V2 minX minY, V2 maxX maxY) (i, j)
       | x <= minX
         || y <= minY
         || x >= maxX
@@ -98,20 +100,20 @@ numAliveNeighbors cells (x, y) =
       | otherwise =
         let nx = fromIntegral $ fromIntegral x + i
             ny = fromIntegral $ fromIntegral y + j
-        in cells ! (nx, ny)
+        in cells ! V2 nx ny
 
 neighborPositions :: [(Int, Int)]
 neighborPositions = [(i, j) | i <- [-1..1], j <- [-1..1], (i, j) /= (0, 0)]
 
-fillOuterEdgesM :: (MArray a Bool m, Ix i, Ix j) => a (i, j) Bool -> m ()
+fillOuterEdgesM :: (MArray a Bool m, Ix i) => a (V2 i) Bool -> m ()
 fillOuterEdgesM arr = do
-  ((minX, minY), (maxX, maxY)) <- getBounds arr
+  (V2 minX minY, V2 maxX maxY) <- getBounds arr
   for_ (range (minX, maxX)) $ \x -> do
-    writeArray arr (x, minY) True
-    writeArray arr (x, maxY) True
+    writeArray arr (V2 x minY) True
+    writeArray arr (V2 x maxY) True
   for_ (range (minY, maxY)) $ \y -> do
-    writeArray arr (minX, y) True
-    writeArray arr (maxX, y) True
+    writeArray arr (V2 minX y) True
+    writeArray arr (V2 maxX y) True
 
 cloneMArray
   :: forall a a' i e m.
@@ -128,20 +130,20 @@ cloneMArray = thaw @_ @UArray <=< freeze
 
 -- | Flood fill a cell array starting at a point, returning a list of all the
 -- (true) cell locations reachable from that point
-floodFill :: forall a i j.
+floodFill :: forall a i.
             ( IArray a Bool
-            , Ix (i, j)
-            , Enum i , Enum j
-            , Bounded i , Bounded j
-            , Eq i , Eq j
+            , Ix i
+            , Enum i
+            , Bounded i
+            , Eq i
             )
-          => a (i, j) Bool -- ^ array
-          -> (i, j)        -- ^ position
-          -> Set (i, j)
+          => a (V2 i) Bool -- ^ array
+          -> (V2 i)        -- ^ position
+          -> Set (V2 i)
 floodFill = go mempty
   where
-    go :: Set (i, j) -> a (i, j) Bool -> (i, j) -> Set (i, j)
-    go res arr@(bounds -> arrBounds) idx@(x, y)
+    go :: Set (V2 i) -> a (V2 i) Bool -> (V2 i) -> Set (V2 i)
+    go res arr@(bounds -> arrBounds) idx@(V2 x y)
       | not (inRange arrBounds idx) =  res
       | not (arr ! idx) =  res
       | otherwise =
@@ -149,7 +151,7 @@ floodFill = go mempty
               = filter (inRange arrBounds)
               . filter (/= idx)
               . filter (`notMember` res)
-              $ (,)
+              $ V2
               <$> [(if x == minBound then x else pred x)
                    ..
                    (if x == maxBound then x else succ x)]
@@ -162,19 +164,19 @@ floodFill = go mempty
                                in r' `seq` go r' arr idx')
                      else r)
            (res & contains idx .~ True) neighbors
-{-# SPECIALIZE floodFill :: UArray (Word, Word) Bool -> (Word, Word) -> Set (Word, Word) #-}
+{-# SPECIALIZE floodFill :: UArray (V2 Word) Bool -> (V2 Word) -> Set (V2 Word) #-}
 
 -- | Gives a list of all the disconnected regions in a cell array, represented
 -- each as lists of points
-regions :: forall a i j.
+regions :: forall a i.
           ( IArray a Bool
-          , Ix (i, j)
-          , Enum i , Enum j
-          , Bounded i , Bounded j
-          , Eq i , Eq j
+          , Ix i
+          , Enum i
+          , Bounded i
+          , Eq i
           )
-        => a (i, j) Bool
-        -> [Set (i, j)]
+        => a (V2 i) Bool
+        -> [Set (V2 i)]
 regions arr
   | Just firstPoint <- findFirstPoint arr =
       let region = floodFill arr firstPoint
@@ -182,9 +184,9 @@ regions arr
       in region : regions arr'
   | otherwise = []
   where
-    findFirstPoint :: a (i, j) Bool -> Maybe (i, j)
+    findFirstPoint :: a (V2 i) Bool -> Maybe (V2 i)
     findFirstPoint = fmap fst . headMay . filter snd . assocs
-{-# SPECIALIZE regions :: UArray (Word, Word) Bool -> [Set (Word, Word)] #-}
+{-# SPECIALIZE regions :: UArray (V2 Word) Bool -> [Set (V2 Word)] #-}
 
 fillAll :: (IArray a Bool, Ix i, Foldable f) => f i -> a i Bool -> a i Bool
 fillAll ixes a = accum (const fst) a $ (, (False, ())) <$> toList ixes
diff --git a/users/glittershark/xanthous/src/Xanthous/Generators/Village.hs b/users/glittershark/xanthous/src/Xanthous/Generators/Village.hs
index 614170d0c4f1..cc9c9d963f5c 100644
--- a/users/glittershark/xanthous/src/Xanthous/Generators/Village.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Generators/Village.hs
@@ -73,9 +73,9 @@ fromCave' wallPositions = failing (pure ()) $ do
 
   where
     insertEntity e pt = modify $ EntityMap.insertAt (ptToPos pt) $ SomeEntity e
-    ptToPos pt = _Position # (pt & both %~ fromIntegral)
+    ptToPos pt = _Position # (fromIntegral <$> pt)
 
-    stepOut :: Set (Word, Word) -> [[(Word, Word)]] -> MaybeT m [[(Word, Word)]]
+    stepOut :: Set (V2 Word) -> [[V2 Word]] -> MaybeT m [[V2 Word]]
     stepOut circ rooms = for rooms $ \room ->
       let nextLevels = hashNub $ toList . neighborCells =<< room
       in pure
diff --git a/users/glittershark/xanthous/src/Xanthous/Util/Graphics.hs b/users/glittershark/xanthous/src/Xanthous/Util/Graphics.hs
index 1b8b79164397..353fcfc59b14 100644
--- a/users/glittershark/xanthous/src/Xanthous/Util/Graphics.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Util/Graphics.hs
@@ -38,18 +38,22 @@ import           Linear.V2
 --
 -- Code taken from <https://rosettacode.org/wiki/Bitmap/Midpoint_circle_algorithm#Haskell>
 circle :: (Num i, Ord i)
-       => (i, i) -- ^ center
-       -> i      -- ^ radius
-       -> [(i, i)]
-circle (x₀, y₀) radius
+       => V2 i -- ^ center
+       -> i    -- ^ radius
+       -> [V2 i]
+circle (V2 x₀ y₀) radius
   -- Four initial points, plus the generated points
-  = (x₀, y₀ + radius) : (x₀, y₀ - radius) : (x₀ + radius, y₀) : (x₀ - radius, y₀) : points
+  = V2 x₀ (y₀ + radius)
+  : V2 x₀ (y₀ - radius)
+  : V2 (x₀ + radius) y₀
+  : V2 (x₀ - radius) y₀
+  : points
     where
       -- Creates the (x, y) octet offsets, then maps them to absolute points in all octets.
       points = concatMap generatePoints $ unfoldr step initialValues
 
-      generatePoints (x, y)
-        = [ (x₀ `xop` x', y₀ `yop` y')
+      generatePoints (V2 x y)
+        = [ V2 (x₀ `xop` x') (y₀ `yop` y')
           | (x', y') <- [(x, y), (y, x)]
           , xop <- [(+), (-)]
           , yop <- [(+), (-)]
@@ -59,7 +63,7 @@ circle (x₀, y₀) radius
 
       step (f, ddf_x, ddf_y, x, y)
         | x >= y = Nothing
-        | otherwise = Just ((x', y'), (f', ddf_x', ddf_y', x', y'))
+        | otherwise = Just (V2 x' y', (f', ddf_x', ddf_y', x', y'))
         where
           (f', ddf_y', y') | f >= 0 = (f + ddf_y' + ddf_x', ddf_y + 2, y - 1)
                            | otherwise = (f + ddf_x, ddf_y, y)
@@ -70,11 +74,11 @@ circle (x₀, y₀) radius
 data FillState i
   = FillState
   { _inCircle :: Bool
-  , _result :: NonEmpty (i, i)
+  , _result :: NonEmpty (V2 i)
   }
 makeLenses ''FillState
 
-runFillState :: NonEmpty (i, i) -> State (FillState i) a -> [(i, i)]
+runFillState :: NonEmpty (V2 i) -> State (FillState i) a -> [V2 i]
 runFillState circumference s
   = toList
   . view result
@@ -84,11 +88,11 @@ runFillState circumference s
 -- | Generate a *filled* circle centered at the given point and with the given
 -- radius by filling a circle generated with 'circle'
 filledCircle :: (Num i, Integral i, Ix i)
-             => (i, i) -- ^ center
-             -> i      -- ^ radius
-             -> [(i, i)]
-filledCircle origin radius =
-  case NE.nonEmpty (circle origin radius) of
+             => V2 i -- ^ center
+             -> i    -- ^ radius
+             -> [V2 i]
+filledCircle center radius =
+  case NE.nonEmpty (circle center radius) of
     Nothing -> []
     Just circumference -> runFillState circumference $
       -- the first and last lines of all circles are solid, so the whole "in the
@@ -96,44 +100,44 @@ filledCircle origin radius =
       -- we don't need to fill them. So just skip them
       for_ [succ minX..pred maxX] $ \x ->
         for_ [minY..maxY] $ \y -> do
-          let pt = (x, y)
-              next = (x, succ y)
+          let pt = V2 x y
+              next = V2 x $ succ y
           whenM (use inCircle) $ result %= NE.cons pt
 
           when (pt `elem` circumference && next `notElem` circumference)
             $ inCircle %= not
 
       where
-        ((minX, minY), (maxX, maxY)) = minmaxes circumference
+        (V2 minX minY, V2 maxX maxY) = minmaxes circumference
 
 -- | Draw a line between two points using Bresenham's line drawing algorithm
 --
 -- Code taken from <https://wiki.haskell.org/Bresenham%27s_line_drawing_algorithm>
-line :: (Num i, Ord i) => (i, i) -> (i, i) -> [(i, i)]
-line pa@(xa, ya) pb@(xb, yb)
+line :: (Num i, Ord i) => V2 i -> V2 i -> [V2 i]
+line pa@(V2 xa ya) pb@(V2 xb yb)
   = (if maySwitch pa < maySwitch pb then id else reverse) points
   where
     points               = map maySwitch . unfoldr go $ (x₁, y₁, 0)
     steep                = abs (yb - ya) > abs (xb - xa)
-    maySwitch            = if steep then swap else id
-    [(x₁, y₁), (x₂, y₂)] = sort [maySwitch pa, maySwitch pb]
+    maySwitch            = if steep then view _yx else id
+    [V2 x₁ y₁, V2 x₂ y₂] = sort [maySwitch pa, maySwitch pb]
     δx                   = x₂ - x₁
     δy                   = abs (y₂ - y₁)
     ystep                = if y₁ < y₂ then 1 else -1
     go (xTemp, yTemp, err)
       | xTemp > x₂ = Nothing
-      | otherwise  = Just ((xTemp, yTemp), (xTemp + 1, newY, newError))
+      | otherwise  = Just ((V2 xTemp yTemp), (xTemp + 1, newY, newError))
       where
         tempError        = err + δy
         (newY, newError) = if (2 * tempError) >= δx
                            then (yTemp + ystep, tempError - δx)
                            else (yTemp, tempError)
-{-# SPECIALIZE line :: (Int, Int) -> (Int, Int) -> [(Int, Int)] #-}
-{-# SPECIALIZE line :: (Word, Word) -> (Word, Word) -> [(Word, Word)] #-}
+{-# SPECIALIZE line :: V2 Int -> V2 Int -> [V2 Int] #-}
+{-# SPECIALIZE line :: V2 Word -> V2 Word -> [V2 Word] #-}
 
-straightLine :: (Num i, Ord i) => (i, i) -> (i, i) -> [(i, i)]
-straightLine pa@(xa, _) pb@(_, yb) = line pa midpoint ++ line midpoint pb
-  where midpoint = (xa, yb)
+straightLine :: (Num i, Ord i) => V2 i -> V2 i -> [V2 i]
+straightLine pa@(V2 xa _) pb@(V2 _ yb) = line pa midpoint ++ line midpoint pb
+  where midpoint = V2 xa yb
 
 
 delaunay
@@ -151,26 +155,24 @@ delaunay
 
 --------------------------------------------------------------------------------
 
-renderBooleanGraphics :: forall i. (Num i, Ord i, Enum i) => [(i, i)] -> String
+renderBooleanGraphics :: forall i. (Num i, Ord i, Enum i) => [V2 i] -> String
 renderBooleanGraphics [] = ""
 renderBooleanGraphics (pt : pts') = intercalate "\n" rows
   where
     rows = row <$> [minX..maxX]
-    row x = [minY..maxY] <&> \y -> if (x, y) `member` ptSet then 'X' else ' '
-    ((minX, minY), (maxX, maxY)) = minmaxes pts
+    row x = [minY..maxY] <&> \y -> if V2 x y `member` ptSet then 'X' else ' '
+    (V2 minX minY, V2 maxX maxY) = minmaxes pts
     pts = pt :| pts'
-    ptSet :: Set (i, i)
+    ptSet :: Set (V2 i)
     ptSet = setFromList $ toList pts
 
-showBooleanGraphics :: forall i. (Num i, Ord i, Enum i) => [(i, i)] -> IO ()
+showBooleanGraphics :: forall i. (Num i, Ord i, Enum i) => [V2 i] -> IO ()
 showBooleanGraphics = putStrLn . pack . renderBooleanGraphics
 
-minmaxes :: forall i. (Ord i) => NonEmpty (i, i) -> ((i, i), (i, i))
+minmaxes :: forall i. (Ord i) => NonEmpty (V2 i) -> (V2 i, V2 i)
 minmaxes xs =
-    ( ( minimum1Of (traverse1 . _1) xs
-      , minimum1Of (traverse1 . _2) xs
-      )
-    , ( maximum1Of (traverse1 . _1) xs
-      , maximum1Of (traverse1 . _2) xs
-      )
-    )
+  ( V2 (minimum1Of (traverse1 . _x) xs)
+       (minimum1Of (traverse1 . _y) xs)
+  , V2 (maximum1Of (traverse1 . _x) xs)
+       (maximum1Of (traverse1 . _y) xs)
+  )
diff --git a/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs b/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs
index c82c385987b5..cdfadc06f505 100644
--- a/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs
+++ b/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE PackageImports #-}
-
+--------------------------------------------------------------------------------
 module Xanthous.Generators.UtilSpec (main, test) where
-
+--------------------------------------------------------------------------------
 import Test.Prelude
 import System.Random (mkStdGen)
 import Control.Monad.Random (runRandT)
@@ -11,18 +11,23 @@ import Data.Array.MArray (newArray, readArray, writeArray)
 import Data.Array (Array, range, listArray, Ix)
 import Control.Monad.ST (ST, runST)
 import "checkers" Test.QuickCheck.Instances.Array ()
-
+import Linear.V2
+--------------------------------------------------------------------------------
 import Xanthous.Util
 import Xanthous.Data (width, height)
 import Xanthous.Generators.Util
+--------------------------------------------------------------------------------
 
 main :: IO ()
 main = defaultMain test
 
+--------------------------------------------------------------------------------
+
 newtype GenArray a b = GenArray (Array a b)
   deriving stock (Show, Eq)
 
-instance (Ix a, Arbitrary a, CoArbitrary a, Arbitrary b) => Arbitrary (GenArray a b) where
+instance (Ix a, Arbitrary a, CoArbitrary a, Arbitrary b)
+       => Arbitrary (GenArray a b) where
   arbitrary = GenArray <$> do
     (mkElem :: a -> b) <- arbitrary
     minDims <- arbitrary
@@ -33,16 +38,18 @@ instance (Ix a, Arbitrary a, CoArbitrary a, Arbitrary b) => Arbitrary (GenArray
 test :: TestTree
 test = testGroup "Xanthous.Generators.Util"
   [ testGroup "randInitialize"
-    [ testProperty "returns an array of the correct dimensions" $ \dims seed aliveChance ->
+    [ testProperty "returns an array of the correct dimensions"
+      $ \dims seed aliveChance ->
         let gen = mkStdGen seed
             res = runSTUArray
                 $ fmap fst
                 $ flip runRandT gen
                 $ randInitialize dims aliveChance
-        in bounds res === ((0, 0), (dims ^. width, dims ^. height))
+        in bounds res === (0, V2 (dims ^. width) (dims ^. height))
     ]
   , testGroup "numAliveNeighborsM"
-    [ testProperty "maxes out at 8" $ \(GenArray (arr :: Array (Word, Word) Bool)) loc ->
+    [ testProperty "maxes out at 8"
+      $ \(GenArray (arr :: Array (V2 Word) Bool)) loc ->
         let
           act :: forall s. ST s Word
           act = do
@@ -53,7 +60,7 @@ test = testGroup "Xanthous.Generators.Util"
     ]
   , testGroup "numAliveNeighbors"
     [ testProperty "is equivalient to runST . numAliveNeighborsM . thaw" $
-      \(GenArray (arr :: Array (Word, Word) Bool)) loc ->
+      \(GenArray (arr :: Array (V2 Word) Bool)) loc ->
         let
           act :: forall s. ST s Word
           act = do
diff --git a/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs b/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs
index ff99d1073840..61e589280362 100644
--- a/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs
+++ b/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs
@@ -2,10 +2,13 @@ module Xanthous.Util.GraphicsSpec (main, test) where
 --------------------------------------------------------------------------------
 import Test.Prelude hiding (head)
 --------------------------------------------------------------------------------
+import Data.List (nub, head)
+import Data.Set (isSubsetOf)
+import Linear.V2
+--------------------------------------------------------------------------------
 import Xanthous.Util.Graphics
 import Xanthous.Util
-import Data.List (head)
-import Data.Set (isSubsetOf)
+import Xanthous.Orphans ()
 --------------------------------------------------------------------------------
 
 main :: IO ()
@@ -23,24 +26,28 @@ test = testGroup "Xanthous.Util.Graphics"
         | 2 |   | x |   | x |
         | 3 |   |   | x |   |
       -}
-      $ (sort . unique @[] @[_]) (circle @Int (2, 2) 1)
-      @?= [ (1, 2)
-          , (2, 1), (2, 3)
-          , (3, 2)
+      $ (sort . unique @[] @[_]) (circle @Int (V2 2 2) 1)
+      @?= [ V2 1 2
+          , V2 2 1, V2 2 3
+          , V2 3 2
           ]
     , testCase "radius 12, origin 0"
-      $ (sort . unique @[] @[_]) (circle @Int (0, 0) 12)
-      @?= [ (-12,-4),(-12,-3),(-12,-2),(-12,-1),(-12,0),(-12,1),(-12,2)
-          , (-12,3),(-12,4),(-11,-6),(-11,-5),(-11,5),(-11,6),(-10,-7),(-10,7)
-          , (-9,-9),(-9,-8),(-9,8),(-9,9),(-8,-9),(-8,9),(-7,-10),(-7,10)
-          , (-6,-11),(-6,11),(-5,-11),(-5 ,11),(-4,-12),(-4,12),(-3,-12),(-3,12)
-          , (-2,-12),(-2,12),(-1,-12),(-1,12),(0,-12),(0,12),(1,-12),(1,12)
-          , (2,-12),(2,12),(3,-12),(3,12),(4,-12),(4,12),(5,-11),(5 ,11),(6,-11)
-          , (6,11),(7,-10),(7,10),(8,-9),(8,9),(9,-9),(9,-8),(9,8),(9,9),(10,-7)
-          , (10,7),(11,-6),(11,-5),(11,5),(11,6),(12,-4),(12,-3),(12,-2),(12,-1)
-          , (12,0), (12,1),(12,2),(12,3),(12,4)
+      $   (sort . nub) (circle @Int 0 12)
+      @?= (sort . nub)
+          [ V2 (-12) (-4), V2 (-12) (-3), V2 (-12) (-2), V2 (-12) (-1)
+          , V2 (-12) 0, V2 (-12) 1, V2 (-12) 2, V2 (-12) 3, V2 (-12) 4
+          , V2 (-11) (-6), V2 (-11) (-5), V2 (-11) 5, V2 (-11) 6, V2 (-10) (-7)
+          , V2 (-10) 7, V2 (-9) (-9), V2 (-9) (-8), V2 (-9) 8, V2 (-9) 9
+          , V2 (-8) (-9), V2 (-8) 9, V2 (-7) (-10), V2 (-7) 10, V2 (-6) (-11)
+          , V2 (-6) 11, V2 (-5) (-11), V2 (-5) 11, V2 (-4) (-12), V2 (-4) 12
+          , V2 (-3) (-12), V2 (-3) 12, V2 (-2) (-12), V2 (-2) 12, V2 (-1) (-12)
+          , V2 (-1) 12, V2 0 (-12), V2 0 12, V2 1 (-12), V2 1 12, V2 2 (-12)
+          , V2 2 12, V2 3 (-12), V2 3 12, V2 4 (-12), V2 4 12, V2 5 (-11)
+          , V2 5 11, V2 6 (-11), V2 6 11, V2 7 (-10), V2 7 10, V2 8 (-9), V2 8 9
+          , V2 9 (-9), V2 9 (-8), V2 9 8, V2 9 9, V2 10 (-7), V2 10 7
+          , V2 11 (-6), V2 11 (-5), V2 11 5, V2 11 6, V2 12 (-4), V2 12 (-3)
+          , V2 12 (-2), V2 12 (-1), V2 12 0, V2 12 1, V2 12 2, V2 12 3, V2 12 4
           ]
-
     ]
   , testGroup "filledCircle"
     [ testProperty "is a superset of circle" $ \center radius ->
diff --git a/users/glittershark/xanthous/xanthous.cabal b/users/glittershark/xanthous/xanthous.cabal
index 653389a4c5cb..3f093a37a15a 100644
--- a/users/glittershark/xanthous/xanthous.cabal
+++ b/users/glittershark/xanthous/xanthous.cabal
@@ -1,10 +1,10 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.31.2.
+-- This file has been generated from package.yaml by hpack version 0.33.1.
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 5f419c8c149f045c818a2fb392b1233a0958e71e92d7a837deabc412e2b5adda
+-- hash: bb0a26ab512a1b8d095f3fa71370dcc5221c3f20888042a0d5c41d054dc403cf
 
 name:           xanthous
 version:        0.1.0.0
@@ -106,6 +106,7 @@ library
     , comonad-extras
     , constraints
     , containers
+    , criterion
     , data-default
     , deepseq
     , directory
@@ -231,6 +232,7 @@ executable xanthous
     , comonad-extras
     , constraints
     , containers
+    , criterion
     , data-default
     , deepseq
     , directory
@@ -323,6 +325,7 @@ test-suite test
     , comonad-extras
     , constraints
     , containers
+    , criterion
     , data-default
     , deepseq
     , directory