-------------------------------------------------------------------------------
-- ANSI terminal display
-- (C) 2017 Francesco Ariis (GPL v3)
-------------------------------------------------------------------------------
-- Plane to ANSI terminal display
module Terminal.Game.ANSI where
import Terminal.Game.Draw
import Terminal.Game.Plane
import qualified System.Console.ANSI as CA
import qualified Data.List.Split as LS
import qualified Control.Monad as CM
import qualified Data.Array as A
-- xxx elmina 80 cols
-- th tw: terminal width and height
-- pn: new plane, po: old plane
-- fps sono gli fps attuali, puoi stamparli come preferisci (o non stamparli)
-- wo, ho: dimensions of the terminal. If they change, reinit double buffering
blitPlane :: Width -> Height -> Maybe Plane -> Plane -> Integer -> IO ()
blitPlane tw th mpo pn cFps =
-- old plane
let
(pw, ph) = planeSize pn
bp = blankPlane pw ph
po = pastePlane (maybe bp id mpo) bp (1, 1)
in
-- new plane
let pn' = pastePlane pn bp (1, 1)
pn'' = pastePlane (textBox (show cFps) 100 100) pn' (1, 2)
in
-- reset formatting and print everything
-- CA.setSGR [CA.Reset, CA.SetColor CA.Background CA.Dull CA.Black] >>
CA.setSGR [CA.Reset] >>
blitMap po pn' tw th
-----------------
-- ANCILLARIES --
-----------------
-- plane + term w/h
blitMap :: Plane -> Plane -> Width -> Height -> IO ()
blitMap po pn tw th = CM.when (planeSize po /= planeSize pn)
(error "blitMap: different plane sizes") >>
CA.setCursorPosition (fi cr) (fi cc) >>
blitToTerminal cc (orderedCells po) (orderedCells pn)
where
(pw, ph) = planeSize pn
cr = div (th - ph) 2
cc = div (tw - pw) 2
fi = fromIntegral
orderedCells :: Plane -> [[Cell]]
orderedCells p = LS.chunksOf (fromIntegral w) cells
where
-- todo altra funzione invece che un map 2nd?
cells = map snd $ assocsPlane p
(w, _) = planeSize p
-- ordered sequence of cells, both old and new, like they were a String to
-- print to screen
blitToTerminal :: Column -> [[Cell]] -> [[Cell]] -> IO ()
blitToTerminal rc ocs ncs = mapM_ blitLine oldNew
where
oldNew :: [[(Cell, Cell)]]
oldNew = zipWith zip ocs ncs
blitLine :: [(Cell, Cell)] -> IO ()
blitLine ccs = CM.foldM blitChar 0 ccs >>
CA.cursorDown 1 >>
CA.setCursorColumn (fromIntegral rc)
-- k is "spaces to skip"
blitChar :: Int -> (Cell, Cell) -> IO Int
blitChar k (clo, cln)
| cln == clo = return (k+1)
| otherwise = moveIf k >>= \k' ->
putChar (cellChar cln) >>
return k'
moveIf :: Int -> IO Int
moveIf k | k == 0 = return k
| otherwise = CA.cursorForward k >>
return 0