nyan-0.2: src/Main.hs

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Main entry point.

module Main where

import           Control.Concurrent
import           Control.Monad.Trans
import qualified Data.ByteString      as B
import           Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as L
import           Data.Char
import           Data.Int
import           Data.Monoid
import           Data.Text            (Text)
import qualified Data.Text            as T
import           Data.Text.Encoding
import           Data.Word
import           System.IO
import           UI.NCurses

-- | Main entry point.
main :: IO ()
main = do
  hSetBinaryMode stdin True
  hSetBuffering stdin NoBuffering
  runCurses $ do
    w <- defaultWindow
    garbage <- getGarbage mempty
    showScene w garbage 0

-- | Render nyan cat flying through space.
showScene :: Window -> ByteString -> Int -> Curses ()
showScene w garbage sceneIndex = do
  updateWindow w $ do
    moveCursor 0 0
    drawText $ (decodeUtf8 $ B.concat . L.toChunks . L.pack $
             L.zipWith paint (L.cycle garbage) $ frames !! sceneIndex)
             `mappend` "\n\n"
  render
  io $ threadDelay $ 1000 * 200
  newGarbage <- getGarbage garbage
  showScene w
            newGarbage
            (if sceneIndex == length frames - 1 then 0 else sceneIndex + 1)

-- | Get garbage input from stdin to be used for the rainbow.
getGarbage :: ByteString -> Curses ByteString
getGarbage previous = io $ do
  bytes <- fmap (L.filter (isAllowedChar.enumToEnum)) $ L.hGetNonBlocking stdin 100
  return $ L.take 100 $
    bytes `mappend`
    previous `mappend`
    L.repeat (fromIntegral $ fromEnum '=')

-- | Is an allowed byte?
isAllowedChar :: Char -> Bool
isAllowedChar c = elem c asciiChars

-- | Allowed bytes from input.
asciiChars :: [Char]
asciiChars = "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJ" ++
             "KLMNOPQRSTUVWXYZ[\\]^`abcdefghijklmnopqrstuvwxyz{|}~"

-- | "Paint" the garbage input onto the rainbow part of the frame.
paint :: Word8 -> Word8 -> Word8
paint garbageChar (enumToEnum -> '=')
  | isLatin1 (enumToEnum garbageChar) = garbageChar
  | otherwise = enumToEnum $ ';'
paint _           c   = c

-- | Convert one enum to another enum type.
enumToEnum :: (Enum a,Enum b) => a -> b
enumToEnum = toEnum . fromEnum

-- | Madness.
io :: MonadIO m => IO a -> m a
io = liftIO

frames :: [ByteString]
frames = map (L.fromChunks.return.encodeUtf8) $ T.splitOn ("\n\n") $ 
         ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;________________________;;;;;;;;;;;;;;;;;;;;;;\n================/                        \\;;;;;;;;;;;;;;;;;;;;;\n================|  '@'''''''@'''''@_''''  |;;;;;;;;;;;;;;;;;;;;\n================| ''''''''''''''''| \\'@'' |;/ |;;;;;;;;;;;;;;;;\n================| ''''''''''''''''|  \\_____/  |';;;;;;;;;;;;;;;\n==========_=====| ''''@''''@'''''|             ;;;;;;;;;;;;;;;;\n=========| \\____| ''''''''''''''|     _|    _|  \\;;;;;;;;;;;;;;\n==========\\_____| ''@''''''''''@| ##       #   ##|;;;;;;;;;;;;;\n================| '''''''@'''''''\\     |___,__| /;;;;;;;;;;;;;;\n================|  ''@'''''''''''`\\___________;;;;;;;;;;;;;;;;;\n================ \\_________________________/; \\;;;;;;;;;;;;;;;;\n=================\\_\\;\\_\\;;;;;;;;;;;;;;;\\_\\;;;\\_\\;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;________________________;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;/                        \\;;;;;;;;;;;;;;;;;;;;;\n================| ''''''''''''''''| \\'@'' |;/ |;;;;;;;;;;;;;;;;\n================| ''''''''''''''''|  \\_____/  |';;;;;;;;;;;;;;;\n================| ''''@''''@'''''|             ;;;;;;;;;;;;;;;;\n=========_______| ''''''''''''''|     _|    _|  \\;;;;;;;;;;;;;;\n=========\\______| ''@''''''''''@| ##       #   ##|;;;;;;;;;;;;;\n================| '''''''@'''''''\\     |___,__| /;;;;;;;;;;;;;;\n================|  ''@'''''''''''`\\___________;;;;;;;;;;;;;;;;;\n================|  ''''''''''''''''          /;;;;;;;;;;;;;;;;;\n===============| \\_________________________/ |;;;;;;;;;;;;;;;;;\n===============|_|;;|_/;;;;;;;;;;;;;;|_|;;|_|;;;;;;;;;;;;;;;;;;\n===============;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;________________________;;;;;;;;;;;;;;;;;;;;;;\n================/                        \\;;;;;;;;;;;;;;;;;;;;;\n================|  '@'''''''@'''''@_''''  |;;;;;;;;;;;;;;;;;;;;\n================| ''''''''''''''''| \\'@'' |;/ |;;;;;;;;;;;;;;;;\n================| ''''''''''''''''|  \\_____/  |';;;;;;;;;;;;;;;\n================| ''''@''''@'''''|             ;;;;;;;;;;;;;;;;\n=============___| ''''''''''''''|     _|    _|  \\;;;;;;;;;;;;;;\n=========/```___| ''@''''''''''@| ##       #   ##|;;;;;;;;;;;;;\n=========|/``===| '''''''@'''''''\\     |___,__| /;;;;;;;;;;;;;;\n================|  ''@'''''''''''`\\___________;;;;;;;;;;;;;;;;;\n==============/  \\________________________//;;;;;;;;;;;;;;;;;;;\n=============/_/;/_/;;;;;;;;;;;;;;/_/;;;/_/;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;"