錯誤「光澤/ OpenGL的堆棧溢出‘drawPicture後’，」使用基於遞歸動畫

Question

時只需更動Haskell的光澤圖書館，我寫道：

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時不會這樣做，但這可能是由於它不會每次打勾都傳遞一個狀態。

如果我要做一個遊戲，我不得不使用play將狀態傳遞給下一個打勾;我無法按時完成所有任務。有沒有解決的辦法？谷歌搜索的錯誤產量幾乎沒有。

Answer 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)