Changeset 20534 for lang/haskell/nario/Main.hs

Timestamp:

10/03/08 01:04:54 (3 months ago)

Author:

mokehehe

Message:

Existence 型を使って書き換え

Files:

• lang/haskell/nario/Main.hs (modified) (6 diffs)

lang/haskell/nario/Main.hs

@@ +1 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
 -- Nario
 
@@ -74 +76 @@
 
 ----
+data ObjWrapper = forall a. Actor a => ObjWrapper a     -- 存在型aの動く範囲を型クラスDuckに制限
+
+updateActors :: [ObjWrapper] -> [(ObjWrapper, [Event])]
+updateActors = map (\(ObjWrapper x) -> let (x', ev') = update x in (ObjWrapper x', ev'))
+
+renderActors :: ImageResource -> Int -> Surface -> [ObjWrapper] -> IO ()
+renderActors imgres ofsx sur = mapM_ (\(ObjWrapper x) -> render x imgres ofsx sur)
 
 
@@ -81 +90 @@
                 pl :: Player,
                 fld :: Field,
-                actors :: [Actor],
+                actors :: [ObjWrapper],
                 time :: Int
         }
@@ -134 +143 @@
                                 time' = max 0 (time gs - one `div` 25)
                                 (pl', ev) = updatePlayer kp (fld gs) (pl gs)
-                                actors_updates = map updateActor (actors gs)
+                                actors_updates = updateActors (actors gs)
                                 actors' = map fst actors_updates
                                 ev' = concatMap snd actors_updates
@@ -153 +162 @@
                         where
                                 fld' = fieldSet (fld gs) cx cy '*'
-                                actors' = (newAnimBlock cx cy) : actors gs
+                                actors' = (ObjWrapper $ newAnimBlock cx cy) : actors gs
                 f gs (EvSetField cx cy c) = gs { fld = fld' }
                         where
@@ -170 +179 @@
         renderPlayer sur imgres scrx (pl gs)
 
-        mapM_ (\act -> renderActor act imgres scrx sur) (actors gs)
+        renderActors imgres scrx sur (actors gs)
         return ()