A simple opening/closing spiral going upwards

Main.hs

@@ -12,7 +12,8 @@ type Length = Int -- ^ The length of an line segment
 type X = Int
 type Y = Int
 type Z = Int
-type Point = (X, Y, Z)
+type Point2D = (X, Y)
+type Point3D = (X, Y, Z)
 
 area :: Int -> Int
 area a = a * a
@@ -20,68 +21,53 @@ area a = a * a
 cube :: Int -> Int
 cube a = a * a * a
 
-layer :: Cell -> Layer
-layer c = integerCubeRoot c `div` 2
-
 ring :: Cell -> Ring
 ring o = integerSquareRoot o `div` 2
 
 edge :: Layer -> Length
 edge l = 2 * l + 2
 
--- | Offset of a cell within its layer
-lOffset :: Cell -> Cell
-lOffset c = c - cube (edge $ layer c - 1)
+atZ :: Z -> Point2D -> Point3D
+atZ z (x, y) = (x, y, z)
 
--- | Offset of a cell in a layer within its spiral ring
-rOffset :: Cell -> Cell
-rOffset o = o - area (edge $ ring o - 1)
+reflectY :: Point2D -> Point2D
+reflectY (x, y) = (x, -y - 1)
 
-location :: Cell -> Point
-location c | o < a = locationOnTop (e `div` 2 - 1) o
-           | o < a + (e - 2) * (e - 1) * 4 = locationAround c
-           | otherwise = locationOnBottom ((-e) `div` 2) c (o - a - (e - 2) * (e - 1) * 4)
-  where o = lOffset c -- ^ offset within the current layer
-        l = layer c   -- ^ the current layer
-        e = edge l    -- ^ the length of the edge of the current layer
-        a = area e    -- ^ the area of a side of the current layer
+reflectX :: Point2D -> Point2D
+reflectX (x, y) = (-x - 1, y)
 
-locationOnTop :: Z -> Cell -> Point
-locationOnTop z o | o == 0         = (0, 0, z)
-                  | ro <     e - 1 = (r, ro - r, z) -- 64
-                  | ro < 2 * e - 2 = (3 * r - ro, r, z)
-                  | ro < 3 * e - 3 = (0 - r - 1, 5 * r - ro + 1, z)
-                  | otherwise      = (ro - 7 * r - 3, 0 - r - 1, z)
-  where r = ring o     -- ^ the current spiral ring
-        ro = rOffset o -- ^ offset within this ring
-        e = edge r     -- ^ edge of the this ring
+rotate :: Length -> Point2D -> Point2D
+rotate l (x, y) = (-y - 1, -x - 1)
 
-locationAround :: Cell -> Point
-locationAround c | o <= r             = (l - r + o, 0 - l - 1, l - r - 1)
-                 | o <= r +     e - 1 = (l, 0 - l - 1 + o - r, l - r - 1)
-                 | o <= r + 2 * e - 2 = (l - o + r + e - 1, l, l - r - 1)
-                 | o <= r + 3 * e - 3 = (0 - l - 1, l - o + r + 2 * e - 2, l - r - 1)
-                 | otherwise          = (0 - l - 1 + o - r - 3 * e + 3, 0 - l - 1, l - r - 1)
-  where l = layer c
-        e = edge l
-        s = lOffset c - area e  -- ^ offset since starting the sides of the cude
-        r = s `div` (4 * e - 4) -- ^ revolutions since starting on the side
-        o = s - (4 * e - 4) * r -- ^ offset within this revolution
+location :: Length -> Cell -> Point3D
+location l c = atZ h $ case h `mod` 4 of
+    0 -> growingSpiral l o
+    1 -> rotate l $ shrinkingSpiral l o
+    2 -> reflectX . reflectY $ growingSpiral l o
+    3 -> reflectX . reflectY . rotate l $ shrinkingSpiral l o
+  where h = c `div` area l
+        o = c - h * area l
+        z = h - l `div` 2 - 1
 
-locationOnBottom :: Z -> Cell -> Cell -> Point
-locationOnBottom z c b | False =  (r, r, z)
-                       | otherwise = (3, -3, z)
-  where l = layer c
-        r = integerSquareRoot (area (edge l) - b - 1) `div` 2 -- ^ the current spiral ring
+growingSpiral :: Length -> Cell -> Point2D
+growingSpiral l o | o == 0         = (0, 0)
+                  | ro <     e - 1 = (r, ro - r) -- 64
+                  | ro < 2 * e - 2 = (3 * r - ro, r)
+                  | ro < 3 * e - 3 = (0 - r - 1, 5 * r - ro + 1)
+                  | otherwise      = (ro - 7 * r - 3, 0 - r - 1)
+  where r = ring o                   -- ^ the current spiral ring
+        ro = o - area (edge $ r - 1) -- ^ offset within this ring
+        e = edge r                   -- ^ edge of the this ring
+
+shrinkingSpiral :: Length -> Cell -> Point2D
+shrinkingSpiral l o = growingSpiral l (area l - o - 1)
 
 asMatrix :: Length -> [[[Cell]]]
 asMatrix e = foldl (\c (i, x, y, z) -> replace c z $ replace (c!!z) y $ replace (c!!z!!y) x i)
                    (replicate e $ replicate e $ replicate e (-1))
-                   [ (i, x + div e 2, y + div e 2, z + div e 2)
+                   [ (i, x + div e 2, y + div e 2, z)
                    | i <- [0..cube e - 1]
-                   , let (x, y, z) = location i
-                   -- , x + div e 2 >= 0, y + div e 2 >= 0, z + div e 2 >= 0
-                   -- , x < div e 2, y < div e 2, z < div e 2
+                   , let (x, y, z) = location e i
                    ]
   where replace :: [a] -> Int -> a -> [a]
         replace l i e = take i l ++ [e] ++ drop (i+1) l