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