Changeset 20775 for lang/haskell

Timestamp:

10/05/08 16:27:31 (2 months ago)

Author:

mokehehe

Message:

エフェクトオブジェクト（コイン取得、スコア加算、ブロック破壊）追加

Location:

lang/haskell/nario

Files:

• Actor/AnimBlock.hs (modified) (2 diffs)
• Actor/BrokenBlock.hs (added)
• Actor/CoinGet.hs (added)
• Actor/Kinoko.hs (modified) (2 diffs)
• Actor/ScoreAdd.hs (added)
• Event.hs (modified) (1 diff)
• Images.hs (modified) (1 diff)
• Main.hs (modified) (7 diffs)
• Player.hs (modified) (7 diffs)

lang/haskell/nario/Actor/AnimBlock.hs

@@ -14 +14 @@
 import Event
 
--- ============================================================================
--- AnimBlock
---      ブロックを叩いたときのバウンド演出
 
 data AnimBlock = AnimBlock {
@@ -40 +37 @@
 
         render self imgres scrx sur = do
-                blitSurface (getImageSurface imgres $ chr2img $ chr self) Nothing sur (pt ((x self) `div` one - scrx) ((y self) `div` one - 8))
+                blitSurface (getImageSurface imgres $ chr2img $ chr self) Nothing sur (pt (x self `div` one - scrx) (y self `div` one - 8))
                 return ()
 

lang/haskell/nario/Actor/Kinoko.hs

@@ -13 +13 @@
 import Images
 import Field
-import Player (PlayerType(..), getPlayerType, setPlayerType)
+import Player (PlayerType(..), getPlayerType, setPlayerType, addScore)
 
 maxVy = one * 6
+
+pointKinoko = 1000
 
 
@@ -53 +55 @@
                         yy = y self `div` one
 
-        onHit pl self = (setPlayerType nt pl, Nothing)
+        onHit pl self = (addScore pointKinoko $ setPlayerType nt pl, Nothing)
                 where
                         nt = case typ of

lang/haskell/nario/Event.hs

@@ -14 +14 @@
                 -- 敵登場
         |       EvAppearEnemy Int Int Cell
+
+                -- スコア加算エフェクト
+        |       EvScoreAddEfe Int Int ImageType

lang/haskell/nario/Images.hs

@@ -1 +1 @@
 module Images (ImageType(..), imageTypes, imageFn) where
 import Maybe (fromJust)
-data ImageType = ImgBlock1 | ImgBlock2 | ImgBlock3 | ImgBlock4 | ImgBlock5 | ImgCloud00 | ImgCloud01 | ImgCloud02 | ImgCloud10 | ImgCloud11 | ImgCloud12 | ImgCoin0 | ImgCoin1 | ImgCoin2 | ImgCoin3 | ImgDk00 | ImgDk01 | ImgDk10 | ImgDk11 | ImgFlag | ImgFlower | ImgFNarioLJump | ImgFNarioLShot | ImgFNarioLSit | ImgFNarioLSlip | ImgFNarioLStand | ImgFNarioLWalk1 | ImgFNarioLWalk2 | ImgFNarioLWalk3 | ImgFNarioRJump | ImgFNarioRShot | ImgFNarioRSit | ImgFNarioRSlip | ImgFNarioRStand | ImgFNarioRWalk1 | ImgFNarioRWalk2 | ImgFNarioRWalk3 | ImgFont | ImgGrass0 | ImgGrass1 | ImgGrass2 | ImgKinoko | ImgKuri0 | ImgKuri1 | ImgKuriDead | ImgMt02 | ImgMt11 | ImgMt12 | ImgMt13 | ImgMt22 | ImgNarioDead | ImgNarioLJump | ImgNarioLSlip | ImgNarioLStand | ImgNarioLWalk1 | ImgNarioLWalk2 | ImgNarioLWalk3 | ImgNarioRJump | ImgNarioRSlip | ImgNarioRStand | ImgNarioRWalk1 | ImgNarioRWalk2 | ImgNarioRWalk3 | ImgNoko0 | ImgNoko1 | ImgPole0 | ImgPole1 | ImgSNarioLJump | ImgSNarioLSit | ImgSNarioLSlip | ImgSNarioLStand | ImgSNarioLWalk1 | ImgSNarioLWalk2 | ImgSNarioLWalk3 | ImgSNarioRJump | ImgSNarioRSit | ImgSNarioRSlip | ImgSNarioRStand | ImgSNarioRWalk1 | ImgSNarioRWalk2 | ImgSNarioRWalk3 | ImgTitle      deriving (Eq)
-imageTypes = [ImgBlock1, ImgBlock2, ImgBlock3, ImgBlock4, ImgBlock5, ImgCloud00, ImgCloud01, ImgCloud02, ImgCloud10, ImgCloud11, ImgCloud12, ImgCoin0, ImgCoin1, ImgCoin2, ImgCoin3, ImgDk00, ImgDk01, ImgDk10, ImgDk11, ImgFlag, ImgFlower, ImgFNarioLJump, ImgFNarioLShot, ImgFNarioLSit, ImgFNarioLSlip, ImgFNarioLStand, ImgFNarioLWalk1, ImgFNarioLWalk2, ImgFNarioLWalk3, ImgFNarioRJump, ImgFNarioRShot, ImgFNarioRSit, ImgFNarioRSlip, ImgFNarioRStand, ImgFNarioRWalk1, ImgFNarioRWalk2, ImgFNarioRWalk3, ImgFont, ImgGrass0, ImgGrass1, ImgGrass2, ImgKinoko, ImgKuri0, ImgKuri1, ImgKuriDead, ImgMt02, ImgMt11, ImgMt12, ImgMt13, ImgMt22, ImgNarioDead, ImgNarioLJump, ImgNarioLSlip, ImgNarioLStand, ImgNarioLWalk1, ImgNarioLWalk2, ImgNarioLWalk3, ImgNarioRJump, ImgNarioRSlip, ImgNarioRStand, ImgNarioRWalk1, ImgNarioRWalk2, ImgNarioRWalk3, ImgNoko0, ImgNoko1, ImgPole0, ImgPole1, ImgSNarioLJump, ImgSNarioLSit, ImgSNarioLSlip, ImgSNarioLStand, ImgSNarioLWalk1, ImgSNarioLWalk2, ImgSNarioLWalk3, ImgSNarioRJump, ImgSNarioRSit, ImgSNarioRSlip, ImgSNarioRStand, ImgSNarioRWalk1, ImgSNarioRWalk2, ImgSNarioRWalk3, ImgTitle]
-imageFilenames = ["block1.bmp", "block2.bmp", "block3.bmp", "block4.bmp", "block5.bmp", "cloud00.bmp", "cloud01.bmp", "cloud02.bmp", "cloud10.bmp", "cloud11.bmp", "cloud12.bmp", "coin0.bmp", "coin1.bmp", "coin2.bmp", "coin3.bmp", "dk00.bmp", "dk01.bmp", "dk10.bmp", "dk11.bmp", "flag.bmp", "flower.bmp", "fNarioLJump.bmp", "fNarioLShot.bmp", "fNarioLSit.bmp", "fNarioLSlip.bmp", "fNarioLStand.bmp", "fNarioLWalk1.bmp", "fNarioLWalk2.bmp", "fNarioLWalk3.bmp", "fNarioRJump.bmp", "fNarioRShot.bmp", "fNarioRSit.bmp", "fNarioRSlip.bmp", "fNarioRStand.bmp", "fNarioRWalk1.bmp", "fNarioRWalk2.bmp", "fNarioRWalk3.bmp", "font.bmp", "grass0.bmp", "grass1.bmp", "grass2.bmp", "kinoko.bmp", "kuri0.bmp", "kuri1.bmp", "kuriDead.bmp", "mt02.bmp", "mt11.bmp", "mt12.bmp", "mt13.bmp", "mt22.bmp", "narioDead.bmp", "narioLJump.bmp", "narioLSlip.bmp", "narioLStand.bmp", "narioLWalk1.bmp", "narioLWalk2.bmp", "narioLWalk3.bmp", "narioRJump.bmp", "narioRSlip.bmp", "narioRStand.bmp", "narioRWalk1.bmp", "narioRWalk2.bmp", "narioRWalk3.bmp", "noko0.bmp", "noko1.bmp", "pole0.bmp", "pole1.bmp", "sNarioLJump.bmp", "sNarioLSit.bmp", "sNarioLSlip.bmp", "sNarioLStand.bmp", "sNarioLWalk1.bmp", "sNarioLWalk2.bmp", "sNarioLWalk3.bmp", "sNarioRJump.bmp", "sNarioRSit.bmp", "sNarioRSlip.bmp", "sNarioRStand.bmp", "sNarioRWalk1.bmp", "sNarioRWalk2.bmp", "sNarioRWalk3.bmp", "title.bmp"]
+data ImageType = Img100 | Img1000 | Img200 | Img500 | ImgBlock1 | ImgBlock2 | ImgBlock3 | ImgBlock4 | ImgBlock5 | ImgBroken | ImgCloud00 | ImgCloud01 | ImgCloud02 | ImgCloud10 | ImgCloud11 | ImgCloud12 | ImgCoin0 | ImgCoin1 | ImgCoin2 | ImgCoin3 | ImgDk00 | ImgDk01 | ImgDk10 | ImgDk11 | ImgFlag | ImgFlower | ImgFNarioLJump | ImgFNarioLShot | ImgFNarioLSit | ImgFNarioLSlip | ImgFNarioLStand | ImgFNarioLWalk1 | ImgFNarioLWalk2 | ImgFNarioLWalk3 | ImgFNarioRJump | ImgFNarioRShot | ImgFNarioRSit | ImgFNarioRSlip | ImgFNarioRStand | ImgFNarioRWalk1 | ImgFNarioRWalk2 | ImgFNarioRWalk3 | ImgFont | ImgGrass0 | ImgGrass1 | ImgGrass2 | ImgKinoko | ImgKuri0 | ImgKuri1 | ImgKuriDead | ImgMt02 | ImgMt11 | ImgMt12 | ImgMt13 | ImgMt22 | ImgNarioDead | ImgNarioLJump | ImgNarioLSlip | ImgNarioLStand | ImgNarioLWalk1 | ImgNarioLWalk2 | ImgNarioLWalk3 | ImgNarioRJump | ImgNarioRSlip | ImgNarioRStand | ImgNarioRWalk1 | ImgNarioRWalk2 | ImgNarioRWalk3 | ImgNoko0 | ImgNoko1 | ImgPole0 | ImgPole1 | ImgSNarioLJump | ImgSNarioLSit | ImgSNarioLSlip | ImgSNarioLStand | ImgSNarioLWalk1 | ImgSNarioLWalk2 | ImgSNarioLWalk3 | ImgSNarioRJump | ImgSNarioRSit | ImgSNarioRSlip | ImgSNarioRStand | ImgSNarioRWalk1 | ImgSNarioRWalk2 | ImgSNarioRWalk3 | ImgTitle     deriving (Eq)
+imageTypes = [Img100, Img1000, Img200, Img500, ImgBlock1, ImgBlock2, ImgBlock3, ImgBlock4, ImgBlock5, ImgBroken, ImgCloud00, ImgCloud01, ImgCloud02, ImgCloud10, ImgCloud11, ImgCloud12, ImgCoin0, ImgCoin1, ImgCoin2, ImgCoin3, ImgDk00, ImgDk01, ImgDk10, ImgDk11, ImgFlag, ImgFlower, ImgFNarioLJump, ImgFNarioLShot, ImgFNarioLSit, ImgFNarioLSlip, ImgFNarioLStand, ImgFNarioLWalk1, ImgFNarioLWalk2, ImgFNarioLWalk3, ImgFNarioRJump, ImgFNarioRShot, ImgFNarioRSit, ImgFNarioRSlip, ImgFNarioRStand, ImgFNarioRWalk1, ImgFNarioRWalk2, ImgFNarioRWalk3, ImgFont, ImgGrass0, ImgGrass1, ImgGrass2, ImgKinoko, ImgKuri0, ImgKuri1, ImgKuriDead, ImgMt02, ImgMt11, ImgMt12, ImgMt13, ImgMt22, ImgNarioDead, ImgNarioLJump, ImgNarioLSlip, ImgNarioLStand, ImgNarioLWalk1, ImgNarioLWalk2, ImgNarioLWalk3, ImgNarioRJump, ImgNarioRSlip, ImgNarioRStand, ImgNarioRWalk1, ImgNarioRWalk2, ImgNarioRWalk3, ImgNoko0, ImgNoko1, ImgPole0, ImgPole1, ImgSNarioLJump, ImgSNarioLSit, ImgSNarioLSlip, ImgSNarioLStand, ImgSNarioLWalk1, ImgSNarioLWalk2, ImgSNarioLWalk3, ImgSNarioRJump, ImgSNarioRSit, ImgSNarioRSlip, ImgSNarioRStand, ImgSNarioRWalk1, ImgSNarioRWalk2, ImgSNarioRWalk3, ImgTitle]
+imageFilenames = ["100.bmp", "1000.bmp", "200.bmp", "500.bmp", "block1.bmp", "block2.bmp", "block3.bmp", "block4.bmp", "block5.bmp", "broken.bmp", "cloud00.bmp", "cloud01.bmp", "cloud02.bmp", "cloud10.bmp", "cloud11.bmp", "cloud12.bmp", "coin0.bmp", "coin1.bmp", "coin2.bmp", "coin3.bmp", "dk00.bmp", "dk01.bmp", "dk10.bmp", "dk11.bmp", "flag.bmp", "flower.bmp", "fNarioLJump.bmp", "fNarioLShot.bmp", "fNarioLSit.bmp", "fNarioLSlip.bmp", "fNarioLStand.bmp", "fNarioLWalk1.bmp", "fNarioLWalk2.bmp", "fNarioLWalk3.bmp", "fNarioRJump.bmp", "fNarioRShot.bmp", "fNarioRSit.bmp", "fNarioRSlip.bmp", "fNarioRStand.bmp", "fNarioRWalk1.bmp", "fNarioRWalk2.bmp", "fNarioRWalk3.bmp", "font.bmp", "grass0.bmp", "grass1.bmp", "grass2.bmp", "kinoko.bmp", "kuri0.bmp", "kuri1.bmp", "kuriDead.bmp", "mt02.bmp", "mt11.bmp", "mt12.bmp", "mt13.bmp", "mt22.bmp", "narioDead.bmp", "narioLJump.bmp", "narioLSlip.bmp", "narioLStand.bmp", "narioLWalk1.bmp", "narioLWalk2.bmp", "narioLWalk3.bmp", "narioRJump.bmp", "narioRSlip.bmp", "narioRStand.bmp", "narioRWalk1.bmp", "narioRWalk2.bmp", "narioRWalk3.bmp", "noko0.bmp", "noko1.bmp", "pole0.bmp", "pole1.bmp", "sNarioLJump.bmp", "sNarioLSit.bmp", "sNarioLSlip.bmp", "sNarioLStand.bmp", "sNarioLWalk1.bmp", "sNarioLWalk2.bmp", "sNarioLWalk3.bmp", "sNarioRJump.bmp", "sNarioRSit.bmp", "sNarioRSlip.bmp", "sNarioRStand.bmp", "sNarioRWalk1.bmp", "sNarioRWalk2.bmp", "sNarioRWalk3.bmp", "title.bmp"]
 imageFn = fromJust . flip lookup (zip imageTypes imageFilenames)

lang/haskell/nario/Main.hs

@@ -23 +23 @@
 import Actor.Kinoko
 import Actor.Flower
+import Actor.BrokenBlock
+import Actor.CoinGet
+import Actor.ScoreAdd
 
 -- 背景色
@@ -29 +32 @@
 -- 描画コマンド
 type Scr = Surface -> IO ()
+
+
+pointBreakBlock = 50
+pointGetCoin = 200
+
 
 -- エントリ
@@ -110 +118 @@
 
 
-
 -- マップのスクロールに応じたイベント
 scrollEvent :: Field -> Int -> (Field, [Event])
@@ -127 +134 @@
 
 
-
 -- 当たり判定
 hitcheck :: Player -> [ActorWrapper] -> (Player, [ActorWrapper])
@@ -191 +197 @@
                 proc gs (EvHitBlock imgtype cx cy bSuper)
                         | hardBlock c                   = gs
-                        | bSuper && breakable c = gs { fld = fieldSet (fld gs) cx cy ' ' }
-                        | otherwise                             = gs { fld = fld', actors = actors' }
+                        | bSuper && breakable c = breakBlock gs cx cy
+                        | c == 'K'                              = genKinoko
+                        | c == '?'                              = getCoin
+                        | otherwise                             = gs'
                         where
                                 c = fieldRef (fld gs) cx cy
-                                items
-                                        | c == 'K'      = if not bSuper then [ActorWrapper $ newKinoko cx cy] else [ActorWrapper $ newFlower cx cy]
-                                        | otherwise     = []
-                                actors' = actors gs ++ [ActorWrapper $ newAnimBlock cx cy $ fieldRef (fld gs) cx cy] ++ items
+                                breakable c = c == 'O'
+
+                                gs' = gs { fld = fld', actors = actors' }
+                                actors' = actors gs ++ [ActorWrapper $ newAnimBlock cx cy $ fieldRef (fld gs) cx cy]
                                 fld' = fieldSet (fld gs) cx cy '*'
-                                breakable c = c == 'O'
+
+                                breakBlock gs cx cy =
+                                        gs {
+                                                fld = fieldSet (fld gs) cx cy ' ',
+                                                actors = actors gs ++ map ActorWrapper (newBrokenBlock cx cy),
+                                                pl = addScore pointBreakBlock $ pl gs
+                                                }
+                                genKinoko = gs' { actors = actors gs' ++ [a] }
+                                        where a = if not bSuper then ActorWrapper $ newKinoko cx cy else ActorWrapper $ newFlower cx cy
+                                getCoin = gs' { actors = actors gs' ++ [ActorWrapper a], pl = addScore pointGetCoin $ playerGetCoin $ pl gs' }
+                                        where a = newCoinGet cx cy
+
                 proc gs (EvSetField cx cy c) = gs { fld = fieldSet (fld gs) cx cy c }
                 proc gs (EvAppearEnemy cx cy c) = gs { actors = actors gs ++ [ene] }
