Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

ファイヤーナリオのときにショットを撃てるように

git-svn-id: http://svn.coderepos.org/share/lang/haskell/nario@21066 d0d07461-0603-4401-acd4-de1884942a52
  • Loading branch information...
commit a080f0fec1651f7f0eee2123630f095c1bd61523 1 parent 52dd0af
mokehehe authored
View
4 Actor.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
+{-# LANGUAGE ExistentialQuantification #-}
-- -*- mode: haskell; Encoding: UTF-8 -*-
-- ゲーム内に登場するオブジェクト
@@ -16,7 +16,7 @@ import Multimedia.SDL (Surface)
import AppUtil (ImageResource, Rect)
import Event (Event)
import Field (Field)
-import Player (Player)
+import {-# SOURCE #-} Player (Player)
class Actor a where
View
2  Actor/AnimBlock.hs
@@ -5,8 +5,6 @@ module Actor.AnimBlock (
newAnimBlock
) where
---import Multimedia.SDL hiding (Event)
-
import Actor (Actor(..))
import AppUtil (cellCrd, putimg)
import Const
View
2  Actor/BrokenBlock.hs
@@ -5,8 +5,6 @@ module Actor.BrokenBlock (
newBrokenBlock
) where
-import Multimedia.SDL hiding (Event)
-
import Actor (Actor(..))
import Const
import AppUtil (putimg)
View
2  Actor/CoinGet.hs
@@ -5,8 +5,6 @@ module Actor.CoinGet (
newCoinGet
) where
-import Multimedia.SDL hiding (Event)
-
import Actor (Actor(..))
import AppUtil (putimg)
import Const
View
3  Actor/Common.hs
@@ -1,4 +1,4 @@
--- -*- mode: haskell; Encoding: UTF-8 -*-
+-- -*- mode: haskell; Encoding: UTF-8 -*-
-- 共通動作
module Actor.Common (
@@ -12,7 +12,6 @@ import Util (sgn)
import AppUtil (cellCrd)
import Player (Player(..), getPlayerVY)
-maxVy = one * 5
-- 共通動作
{-
View
2  Actor/Flower.hs
@@ -5,8 +5,6 @@ module Actor.Flower (
newFlower
) where
---import Multimedia.SDL (itSurface, pt)
-
import Actor (Actor(..))
import Const
import Util (sgn)
View
2  Actor/Kinoko.hs
@@ -5,8 +5,6 @@ module Actor.Kinoko (
newKinoko
) where
---import Multimedia.SDL (blitSurface, pt)
-
import Actor (Actor(..))
import Actor.Common (updateActorBase)
import AppUtil (Rect(..), putimg)
View
2  Actor/Koura.hs
@@ -5,8 +5,6 @@ module Actor.Koura (
newKoura
) where
---import Multimedia.SDL (blitSurface, pt)
-
import Actor (Actor(..), ActorWrapper(..))
import Actor.Common (updateActorBase, stamp)
import AppUtil (Rect(..), putimg)
View
2  Actor/Kuribo.hs
@@ -5,8 +5,6 @@ module Actor.Kuribo (
newKuribo
) where
---import Multimedia.SDL (blitSurface, pt)
-
import Actor (Actor(..), ActorWrapper(..))
import Actor.Common (updateActorBase, stamp)
import AppUtil (Rect(..), putimg)
View
2  Actor/Nokonoko.hs
@@ -5,8 +5,6 @@ module Actor.Nokonoko (
newNokonoko
) where
---import Multimedia.SDL (blitSurface, pt)
-
import Actor (Actor(..), ActorWrapper(..))
import Actor.Common (updateActorBase, stamp)
import Actor.Koura
View
2  Actor/ScoreAdd.hs
@@ -5,8 +5,6 @@ module Actor.ScoreAdd (
newScoreAdd
) where
---import Multimedia.SDL hiding (Event)
-
import Actor (Actor(..))
import AppUtil (putimg)
import Const
View
60 Actor/Shot.hs
@@ -0,0 +1,60 @@
+-- -*- mode: haskell; Encoding: UTF-8 -*-
+-- プレーヤーが撃つショット(ファイヤー)
+
+module Actor.Shot (
+ newShot
+) where
+
+import Actor (Actor(..))
+import AppUtil (cellCrd, putimg)
+import Const
+import Images
+import Field (Cell, isBlock, fieldRef)
+import Event (Event(..))
+
+velX = 4 * one
+velY = 3 * one
+size = 8
+
+
+data Shot = Shot {
+ x :: Int,
+ y :: Int,
+ vx :: Int,
+ vy :: Int,
+ cnt :: Int,
+ dead :: Bool
+ }
+
+instance Actor Shot where
+ update fld self = (self { x = x', y = y', vy = vy', cnt = cnt', dead = dead' }, [])
+ where
+ vytmp = min velY $ vy self + gravity
+ vy'
+ | isFloor = -vytmp
+ | otherwise = vytmp
+ isFloor = isBlock $ fieldRef fld (cellCrd $ x self) (cellCrd $ y self + vytmp)
+ y' = y self + vy'
+
+ x' = x self + vx self
+ cnt' = cnt self + 1
+
+ dead' = isBlock $ fieldRef fld (cellCrd x') (cellCrd y')
+
+ render self imgres scrx sur =
+ putimg sur imgres imgtype (x self `div` one - size `div` 2 - scrx) (y self `div` one - size `div` 2 - 8)
+ where
+ imgtype = [ImgFire0, ImgFire1, ImgFire2, ImgFire3] !! (cnt self `mod` 4)
+
+ bDead self = dead self || x self < -size * one || y self >= (screenHeight + size) * one
+
+
+newShot :: Int -> Int -> Int -> Shot
+newShot xx yy lr =
+ Shot { x = x', y = y', vx = vx', vy = vy', cnt = 0, dead = False }
+ where
+ dir = if lr == 0 then -1 else 1
+ x' = xx + dir * (8 * one)
+ y' = yy - 16 * one
+ vx' = dir * velX
+ vy' = velY
View
3  Const.hs
@@ -21,6 +21,9 @@ chrSize = 16 :: Int
-- 重力
gravity = one * 2 `div` 5
+-- 最大落下速度
+maxVy = one * 5
+
-- ポイント
pointKuribo = 100 :: Int
View
4 Field.hs
@@ -12,9 +12,9 @@ module Field (
fieldRef,
fieldSet,
isBlock,
+ hardBlock,
renderField,
- chr2img,
- hardBlock
+ chr2img
) where
import Multimedia.SDL
View
6 Images.hs
@@ -1,6 +1,6 @@
module Images (ImageType(..), imageTypes, imageFn) where
import Maybe (fromJust)
-data ImageType = Img100 | Img1000 | Img200 | Img400 | 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 | ImgKoura | ImgKoura2 | ImgKuri0 | ImgKuri1 | ImgKuriDead | ImgMt02 | ImgMt11 | ImgMt12 | ImgMt13 | ImgMt22 | ImgNarioDead | ImgNarioLJump | ImgNarioLSlip | ImgNarioLStand | ImgNarioLWalk1 | ImgNarioLWalk2 | ImgNarioLWalk3 | ImgNarioRJump | ImgNarioRSlip | ImgNarioRStand | ImgNarioRWalk1 | ImgNarioRWalk2 | ImgNarioRWalk3 | ImgNokoL0 | ImgNokoL1 | ImgNokoR0 | ImgNokoR1 | ImgPole0 | ImgPole1 | ImgSNarioLJump | ImgSNarioLSit | ImgSNarioLSlip | ImgSNarioLStand | ImgSNarioLWalk1 | ImgSNarioLWalk2 | ImgSNarioLWalk3 | ImgSNarioRJump | ImgSNarioRSit | ImgSNarioRSlip | ImgSNarioRStand | ImgSNarioRWalk1 | ImgSNarioRWalk2 | ImgSNarioRWalk3 | ImgTitle deriving (Eq)
-imageTypes = [Img100, Img1000, Img200, Img400, 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, ImgKoura, ImgKoura2, ImgKuri0, ImgKuri1, ImgKuriDead, ImgMt02, ImgMt11, ImgMt12, ImgMt13, ImgMt22, ImgNarioDead, ImgNarioLJump, ImgNarioLSlip, ImgNarioLStand, ImgNarioLWalk1, ImgNarioLWalk2, ImgNarioLWalk3, ImgNarioRJump, ImgNarioRSlip, ImgNarioRStand, ImgNarioRWalk1, ImgNarioRWalk2, ImgNarioRWalk3, ImgNokoL0, ImgNokoL1, ImgNokoR0, ImgNokoR1, ImgPole0, ImgPole1, ImgSNarioLJump, ImgSNarioLSit, ImgSNarioLSlip, ImgSNarioLStand, ImgSNarioLWalk1, ImgSNarioLWalk2, ImgSNarioLWalk3, ImgSNarioRJump, ImgSNarioRSit, ImgSNarioRSlip, ImgSNarioRStand, ImgSNarioRWalk1, ImgSNarioRWalk2, ImgSNarioRWalk3, ImgTitle]
-imageFilenames = ["100.bmp", "1000.bmp", "200.bmp", "400.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", "koura.bmp", "koura2.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", "nokoL0.bmp", "nokoL1.bmp", "nokoR0.bmp", "nokoR1.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 | Img400 | Img500 | ImgBlock1 | ImgBlock2 | ImgBlock3 | ImgBlock4 | ImgBlock5 | ImgBroken | ImgCloud00 | ImgCloud01 | ImgCloud02 | ImgCloud10 | ImgCloud11 | ImgCloud12 | ImgCoin0 | ImgCoin1 | ImgCoin2 | ImgCoin3 | ImgDk00 | ImgDk01 | ImgDk10 | ImgDk11 | ImgFire0 | ImgFire1 | ImgFire2 | ImgFire3 | ImgFlag | ImgFlower | ImgFNarioLJump | ImgFNarioLShot | ImgFNarioLSit | ImgFNarioLSlip | ImgFNarioLStand | ImgFNarioLWalk1 | ImgFNarioLWalk2 | ImgFNarioLWalk3 | ImgFNarioRJump | ImgFNarioRShot | ImgFNarioRSit | ImgFNarioRSlip | ImgFNarioRStand | ImgFNarioRWalk1 | ImgFNarioRWalk2 | ImgFNarioRWalk3 | ImgFont | ImgGrass0 | ImgGrass1 | ImgGrass2 | ImgKinoko | ImgKoura | ImgKoura2 | ImgKuri0 | ImgKuri1 | ImgKuriDead | ImgMt02 | ImgMt11 | ImgMt12 | ImgMt13 | ImgMt22 | ImgNarioDead | ImgNarioLJump | ImgNarioLSlip | ImgNarioLStand | ImgNarioLWalk1 | ImgNarioLWalk2 | ImgNarioLWalk3 | ImgNarioRJump | ImgNarioRSlip | ImgNarioRStand | ImgNarioRWalk1 | ImgNarioRWalk2 | ImgNarioRWalk3 | ImgNokoL0 | ImgNokoL1 | ImgNokoR0 | ImgNokoR1 | ImgPole0 | ImgPole1 | ImgSNarioLJump | ImgSNarioLSit | ImgSNarioLSlip | ImgSNarioLStand | ImgSNarioLWalk1 | ImgSNarioLWalk2 | ImgSNarioLWalk3 | ImgSNarioRJump | ImgSNarioRSit | ImgSNarioRSlip | ImgSNarioRStand | ImgSNarioRWalk1 | ImgSNarioRWalk2 | ImgSNarioRWalk3 | ImgTitle deriving (Eq)
+imageTypes = [Img100, Img1000, Img200, Img400, Img500, ImgBlock1, ImgBlock2, ImgBlock3, ImgBlock4, ImgBlock5, ImgBroken, ImgCloud00, ImgCloud01, ImgCloud02, ImgCloud10, ImgCloud11, ImgCloud12, ImgCoin0, ImgCoin1, ImgCoin2, ImgCoin3, ImgDk00, ImgDk01, ImgDk10, ImgDk11, ImgFire0, ImgFire1, ImgFire2, ImgFire3, ImgFlag, ImgFlower, ImgFNarioLJump, ImgFNarioLShot, ImgFNarioLSit, ImgFNarioLSlip, ImgFNarioLStand, ImgFNarioLWalk1, ImgFNarioLWalk2, ImgFNarioLWalk3, ImgFNarioRJump, ImgFNarioRShot, ImgFNarioRSit, ImgFNarioRSlip, ImgFNarioRStand, ImgFNarioRWalk1, ImgFNarioRWalk2, ImgFNarioRWalk3, ImgFont, ImgGrass0, ImgGrass1, ImgGrass2, ImgKinoko, ImgKoura, ImgKoura2, ImgKuri0, ImgKuri1, ImgKuriDead, ImgMt02, ImgMt11, ImgMt12, ImgMt13, ImgMt22, ImgNarioDead, ImgNarioLJump, ImgNarioLSlip, ImgNarioLStand, ImgNarioLWalk1, ImgNarioLWalk2, ImgNarioLWalk3, ImgNarioRJump, ImgNarioRSlip, ImgNarioRStand, ImgNarioRWalk1, ImgNarioRWalk2, ImgNarioRWalk3, ImgNokoL0, ImgNokoL1, ImgNokoR0, ImgNokoR1, ImgPole0, ImgPole1, ImgSNarioLJump, ImgSNarioLSit, ImgSNarioLSlip, ImgSNarioLStand, ImgSNarioLWalk1, ImgSNarioLWalk2, ImgSNarioLWalk3, ImgSNarioRJump, ImgSNarioRSit, ImgSNarioRSlip, ImgSNarioRStand, ImgSNarioRWalk1, ImgSNarioRWalk2, ImgSNarioRWalk3, ImgTitle]
+imageFilenames = ["100.bmp", "1000.bmp", "200.bmp", "400.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", "fire0.bmp", "fire1.bmp", "fire2.bmp", "fire3.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", "koura.bmp", "koura2.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", "nokoL0.bmp", "nokoL1.bmp", "nokoR0.bmp", "nokoR1.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)
View
24 Player.hs
@@ -21,7 +21,7 @@ module Player (
stampPlayer
) where
-import Multimedia.SDL (blitSurface, pt)
+--import Multimedia.SDL (blitSurface, pt)
import Data.Bits ((.&.))
import Util
@@ -30,11 +30,12 @@ import Const
import Images
import Field
import Event
+import Actor (ActorWrapper(..))
+import Actor.Shot
walkVx = one * 4 `div` 2
runVx = one * 11 `div` 4
-maxVy = one * 5
acc = one `div` 32
acc2 = one `div` 14
jumpVy = -12 * gravity
@@ -74,7 +75,7 @@ data Player = Player {
}
newPlayer = Player {
- pltype = SmallNario,
+ pltype = FireNario,
plstate = Normal,
x = 3 * chrSize * one,
y = 13 * chrSize * one,
@@ -241,6 +242,18 @@ doJump kp self
where
vy' = (jumpVy2 - jumpVy) * (abs $ vx self) `div` runVx + jumpVy
+
+-- ショットを撃つ?
+shot :: KeyProc -> Player -> (Player, [Event])
+shot kp self
+ | canShot && padPressed kp PadB = (shotPl, shotEv)
+ | otherwise = (self, [])
+ where
+ canShot = pltype self == FireNario
+ shotPl = self
+ shotEv = [EvAddActor $ ActorWrapper $ newShot (x self) (y self) (lr self)]
+
+
-- 更新処理
updatePlayer :: KeyProc -> Field -> Player -> (Player, [Event])
updatePlayer kp fld self =
@@ -253,9 +266,10 @@ updatePlayer kp fld self =
-- 通常時
updateNormal :: KeyProc -> Field -> Player -> (Player, [Event])
-updateNormal kp fld self =
- moveY $ scroll self $ checkX fld $ moveX kp self
+updateNormal kp fld self = (self'', ev' ++ ev'')
where
+ (self', ev') = moveY $ scroll self $ checkX fld $ moveX kp self
+ (self'', ev'') = shot kp self'
moveY = checkCeil fld . doJump kp . checkFloor fld . fall (padPressing kp PadA)
-- 死亡時
View
5 Player.hs-boot
@@ -0,0 +1,5 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+module Player where
+
+data Player
Please sign in to comment.
Something went wrong with that request. Please try again.