animascii-0.1.1.0: src/Display.hs

module Display where

import Parse
import Export.Queue

import Terminal.Game

import Control.Concurrent

import qualified System.FilePath  as FP
import qualified System.Directory as D
import qualified Data.Maybe as M
import qualified Data.List as L


-- terminal function

playAnimation :: Integer -> FilePath -> MVar FilePath ->
                 JobQueue -> ResQueue -> IO ()
playAnimation fps idir mvf mvq mrq =
            D.getDirectoryContents idir >>= \dc ->
            screenSize >>= \(sw, sh) ->
            let flt = filter ((== ".txt") . FP.takeExtension) dc in
            (if not . null $ flt
              then readAnimation ("input-dir" FP.</> head flt)
              else return (Left $ "no available animation files in " ++
                           idir ++ "!"))
            >>= \ifs ->
            gameLoop "animascii v 0.1.0.0?"
                     (initState ifs)
                     lf
                     (df sw sh)
                     sExit
                     fps
    where
          initState fs = StateA fs
                                False
                                mvf
                                mvq
                                mrq
                                [initTimer idir]

-- state --

data StateA = StateA { -- ani to display
                       sAni      :: Either String Animation,
                       -- exit condition
                       sExit     :: Bool,
                       -- current file
                       smFile    :: MVar FilePath,
                       -- queue to process
                       smQueue   :: JobQueue,
                       -- results of the exports
                       smResults :: ResQueue,
                       -- list of timed feedback messages to display to screen
                       smDispRes :: [TimeMes] }

lf :: StateA -> Maybe Char -> IO StateA
lf st                              (Just 'q') = return $ st { sExit = True }
lf st@(StateA ea eb mvf mvq mrq _) _          =
        tryTakeMVar mvf >>= \mfp ->
        readMVar    mvq >>= \q   ->
        (case mfp of
           Just fp -> readAnimation fp >>= \ea' ->
                      let st'  = st { sAni = ea' }
                      in return st'
           Nothing -> let st' = st { sAni = fmap tick ea }
                      in return st')
        -- timers (adds/prunes)
        >>= addTMsgs >>= tickTimers


-- draw --

df :: Width -> Height -> StateA -> Plane
df sw sh s =
       case sAni s of
         Left es -> textBox es 40 15
         Right a -> let -- animation plane
                        drawAni    = fetchFrame a
                        (pw, ph)   = planeSize drawAni
                        ar = div (sh - ph) 2 + 1
                        ac = div (sw - pw) 2 + 1

                        -- background
                        background :: Plane
                        background =            blankPlane sw sh &
                                      (1,1)   % box ' ' sw sh

                        -- communitcation rectangle
                        commRect :: Plane
                        commRect = tMsgsPlane (sw-4) (smDispRes s)
                        -- its height and width
                        (_, crh) = planeSize commRect
                        -- xxx fai una funzione che ti aiuti a fare questo
                        -- (place by lowerright)?
                        -- its row placement
                        crhp = sh - crh
                    in

                                 background &
                    (ar  , ac) % drawAni    &
                    (crhp,  3) % commRect



-- xxx error in array index quando vai fuori scrittura
-- xxx a posto messaggi di feedback
-- xxx 100% cpu

-- message timers --

type TimeMes = Timed (Maybe String)

initTimer :: FilePath -> TimeMes
initTimer dir = creaTimer (Just initMes) Nothing 500
    where
          initMes = "Welcome!\nEdit & save files in " ++ dir FP.</>
                    " to display animations.\nPress 'q' to quit.\n\nManual: \
                    \http://ariis.it/static/articles/animascii/page.html"

tickTimers :: StateA -> IO StateA
tickTimers s = return (s { smDispRes = tsn })
    where
          tsn = pruneTMsgs $ fmap tick (smDispRes s)

          pruneTMsgs :: [TimeMes] -> [TimeMes]
          pruneTMsgs ms = filter ((/= Nothing) . fetchFrame) ms


addTMsgs :: StateA -> IO StateA
addTMsgs s = getResults rq >>= \rms ->
             let rms' = fmap mtim rms in
             return (s { smDispRes = ms ++ rms' })
    where
          rq = smResults s
          ms = smDispRes s

          mtim s = creaTimer (Just s) Nothing 300

-- xxx error on textbox shorter than it should be

tMsgsPlane :: Width -> [TimeMes] -> Plane
tMsgsPlane w tms = textBox ms (200) (L.genericLength $ lines ms)
    where
          ms = unlines $ map (M.fromJust . fetchFrame) tms