add withVty to Graphics.Vty.Inline.

src/Graphics/Vty/Image.hs

@@ -54,7 +54,6 @@ import Data.Monoid
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Lazy.Builder as TL
 import qualified Data.Text.Lazy.Encoding as TL
 import Data.Word
 

src/Graphics/Vty/Inline.hs

@@ -25,14 +25,15 @@
 --
 -- Copyright 2009-2010 Corey O'Connor
 {-# LANGUAGE BangPatterns #-}
-module Graphics.Vty.Inline (module Graphics.Vty.Inline)
+module Graphics.Vty.Inline ( module Graphics.Vty.Inline
+                           , withVty
+                           )
     where
 
-import Graphics.Vty.Attributes
+import Graphics.Vty
 import Graphics.Vty.DisplayAttributes
 import Graphics.Vty.Inline.Unsafe
 import Graphics.Vty.Terminal.Interface
-import Graphics.Vty.Terminal
 
 import Control.Applicative
 import Control.Monad.State.Strict
@@ -103,13 +104,7 @@ put_attr_change t c = liftIO $ do
 -- This will flush the terminal output.
 put_attr_change_ :: ( Applicative m, MonadIO m ) => InlineM () -> m ()
 put_attr_change_ c = liftIO $ do
-    mt <- readIORef global_vty_terminal
-    t <- case mt of
-        Nothing -> do
-            t <- current_terminal
-            writeIORef global_vty_terminal (Just t)
-            return t
-        Just t -> return t
+    t <- withVty $ return . terminal
     hFlush stdout
     put_attr_change t c
     hFlush stdout

src/Graphics/Vty/Inline/Unsafe.hs

@@ -1,11 +1,23 @@
 module Graphics.Vty.Inline.Unsafe where
 
-import Graphics.Vty.Terminal.Interface (Terminal)
+import Graphics.Vty
 
 import Data.IORef
 
 import System.IO.Unsafe
 
-global_vty_terminal :: IORef (Maybe Terminal)
-{-# NOINLINE global_vty_terminal #-}
-global_vty_terminal = unsafePerformIO $ newIORef Nothing
+global_vty :: IORef (Maybe Vty)
+{-# NOINLINE global_vty #-}
+global_vty = unsafePerformIO $ newIORef Nothing
+
+withVty :: (Vty -> IO b) -> IO b
+withVty f = do
+    mvty <- readIORef global_vty
+    vty <- case mvty of
+        Nothing -> do
+            vty <- mkVty
+            writeIORef global_vty (Just vty)
+            return vty
+        Just vty -> return vty
+    f vty
+

test/Rouge.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TemplateHaskell #-}
 module Main where
 
 import Graphics.Vty
@@ -7,6 +8,7 @@ import qualified Data.ByteString as B
 import Data.Word
 
 import Control.Applicative
+import Control.Lens hiding (Level)
 import Control.Monad
 import Control.Monad.RWS
 import Control.Monad.Writer
@@ -46,7 +48,7 @@ main = do
     vty <- mkVty
     level_0 <- mkLevel 1
     let world_0 = World (Dude (fst $ start level_0) (snd $ start level_0)) level_0
-    (_final_world, ()) <- execRWST (play >> view) vty world_0
+    (_final_world, ()) <- execRWST (play >> update_display) vty world_0
     shutdown vty
 
 mkLevel difficulty = do
@@ -82,7 +84,7 @@ pieceA = def_attr `with_fore_color` blue `with_back_color` green
 dumpA = def_attr `with_style` reverse_video
 
 play = do
-    view
+    update_display
     done <- process_event
     unless done play
 
@@ -111,8 +113,8 @@ move_dude dx dy = do
         EmptySpace -> put $ world { dude = Dude x' y' }
         _          -> return ()
 
-view :: Game ()
-view = do
+update_display :: Game ()
+update_display = do
     let info = string def_attr "Move with the arrows keys. Press ESC to exit."
     -- determine offsets to place the dude in the center of the level.
     DisplayRegion w h <- asks terminal >>= liftIO . display_bounds