diff options
Diffstat (limited to 'src/System/IO/Terminal')
| -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. | 
