drawPicture之后的错误“Gloss / OpenGL Stack Overflow”。“”使用基于递归的动画时

时间:2014-10-28 01:09:45

标签: opengl haskell gloss

为了弄乱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)

显示随着时间的推移旋转的一些“错误”(形成头部和躯干的两个圆圈)。问题是,经过几秒钟的运行后,它崩溃了:

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上),所以我是SOL吗?使用animate时不会这样做,但这可能是因为它没有通过每个tick的状态。

如果我打算制作一个游戏,我将不得不使用play将状态传递到下一个刻度;我不能按时完成所有事情。有没有解决的办法?谷歌搜索错误几乎没有。

1 个答案:

答案 0 :(得分:1)

问题在于,在每个“滴答”上,它通过将其包装在另一个转换(最终导致溢出)中进一步嵌套图片。要解决它, 我只是将每个值存储在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)