{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Terminal.Game.Layer.Object.IO where
import Terminal.Game.Layer.Object.Interface
import Terminal.Game.Plane
import Terminal.Game.Utils
import qualified Control.Concurrent as CC
import qualified Control.Monad as CM
import qualified Control.Monad.Catch as MC
import qualified Control.Monad.Trans as T
import qualified Data.List.Split as LS
import qualified System.Clock as SC
import qualified System.Console.ANSI as CA
import qualified System.Console.Terminal.Size as TS
import qualified System.IO as SI
instance {-# OVERLAPS #-} (Monad m, T.MonadIO m) => MonadInput m where
startEvents :: FPS -> m InputHandle
startEvents FPS
fps = IO InputHandle -> m InputHandle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (IO InputHandle -> m InputHandle)
-> IO InputHandle -> m InputHandle
forall a b. (a -> b) -> a -> b
$ Maybe (MVar [Event]) -> FPS -> IO InputHandle
startIOInput Maybe (MVar [Event])
forall a. Maybe a
Nothing FPS
fps
pollEvents :: MVar [Event] -> m [Event]
pollEvents MVar [Event]
ve = IO [Event] -> m [Event]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (IO [Event] -> m [Event]) -> IO [Event] -> m [Event]
forall a b. (a -> b) -> a -> b
$ MVar [Event] -> [Event] -> IO [Event]
forall a. MVar a -> a -> IO a
CC.swapMVar MVar [Event]
ve []
stopEvents :: [ThreadId] -> m ()
stopEvents [ThreadId]
ts = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [ThreadId] -> IO ()
stopEventsIO [ThreadId]
ts
startIOInput :: Maybe (CC.MVar [Event]) -> FPS -> IO InputHandle
startIOInput :: Maybe (MVar [Event]) -> FPS -> IO InputHandle
startIOInput Maybe (MVar [Event])
mr FPS
fps =
Handle -> BufferMode -> IO ()
SI.hSetBuffering Handle
SI.stdin BufferMode
SI.NoBuffering IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Handle -> BufferMode -> IO ()
SI.hSetBuffering Handle
SI.stdout BufferMode
SI.NoBuffering IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Handle -> Bool -> IO ()
SI.hSetEcho Handle
SI.stdin Bool
False IO () -> IO (MVar [Event]) -> IO (MVar [Event])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
[Event] -> IO (MVar [Event])
forall a. a -> IO (MVar a)
CC.newMVar [] IO (MVar [Event])
-> (MVar [Event] -> IO InputHandle) -> IO InputHandle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVar [Event]
ve ->
IO () -> IO ThreadId
CC.forkIO (Maybe (MVar [Event]) -> MVar [Event] -> FPS -> IO ()
addTick Maybe (MVar [Event])
mr MVar [Event]
ve FPS
fps) IO ThreadId -> (ThreadId -> IO InputHandle) -> IO InputHandle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ThreadId
te ->
IO () -> IO ThreadId
CC.forkIO (Maybe (MVar [Event]) -> MVar [Event] -> IO ()
addKeypress Maybe (MVar [Event])
mr MVar [Event]
ve) IO ThreadId -> (ThreadId -> IO InputHandle) -> IO InputHandle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ThreadId
tk ->
InputHandle -> IO InputHandle
forall (m :: * -> *) a. Monad m => a -> m a
return (MVar [Event] -> [ThreadId] -> InputHandle
InputHandle MVar [Event]
ve [ThreadId
te, ThreadId
tk])
addTick :: Maybe (CC.MVar [Event]) -> CC.MVar [Event] -> FPS -> IO ()
addTick :: Maybe (MVar [Event]) -> MVar [Event] -> FPS -> IO ()
addTick Maybe (MVar [Event])
mr MVar [Event]
ve FPS
fps = Maybe (MVar [Event]) -> MVar [Event] -> Event -> IO ()
addEvent Maybe (MVar [Event])
mr MVar [Event]
ve Event
Tick IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Int -> IO ()
CC.threadDelay Int
delayAmount IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Maybe (MVar [Event]) -> MVar [Event] -> FPS -> IO ()
addTick Maybe (MVar [Event])
mr MVar [Event]
ve FPS
fps
where
delayAmount :: Int
delayAmount :: Int
delayAmount = FPS -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FPS -> Int) -> FPS -> Int
forall a b. (a -> b) -> a -> b
$ FPS -> FPS -> FPS
forall a. Integral a => a -> a -> a
quot FPS
oneTickSec FPS
fps
addKeypress :: Maybe (CC.MVar [Event]) -> CC.MVar [Event] -> IO ()
addKeypress :: Maybe (MVar [Event]) -> MVar [Event] -> IO ()
addKeypress Maybe (MVar [Event])
mr MVar [Event]
ve =
IO Char
inputCharTerminal IO Char -> (Char -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c ->
Maybe (MVar [Event]) -> MVar [Event] -> Event -> IO ()
addEvent Maybe (MVar [Event])
mr MVar [Event]
ve (Char -> Event
KeyPress Char
c) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Maybe (MVar [Event]) -> MVar [Event] -> IO ()
addKeypress Maybe (MVar [Event])
mr MVar [Event]
ve
addEvent :: Maybe (CC.MVar [Event]) -> CC.MVar [Event] -> Event -> IO ()
addEvent :: Maybe (MVar [Event]) -> MVar [Event] -> Event -> IO ()
addEvent Maybe (MVar [Event])
mr MVar [Event]
ve Event
e | (Just MVar [Event]
d) <- Maybe (MVar [Event])
mr = MVar [Event] -> IO ()
vf MVar [Event]
d IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVar [Event] -> IO ()
vf MVar [Event]
ve
| Bool
otherwise = MVar [Event] -> IO ()
vf MVar [Event]
ve
where
vf :: MVar [Event] -> IO ()
vf MVar [Event]
d = MVar [Event] -> ([Event] -> IO [Event]) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
CC.modifyMVar_ MVar [Event]
d ([Event] -> IO [Event]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Event] -> IO [Event])
-> ([Event] -> [Event]) -> [Event] -> IO [Event]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Event] -> [Event] -> [Event]
forall a. [a] -> [a] -> [a]
++[Event
e]))
stopEventsIO :: [CC.ThreadId] -> IO ()
stopEventsIO :: [ThreadId] -> IO ()
stopEventsIO [ThreadId]
ts = (ThreadId -> IO ()) -> [ThreadId] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ThreadId -> IO ()
CC.killThread [ThreadId]
ts
instance {-# OVERLAPS #-} (Monad m, T.MonadIO m) => MonadTimer m where
getTime :: m FPS
getTime = IO FPS -> m FPS
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (IO FPS -> m FPS) -> IO FPS -> m FPS
forall a b. (a -> b) -> a -> b
$ TimeSpec -> FPS
SC.toNanoSecs (TimeSpec -> FPS) -> IO TimeSpec -> IO FPS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Clock -> IO TimeSpec
SC.getTime Clock
SC.Monotonic
sleepABit :: FPS -> m ()
sleepABit FPS
fps = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
Int -> IO ()
CC.threadDelay (FPS -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FPS -> Int) -> FPS -> Int
forall a b. (a -> b) -> a -> b
$ FPS -> FPS -> FPS
forall a. Integral a => a -> a -> a
quot FPS
oneTickSec (FPS
fpsFPS -> FPS -> FPS
forall a. Num a => a -> a -> a
*FPS
10))
instance {-# OVERLAPS #-}
(Monad m, T.MonadIO m, MC.MonadMask m, MC.MonadThrow m) =>
MonadException m where
cleanUpErr :: m a -> m b -> m a
cleanUpErr m a
m m b
c = m a -> m b -> m a
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
MC.finally m a
m m b
c
throwExc :: ATGException -> m a
throwExc ATGException
t = ATGException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
MC.throwM ATGException
t
instance {-# OVERLAPS #-} (Monad m, T.MonadIO m) =>
MonadLogic m where
checkQuit :: (s -> Bool) -> s -> m Bool
checkQuit s -> Bool
fb s
s = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> Bool
fb s
s)
instance {-# OVERLAPS #-} (Monad m, T.MonadIO m) => MonadDisplay m where
setupDisplay :: m ()
setupDisplay = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO IO ()
initPart
clearDisplay :: m ()
clearDisplay = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO IO ()
clearScreen
displaySize :: m (Maybe (Int, Int))
displaySize = IO (Maybe (Int, Int)) -> m (Maybe (Int, Int))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO IO (Maybe (Int, Int))
displaySizeIO
blitPlane :: Int -> Int -> Maybe Plane -> Plane -> m ()
blitPlane Int
w Int
h Maybe Plane
mp Plane
p = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (Int -> Int -> Maybe Plane -> Plane -> IO ()
blitPlaneIO Int
w Int
h Maybe Plane
mp Plane
p)
shutdownDisplay :: m ()
shutdownDisplay = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO IO ()
cleanAndExit
displaySizeIO :: IO (Maybe (Width, Height))
displaySizeIO :: IO (Maybe (Int, Int))
displaySizeIO =
IO (Maybe (Window Int))
forall n. Integral n => IO (Maybe (Window n))
TS.size IO (Maybe (Window Int))
-> (Maybe (Window Int) -> IO (Maybe (Int, Int)))
-> IO (Maybe (Int, Int))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe (Window Int)
ts ->
IO Bool
isWin32Console IO Bool -> (Bool -> IO (Maybe (Int, Int))) -> IO (Maybe (Int, Int))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
bw ->
Maybe (Int, Int) -> IO (Maybe (Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Window Int -> (Int, Int))
-> Maybe (Window Int) -> Maybe (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Window Int -> (Int, Int)
f Bool
bw) Maybe (Window Int)
ts)
where
f :: Bool -> TS.Window Int -> (Width, Height)
f :: Bool -> Window Int -> (Int, Int)
f Bool
wbw (TS.Window Int
h Int
w) =
let h' :: Int
h' | Bool
wbw = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
| Bool
otherwise = Int
h
in (Int
w, Int
h')
blitPlaneIO :: Width -> Height -> Maybe Plane -> Plane -> IO ()
blitPlaneIO :: Int -> Int -> Maybe Plane -> Plane -> IO ()
blitPlaneIO Int
tw Int
th Maybe Plane
mpo Plane
pn =
let
(Int
pw, Int
ph) = Plane -> (Int, Int)
planeSize Plane
pn
bp :: Plane
bp = Int -> Int -> Plane
blankPlane Int
pw Int
ph
po :: Plane
po = Plane -> Plane -> (Int, Int) -> Plane
pastePlane (Plane -> (Plane -> Plane) -> Maybe Plane -> Plane
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Plane
bp Plane -> Plane
forall a. a -> a
id Maybe Plane
mpo) Plane
bp (Int
1, Int
1)
in
let pn' :: Plane
pn' = Plane -> Plane -> (Int, Int) -> Plane
pastePlane Plane
pn Plane
bp (Int
1, Int
1)
in
[SGR] -> IO ()
CA.setSGR [SGR
CA.Reset] IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Plane -> Plane -> Int -> Int -> IO ()
blitMap Plane
po Plane
pn' Int
tw Int
th
initPart :: IO ()
initPart :: IO ()
initPart =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
CM.unless Bool
CC.rtsSupportsBoundThreads
([Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
errMes) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
IO ()
CA.hideCursor IO () -> IO TextEncoding -> IO TextEncoding
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
[Char] -> IO TextEncoding
SI.mkTextEncoding [Char]
"UTF-8//TRANSLIT" IO TextEncoding -> (TextEncoding -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TextEncoding
te ->
Handle -> TextEncoding -> IO ()
SI.hSetEncoding Handle
SI.stdout TextEncoding
te IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
IO ()
clearScreen
where
errMes :: [Char]
errMes = [[Char]] -> [Char]
unlines
[[Char]
"\nError: you *must* compile this program with -threaded!",
[Char]
"Just add",
[Char]
"",
[Char]
" ghc-options: -threaded",
[Char]
"",
[Char]
"in your .cabal file (executable section) and you will be fine!"]
clearScreen :: IO ()
clearScreen :: IO ()
clearScreen = Int -> Int -> IO ()
CA.setCursorPosition Int
0 Int
0 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
[SGR] -> IO ()
CA.setSGR [SGR
CA.Reset] IO () -> IO (Int, Int) -> IO (Int, Int)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
IO (Int, Int)
forall (m :: * -> *).
(MonadDisplay m, MonadException m) =>
m (Int, Int)
displaySizeErr IO (Int, Int) -> ((Int, Int) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int
w, Int
h) ->
Int -> IO () -> IO ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
CM.replicateM_ (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
h) (Char -> IO ()
putChar Char
' ')
cleanAndExit :: IO ()
cleanAndExit :: IO ()
cleanAndExit = [SGR] -> IO ()
CA.setSGR [SGR
CA.Reset] IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
IO ()
CA.clearScreen IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Int -> Int -> IO ()
CA.setCursorPosition Int
0 Int
0 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
IO ()
CA.showCursor
blitMap :: Plane -> Plane -> Width -> Height -> IO ()
blitMap :: Plane -> Plane -> Int -> Int -> IO ()
blitMap Plane
po Plane
pn Int
tw Int
th =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
CM.when (Plane -> (Int, Int)
planeSize Plane
po (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
/= Plane -> (Int, Int)
planeSize Plane
pn)
([Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"blitMap: different plane sizes") IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Int -> Int -> IO ()
CA.setCursorPosition (Int -> Int
fi Int
cr) (Int -> Int
fi Int
cc) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(Int, Int) -> [[Cell]] -> [[Cell]] -> IO ()
blitToTerminal (Int
cr, Int
cc) (Plane -> [[Cell]]
orderedCells Plane
po) (Plane -> [[Cell]]
orderedCells Plane
pn)
where
(Int
pw, Int
ph) = Plane -> (Int, Int)
planeSize Plane
pn
cr :: Int
cr = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int
th Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ph) Int
2
cc :: Int
cc = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int
tw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pw) Int
2
fi :: Int -> Int
fi = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
orderedCells :: Plane -> [[Cell]]
orderedCells :: Plane -> [[Cell]]
orderedCells Plane
p = Int -> [Cell] -> [[Cell]]
forall e. Int -> [e] -> [[e]]
LS.chunksOf (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) [Cell]
cells
where
cells :: [Cell]
cells = (((Int, Int), Cell) -> Cell) -> [((Int, Int), Cell)] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int), Cell) -> Cell
forall a b. (a, b) -> b
snd ([((Int, Int), Cell)] -> [Cell]) -> [((Int, Int), Cell)] -> [Cell]
forall a b. (a -> b) -> a -> b
$ Plane -> [((Int, Int), Cell)]
assocsPlane Plane
p
(Int
w, Int
_) = Plane -> (Int, Int)
planeSize Plane
p
blitToTerminal :: Coords -> [[Cell]] -> [[Cell]] -> IO ()
blitToTerminal :: (Int, Int) -> [[Cell]] -> [[Cell]] -> IO ()
blitToTerminal (Int
rr, Int
rc) [[Cell]]
ocs [[Cell]]
ncs = (Int -> [(Cell, Cell)] -> IO Int)
-> Int -> [[(Cell, Cell)]] -> IO ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
CM.foldM_ Int -> [(Cell, Cell)] -> IO Int
blitLine Int
rr [[(Cell, Cell)]]
oldNew
where
oldNew :: [[(Cell, Cell)]]
oldNew :: [[(Cell, Cell)]]
oldNew = ([Cell] -> [Cell] -> [(Cell, Cell)])
-> [[Cell]] -> [[Cell]] -> [[(Cell, Cell)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Cell] -> [Cell] -> [(Cell, Cell)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Cell]]
ocs [[Cell]]
ncs
blitLine :: Row -> [(Cell, Cell)] -> IO Row
blitLine :: Int -> [(Cell, Cell)] -> IO Int
blitLine Int
pr [(Cell, Cell)]
ccs =
(Int -> (Cell, Cell) -> IO Int) -> Int -> [(Cell, Cell)] -> IO ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
CM.foldM_ Int -> (Cell, Cell) -> IO Int
blitCell Int
0 [(Cell, Cell)]
ccs IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
let wr :: Int
wr = Int
pr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 in
Int -> Int -> IO ()
CA.setCursorPosition (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wr)
(Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rc) IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
wr
blitCell :: Int -> (Cell, Cell) -> IO Int
blitCell :: Int -> (Cell, Cell) -> IO Int
blitCell Int
k (Cell
clo, Cell
cln)
| Cell
cln Cell -> Cell -> Bool
forall a. Eq a => a -> a -> Bool
== Cell
clo = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
| Bool
otherwise = Int -> IO Int
moveIf Int
k IO Int -> (Int -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
k' ->
Cell -> IO ()
putCellStyle Cell
cln IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
k'
moveIf :: Int -> IO Int
moveIf :: Int -> IO Int
moveIf Int
k | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
k
| Bool
otherwise = Int -> IO ()
CA.cursorForward Int
k IO () -> IO Int -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
putCellStyle :: Cell -> IO ()
putCellStyle :: Cell -> IO ()
putCellStyle Cell
c = [SGR] -> IO ()
CA.setSGR ([SGR
CA.Reset] [SGR] -> [SGR] -> [SGR]
forall a. [a] -> [a] -> [a]
++ [SGR]
sgrb [SGR] -> [SGR] -> [SGR]
forall a. [a] -> [a] -> [a]
++ [SGR]
sgrr [SGR] -> [SGR] -> [SGR]
forall a. [a] -> [a] -> [a]
++ [SGR]
sgrc) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Char -> IO ()
putChar (Cell -> Char
cellChar Cell
c)
where
sgrb :: [SGR]
sgrb | Cell -> Bool
isBold Cell
c = [ConsoleIntensity -> SGR
CA.SetConsoleIntensity ConsoleIntensity
CA.BoldIntensity]
| Bool
otherwise = []
sgrr :: [SGR]
sgrr | Cell -> Bool
isReversed Cell
c = [Bool -> SGR
CA.SetSwapForegroundBackground Bool
True]
| Bool
otherwise = []
sgrc :: [SGR]
sgrc | Just (Color
k, ColorIntensity
i) <- Cell -> Maybe (Color, ColorIntensity)
cellColor Cell
c = [ConsoleLayer -> ColorIntensity -> Color -> SGR
CA.SetColor ConsoleLayer
CA.Foreground ColorIntensity
i Color
k]
| Bool
otherwise = []
oneTickSec :: Integer
oneTickSec :: FPS
oneTickSec = FPS
10 FPS -> FPS -> FPS
forall a b. (Num a, Integral b) => a -> b -> a
^ (FPS
6 :: Integer)