Permalink
Browse files

プレーヤー操作性調整

ノコノコを倒して蹴れるように
スコア演出追加


git-svn-id: http://svn.coderepos.org/share/lang/haskell/nario@20811 d0d07461-0603-4401-acd4-de1884942a52
  • Loading branch information...
1 parent 28738a9 commit 374232a713580f2fc806632bf1e2b1d80f66905d mokehehe committed Oct 5, 2008
Showing with 285 additions and 105 deletions.
  1. +2 −2 Actor.hs
  2. +7 −0 Actor.hs-boot
  3. +1 −0 Actor/AnimBlock.hs
  4. +1 −0 Actor/BrokenBlock.hs
  5. +2 −1 Actor/CoinGet.hs
  6. +40 −0 Actor/Common.hs
  7. +5 −4 Actor/Flower.hs
  8. +11 −20 Actor/Kinoko.hs
  9. +70 −0 Actor/Koura.hs
  10. +16 −7 Actor/Kuribo.hs
  11. +28 −6 Actor/Nokonoko.hs
  12. +13 −5 Actor/ScoreAdd.hs
  13. +11 −1 Const.hs
  14. +6 −6 Event.hs
  15. +3 −3 Images.hs
  16. +24 −24 Main.hs
  17. +41 −25 Player.hs
  18. +3 −0 README.txt
  19. +1 −1 data/stage0.map
