animascii-0.1.0.0: src/Parse.hs

module Parse where

import Text.Parsec
import Terminal.Game

import Data.List
import qualified Data.Functor.Identity as I
import qualified Data.Bifunctor as B
import qualified Data.Tuple as T

-- reads an animation file, returns frames (or an error)
readAnimation :: FilePath -> IO (Either String Animation)
readAnimation fp = readFile fp >>= \c ->
                   let parsed = parse animation fp c in
                   return (B.first (("readFrames: " ++) . show) parsed)


type Frame p i = (i, p)

-------------
-- PARSERS --
-------------

type Parser a = ParsecT String () (I.Identity) a

animation :: Parser Animation
animation = top                >>= \(w, mc, l) ->
            many1 (frame mc w) >>= \fs ->
            let fhs = fixHeight w fs in
            return (creaAni l fhs)
          <?> "animation"

-- get every frame at the same height
fixHeight :: Integer -> [Frame Plane Integer] -> [Frame Plane Integer]
fixHeight w fs = let ps = map snd fs
                     hs = map (snd . planeSize) ps
                     mh = maximum hs
                 in map (fhf w mh) fs
    where
          fhf :: Width -> Integer -> Frame Plane Integer ->
                 Frame Plane Integer
          fhf wh hh (i, p) = let p' =          blankPlane wh hh &
                                      (1, 1) % p
                           in (i, p')

top :: Parser (Integer, Maybe Char, Loop)
top = lLength         >>= \ln ->
      indicators      >>= \(tc, l) ->
      return (ln, tc, l)
    <?> "top-of-file indicator"
    where
          lLength :: Parser Integer
          lLength = lookAhead . try $
                        genericLength <$> manyTill anyChar (char '\n')

          indicators :: Parser (Maybe Char, Loop)
          indicators = inverted transChar loops

          -- vedi places
          inverted pa pb = try (places pa pb) <|>
                           T.swap <$> places pb pa

          -- per 2 parser interscambiabili
          places pa pb = tp1 *> pa >>= \x ->
                         tp  *> pb >>= \y  ->
                         tp        >>
                         endOfLine >>
                         return (x, y)

          tp :: Parser ()
          tp = () <$ many (char '=')

          tp1 :: Parser ()
          tp1 = () <$ many1 (char '=')

          -- Tc=
          transChar :: Parser (Maybe Char)
          transChar = optionMaybe (try $ char 'T' *> anyChar <* char '=')
                    <?> "transparent char indicator"

          -- L2=
          loops :: Parser (Loop)
          loops = option AlwaysLoop
                    (try $ char 'L'
                             *> fmap (flip Times Elapse) integer <* char '=')
                <?> "loop-times indicator"

-- frame of width w
frame :: Maybe Char -> Integer -> Parser (Frame Plane Integer)
frame mc w = content mc w >>= \tart ->
             endFrame     >>= \delay ->
             return (delay, tart)
           <?> "frame (content + division line)"

content :: Maybe Char -> Integer -> Parser Plane
content mc w = stringPlane mc w <$> manyTill1 anyChar end <* endOfLine
             <?> "frame content"
    where
          manyTill1 p e = (:) <$> p <*> manyTill p e
          end = lookAhead . try $ endOfLine *> endFrame

endFrame :: Parser Integer
endFrame = frameLine *> integer <* (frameLine *> fin)
         <?> "frame division line"
    where
          fin = () <$ endOfLine <|> eof
          frameLine = () <$ many1 (char '-')


-----------------
-- ANCILLARIES --
-----------------

integer :: Parser Integer
integer = fmap read (many1 digit) <?> "integer"