829ae9c · vty · git.iko.soy

git.iko.soy/vty

add withVty to Graphics.Vty.Inline.

commit829ae9c4df363431b51e83e902f08cad5b006e90 authorCorey O'Connor <corey@ooyala.com> dateFri 29 Nov 2013, 01:21 (13 years ago) parent8237c57

4 files changed+27−19

compare with master

unifiedsplit

src/Graphics/Vty/Image.hs−1 src/Graphics/Vty/Inline.hs+5−10 src/Graphics/Vty/Inline/Unsafe.hs+16−4 test/Rouge.hs+6−4

src/Graphics/Vty/Image.hs−1

@@ -54,7 +54,6 @@ import Data.Monoid

5454import qualified Data.Text as T

5555import qualified Data.Text.Encoding as T

5656import qualified Data.Text.Lazy as TL

57−import qualified Data.Text.Lazy.Builder as TL

5857import qualified Data.Text.Lazy.Encoding as TL

5958import Data.Word

6059

src/Graphics/Vty/Inline.hs+5−10

@@ -25,14 +25,15 @@

2525--

2727{-# LANGUAGE BangPatterns #-}

28−module Graphics.Vty.Inline (module Graphics.Vty.Inline)

28+module Graphics.Vty.Inline ( module Graphics.Vty.Inline

29+ , withVty

30+ )

2931 where

3032

31−import Graphics.Vty.Attributes

33+import Graphics.Vty

3234import Graphics.Vty.DisplayAttributes

3335import Graphics.Vty.Inline.Unsafe

3436import Graphics.Vty.Terminal.Interface

35−import Graphics.Vty.Terminal

3637

3738import Control.Applicative

3839import Control.Monad.State.Strict

@@ -103,13 +104,7 @@ put_attr_change t c = liftIO $ do

103104-- This will flush the terminal output.

104105put_attr_change_ :: ( Applicative m, MonadIO m ) => InlineM () -> m ()

105106put_attr_change_ c = liftIO $ do

106− mt <- readIORef global_vty_terminal

107− t <- case mt of

108− Nothing -> do

109− t <- current_terminal

110− writeIORef global_vty_terminal (Just t)

111− return t

112− Just t -> return t

107+ t <- withVty $ return . terminal

113108 hFlush stdout

114109 put_attr_change t c

115110 hFlush stdout

src/Graphics/Vty/Inline/Unsafe.hs+16−4

@@ -1,11 +1,23 @@

11module Graphics.Vty.Inline.Unsafe where

3−import Graphics.Vty.Terminal.Interface (Terminal)

3+import Graphics.Vty

55import Data.IORef

77import System.IO.Unsafe

9−global_vty_terminal :: IORef (Maybe Terminal)

10−{-# NOINLINE global_vty_terminal #-}

11−global_vty_terminal = unsafePerformIO $ newIORef Nothing

9+global_vty :: IORef (Maybe Vty)

10+{-# NOINLINE global_vty #-}

11+global_vty = unsafePerformIO $ newIORef Nothing

12+

13+withVty :: (Vty -> IO b) -> IO b

14+withVty f = do

15+ mvty <- readIORef global_vty

16+ vty <- case mvty of

17+ Nothing -> do

18+ vty <- mkVty

19+ writeIORef global_vty (Just vty)

20+ return vty

21+ Just vty -> return vty

22+ f vty

23+

test/Rouge.hs+6−4

@@ -1,3 +1,4 @@

1+{-# LANGUAGE TemplateHaskell #-}

12module Main where

34import Graphics.Vty

@@ -7,6 +8,7 @@ import qualified Data.ByteString as B

78import Data.Word

910import Control.Applicative

11+import Control.Lens hiding (Level)

1012import Control.Monad

1113import Control.Monad.RWS

1214import Control.Monad.Writer

@@ -46,7 +48,7 @@ main = do

4648 vty <- mkVty

4749 level_0 <- mkLevel 1

4850 let world_0 = World (Dude (fst $ start level_0) (snd $ start level_0)) level_0

49− (_final_world, ()) <- execRWST (play >> view) vty world_0

51+ (_final_world, ()) <- execRWST (play >> update_display) vty world_0

5052 shutdown vty

5153

5254mkLevel difficulty = do

@@ -82,7 +84,7 @@ pieceA = def_attr `with_fore_color` blue `with_back_color` green

8284dumpA = def_attr `with_style` reverse_video

8385

8486play = do

85− view

87+ update_display

8688 done <- process_event

8789 unless done play

8890

@@ -111,8 +113,8 @@ move_dude dx dy = do

111113 EmptySpace -> put $ world { dude = Dude x' y' }

112114 _ -> return ()

113115

114−view :: Game ()

115−view = do

116+update_display :: Game ()

117+update_display = do

116118 let info = string def_attr "Move with the arrows keys. Press ESC to exit."

117119 -- determine offsets to place the dude in the center of the level.

118120 DisplayRegion w h <- asks terminal >>= liftIO . display_bounds