Drawing spirals in cubes
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 

116 lines
4.1 KiB

  1. module Main where
  2. import Control.Monad (forM_)
  3. import Data.List (intercalate)
  4. import Debug.Trace (trace)
  5. import Math.NumberTheory.Roots (integerSquareRoot, integerCubeRoot)
  6. type Cell = Int -- ^ The index of a cell in the cube
  7. type Peel = Int -- ^ A peel of our cube
  8. type Ring = Int -- ^ A ring of a 2D spiral
  9. type Length = Int -- ^ The length of an line segment
  10. type X = Int
  11. type Y = Int
  12. type Z = Int
  13. type Point2D = (X, Y)
  14. type Point3D = (X, Y, Z)
  15. area :: Int -> Int
  16. area a = a * a
  17. cube :: Int -> Int
  18. cube a = a * a * a
  19. ring :: Cell -> Ring
  20. ring o = integerSquareRoot o `div` 2
  21. peel :: Cell -> Peel
  22. peel c = integerCubeRoot c `div` 2
  23. edge :: Peel -> Length
  24. edge l = 2 * l + 2
  25. atZ :: Z -> Point2D -> Point3D
  26. atZ z (x, y) = (x, y, z)
  27. reflectY :: Point2D -> Point2D
  28. reflectY (x, y) = (x, -y - 1)
  29. reflectX :: Point2D -> Point2D
  30. reflectX (x, y) = (-x - 1, y)
  31. reflectX3 :: Point3D -> Point3D
  32. reflectX3 (x, y, z) = (-x - 1, y, z)
  33. reflectZ3 :: Point3D -> Point3D
  34. reflectZ3 (x, y, z) = (x, y, -z - 1)
  35. rotate :: Length -> Point2D -> Point2D
  36. rotate l (x, y) = (-y - 1, -x - 1)
  37. spirals :: Length -> Cell -> Point3D
  38. spirals l c = atZ h $ case h `mod` 4 of
  39. 0 -> growingSpiral l o
  40. 1 -> rotate l $ shrinkingSpiral l o
  41. 2 -> reflectX . reflectY $ growingSpiral l o
  42. 3 -> reflectX . reflectY . rotate l $ shrinkingSpiral l o
  43. where h = c `div` area l
  44. o = c - h * area l
  45. z = h - l `div` 2 - 1
  46. growingSpiral :: Length -> Cell -> Point2D
  47. growingSpiral l o | o == 0 = (0, 0)
  48. | ro < e - 1 = (r, ro - r) -- 64
  49. | ro < 2 * e - 2 = (3 * r - ro, r)
  50. | ro < 3 * e - 3 = (0 - r - 1, 5 * r - ro + 1)
  51. | otherwise = (ro - 7 * r - 3, 0 - r - 1)
  52. where r = ring o -- ^ the current spiral ring
  53. ro = o - area (edge $ r - 1) -- ^ offset within this ring
  54. e = edge r -- ^ edge of the this ring
  55. shrinkingSpiral :: Length -> Cell -> Point2D
  56. shrinkingSpiral l o = growingSpiral l (area l - o - 1)
  57. peeledCubes :: Length -> Cell -> Point3D
  58. peeledCubes _ c | o < a = reverseIfOdd
  59. . atZ (e `div` 2 - 1) -- on top of the cube
  60. $ growingSpiral e o
  61. | o < a + (e - 2) * (e - 1) * 4
  62. = reverseIfOdd
  63. $ mantel p e (o - a)
  64. | otherwise
  65. = reverseIfOdd
  66. . atZ (-e `div` 2) -- on the bottom of the cube
  67. . reflectX
  68. $ shrinkingSpiral e (o - a - (e - 2) * (e - 1) * 4)
  69. where p = peel c -- ^ the current peel
  70. o = c - cube (edge $ p - 1) -- ^ offset within the current peel
  71. e = edge p -- ^ the length of the edge of the current peel
  72. a = area e -- ^ the area of a side of the current peel
  73. reverseIfOdd = if p `mod` 2 == 0 then id else (reflectX3 . reflectZ3)
  74. mantel :: Peel -> Length -> Cell -> Point3D
  75. mantel p e m | o <= r = (p - r + o, 0 - p - 1, p - r - 1)
  76. | o <= r + e - 1 = (p, 0 - p - 1 + o - r, p - r - 1)
  77. | o <= r + 2 * e - 2 = (p - o + r + e - 1, p, p - r - 1)
  78. | o <= r + 3 * e - 3 = (0 - p - 1, p - o + r + 2 * e - 2, p - r - 1)
  79. | otherwise = (0 - p - 1 + o - r - 3 * e + 3, 0 - p - 1, p - r - 1)
  80. where r = m `div` (4 * e - 4) -- ^ revolutions since starting on the side
  81. o = m - (4 * e - 4) * r -- ^ offset within this revolution
  82. asMatrix :: Length -> [[[Cell]]]
  83. asMatrix e = foldl (\c (i, x, y, z) -> replace c z $ replace (c!!z) y $ replace (c!!z!!y) x i)
  84. (replicate e $ replicate e $ replicate e (-1))
  85. [ (i, x + div e 2, y + div e 2, z + div e 2)
  86. | i <- [0..cube e - 1]
  87. , let (x, y, z) = peeledCubes e i
  88. ]
  89. where replace :: [a] -> Int -> a -> [a]
  90. replace l i e = take i l ++ [e] ++ drop (i+1) l
  91. main :: IO ()
  92. main = forM_ (reverse $ asMatrix 6) $ \plane -> do
  93. forM_ (reverse plane) $ \row -> do
  94. putStrLn $ intercalate ",\t" $ map show row
  95. putStrLn ""