View
@@ -26,8 +26,8 @@ class Actor a where
getHitRect :: a -> Maybe Rect
getHitRect _ = Nothing
- onHit :: Player -> a -> (Player, Maybe ActorWrapper)
- onHit pl ac = (pl, Nothing)
+ onHit :: Player -> a -> (Player, Maybe ActorWrapper, [Event])
+ onHit pl ac = (pl, Nothing, [])
-- ============================================================================
View
@@ -0,0 +1,7 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+module Actor where
+
+class Actor a where
+
+data ActorWrapper = forall a. Actor a => ActorWrapper a
View
@@ -1,3 +1,4 @@
+-- -*- mode: haskell; Encoding: UTF-8 -*-
-- ブロックを叩いたときのバウンド演出
module Actor.AnimBlock (
View
@@ -1,3 +1,4 @@
+-- -*- mode: haskell; Encoding: UTF-8 -*-
-- ブロックを叩いたときのバウンド演出
module Actor.BrokenBlock (
View
@@ -1,3 +1,4 @@
+-- -*- mode: haskell; Encoding: UTF-8 -*-
-- コインを取ったときの演出コイン
module Actor.CoinGet (
@@ -25,7 +26,7 @@ imgtbl = [ImgCoin0, ImgCoin1, ImgCoin2, ImgCoin3]
instance Actor CoinGet where
update _ self
- | bDead self' = (self', [EvScoreAddEfe (sx self) (y self `div` one) Img1000])
+ | bDead self' = (self', [EvScoreAddEfe (sx self) (y self `div` one) pointGetCoin])
| otherwise = (self', [])
where
self' = self { y = y self + vy self, vy = vy self + gravity, cnt = cnt self + 1 }
View
@@ -0,0 +1,40 @@
+-- -*- mode: haskell; Encoding: UTF-8 -*-
+-- 共通動作
+
+module Actor.Common (
+ updateActorBase,
+ stamp
+) where
+
+import Const
+import Field
+import Util (sgn)
+import AppUtil (cellCrd)
+import Player (Player(..), getPlayerVY)
+
+maxVy = one * 5
+
+-- 共通動作
+{-
+ 左右に移動、壁にぶつかったら反転、下に何もなかったら落下
+-}
+updateActorBase :: Field -> (Int, Int, Int, Int) -> (Int, Int, Int, Int)
+updateActorBase fld (x, y, vx, vy)
+ | isGround = (x', groundy', vx', 0)
+ | otherwise = (x', y', vx', vy')
+ where
+ x' = x + vx
+ sideWall = isBlock $ fieldRef fld (cellCrd $ x' + sgn vx * 6 * one) (cellCrd $ y - chrSize * one `div` 2)
+ vx'
+ | sideWall = -vx
+ | otherwise = vx
+
+ vy' = min maxVy $ vy + gravity
+ y' = y + vy'
+ isGround = isBlock $ fieldRef fld (cellCrd $ x') (cellCrd y')
+ groundy' = (cellCrd y') * one * chrSize
+
+
+-- プレーヤーに踏みつけられた?
+stamp :: Player -> (Int, Int) -> Bool
+stamp pl (x, y) = getPlayerVY pl > 0
View
@@ -1,3 +1,4 @@
+-- -*- mode: haskell; Encoding: UTF-8 -*-
-- フラワー
module Actor.Flower (
@@ -12,9 +13,8 @@ import Util (sgn)
import AppUtil (getImageSurface, cellCrd, Rect(..))
import Images
import Field
-import Player (PlayerType(..), getPlayerType, setPlayerType)
-
-maxVy = one * 6
+import Player (PlayerType(..), getPlayerType, setPlayerType, addScore)
+import Event (Event(..))
data Flower = Flower {
@@ -36,13 +36,14 @@ instance Actor Flower where
xx = x self `div` one
yy = y self `div` one
- onHit pl self = (setPlayerType nt pl, Nothing)
+ onHit pl self = (addScore pointFlower $ setPlayerType nt pl, Nothing, ev)
where
nt = case typ of
SmallNario -> SuperNario
SuperNario -> FireNario
otherwise -> typ
typ = getPlayerType pl
+ ev = [EvScoreAddEfe (x self `div` one) (y self `div` one - chrSize * 2) pointFlower]
newFlower :: Int -> Int -> Flower
View
@@ -1,3 +1,4 @@
+-- -*- mode: haskell; Encoding: UTF-8 -*-
-- きのこ
module Actor.Kinoko (
@@ -7,16 +8,15 @@ module Actor.Kinoko (
import Multimedia.SDL (blitSurface, pt)
import Actor (Actor(..))
+import Actor.Common (updateActorBase)
import Const
-import Util (sgn)
import AppUtil (getImageSurface, cellCrd, Rect(..))
import Images
import Field
import Player (PlayerType(..), getPlayerType, setPlayerType, addScore)
+import Event (Event(..))
-maxVy = one * 6
-
-pointKinoko = 1000
+ofsH = 15
data Kinoko = Kinoko {
@@ -27,40 +27,31 @@ data Kinoko = Kinoko {
}
instance Actor Kinoko where
- update fld self
- | isGround = (self { x = x', vx = vx', y = (cellCrd y') * one * chrSize, vy = 0 }, [])
- | otherwise = (self { x = x', vx = vx', y = y', vy = vy' }, [])
+ update fld self = (self', [])
where
- x' = x self + vx self
- sideWall = isBlock $ fieldRef fld (cellCrd $ x' + sgn (vx self) * 6 * one) (cellCrd $ y self - chrSize * one `div` 2)
- vx'
- | sideWall = -(vx self)
- | otherwise = vx self
-
- vy' = min maxVy $ vy self + gravity
- y' = y self + vy'
- isGround = isBlock $ fieldRef fld (cellCrd $ x') (cellCrd y')
+ self' = self { x = x', y = y', vx = vx', vy = vy' }
+ (x', y', vx', vy') = updateActorBase fld (x self, y self, vx self, vy self)
render self imgres scrx sur = do
- blitSurface (getImageSurface imgres imgtype) Nothing sur (pt ((x self) `div` one - chrSize `div` 2 - scrx) ((y self) `div` one - 15 - 8))
+ blitSurface (getImageSurface imgres imgtype) Nothing sur (pt ((x self) `div` one - chrSize `div` 2 - scrx) ((y self) `div` one - ofsH - 8))
return ()
where
imgtype = ImgKinoko
- bDead self = y self `div` one >= screenHeight + chrSize * 3
+ bDead self = y self >= (screenHeight + chrSize * 3) * one || x self <= -chrSize * one
getHitRect self = Just $ Rect (xx - 8) (yy - 16) (xx + 8) yy
where
xx = x self `div` one
yy = y self `div` one
- onHit pl self = (addScore pointKinoko $ setPlayerType nt pl, Nothing)
+ onHit pl self = (addScore pointKinoko $ setPlayerType nt pl, Nothing, ev)
where
nt = case typ of
SmallNario -> SuperNario
otherwise -> typ
typ = getPlayerType pl
-
+ ev = [EvScoreAddEfe (x self `div` one) (y self `div` one - chrSize * 2) pointKinoko]
newKinoko :: Int -> Int -> Kinoko
newKinoko cx cy =
View
@@ -0,0 +1,70 @@
+-- -*- mode: haskell; Encoding: UTF-8 -*-
+-- 甲羅
+
+module Actor.Koura (
+ newKoura
+) where
+
+import Multimedia.SDL (blitSurface, pt)
+
+import Actor (Actor(..), ActorWrapper(..))
+import Actor.Common (updateActorBase, stamp)
+import Const
+import AppUtil (getImageSurface, cellCrd, Rect(..))
+import Images
+import Player (getPlayerX, stampPlayer, setPlayerDamage, addScore)
+import Event (Event(..))
+
+ofsH = 15
+vel = 7 * one `div` 2
+reviveCount = 6 * frameRate
+
+
+data Koura = Koura {
+ x :: Int,
+ y :: Int,
+ vx :: Int,
+ vy :: Int,
+ nomovecnt :: Int
+ }
+
+instance Actor Koura where
+ update fld self =
+ if not revive
+ then (self', [])
+ else (gotoDie, [])
+ where
+ self' = self { x = x', y = y', vx = vx', vy = vy', nomovecnt = nomovecnt' }
+ (x', y', vx', vy') = updateActorBase fld (x self, y self, vx self, vy self)
+ nomovecnt'
+ | vx self == 0 = nomovecnt self + 1
+ | otherwise = 0
+ revive = nomovecnt' >= reviveCount
+ gotoDie = self { x = -chrSize * one }
+
+ render self imgres scrx sur = do
+ blitSurface (getImageSurface imgres imgtype) Nothing sur (pt ((x self) `div` one - chrSize `div` 2 - scrx) ((y self) `div` one - ofsH - 8))
+ return ()
+ where
+ imgtype = ImgKoura
+
+ bDead self = y self >= (screenHeight + chrSize * 3) * one || x self <= -chrSize * one
+
+ getHitRect self = Just $ Rect (xx - 8) (yy - 16) (xx + 8) yy
+ where
+ xx = x self `div` one
+ yy = y self `div` one
+
+ onHit pl self
+ | vx self == 0 = (addScore pointKoura $ pl, Just $ ActorWrapper $ self { vx = (if x self > getPlayerX pl then 1 else -1) * vel }, ev)
+ | stamp pl (x self, y self) = (stampPlayer pl, Just $ ActorWrapper $ self { vx = 0 }, [])
+ | collide = (setPlayerDamage pl, Just $ ActorWrapper self, [])
+ | otherwise = (pl, Just $ ActorWrapper self, [])
+ where
+ collide = (getPlayerX pl - x self) * (vx self) > 0
+ ev = [EvScoreAddEfe (x self `div` one) (y self `div` one - chrSize * 2) pointKoura]
+
+
+newKoura :: Int -> Int -> Koura
+newKoura xx yy =
+ Koura { x = xx, y = yy, vx = 0, vy = 0, nomovecnt = 0 }
View
@@ -1,3 +1,4 @@
+-- -*- mode: haskell; Encoding: UTF-8 -*-
-- クリボー
module Actor.Kuribo (
@@ -7,11 +8,14 @@ module Actor.Kuribo (
import Multimedia.SDL (blitSurface, pt)
import Actor (Actor(..), ActorWrapper(..))
+import Actor.Common (updateActorBase, stamp)
import Const
-import AppUtil
+import AppUtil (getImageSurface, cellCrd, Rect(..))
import Images
-import Player (setPlayerDamage, getPlayerVY, stampPlayer)
+import Player (setPlayerDamage, stampPlayer, addScore)
+import Event (Event(..))
+ofsH = 15
data Kuribo = Kuribo {
x :: Int,
@@ -22,24 +26,29 @@ data Kuribo = Kuribo {
}
instance Actor Kuribo where
- update fld self = (self { x = x self + vx self, cnt = cnt self + 1 }, [])
+ update fld self = (self', [])
+ where
+ self' = self { x = x', y = y', vx = vx', vy = vy', cnt = cnt self + 1 }
+ (x', y', vx', vy') = updateActorBase fld (x self, y self, vx self, vy self)
render self imgres scrx sur = do
- blitSurface (getImageSurface imgres imgtype) Nothing sur (pt (x self `div` one - chrSize `div` 2 - scrx) (y self `div` one - 15 - 8))
+ blitSurface (getImageSurface imgres imgtype) Nothing sur (pt (x self `div` one - chrSize `div` 2 - scrx) (y self `div` one - ofsH - 8))
return ()
where
imgtype = [ImgKuri0, ImgKuri1] !! (cnt self `mod` 16 `div` 8)
+ bDead self = y self >= (screenHeight + chrSize * 3) * one || x self <= -chrSize * one
+
getHitRect self = Just $ Rect (xx - 8) (yy - 16) (xx + 8) yy
where
xx = x self `div` one
yy = y self `div` one
onHit pl self
- | stamp = (stampPlayer pl, Just $ ActorWrapper $ newStampedKuribo (x self `div` one - chrSize `div` 2) (y self `div` one))
- | otherwise = (setPlayerDamage pl, Just $ ActorWrapper self)
+ | stamp pl (x self, y self) = (addScore pointKuribo $ stampPlayer pl, Just $ ActorWrapper $ newStampedKuribo (x self `div` one - chrSize `div` 2) (y self `div` one), ev)
+ | otherwise = (setPlayerDamage pl, Just $ ActorWrapper self, [])
where
- stamp = getPlayerVY pl > 0
+ ev = [EvScoreAddEfe (x self `div` one) (y self `div` one - chrSize * 2) pointKuribo]
newKuribo :: Int -> Int -> Kuribo
newKuribo cx cy =
View
@@ -1,16 +1,22 @@
--- クリボー
+-- -*- mode: haskell; Encoding: UTF-8 -*-
+-- ノコノコ
module Actor.Nokonoko (
newNokonoko
) where
-import Multimedia.SDL hiding (Event)
+import Multimedia.SDL (blitSurface, pt)
-import Actor (Actor(..))
+import Actor (Actor(..), ActorWrapper(..))
+import Actor.Common (updateActorBase, stamp)
+import Actor.Koura
import Const
-import AppUtil
+import AppUtil (getImageSurface, cellCrd, Rect(..))
import Images
+import Player (setPlayerDamage, stampPlayer, addScore)
+import Event (Event(..))
+ofsH = 23
data Nokonoko = Nokonoko {
x :: Int,
@@ -21,14 +27,30 @@ data Nokonoko = Nokonoko {
}
instance Actor Nokonoko where
- update fld self = (self { x = x self + vx self, cnt = cnt self + 1 }, [])
+ update fld self = (self', [])
+ where
+ self' = self { x = x', y = y', vx = vx', vy = vy', cnt = cnt self + 1 }
+ (x', y', vx', vy') = updateActorBase fld (x self, y self, vx self, vy self)
render self imgres scrx sur = do
- blitSurface (getImageSurface imgres imgtype) Nothing sur (pt ((x self) `div` one - scrx) ((y self) `div` one - 8))
+ blitSurface (getImageSurface imgres imgtype) Nothing sur (pt (x self `div` one - chrSize `div` 2 - scrx) (y self `div` one - ofsH - 8))
return ()
where
imgtype = [ImgNoko0, ImgNoko1] !! (cnt self `mod` 16 `div` 8)
+ bDead self = y self >= (screenHeight + chrSize * 3) * one || x self <= -chrSize * one
+
+ getHitRect self = Just $ Rect (xx - 8) (yy - 16) (xx + 8) yy
+ where
+ xx = x self `div` one
+ yy = y self `div` one
+
+ onHit pl self
+ | stamp pl (x self, y self) = (addScore pointNokonoko $ stampPlayer pl, Just $ ActorWrapper $ newKoura (x self) (y self), ev)
+ | otherwise = (setPlayerDamage pl, Just $ ActorWrapper self, [])
+ where
+ ev = [EvScoreAddEfe (x self `div` one) (y self `div` one - chrSize * 2) pointNokonoko]
+
newNokonoko :: Int -> Int -> Nokonoko
newNokonoko cx cy =
Nokonoko { x = cx * chrSize * one, y = cy * chrSize * one, vx = -one `div` 2, vy = 0, cnt = 0 }
Oops, something went wrong.

0 comments on commit 374232a

Please sign in to comment.