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

Timestamp:

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

Author:

mokehehe

Message:

Existence 型を使って書き換え

Files:

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

lang/haskell/nario/Actor.hs

@@ +1 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
 
 module Actor where
@@ -10 +11 @@
 import Event
 
-
-data AnimBlock = AnimBlock { startcy :: Int, x :: Int, y :: Int, vy :: Int }
-
-data Actor = ActNull | ActAnimBlock AnimBlock
+class Actor a where
+        update :: a -> (a, [Event])
+        render :: a -> ImageResource -> Int -> Surface -> IO ()
+        bDead :: a -> Bool
 
 -- ============================================================================
@@ -19 +20 @@
 --      死亡
 
-updateNull = (ActNull, [])
+data AnimNull = AnimNull
 
-renderNull imgres scrx sur = return ()
-
-bDieNull = True
+instance Actor AnimNull where
+        update self = (self, [])
+        render self imgres scrx sur = return ()
+        bDead self = True
 
 
@@ -30 +32 @@
 --      ブロックを叩いたときのバウンド演出
 
-updateAnimBlock self = result'
-        where
-                result'
-                        | not bEnd      = (ActAnimBlock $ self { vy = vy', y = y' }, [])
-                        | otherwise     = (ActNull, [EvSetField (cellCrd $ x self) (startcy self) '@'])
+data AnimBlock = AnimBlock { startcy :: Int, x :: Int, y :: Int, vy :: Int }
 
-                vy' = vy self + gravity
-                y' = y self + vy'
-                bEnd = y' >= startcy self * chrSize * one
+instance Actor AnimBlock where
+        update self = result'
+                where
+                        result'
+                                | not bEnd      = (self { vy = vy', y = y' }, [])
+                                | otherwise     = (self, [EvSetField (cellCrd $ x self) (startcy self) '@'])
+
+                        vy' = vy self + gravity
+                        y' = y self + vy'
+                        bEnd = y' >= startcy self * chrSize * one
+
+        render self imgres scrx sur = do
+                blitSurface (getImageSurface imgres ImgBlock2) Nothing sur (pt ((x self) `div` one - scrx) ((y self) `div` one - 8))
+                return ()
+
+        bDead self = False
 
 
-renderAnimBlock self imgres scrx sur = do
-        blitSurface (getImageSurface imgres ImgBlock2) Nothing sur (pt ((x self) `div` one - scrx) ((y self) `div` one - 8))
-        return ()
-
-bDieAnimBlock self = False
-
-newAnimBlock cx cy = ActAnimBlock $ AnimBlock { startcy = cy, x = cx * chrSize * one, y = cy * chrSize * one, vy = -3 * one }
-
+newAnimBlock cx cy = AnimBlock { startcy = cy, x = cx * chrSize * one, y = cy * chrSize * one, vy = -3 * one }
 
 
@@ -54 +58 @@
 -- ============================================================================
 
+{-
 updateActor :: Actor -> (Actor, [Event])
 updateActor ActNull                             = updateNull
@@ -65 +70 @@
 bDieActor ActNull                               = bDieNull
 bDieActor (ActAnimBlock a)              = bDieAnimBlock a
-
+-}