80 lines
2.4 KiB
Haskell
80 lines
2.4 KiB
Haskell
module Main where
|
|
|
|
import Control.Monad (forM_)
|
|
import Data.List (intercalate)
|
|
import Debug.Trace (trace)
|
|
import Math.NumberTheory.Roots (integerSquareRoot, integerCubeRoot)
|
|
|
|
type Cell = Int -- ^ The index of a cell in the cube
|
|
type Layer = Int -- ^ A layer of our cube
|
|
type Ring = Int -- ^ A ring of a 2D spiral
|
|
type Length = Int -- ^ The length of an line segment
|
|
type X = Int
|
|
type Y = Int
|
|
type Z = Int
|
|
type Point2D = (X, Y)
|
|
type Point3D = (X, Y, Z)
|
|
|
|
area :: Int -> Int
|
|
area a = a * a
|
|
|
|
cube :: Int -> Int
|
|
cube a = a * a * a
|
|
|
|
ring :: Cell -> Ring
|
|
ring o = integerSquareRoot o `div` 2
|
|
|
|
edge :: Layer -> Length
|
|
edge l = 2 * l + 2
|
|
|
|
atZ :: Z -> Point2D -> Point3D
|
|
atZ z (x, y) = (x, y, z)
|
|
|
|
reflectY :: Point2D -> Point2D
|
|
reflectY (x, y) = (x, -y - 1)
|
|
|
|
reflectX :: Point2D -> Point2D
|
|
reflectX (x, y) = (-x - 1, y)
|
|
|
|
rotate :: Length -> Point2D -> Point2D
|
|
rotate l (x, y) = (-y - 1, -x - 1)
|
|
|
|
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
|
|
|
|
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)
|
|
| i <- [0..cube e - 1]
|
|
, 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
|
|
|
|
main :: IO ()
|
|
main = forM_ (reverse $ asMatrix 6) $ \plane -> do
|
|
forM_ (reverse plane) $ \row -> do
|
|
putStrLn $ intercalate ",\t" $ map show row
|
|
putStrLn ""
|