Changeset 20691 for lang/haskell

Show
Ignore:
Timestamp:
10/04/08 18:09:41 (2 months ago)
Author:
mokehehe
Message:

敵との当たり判定追加

Location:
lang/haskell/nario
Files:
5 modified

Legend:

Unmodified
Added
Removed

  • lang/haskell/nario/Actor.hs

    r20680 r20691  
    2727        getHitRect _ = Nothing 
    2828 
    29         onHit :: Player -> a -> (Player, Maybe a) 
     29        onHit :: Player -> a -> (Player, Maybe ActorWrapper) 
    3030        onHit pl ac = (pl, Nothing) 
    3131 

  • lang/haskell/nario/Actor/Kuribo.hs

    r20670 r20691  
    55) where 
    66 
    7 import Multimedia.SDL hiding (Event) 
     7import Multimedia.SDL (blitSurface, pt) 
    88 
    9 import Actor (Actor(..)) 
     9import Actor (Actor(..), ActorWrapper(..)) 
    1010import Const 
    1111import AppUtil 
    1212import Images 
     13import Player (setPlayerDamage, getPlayerVY, stampPlayer) 
    1314 
    1415 
    … …  
    2526 
    2627        render self imgres scrx sur = do 
    27                 blitSurface (getImageSurface imgres imgtype) Nothing sur (pt ((x self) `div` one - scrx) ((y self) `div` one - 8)) 
     28                blitSurface (getImageSurface imgres imgtype) Nothing sur (pt (x self `div` one - chrSize `div` 2 - scrx) (y self `div` one - 15 - 8)) 
    2829                return () 
    2930                where 
    3031                        imgtype = [ImgKuri0, ImgKuri1] !! (cnt self `mod` 16 `div` 8) 
    3132 
     33        getHitRect self = Just $ Rect (xx - 8) (yy - 16) (xx + 8) yy 
     34                where 
     35                        xx = x self `div` one 
     36                        yy = y self `div` one 
     37 
     38        onHit pl self 
     39                | stamp         = (stampPlayer pl, Just $ ActorWrapper $ newStampedKuribo (x self `div` one - chrSize `div` 2) (y self `div` one)) 
     40                | otherwise     = (setPlayerDamage pl, Just $ ActorWrapper self) 
     41                where 
     42                        stamp = getPlayerVY pl > 0 
     43 
    3244newKuribo :: Int -> Int -> Kuribo 
    3345newKuribo cx cy = 
    34         Kuribo { x = cx * chrSize * one, y = cy * chrSize * one, vx = -one `div` 2, vy = 0, cnt = 0 } 
     46        Kuribo { x = cx * chrSize * one + chrSize * one `div` 2, y = (cy+1) * chrSize * one, vx = -one `div` 2, vy = 0, cnt = 0 } 
     47 
     48 
     49-- 踏みつけられたクリボー 
     50data StampedKuribo = StampedKuribo { 
     51        sx :: Int, 
     52        sy :: Int, 
     53        ccnt :: Int 
     54        } 
     55 
     56instance Actor StampedKuribo where 
     57        update fld self = (self { ccnt = ccnt self + 1 }, []) 
     58 
     59        render self imgres scrx sur = do 
     60                blitSurface (getImageSurface imgres ImgKuriDead) Nothing sur (pt (sx self - scrx) (sy self - 7 - 8)) 
     61                return () 
     62 
     63        bDead self = ccnt self >= frameRate `div` 2 
     64 
     65newStampedKuribo sx' sy' = StampedKuribo { sx = sx', sy = sy', ccnt = 0 } 

  • lang/haskell/nario/Images.hs

    r20680 r20691  
    11module Images (ImageType(..), imageTypes, imageFn) where 
    22import Maybe (fromJust) 
    3 data ImageType = ImgBlock1 | ImgBlock2 | ImgBlock3 | ImgBlock4 | ImgBlock5 | ImgCloud00 | ImgCloud01 | ImgCloud02 | ImgCloud10 | ImgCloud11 | ImgCloud12 | 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 | ImgMt02 | ImgMt11 | ImgMt12 | ImgMt13 | ImgMt22 | ImgNarioDie | 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) 
    4 imageTypes = [ImgBlock1, ImgBlock2, ImgBlock3, ImgBlock4, ImgBlock5, ImgCloud00, ImgCloud01, ImgCloud02, ImgCloud10, ImgCloud11, ImgCloud12, 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, ImgMt02, ImgMt11, ImgMt12, ImgMt13, ImgMt22, ImgNarioDie, 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] 
    5 imageFilenames = ["block1.bmp", "block2.bmp", "block3.bmp", "block4.bmp", "block5.bmp", "cloud00.bmp", "cloud01.bmp", "cloud02.bmp", "cloud10.bmp", "cloud11.bmp", "cloud12.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", "mt02.bmp", "mt11.bmp", "mt12.bmp", "mt13.bmp", "mt22.bmp", "narioDie.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"] 
     3data 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) 
     4imageTypes = [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] 
     5imageFilenames = ["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"] 
    66imageFn = fromJust . flip lookup (zip imageTypes imageFilenames) 

  • lang/haskell/nario/Main.hs

    r20680 r20691  
    143143                                (pl', a') = onHit pl a 
    144144                                ac' = case a' of 
    145                                         Just a''        -> ac ++ [ActorWrapper a''] 
     145                                        Just a''        -> ac ++ [a''] 
    146146                                        Nothing         -> ac 
    147147 

  • lang/haskell/nario/Player.hs

    r20680 r20691  
    99        getScrollPos, 
    1010        getPlayerYPos, 
     11        getPlayerVY, 
    1112        getPlayerHitRect, 
    1213        getPlayerMedal, 
    1314        getPlayerScore, 
    1415        getPlayerType, 
    15         setPlayerType 
     16        setPlayerType, 
     17        setPlayerDamage, 
     18        stampPlayer 
    1619) where 
    1720 
    1821import Multimedia.SDL (blitSurface, pt) 
     22import Data.Bits ((.&.)) 
    1923 
    2024import Util 
    … …  
    3438scrollMaxX = 8 * chrSize 
    3539gravity2 = one `div` 4          -- Aを長押ししたときの重力 
    36  
     40stampVy = -8 * gravity 
     41undeadFrame = frameRate * 2 
     42 
     43-- 種類 
    3744data PlayerType = SmallNario | SuperNario | FireNario 
    3845        deriving (Eq) 
    3946 
     47-- 状態 
     48data PlayerState = Normal | Dead 
     49        deriving (Eq) 
     50 
     51-- 構造体 
    4052data Player = Player { 
    4153        pltype :: PlayerType, 
     54        plstate :: PlayerState, 
    4255        x :: Int, 
    4356        y :: Int, 
    … …  
    4659        scrx :: Int, 
    4760        stand :: Bool, 
     61        undeadCount :: Int, 
    4862 
    4963        medal :: Int, 
    … …  
    5771newPlayer = Player { 
    5872        pltype = SmallNario, 
     73        plstate = Normal, 
    5974        x = 3 * chrSize * one, 
    6075        y = 13 * chrSize * one, 
    … …  
    6378        scrx = 0, 
    6479        stand = False, 
     80        undeadCount = 0, 
    6581 
    6682        medal = 0, 
    … …  
    8096patSit = patSlip + 1 
    8197patShot = patSit + 1 
     98patDead = patShot + 2 
    8299 
    83100imgTableSmall = [ 
    … …  
    102119                else self' 
    103120        where 
    104                 ax = (-padl + padr) * acc 
     121                ax = if padd then 0 else (-padl + padr) * acc 
    105122                vx' 
    106123                        | ax /= 0                       = rangeadd (vx self) ax (-maxspd) maxspd 
    … …  
    114131                scrollPos = (max vx' 0) * (scrollMaxX - scrollMinX) `div` runVx + scrollMinX 
    115132 
     133                padd = if isPressed (kp PadD) then True else False 
    116134                padl = if isPressed (kp PadL) then 1 else 0 
    117135                padr = if isPressed (kp PadR) then 1 else 0 
    … …  
    130148                                1       -> 1 
    131149                pat' 
     150                        | padd && pltype self /= SmallNario     = patSit 
    132151                        | vx' == 0                              = patStop 
    133152                        | vx' > 0 && lr' == 0   = patSlip 
    … …  
    158177 
    159178-- 重力による落下 
    160 fall :: KeyProc -> Player -> Player 
    161 fall kp self 
     179fall :: Bool -> Player -> Player 
     180fall abtn self 
    162181        | stand self    = self 
    163182        | otherwise             = self { y = y', vy = vy' } 
    164183        where 
    165184                ay 
    166                         | vy self < 0 && isPressed (kp PadA)    = gravity2 
    167                         | otherwise                                                             = gravity 
     185                        | vy self < 0 && abtn   = gravity2 
     186                        | otherwise                             = gravity 
    168187                vy' = min maxVy $ vy self + ay 
    169188                y' = y self + vy' 
    … …  
    211230updatePlayer :: KeyProc -> Field -> Player -> (Player, [Event]) 
    212231updatePlayer kp fld self = 
     232        case plstate self of 
     233                Normal  -> updateNormal kp fld self' 
     234                Dead    -> updateDead kp fld self' 
     235        where 
     236                self' = decUndead self 
     237                decUndead pl = pl { undeadCount = max 0 $ undeadCount pl - 1 } 
     238 
     239-- 通常時 
     240updateNormal :: KeyProc -> Field -> Player -> (Player, [Event]) 
     241updateNormal kp fld self = 
    213242        moveY $ checkX fld $ moveX kp self 
    214243        where 
    215                 moveY = checkCeil fld . doJump kp . checkFloor fld . fall kp 
     244                moveY = checkCeil fld . doJump kp . checkFloor fld . fall (isPressed $ kp PadA) 
     245 
     246-- 死亡時 
     247updateDead :: KeyProc -> Field -> Player -> (Player, [Event]) 
     248updateDead kp fld self = (fall False self, []) 
    216249 
    217250-- スクロール位置取得 
    … …  
    223256getPlayerYPos = (`div` one) . y 
    224257 
     258-- Ｙ速度取得 
     259getPlayerVY :: Player -> Int 
     260getPlayerVY = vy 
     261 
    225262-- 当たり判定用矩形 
    226263getPlayerHitRect :: Player -> Rect 
    … …  
    246283setPlayerType t self = self { pltype = t } 
    247284 
     285-- ダメージを与える 
     286setPlayerDamage :: Player -> Player 
     287setPlayerDamage self 
     288        | undeadCount self > 0                  = self 
     289        | pltype self == SmallNario             = self { plstate = Dead, pat = patDead, vy = jumpVy, stand = False } 
     290        | otherwise                                             = self { pltype = SmallNario, undeadCount = undeadFrame } 
     291 
     292-- 敵を踏み潰した 
     293stampPlayer :: Player -> Player 
     294stampPlayer self = self { vy = stampVy } 
     295 
    248296-- 描画 
    249297renderPlayer sur imgres scrx self = do 
    250         blitSurface (getImageSurface imgres imgtype) Nothing sur pos 
     298        if undeadCount self == 0 || (undeadCount self .&. 1) /= 0 
     299                then blitSurface (getImageSurface imgres imgtype) Nothing sur pos >> return () 
     300                else return () 
    251301        where 
    252302                pos = case pltype self of 
    253303                        SmallNario      -> pt sx $ sy - chrSize + 1 
    254304                        otherwise       -> pt sx $ sy - chrSize * 2 + 1 
    255                 imgtype = imgtbl !! lr self !! pat self 
     305                imgtype 
     306                        | plstate self == Dead  = ImgNarioDead 
     307                        | otherwise                             = imgtbl !! lr self !! pat self 
    256308                imgtbl = case pltype self of 
    257309                        SmallNario      -> imgTableSmall