@@ -207 +226 @@
                                         'k'     -> ActorWrapper $ newKuribo cx cy
                                         'n'     -> ActorWrapper $ newNokonoko cx cy
-
+                proc gs (EvScoreAddEfe sx sy imgtype) = gs { actors = actors gs ++ [ActorWrapper $ newScoreAdd sx sy imgtype] }
 
 -- 描画
@@ -232 +251 @@
         puts 3 1 "NARIO"
         puts 3 2 $ deciWide 6 '0' $ getPlayerScore (pl gs)
-        puts 11 2 ("?*" ++ deciWide 2 '0' (getPlayerMedal (pl gs)))
+        puts 11 2 ("?*" ++ deciWide 2 '0' (getPlayerCoin (pl gs)))
         puts 18 1 "WORLD"
         puts 19 2 "1-1"

lang/haskell/nario/Player.hs

@@ -7 +7 @@
         updatePlayer,
         renderPlayer,
+        playerGetCoin,
+        addScore,
         getScrollPos,
         getPlayerYPos,
         getPlayerVY,
         getPlayerHitRect,
-        getPlayerMedal,
+        getPlayerCoin,
         getPlayerScore,
         getPlayerType,
@@ -61 +63 @@
         undeadCount :: Int,
 
-        medal :: Int,
+        coin :: Int,
         score :: Int,
 
