Permalink
Browse files

a bytestring optimization of the gtk frontend

  • Loading branch information...
Mikolaj committed Apr 5, 2011
1 parent 1413f3e commit c32a171536990de44f7c39c3eb3e6c661a299a62
Showing with 11 additions and 9 deletions.
  1. +2 −2 src/Display/Curses.hs
  2. +6 −4 src/Display/Gtk.hs
  3. +3 −3 src/Display/Vty.hs
View
@@ -6,7 +6,7 @@ import qualified UI.HSCurses.CursesHelper as C
import Data.List as L
import Data.Map as M
import Data.Char
-import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Geometry
@@ -50,7 +50,7 @@ display ((y0,x0),(y1,x1)) (Session { win = w, styles = s }) f msg status =
let defaultStyle = s ! Color.defaultAttr
C.erase
C.setStyle defaultStyle
- mvWAddStr w 0 0 (toWidth (x1 - x0 + 1) msg) -- TODO: bytestring as in vty?
+ mvWAddStr w 0 0 (toWidth (x1 - x0 + 1) msg) -- TODO: BS as in vty
mvWAddStr w (y1+2) 0 (toWidth (x1 - x0 + 1) status)
sequence_ [ C.setStyle (findWithDefault defaultStyle a s)
>> mvWAddStr w (y+1) x [c]
View
@@ -9,6 +9,7 @@ import Graphics.UI.Gtk
import Data.List as L
import Data.IORef
import Data.Map as M
+import qualified Data.ByteString.Char8 as BS
import Geometry
import qualified Keys as K (K.Key(..), K.keyTranslate)
@@ -100,12 +101,13 @@ display ((y0,x0), (y1,x1)) session f msg status =
postGUIAsync $
do
tb <- textViewGetBuffer (sview session)
- let memo = [ let (as, cs) = unzip [ f (y, x) | x <- [x0..x1] ]
- in ((y, as), cs)
- | y <- [y0..y1] ]
+ let fLine y = let (as, cs) = unzip [ f (y, x) | x <- [x0..x1] ]
+ in ((y, as), BS.pack cs)
+ memo = L.map fLine [y0..y1]
attrs = L.map fst memo
chars = L.map snd memo
- textBufferSetText tb (msg ++ "\n" ++ unlines chars ++ status) -- TODO: BS
+ bs = [BS.pack msg, BS.pack "\n", BS.unlines chars, BS.pack status]
+ textBufferSetByteString tb (BS.concat bs)
mapM_ (setTo tb (stags session) x0) attrs
setTo :: TextBuffer -> Map Color.Attr TextTag -> X -> (Y, [Color.Attr]) -> IO ()
View
@@ -4,7 +4,7 @@ module Display.Vty
import Graphics.Vty as V
import Data.List as L
import Data.Char
-import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BS
import Geometry
import qualified Keys as K (K.Key(..))
@@ -27,10 +27,10 @@ display ((y0,x0),(y1,x1)) vty f msg status =
[ [ (x,y) | x <- [x0..x1] ] | y <- [y0..y1] ]
in V.update vty (pic_for_image
(utf8_bytestring (setAttr Color.defaultAttr)
- (BS.pack (L.map (fromIntegral . ord) (toWidth (x1 - x0 + 1) msg))) <->
+ (BS.pack (toWidth (x1 - x0 + 1) msg)) <->
img <->
utf8_bytestring (setAttr Color.defaultAttr)
- (BS.pack (L.map (fromIntegral . ord) (toWidth (x1 - x0 + 1) status)))))
+ (BS.pack (toWidth (x1 - x0 + 1) status))))
toWidth :: Int -> String -> String
toWidth n x = take n (x ++ repeat ' ')

0 comments on commit c32a171

Please sign in to comment.