Changeset 20673 for lang/haskell

Timestamp:

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

Author:

mokehehe

Message:

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

Location:

lang/haskell/nario

Files:

• Actor.hs (modified) (3 diffs)
• Actor/Kinoko.hs (modified) (2 diffs)
• AppUtil.hs (modified) (2 diffs)
• Main.hs (modified) (5 diffs)
• Player.hs (modified) (2 diffs)

lang/haskell/nario/Actor.hs

@@ -3 +3 @@
 module Actor (
         Actor(..),
-        ObjWrapper(..),
+        ActorWrapper(..),
         updateActors,
         filterActors,
@@ -11 +11 @@
 import Multimedia.SDL (Surface)
 
-import Event
-import AppUtil
-import Field 
+import Event (Event)
+import AppUtil (ImageResource, Rect)
+import Field (Field)
 
 
@@ -19 +19 @@
         update :: Field -> a -> (a, [Event])
         render :: a -> ImageResource -> Int -> Surface -> IO ()
+
         bDead :: a -> Bool
         bDead _ = False
+
+        getHitRect :: a -> Maybe Rect
+        getHitRect _ = Nothing
 
 -- ============================================================================
 
 ----
-data ObjWrapper = forall a. Actor a => ObjWrapper a     -- 存在型aの動く範囲を型クラスに制限
+data ActorWrapper = forall a. Actor a => ActorWrapper a -- 存在型aの動く範囲を型クラスに制限
 
-updateActors :: Field -> [ObjWrapper] -> [(ObjWrapper, [Event])]
-updateActors fld = map (\(ObjWrapper x) -> let (x', ev') = update fld x in (ObjWrapper x', ev'))
+updateActors :: Field -> [ActorWrapper] -> [(ActorWrapper, [Event])]
+updateActors fld = map (\(ActorWrapper x) -> let (x', ev') = update fld x in (ActorWrapper x', ev'))
 
-filterActors :: [ObjWrapper] -> [ObjWrapper]
-filterActors = filter (\(ObjWrapper x) -> not $ bDead x)
+filterActors :: [ActorWrapper] -> [ActorWrapper]
+filterActors = filter (\(ActorWrapper x) -> not $ bDead x)
 
-renderActors :: ImageResource -> Int -> Surface -> [ObjWrapper] -> IO ()
-renderActors imgres ofsx sur = mapM_ (\(ObjWrapper x) -> render x imgres ofsx sur)
+renderActors :: ImageResource -> Int -> Surface -> [ActorWrapper] -> IO ()
+renderActors imgres ofsx sur = mapM_ (\(ActorWrapper x) -> render x imgres ofsx sur)

lang/haskell/nario/Actor/Kinoko.hs

@@ -5 +5 @@
 ) where
 
-import Multimedia.SDL hiding (Event)
+import Multimedia.SDL (blitSurface, pt)
 
 import Actor (Actor(..))
 import Const
 import Util (sgn)
-import AppUtil
+import AppUtil (getImageSurface, cellCrd, Rect(..))
 import Images
 import Field
@@ -47 +47 @@
         bDead self = y self `div` one >= screenHeight + chrSize * 3
 
+        getHitRect self = Just $ Rect (xx - 8) (yy - 16) (xx + 8) yy
+                where
+                        xx = x self `div` one
+                        yy = y self `div` one
+
 
 newKinoko :: Int -> Int -> Kinoko

lang/haskell/nario/AppUtil.hs

@@ -1 +1 @@
 module AppUtil where
 
-import Multimedia.SDL
+import Multimedia.SDL (Surface, SDLKey(..), loadBMP, freeSurface, surfacePixelFormat, displayFormat, pfPalette, setColorKey, SurfaceFlag(..))
 import Data.Maybe (fromJust)
 
@@ -73 +73 @@
 cellCrd :: Int -> Int
 cellCrd x = x `div` (chrSize * one)
+
+
+
+-- ========
+data Rect = Rect Int Int Int Int
+
+
+ishit :: Rect -> Rect -> Bool
+ishit (Rect l1 t1 r1 b1) (Rect l2 t2 r2 b2) =
+        l1 < r2 && t1 < b2 && l2 < r1 && t2 < b1

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
 
 

lang/haskell/nario/Player.hs

@@ -8 +8 @@
         getScrollPos,
         getPlayerYPos,
+        getPlayerHitRect,
         getPlayerMedal,
         getPlayerScore
 ) where
 
-import Multimedia.SDL hiding (Event)
+import Multimedia.SDL (blitSurface, pt)
 
 import Util
-import AppUtil
+import AppUtil (KeyProc, isPressed, PadBtn(..), cellCrd, KeyState(..), getImageSurface, Rect(..))
 import Const
 import Images
@@ -200 +201 @@
 getPlayerYPos = (`div` one) . y
 
+-- 当たり判定用矩形
+getPlayerHitRect :: Player -> Rect
+getPlayerHitRect self = Rect (xx - 6) (yy - 16) (xx + 6) yy
+        where
+                xx = x self `div` one
+                yy = y self `div` one
+
 -- メダル枚数取得
 getPlayerMedal :: Player -> Int