Spiral/spiral.hs

import System.IO

data Incarnation = S Bool Bool Int (Int,Int) Int Int

seed :: Int -> Int
seed n = 1 + (h * (n+1))
   where h = (div n 2)

lineage :: Int -> [Int]
lineage n = take (n*n) $ futures (atom n)

atom :: Int -> Incarnation
atom n = S False True 1 (1,0) (seed n) n

xor :: Bool -> Bool -> Bool
xor a b = (a || b) && (not (a && b))

futures :: Incarnation -> [Int]
futures self@(S _ _ _ _ l _) =
   (l:(futures (evolve self)))

divine :: Incarnation -> Int
divine (S v s _ _ l n) = l `sign` val
   where
      sign = if s then (+) else (-)
      val = if v then n else 1

evolve :: Incarnation -> Incarnation
evolve i@(S v s cd (so,sn) _ b)
   | cd > 1 = (S v s (cd-1) (so,sn) (divine i) b)
   | otherwise =
      (S (not v) (s `xor` v) (cs ns) ns (divine i) b)
   where
      ns = (intuit v (so,sn))
      cs = (if v then fst else snd)

intuit :: Bool -> (Int,Int) -> (Int,Int)
intuit True (a,b) = ((a+1),b)
intuit _ (a,b) = (a,(b+1))

-- blurgh io
-- bloating the program making me import stuff >:(

main :: IO ()
main = do
   putStr "destinies to observe: "
   hFlush stdout
   args <- getLine
   mapM_ putStrLn
      $ map (\n -> ("n=" ++ (show n) ++ " ~ ")
              ++ (if (aura n)
                  then (show (lineage (read n)))
                  else "[ soul contains invalid aura ]"))
            (words args)

aura :: String -> Bool
aura s = if (foldr (&&) True (map (`elem` ['0'..'9']) s))
         then ((mod rs 2) == 1)
         else False
   where
      rs = (read s)::Int