git.iko.soy/vty
on master help sign in
add empty_picture, add_to_top and add_to_bottom to Graphics.Vty.Picture
dd5e24bCorey O'Connor
CHANGELOG+2
compare with master
unifiedsplit
@@ -15,6 +15,8 @@
15 * The transparent areas for a layer are the background image components.
15 * The transparent areas for a layer are the background image components.
16 * If the background is clear there is no background layer.
16 * If the background is clear there is no background layer.
17 * If there is a background character then the bottom layer is the background layer.
17 * If there is a background character then the bottom layer is the background layer.
18+ * empty_picture is a Picture with no layers and no cursor
19+ * add_to_top and add_to_bottom add a layer to the top and bottom of the given Picture.
18 * compatibility improvements:
20 * compatibility improvements:
19 * terminfo based terminals with no cursor support are silently accepted. The cursor
21 * terminfo based terminals with no cursor support are silently accepted. The cursor
20 visibility changes in the Picture will have no effect.
22 visibility changes in the Picture will have no effect.
src/Graphics/Vty/Picture.hs+9
@@ -28,6 +28,15 @@ instance Show Picture where
28instance NFData Picture where
28instance NFData Picture where
29 rnf (Picture c l b) = c `deepseq` l `deepseq` b `deepseq` ()
29 rnf (Picture c l b) = c `deepseq` l `deepseq` b `deepseq` ()
30
30
31+empty_picture :: Picture
32+empty_picture = Picture NoCursor [] ClearBackground
33+
34+add_to_top :: Picture -> Image -> Picture
35+add_to_top p i = p {pic_layers = i : pic_layers p}
36+
37+add_to_bottom :: Picture -> Image -> Picture
38+add_to_bottom p i = p {pic_layers = pic_layers p ++ [i]}
39+
31-- | Create a picture for display for the given image. The picture will not have a displayed cursor
40-- | Create a picture for display for the given image. The picture will not have a displayed cursor
32-- and the background display attribute will be `current_attr`.
41-- and the background display attribute will be `current_attr`.
33pic_for_image :: Image -> Picture
42pic_for_image :: Image -> Picture
test/RougeStory.hs+45−23
@@ -6,6 +6,11 @@ import Text.Printf
6import Graphics.Vty
6import Graphics.Vty
7import Graphics.Vty.Inline
7import Graphics.Vty.Inline
8
8
9+import Control.Monad.Trans.State.Strict
10+
11+import Data.Map.Strict (Map)
12+import qualified Data.Map.Strict as Map
13+
9-- Characters are identified by Names
14-- Characters are identified by Names
10type Character = Name
15type Character = Name
11type Name = String
16type Name = String
@@ -28,7 +33,7 @@ class Story repr where
28 -- Aspects are animate objects, inanimate objects or histories.
33 -- Aspects are animate objects, inanimate objects or histories.
29 animate_obj :: Type -> repr Object
34 animate_obj :: Type -> repr Object
30 inanimate_obj :: Type -> repr Object
35 inanimate_obj :: Type -> repr Object
31− history :: Type -> repr History
36+ history :: repr History
32
37
33 -- The goal is to acquire, or dispose of an object.
38 -- The goal is to acquire, or dispose of an object.
34 dispose_obj :: repr Object -> repr Goal
39 dispose_obj :: repr Object -> repr Goal
@@ -61,7 +66,7 @@ instance Story X where
61 add_unknown_obj obj as =
66 add_unknown_obj obj as =
62 animate_obj t =
67 animate_obj t =
63 inanimate_obj t =
68 inanimate_obj t =
64− history t =
69+ history =
65 dispose_obj obj =
70 dispose_obj obj =
66 acquire_obj obj =
71 acquire_obj obj =
67 named obj n =
72 named obj n =
@@ -78,7 +83,7 @@ instance Story ShowStory where
78 add_unknown_obj obj as = ShowStory $ printf "Unknown(%s):%s" (unShowStory obj) (unShowStory as)
83 add_unknown_obj obj as = ShowStory $ printf "Unknown(%s):%s" (unShowStory obj) (unShowStory as)
79 animate_obj t = ShowStory $ printf "%s :: AnimateObj" t
84 animate_obj t = ShowStory $ printf "%s :: AnimateObj" t
80 inanimate_obj t = ShowStory $ printf "%s :: InanimateObj" t
85 inanimate_obj t = ShowStory $ printf "%s :: InanimateObj" t
81− history t = ShowStory $ printf "%s :: History" t
86+ history = ShowStory $ printf "History"
82 dispose_obj obj = ShowStory $ printf "Goal(%s)" (unShowStory obj)
87 dispose_obj obj = ShowStory $ printf "Goal(%s)" (unShowStory obj)
83 acquire_obj obj = ShowStory $ printf "Acquire(%s)" (unShowStory obj)
88 acquire_obj obj = ShowStory $ printf "Acquire(%s)" (unShowStory obj)
84 named obj n = ShowStory $ printf "%s+Name(%s)" (unShowStory obj) (show n)
89 named obj n = ShowStory $ printf "%s+Name(%s)" (unShowStory obj) (show n)
@@ -99,7 +104,7 @@ instance Story TellStory where
99 add_unknown_obj _ as = as
104 add_unknown_obj _ as = as
100 animate_obj t = TellStory t
105 animate_obj t = TellStory t
101 inanimate_obj t = TellStory t
106 inanimate_obj t = TellStory t
102− history t = TellStory t
107+ history = TellStory "History"
103 dispose_obj (TellStory obj)
108 dispose_obj (TellStory obj)
104 = TellStory $ "to dispose of the accursed " ++ obj
109 = TellStory $ "to dispose of the accursed " ++ obj
105 acquire_obj (TellStory obj)
110 acquire_obj (TellStory obj)
@@ -107,26 +112,43 @@ instance Story TellStory where
107 named (TellStory obj) name
112 named (TellStory obj) name
108 = TellStory $ obj ++ " with the name " ++ name
113 = TellStory $ obj ++ " with the name " ++ name
109
114
110−newtype PictureStory t = PictureStory { compose_to_picture :: Picture }
115+newtype BuildPicture t = BuildPicture {build_picture :: Picture -> State PictureCtx Picture}
111−
116+
112−{-
117+type Sprite = (Int, Int, Image)
118+data PictureCtx = PictureCtx
119+ { next_ID :: Int -- globally monotonic
120+ , this_ID :: Int
121+ , known_sprites :: Map Int Sprite
122+ }
123+
124+get_ID :: State PictureCtx Int
125+get_ID = gets this_ID
126+
127+new_ID :: Picture -> State PictureCtx Picture
128+new_ID p = do
129+ ctx <- get
130+ let the_ID = next_ID ctx
131+ put $ ctx {next_ID = the_ID + 1, this_ID = the_ID}
132+ return p
133+
134+empty_picture_ctx = PictureCtx 0 1 Map.empty
135+
113−instance Story X where
136+instance Story BuildPicture where
114− story c q =
137+ story _c (BuildPicture q) = BuildPicture q
115− quest g as =
138+ quest _g (BuildPicture as) = BuildPicture as
116− empty_aspects =
139+ empty_aspects = BuildPicture new_ID
117− add_known_history h as =
140+ add_known_history h (BuildPicture as) = BuildPicture as
118− add_known_obj obj as =
141+ add_known_obj obj (BuildPicture as) = BuildPicture as
119− add_unknown_history h as =
142+ add_unknown_history h (BuildPicture as) = BuildPicture as
120− add_unknown_obj obj as =
143+ add_unknown_obj obj (BuildPicture as) = BuildPicture as
121− animate_obj t =
144+ animate_obj t = BuildPicture new_ID
122− inanimate_obj t =
145+ inanimate_obj t = BuildPicture new_ID
123− history t =
146+ history = BuildPicture new_ID
124− dispose_obj obj =
147+ dispose_obj (BuildPicture obj) = BuildPicture obj
125− acquire_obj obj =
148+ acquire_obj (BuildPicture obj) = BuildPicture obj
126− named obj n =
149+ named (BuildPicture obj) n = BuildPicture obj
127−-}
128
150
129main = do
151main = do
130 putStrLn $ unTellStory story_0
152 putStrLn $ unTellStory story_0
131 putStrLn $ unShowStory story_0
153 putStrLn $ unShowStory story_0
132− withVty $ flip update (compose_to_picture story_0)
154+ withVty $ flip update $ evalState (build_picture story_0 empty_picture) empty_picture_ctx