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

Timestamp:

10/04/08 14:32:30 (3 months ago)

Author:

mokehehe

Message:

プレーヤーとの当たり判定追加

Files:

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

lang/haskell/nario/Main.hs

@@ -76 +76 @@
                 pl :: Player,
                 fld :: Field,
-                actors :: [ObjWrapper],
+                actors :: [ActorWrapper],
                 time :: Int
         }
@@ -125 +125 @@
                         | otherwise             = Nothing
 
+
+
+-- 当たり判定
+hitcheck :: Player -> [ActorWrapper] -> (Player, [ActorWrapper])
+hitcheck player actors = foldl proc (player, []) actors
+        where
+                proc (pl, ac) (ActorWrapper a) = case getHitRect a of
+                        Nothing -> nothingHappened
+                        Just rc ->
+                                if not $ ishit plrc rc
+                                        then nothingHappened
+                                        else (pl', ac')
+                        where
+                                nothingHappened = (pl, ac ++ [ActorWrapper a])
+                                plrc = getPlayerHitRect player
+                                pl' = pl
+                                ac' = ac
+
+
 -- ゲーム
 doGame :: Field -> [[SDLKey]] -> [ImageResource -> Scr]
@@ -152 +171 @@
                                 ev' = concatMap snd actors_updates
 
-                                gstmp = gs { pl = pl', fld = fld', actors = actors', time = time' }
+                                (pl'', actors'') = hitcheck pl' actors'
+
+                                gstmp = gs { pl = pl'', fld = fld', actors = actors'', time = time' }
                                 gs' = procEvent gstmp (plev ++ ev' ++ screv')
 
                 initialState = GameGame { pl = newPlayer, fld = fldmap, actors = [], time = 400 * one }
 
+-- ゲームオーバー
 doGameOver fldmap kss = doTitle fldmap kss
 
@@ -170 +192 @@
                                 c = fieldRef (fld gs) cx cy
                                 items
-                                        | c == 'K'      = [ObjWrapper $ newKinoko cx cy]
+                                        | c == 'K'      = [ActorWrapper $ newKinoko cx cy]
                                         | otherwise     = []
-                                actors' = actors gs ++ [ObjWrapper $ newAnimBlock cx cy $ fieldRef (fld gs) cx cy] ++ items
+                                actors' = actors gs ++ [ActorWrapper $ newAnimBlock cx cy $ fieldRef (fld gs) cx cy] ++ items
                                 fld' = fieldSet (fld gs) cx cy '*'
                 proc gs (EvSetField cx cy c) = gs { fld = fieldSet (fld gs) cx cy c }
@@ -178 +200 @@
                         where
                                 ene = case c of
-                                        'k'     -> ObjWrapper $ newKuribo cx cy
-                                        'n'     -> ObjWrapper $ newNokonoko cx cy
+                                        'k'     -> ActorWrapper $ newKuribo cx cy
+                                        'n'     -> ActorWrapper $ newNokonoko cx cy