d05afa1 · vty · git.iko.soy

git.iko.soy/vty

improve performance of the rouge game

commitd05afa18cad76921486eb0e52c579f14cd73944b authorCorey O'Connor <corey@ooyala.com> dateWed 20 Nov 2013, 15:53 (13 years ago) parenta1038b2

3 files changed+26−14

compare with master

unifiedsplit

src/Graphics/Vty/Image.hs+5−4 src/Graphics/Vty/Image/Internal.hs+2 test/Rouge.hs+19−10

src/Graphics/Vty/Image.hs+5−4

@@ -54,6 +54,7 @@ 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

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

5859import Data.Word

5960

@@ -63,7 +64,7 @@ infixr 4 <->

6364-- | Append in the Monoid instance is equivalent to <->.

6465instance Monoid Image where

6566 mempty = EmptyImage

66− mappend = (<->)

67+ mappend = vert_join

6768

6869-- | combines two images side by side

6970--

@@ -150,11 +151,11 @@ background_fill w h

150151

151152-- | Compose any number of images horizontally.

152153horiz_cat :: [Image] -> Image

153−horiz_cat = foldr (<|>) EmptyImage

154+horiz_cat = foldr horiz_join EmptyImage

154155

155156-- | Compose any number of images vertically.

156157vert_cat :: [Image] -> Image

157−vert_cat = foldr (<->) EmptyImage

158+vert_cat = foldr vert_join EmptyImage

158159

159160-- | A Data.Text.Lazy value

160161text :: Attr -> TL.Text -> Image

@@ -173,7 +174,7 @@ text' a txt

173174-- | an image of a single character. This is a standard Haskell 31-bit character assumed to be in

174175-- the ISO-10646 encoding.

175176char :: Attr -> Char -> Image

176−char a c =

177+char a c =

177178 let display_width = safe_wcwidth c

178179 in HorizText a (TL.singleton c) display_width 1

179180

src/Graphics/Vty/Image/Internal.hs+2

@@ -13,6 +13,8 @@ import qualified Data.Text.Lazy as TL

1313-- TODO(corey): hm. there is an explicit equation for each type which goes to a lazy text. Each

1414-- application probably uses a single type. Perhaps parameterize the entire vty interface by the

1515-- input text type?

16+-- TODO: Try using a builder instead of a TL.Text instance directly. That might improve performance

17+-- for the usual case of appending a bunch of characters with the same attribute together.

1618type DisplayText = TL.Text

1719

1820-- TODO: store a skip list in HorizText(?)

test/Rouge.hs+19−10

@@ -29,6 +29,9 @@ data Level = Level

2929 { start :: (Int, Int)

3030 , end :: (Int, Int)

3131 , geo :: Array (Int, Int) LevelPiece

32+ -- building the geo image is expensive. Cache it. Though VTY should go through greater lengths

33+ -- to avoid the need to cache images.

34+ , geo_image :: Image

3235 }

3336 deriving (Show,Eq)

3437

@@ -47,8 +50,8 @@ main = do

4750 shutdown vty

4851

4952mkLevel _difficulty = do

50− level_width <- randomRIO (40,80)

51− level_height <- randomRIO (40,80)

53+ level_width <- randomRIO (200,300)

54+ level_height <- randomRIO (200,300)

5255 start <- (,) <$> randomRIO (2, level_width-3) <*> randomRIO (2, level_height-3)

5356 end <- (,) <$> randomRIO (2, level_width-3) <*> randomRIO (2, level_height-3)

5457 -- first the base geography: all rocks

@@ -56,7 +59,7 @@ mkLevel _difficulty = do

5659 [((x,y),Rock) | x <- [0..level_width-1], y <- [0..level_height-1]]

5760 -- next the empty spaces that make the rooms

5861 geo <- add_room start base_geo level_width level_height

59− return $ Level start end geo

62+ return $ Level start end geo (build_geo_image geo)

6063

6164add_room (center_x, center_y) geo level_width level_height = do

6265 size <- randomRIO (5,15)

@@ -122,10 +125,16 @@ world = do

122125 the_dude <- gets dude

123126 the_level <- gets level

124127 let dude_image = translate (dude_x the_dude) (dude_y the_dude) (char pieceA '@')

125− (geo_width, geo_height) = snd $ bounds (geo the_level)

126− geo_image = vert_cat [ geo_row | y <- [0..geo_height-1],

127− let geo_row = horiz_cat [ i | x <- [0..geo_width-1],

128− let i = image_for_geo (geo the_level ! (x,y))

129− ]

130− ]

131− return [dude_image, geo_image]

128+ return [dude_image, geo_image the_level]

129+

130+build_geo_image geo =

131+ let (geo_width, geo_height) = snd $ bounds geo

132+ -- seems like a the repeated index operation should be removable. This is not performing random

133+ -- access but (presumably) access in order of index.

134+ in vert_cat [ geo_row

135+ | y <- [0..geo_height-1]

136+ , let geo_row = horiz_cat [ i

137+ | x <- [0..geo_width-1]

138+ , let i = image_for_geo (geo ! (x,y))

139+ ]

140+ ]