@@ -80 +82 @@
         undeadCount = 0,
 
-        medal = 0,
+        coin = 0,
         score = 0,
 
@@ -206 +208 @@
 checkCeil fld self
         | stand self || vy self >= 0 || not isCeil      = (self, [])
-        | otherwise = (self { vy = 0, score = (score self) + 10 }, [EvHitBlock ImgBlock2 cx cy (pltype self /= SmallNario)])
+        | otherwise = (self { y = y', vy = 0 }, [EvHitBlock ImgBlock2 cx cy (pltype self /= SmallNario)])
         where
                 yofs = case pltype self of
-                        SmallNario      -> 15
-                        SuperNario      -> 30
-                        FireNario       -> 30
+                        SmallNario      -> 14
+                        SuperNario      -> 28
+                        FireNario       -> 28
                 ytmp = y self - yofs * one
 
@@ -218 +220 @@
                 isCeil = isBlock $ fieldRef fld cx cy
                 yground y = (cellCrd y) * (chrSize * one)
+                y' = ((cy + 1) * chrSize + yofs) * one
 
 
@@ -267 +270 @@
                 yy = y self `div` one
 
--- メダル枚数取得
-getPlayerMedal :: Player -> Int
-getPlayerMedal = medal
+-- コイン枚数取得
+getPlayerCoin :: Player -> Int
+getPlayerCoin = coin
 
 -- スコア取得
@@ -293 +296 @@
 stampPlayer :: Player -> Player
 stampPlayer self = self { vy = stampVy }
+
+-- コイン取得
+playerGetCoin :: Player -> Player
+playerGetCoin self = self { coin = (coin self + 1) `mod` 100 }
+
+-- スコア加算
+addScore :: Int -> Player -> Player
+addScore a self = self { score = score self + a }
 
 -- 描画