diff options
| -rw-r--r-- | src/System/IO/Terminal/Render.hs | 26 |
1 files changed, 19 insertions, 7 deletions
diff --git a/src/System/IO/Terminal/Render.hs b/src/System/IO/Terminal/Render.hs index 86b5cb3..f3f0b59 100644 --- a/src/System/IO/Terminal/Render.hs +++ b/src/System/IO/Terminal/Render.hs @@ -40,7 +40,7 @@ module System.IO.Terminal.Render ,RenderT, Render, withRender, liftIO ,getTermSize ,redraw, redrawFull - ,write, putc + ,write, putc, putcWith ,readPixel ,setStyle, setFg, setBg, setBold, setUnderline ,savingStyle @@ -196,21 +196,33 @@ getTermSize = do write :: MonadIO m => (Int, Int) -> String -> RenderT m () write (x, y1) str = do (wid, hei) <- getTermSize - let writeLine y line = sequence_ [putc' (x', y) c | (x', c) <- zip [x..] line] + let writeLine y line = sequence_ [unsafePutc (x', y) c | (x', c) <- zip [x..] line] sequence_ [writeLine y (take (wid - x) line) | (y, line) <- take (hei - y1) $ zip [y1..] (lines str)] -- | Write one character to the draw buffer at the given position. putc :: MonadIO m => (Int, Int) -> Char -> RenderT m () -putc (x, y) c = whenM (inBounds (x, y)) $ putc' (x, y) c +putc (x, y) c = whenM (inBounds (x, y)) $ unsafePutc (x, y) c -putc' :: MonadIO m => (Int, Int) -> Char -> RenderT m () -putc' (x, y) c = do - drawBuffer <- gets rDrawBuffer +-- | Write one character to the draw buffer at the given position with the given +-- style (instead of the stateful style). +putcWith :: MonadIO m => Style -> (Int, Int) -> Char -> RenderT m () +putcWith sty (x, y) c = whenM (inBounds (x, y)) $ unsafePutcWith sty (x, y) c + +-- | 'putc', but don't check bounds +unsafePutc :: MonadIO m => (Int, Int) -> Char -> RenderT m () +unsafePutc (x, y) c = do style <- gets rCurrentStyle + unsafePutcWith style (x, y) c + +-- | 'putcWith', but don't check bounds +unsafePutcWith :: MonadIO m => Style -> (Int, Int) -> Char -> RenderT m () +unsafePutcWith style (x, y) c = do + drawBuffer <- gets rDrawBuffer let cell = Cell { cChar = c, cStyle = style } liftIO $ writeArray drawBuffer (y, x) cell + -- | Obtain the current character and style in the draw buffer at the given -- position. readPixel :: MonadIO m => (Int, Int) -> RenderT m (Style, Char) @@ -255,7 +267,7 @@ setUnderline ul = modifyCurrentStyle (\s -> s { sUnderline = ul }) fillRect :: MonadIO m => (Int, Int) -> (Int, Int) -> Char -> RenderT m () fillRect (fromx, fromy) (tox, toy) ch = forM_ [(x, y) | y <- [fromy..toy], x <- [fromx..tox]] $ \(x, y) -> do - putc' (x, y) ch + unsafePutc (x, y) ch -- | Clear the whole screen. This may also be accomplished using 'fillRect' -- with appropriate bounds. |