使用递归制作动画时,在绘制图片后出现错误“Gloss/OpenGL Stack Overflow”。

3

为了玩弄Haskell的Gloss库,我写了以下代码:

import Graphics.Gloss

data World = World { worldBugs :: [Picture] }

bug :: Point -> Float -> Picture
bug (x, y) s =
    let head = Translate x (y - s) $ Circle (s * 0.8)
        body = Translate x (y + s) $ Circle (s * 1.2)
    in  pictures [head, body]

main = play (InWindow "Animation Test" (400, 400) (100, 100)) white 10
    (World . map (\(n,b) -> Translate (n * 20) (n * 20) $ b) $ zip [0..] $ replicate 100 $ bug (0,0) 100)
    (\world -> pictures $ worldBugs world)
    (\event world -> world)
    (\time (World bs) -> World $ map (Rotate (time * 10)) bs)

这段代码展示了一些“bug”(两个圆形组成的头和躯干),随着时间的推移旋转。问题是,运行几秒钟后,它会崩溃并显示以下错误信息:

Gloss / OpenGL Stack Overflow "after drawPicture."
  This program uses the Gloss vector graphics library, which tried to
  draw a picture using more nested transforms (Translate/Rotate/Scale)
  than your OpenGL implementation supports. The OpenGL spec requires
  all implementations to have a transform stack depth of at least 32,
  and Gloss tries not to push the stack when it doesn't have to, but
  that still wasn't enough.

  You should complain to your harware vendor that they don't provide
  a better way to handle this situation at the OpenGL API level.

  To make this program work you'll need to reduce the number of nested
  transforms used when defining the Picture given to Gloss. Sorry.

如果我理解正确,这基本上意味着最终将太多的转换放到堆栈中,从而导致堆栈溢出。它指出这可能是硬件限制(我使用的是Surface 2 Pro),那么我该怎么办?使用animate时不会出现这种情况,但这可能是因为它在每个刻度不会传递状态。

如果我要制作游戏,我必须使用play将状态传递到下一个刻度;我不能把所有东西都基于时间来做。有没有什么方法可以解决这个问题?谷歌搜索错误几乎没有结果。


2
我刚意识到,通过这样做,我基本上是在创建一个嵌套的转换列表。我将尝试只修改转换器的字段。 - Carcigenicate
1个回答

1
问题在于每次“tick”都会通过将图片包装在另一个变换中进一步嵌套它(最终导致溢出)。为了解决这个问题,我只是将每个值存储在一个“Entity”对象中,然后在“fromEntity”中仅应用一次变换。
    {- LANGUAGE threaded -}
module GlossTest where

import Graphics.Gloss

data Entity = Entity { entRot :: Float, entTrans :: Point, entScale :: Point, entPict :: Picture }

data World = World { worldBugs :: [Entity] }

entTranslate :: Float -> Float -> Entity -> Entity
entTranslate x y (Entity r t s p) = Entity r (x,y) s p

entRotate :: Float -> Entity -> Entity
entRotate x (Entity r t s p) = Entity x t s p

entRotateBy :: Float -> Entity -> Entity
entRotateBy n (Entity r t s p) = Entity (r + n) t s p

entMove :: Float -> Float -> Entity -> Entity
entMove x y (Entity r (tX,tY) s p) = Entity r (tX + x, tY + y) s p

toEntity :: Picture -> Entity
toEntity = Entity 0 (0,0) 1

fromEntity :: Entity -> Picture
fromEntity (Entity r (tX,tY) (sX,sY) p) = Rotate r . Translate tX tY $ Scale sX sY p

bug :: Point -> Float -> Entity
bug (x, y) s =
    let head = Rotate 0 $ Translate x (y - s) $ Circle (s * 0.8)
        body = Rotate 0 $ Translate x (y + s) $ Circle (s * 1.2)
    in  toEntity $ pictures [head, body]

main = play
    (InWindow "Animation Test" (400, 400) (100, 100)) white 1
    (World . map (\(n,b) -> entTranslate (n * 1) (n * 1) $ b) $ zip [0..] $ replicate 10 $ bug (0,0) 100)
    (\world -> pictures . map fromEntity $ worldBugs world)
    (\event world -> world)
    (\time (World bs) -> World $ map (\(n,b) -> entRotateBy (n * time) $ entMove time time b) $ zip [0..] bs)

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接