829ae9c · vty · git.iko.soy

src/Graphics/Vty/Image.hs−1

compare with master

unifiedsplit

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

54import qualified Data.Text as T

55import qualified Data.Text.Encoding as T

56import qualified Data.Text.Lazy as TL

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

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

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

59import Data.Word

58import Data.Word

60

59

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

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

25--

27{-# LANGUAGE BangPatterns #-}

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

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

29+ , withVty

30+ )

29 where

31 where

30

32

31−import Graphics.Vty.Attributes

33+import Graphics.Vty

32import Graphics.Vty.DisplayAttributes

34import Graphics.Vty.DisplayAttributes

33import Graphics.Vty.Inline.Unsafe

35import Graphics.Vty.Inline.Unsafe

34import Graphics.Vty.Terminal.Interface

36import Graphics.Vty.Terminal.Interface

35−import Graphics.Vty.Terminal

36

37

37import Control.Applicative

38import Control.Applicative

38import Control.Monad.State.Strict

39import Control.Monad.State.Strict

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

103-- This will flush the terminal output.

104-- This will flush the terminal output.

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

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

105put_attr_change_ c = liftIO $ do

106put_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

107+ t <- withVty $ return . terminal

112− Just t -> return t

113 hFlush stdout

108 hFlush stdout

114 put_attr_change t c

109 put_attr_change t c

115 hFlush stdout

110 hFlush stdout

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

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

1module Graphics.Vty.Inline.Unsafe where

2

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

3+import Graphics.Vty

4

5import Data.IORef

6

7import System.IO.Unsafe

8

9−global_vty_terminal :: IORef (Maybe Terminal)

9+global_vty :: IORef (Maybe Vty)

10−{-# NOINLINE global_vty_terminal #-}

10+{-# NOINLINE global_vty #-}

11−global_vty_terminal = unsafePerformIO $ newIORef Nothing

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 #-}

1module Main where

2module Main where

2

3

3import Graphics.Vty

4import Graphics.Vty

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

7import Data.Word

8import Data.Word

8

9

9import Control.Applicative

10import Control.Applicative

11+import Control.Lens hiding (Level)

10import Control.Monad

12import Control.Monad

11import Control.Monad.RWS

13import Control.Monad.RWS

12import Control.Monad.Writer

14import Control.Monad.Writer

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

46 vty <- mkVty

48 vty <- mkVty

47 level_0 <- mkLevel 1

49 level_0 <- mkLevel 1

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

50 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

50 shutdown vty

52 shutdown vty

51

53

52mkLevel difficulty = do

54mkLevel difficulty = do

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

82dumpA = def_attr `with_style` reverse_video

84dumpA = def_attr `with_style` reverse_video

83

85

84play = do

86play = do

85− view

87+ update_display

86 done <- process_event

88 done <- process_event

87 unless done play

89 unless done play

88

90

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

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

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

112 _ -> return ()

114 _ -> return ()

113

115

114−view :: Game ()

116+update_display :: Game ()

115−view = do

117+update_display = do

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

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

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

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

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

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