Changeset 20811 for lang/haskell

Show
Ignore:
Timestamp:
10/05/08 22:27:31 (5 years ago)
Author:
mokehehe
Message:

プレーヤー操作性調整
ノコノコを倒して蹴れるように
スコア演出追加

Location:
lang/haskell/nario
Files:
3 added
16 modified

Legend:

Unmodified
Added
Removed
  • lang/haskell/nario/Actor.hs

    r20691 r20811  
    2727        getHitRect _ = Nothing 
    2828 
    29         onHit :: Player -> a -> (Player, Maybe ActorWrapper) 
    30         onHit pl ac = (pl, Nothing) 
     29        onHit :: Player -> a -> (Player, Maybe ActorWrapper, [Event]) 
     30        onHit pl ac = (pl, Nothing, []) 
    3131 
    3232-- ============================================================================ 
  • lang/haskell/nario/Actor/AnimBlock.hs

    r20775 r20811  
     1-- -*- mode: haskell; Encoding: UTF-8 -*- 
    12-- ブロックを叩いたときのバウンド演出 
    23 
  • lang/haskell/nario/Actor/BrokenBlock.hs

    r20775 r20811  
     1-- -*- mode: haskell; Encoding: UTF-8 -*- 
    12-- ブロックを叩いたときのバウンド演出 
    23 
  • lang/haskell/nario/Actor/CoinGet.hs

    r20775 r20811  
     1-- -*- mode: haskell; Encoding: UTF-8 -*- 
    12-- コインを取ったときの演出コイン 
    23 
     
    2627instance Actor CoinGet where 
    2728        update _ self 
    28                 | bDead self'   = (self', [EvScoreAddEfe (sx self) (y self `div` one) Img1000]) 
     29                | bDead self'   = (self', [EvScoreAddEfe (sx self) (y self `div` one) pointGetCoin]) 
    2930                | otherwise             = (self', []) 
    3031                where 
  • lang/haskell/nario/Actor/Flower.hs

    r20680 r20811  
     1-- -*- mode: haskell; Encoding: UTF-8 -*- 
    12-- フラワー 
    23 
     
    1314import Images 
    1415import Field 
    15 import Player (PlayerType(..), getPlayerType, setPlayerType) 
    16  
    17 maxVy = one * 6 
     16import Player (PlayerType(..), getPlayerType, setPlayerType, addScore) 
     17import Event (Event(..)) 
    1818 
    1919 
     
    3737                        yy = y self `div` one 
    3838 
    39         onHit pl self = (setPlayerType nt pl, Nothing) 
     39        onHit pl self = (addScore pointFlower $ setPlayerType nt pl, Nothing, ev) 
    4040                where 
    4141                        nt = case typ of 
     
    4444                                otherwise       -> typ 
    4545                        typ = getPlayerType pl 
     46                        ev = [EvScoreAddEfe (x self `div` one) (y self `div` one - chrSize * 2) pointFlower] 
    4647 
    4748 
  • lang/haskell/nario/Actor/Kinoko.hs

    r20775 r20811  
     1-- -*- mode: haskell; Encoding: UTF-8 -*- 
    12-- きのこ 
    23 
     
    89 
    910import Actor (Actor(..)) 
     11import Actor.Common (updateActorBase) 
    1012import Const 
    11 import Util (sgn) 
    1213import AppUtil (getImageSurface, cellCrd, Rect(..)) 
    1314import Images 
    1415import Field 
    1516import Player (PlayerType(..), getPlayerType, setPlayerType, addScore) 
     17import Event (Event(..)) 
    1618 
    17 maxVy = one * 6 
    18  
    19 pointKinoko = 1000 
     19ofsH = 15 
    2020 
    2121 
     
    2828 
    2929instance Actor Kinoko where 
    30         update fld self 
    31                 | isGround      = (self { x = x', vx = vx', y = (cellCrd y') * one * chrSize, vy = 0 }, []) 
    32                 | otherwise     = (self { x = x', vx = vx', y = y', vy = vy' }, []) 
     30        update fld self = (self', []) 
    3331                where 
    34                         x' = x self + vx self 
    35                         sideWall = isBlock $ fieldRef fld (cellCrd $ x' + sgn (vx self) * 6 * one) (cellCrd $ y self - chrSize * one `div` 2) 
    36                         vx' 
    37                                 | sideWall      = -(vx self) 
    38                                 | otherwise     = vx self 
    39  
    40                         vy' = min maxVy $ vy self + gravity 
    41                         y' = y self + vy' 
    42                         isGround = isBlock $ fieldRef fld (cellCrd $ x') (cellCrd y') 
     32                        self' = self { x = x', y = y', vx = vx', vy = vy' } 
     33                        (x', y', vx', vy') = updateActorBase fld (x self, y self, vx self, vy self) 
    4334 
    4435        render self imgres scrx sur = do 
    45                 blitSurface (getImageSurface imgres imgtype) Nothing sur (pt ((x self) `div` one - chrSize `div` 2 - scrx) ((y self) `div` one - 15 - 8)) 
     36                blitSurface (getImageSurface imgres imgtype) Nothing sur (pt ((x self) `div` one - chrSize `div` 2 - scrx) ((y self) `div` one - ofsH - 8)) 
    4637                return () 
    4738                where 
    4839                        imgtype = ImgKinoko 
    4940 
    50         bDead self = y self `div` one >= screenHeight + chrSize * 3 
     41        bDead self = y self >= (screenHeight + chrSize * 3) * one || x self <= -chrSize * one 
    5142 
    5243        getHitRect self = Just $ Rect (xx - 8) (yy - 16) (xx + 8) yy 
     
    5546                        yy = y self `div` one 
    5647 
    57         onHit pl self = (addScore pointKinoko $ setPlayerType nt pl, Nothing) 
     48        onHit pl self = (addScore pointKinoko $ setPlayerType nt pl, Nothing, ev) 
    5849                where 
    5950                        nt = case typ of 
     
    6152                                otherwise       -> typ 
    6253                        typ = getPlayerType pl 
    63  
     54                        ev = [EvScoreAddEfe (x self `div` one) (y self `div` one - chrSize * 2) pointKinoko] 
    6455 
    6556newKinoko :: Int -> Int -> Kinoko 
  • lang/haskell/nario/Actor/Kuribo.hs

    r20691 r20811  
     1-- -*- mode: haskell; Encoding: UTF-8 -*- 
    12-- クリボー 
    23 
     
    89 
    910import Actor (Actor(..), ActorWrapper(..)) 
     11import Actor.Common (updateActorBase, stamp) 
    1012import Const 
    11 import AppUtil 
     13import AppUtil (getImageSurface, cellCrd, Rect(..)) 
    1214import Images 
    13 import Player (setPlayerDamage, getPlayerVY, stampPlayer) 
     15import Player (setPlayerDamage, stampPlayer, addScore) 
     16import Event (Event(..)) 
    1417 
     18ofsH = 15 
    1519 
    1620data Kuribo = Kuribo { 
     
    2327 
    2428instance Actor Kuribo where 
    25         update fld self = (self { x = x self + vx self, cnt = cnt self + 1 }, []) 
     29        update fld self = (self', []) 
     30                where 
     31                        self' = self { x = x', y = y', vx = vx', vy = vy', cnt = cnt self + 1 } 
     32                        (x', y', vx', vy') = updateActorBase fld (x self, y self, vx self, vy self) 
    2633 
    2734        render self imgres scrx sur = do 
    28                 blitSurface (getImageSurface imgres imgtype) Nothing sur (pt (x self `div` one - chrSize `div` 2 - scrx) (y self `div` one - 15 - 8)) 
     35                blitSurface (getImageSurface imgres imgtype) Nothing sur (pt (x self `div` one - chrSize `div` 2 - scrx) (y self `div` one - ofsH - 8)) 
    2936                return () 
    3037                where 
    3138                        imgtype = [ImgKuri0, ImgKuri1] !! (cnt self `mod` 16 `div` 8) 
     39 
     40        bDead self = y self >= (screenHeight + chrSize * 3) * one || x self <= -chrSize * one 
    3241 
    3342        getHitRect self = Just $ Rect (xx - 8) (yy - 16) (xx + 8) yy 
     
    3746 
    3847        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) 
     48                | 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) 
     49                | otherwise     = (setPlayerDamage pl, Just $ ActorWrapper self, []) 
    4150                where 
    42                         stamp = getPlayerVY pl > 0 
     51                        ev = [EvScoreAddEfe (x self `div` one) (y self `div` one - chrSize * 2) pointKuribo] 
    4352 
    4453newKuribo :: Int -> Int -> Kuribo 
  • lang/haskell/nario/Actor/Nokonoko.hs

    r20680 r20811  
    1 -- クリボー 
     1-- -*- mode: haskell; Encoding: UTF-8 -*- 
     2-- ノコノコ 
    23 
    34module Actor.Nokonoko ( 
     
    56) where 
    67 
    7 import Multimedia.SDL hiding (Event) 
     8import Multimedia.SDL (blitSurface, pt) 
    89 
    9 import Actor (Actor(..)) 
     10import Actor (Actor(..), ActorWrapper(..)) 
     11import Actor.Common (updateActorBase, stamp) 
     12import Actor.Koura 
    1013import Const 
    11 import AppUtil 
     14import AppUtil (getImageSurface, cellCrd, Rect(..)) 
    1215import Images 
     16import Player (setPlayerDamage, stampPlayer, addScore) 
     17import Event (Event(..)) 
    1318 
     19ofsH = 23 
    1420 
    1521data Nokonoko = Nokonoko { 
     
    2228 
    2329instance Actor Nokonoko where 
    24         update fld self = (self { x = x self + vx self, cnt = cnt self + 1 }, []) 
     30        update fld self = (self', []) 
     31                where 
     32                        self' = self { x = x', y = y', vx = vx', vy = vy', cnt = cnt self + 1 } 
     33                        (x', y', vx', vy') = updateActorBase fld (x self, y self, vx self, vy self) 
    2534 
    2635        render self imgres scrx sur = do 
    27                 blitSurface (getImageSurface imgres imgtype) Nothing sur (pt ((x self) `div` one - scrx) ((y self) `div` one - 8)) 
     36                blitSurface (getImageSurface imgres imgtype) Nothing sur (pt (x self `div` one - chrSize `div` 2 - scrx) (y self `div` one - ofsH - 8)) 
    2837                return () 
    2938                where 
    3039                        imgtype = [ImgNoko0, ImgNoko1] !! (cnt self `mod` 16 `div` 8) 
    3140 
     41        bDead self = y self >= (screenHeight + chrSize * 3) * one || x self <= -chrSize * one 
     42 
     43        getHitRect self = Just $ Rect (xx - 8) (yy - 16) (xx + 8) yy 
     44                where 
     45                        xx = x self `div` one 
     46                        yy = y self `div` one 
     47 
     48        onHit pl self 
     49                | stamp pl (x self, y self)     = (addScore pointNokonoko $ stampPlayer pl, Just $ ActorWrapper $ newKoura (x self) (y self), ev) 
     50                | otherwise     = (setPlayerDamage pl, Just $ ActorWrapper self, []) 
     51                where 
     52                        ev = [EvScoreAddEfe (x self `div` one) (y self `div` one - chrSize * 2) pointNokonoko] 
     53 
    3254newNokonoko :: Int -> Int -> Nokonoko 
    3355newNokonoko cx cy = 
  • lang/haskell/nario/Actor/ScoreAdd.hs

    r20775 r20811  
     1-- -*- mode: haskell; Encoding: UTF-8 -*- 
    12-- スコアが増えるときの増分表示 
    23 
     
    1516 
    1617data ScoreAdd = ScoreAdd { 
    17         imgtype :: ImageType, 
     18        pnt :: Int, 
    1819        sx :: Int, 
    1920        sy :: Int, 
     
    2627 
    2728        render self imgres scrx sur = do 
    28                 blitSurface (getImageSurface imgres $ imgtype self) Nothing sur (pt (sx self - scrx) (sy self)) 
     29                blitSurface (getImageSurface imgres imgtype) Nothing sur (pt (sx self - scrx) (sy self)) 
    2930                return () 
     31                where 
     32                        imgtype = case pnt self of 
     33                                100             -> Img100 
     34                                200             -> Img200 
     35                                400             -> Img400 
     36                                500             -> Img500 
     37                                1000    -> Img1000 
    3038 
    3139        bDead self = cnt self >= frameRate `div` 2 
    3240 
    33 newScoreAdd :: Int -> Int -> ImageType -> ScoreAdd 
    34 newScoreAdd sx' sy' imgtype' = 
    35         ScoreAdd { imgtype = imgtype', sx = sx', sy = sy', cnt = 0 } 
     41newScoreAdd :: Int -> Int -> Int -> ScoreAdd 
     42newScoreAdd sx' sy' pnt' = 
     43        ScoreAdd { pnt = pnt', sx = sx', sy = sy', cnt = 0 } 
  • lang/haskell/nario/Const.hs

    r20670 r20811  
    1717 
    1818-- 重力 
    19 gravity = one `div` 2 
     19gravity = one * 2 `div` 5 
     20 
     21 
     22-- ポイント 
     23pointKuribo = 100       :: Int 
     24pointNokonoko = 100     :: Int 
     25pointKinoko = 1000      :: Int 
     26pointFlower = 1000      :: Int 
     27pointBreakBlock = 50    :: Int 
     28pointGetCoin = 200      :: Int 
     29pointKoura = 400        :: Int 
  • lang/haskell/nario/Event.hs

    r20775 r20811  
    11module Event where 
    22 
    3 import Const 
    4 import Images 
    5 import Field 
     3import Images (ImageType) 
     4import Field (Cell) 
     5import {-# SOURCE #-} Actor (Actor(..), ActorWrapper(..)) 
    66 
    77data Event = 
     
    1212        |       EvSetField Int Int Cell 
    1313 
    14                 -- 敵登場 
    15         |       EvAppearEnemy Int Int Cell 
     14                -- アクター追加 
     15        |       EvAddActor ActorWrapper 
    1616 
    1717                -- スコア加算エフェクト 
    18         |       EvScoreAddEfe Int Int ImageType 
     18        |       EvScoreAddEfe Int Int Int 
  • lang/haskell/nario/Images.hs

    r20775 r20811  
    11module Images (ImageType(..), imageTypes, imageFn) where 
    22import Maybe (fromJust) 
    3 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) 
    4 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] 
    5 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"] 
     3data 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 | ImgNoko0 | ImgNoko1 | ImgPole0 | ImgPole1 | ImgSNarioLJump | ImgSNarioLSit | ImgSNarioLSlip | ImgSNarioLStand | ImgSNarioLWalk1 | ImgSNarioLWalk2 | ImgSNarioLWalk3 | ImgSNarioRJump | ImgSNarioRSit | ImgSNarioRSlip | ImgSNarioRStand | ImgSNarioRWalk1 | ImgSNarioRWalk2 | ImgSNarioRWalk3 | ImgTitle     deriving (Eq) 
     4imageTypes = [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, ImgNoko0, ImgNoko1, ImgPole0, ImgPole1, ImgSNarioLJump, ImgSNarioLSit, ImgSNarioLSlip, ImgSNarioLStand, ImgSNarioLWalk1, ImgSNarioLWalk2, ImgSNarioLWalk3, ImgSNarioRJump, ImgSNarioRSit, ImgSNarioRSlip, ImgSNarioRStand, ImgSNarioRWalk1, ImgSNarioRWalk2, ImgSNarioRWalk3, ImgTitle] 
     5imageFilenames = ["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", "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

    r20775 r20811  
    3434 
    3535 
    36 pointBreakBlock = 50 
    37 pointGetCoin = 200 
    38  
    39  
    4036-- エントリ 
    4137main :: IO () 
     
    130126                cols = map (!! cx) fld 
    131127                event cy c 
    132                         | c `elem` "kn" = Just $ EvAppearEnemy cx cy c 
     128                        | c `elem` "kn" = Just $ EvAddActor $ genActor c 
    133129                        | otherwise             = Nothing 
     130                        where 
     131                                genActor c = case c of 
     132                                        'k'     -> ActorWrapper $ newKuribo cx cy 
     133                                        'n'     -> ActorWrapper $ newNokonoko cx cy 
     134 
    134135 
    135136 
    136137-- 当たり判定 
    137 hitcheck :: Player -> [ActorWrapper] -> (Player, [ActorWrapper]) 
    138 hitcheck player actors = foldl proc (player, []) actors 
    139         where 
    140                 proc (pl, ac) (ActorWrapper a) = case getHitRect a of 
     138hitcheck :: Player -> [ActorWrapper] -> (Player, [ActorWrapper], [Event]) 
     139hitcheck player actors = foldl proc (player, [], []) actors 
     140        where 
     141                proc (pl, ac, ev) (ActorWrapper a) = case getHitRect a of 
    141142                        Nothing -> nothingHappened 
    142143                        Just rc -> 
    143144                                if not $ ishit plrc rc 
    144145                                        then nothingHappened 
    145                                         else (pl', ac') 
    146                         where 
    147                                 nothingHappened = (pl, ac ++ [ActorWrapper a]) 
     146                                        else (pl', ac', ev') 
     147                        where 
     148                                nothingHappened = (pl, ac ++ [ActorWrapper a], ev) 
    148149                                plrc = getPlayerHitRect player 
    149                                 (pl', a') = onHit pl a 
     150                                (pl', a', evtmp) = onHit pl a 
    150151                                ac' = case a' of 
    151152                                        Just a''        -> ac ++ [a''] 
    152153                                        Nothing         -> ac 
    153  
     154                                ev' = ev ++ evtmp 
     155 
     156 
     157timeBase = 22 
    154158 
    155159-- ゲーム 
     
    161165                        where 
    162166                                (scr', gs') = updateProc (keyProc bef ks) gs 
    163                                 isPlayerDead = getPlayerYPos (pl gs') >= screenHeight + chrSize * 2 
     167                                isPlayerDead = getPlayerY (pl gs') >= (screenHeight + chrSize * 2) * one 
    164168                                timeOver = time gs' <= 0 
    165169 
     
    172176                updateProc kp gs = (renderProc gs', gs') 
    173177                        where 
    174                                 time' = max 0 (time gs - one `div` 25) 
     178                                time' = max 0 (time gs - 1) 
    175179                                (fld', screv') = scrollEvent (fld gs) $ getScrollPos (pl gs) `div` chrSize + 18 
    176180 
     
    180184                                ev' = concatMap snd actors_updates 
    181185 
    182                                 (pl'', actors'') = hitcheck pl' actors' 
     186                                (pl'', actors'', ev'') = hitcheck pl' actors' 
    183187 
    184188                                gstmp = gs { pl = pl'', fld = fld', actors = actors'', time = time' } 
    185                                 gs' = procEvent gstmp (plev ++ ev' ++ screv') 
    186  
    187                 initialState = GameGame { pl = newPlayer, fld = fldmap, actors = [], time = 400 * one } 
     189                                gs' = procEvent gstmp (plev ++ ev' ++ screv' ++ ev'') 
     190 
     191                initialState = GameGame { pl = newPlayer, fld = fldmap, actors = [], time = 400 * timeBase } 
    188192 
    189193-- ゲームオーバー 
     
    221225 
    222226                proc gs (EvSetField cx cy c) = gs { fld = fieldSet (fld gs) cx cy c } 
    223                 proc gs (EvAppearEnemy cx cy c) = gs { actors = actors gs ++ [ene] } 
    224                         where 
    225                                 ene = case c of 
    226                                         'k'     -> ActorWrapper $ newKuribo cx cy 
    227                                         'n'     -> ActorWrapper $ newNokonoko cx cy 
    228                 proc gs (EvScoreAddEfe sx sy imgtype) = gs { actors = actors gs ++ [ActorWrapper $ newScoreAdd sx sy imgtype] } 
     227                proc gs (EvAddActor act) = gs { actors = actors gs ++ [act] } 
     228                proc gs (EvScoreAddEfe sx sy pnt) = gs { actors = actors gs ++ [ActorWrapper $ newScoreAdd sx sy pnt] } 
    229229 
    230230-- 描画 
     
    255255        puts 19 2 "1-1" 
    256256        puts 25 1 "TIME" 
    257         puts 26 2 $ deciWide 3 ' ' ((time gs + one-1) `div` one) 
     257        puts 26 2 $ deciWide 3 '0' ((time gs + timeBase-1) `div` timeBase) 
    258258 
    259259        where 
     
    264264renderTitle imgres sur = do 
    265265        blitSurface (getImageSurface imgres ImgTitle) Nothing sur (pt (5*8) (3*8)) 
    266         puts 13 14 "@1985 NINTENDO" 
     266--      puts 13 14 "@1985 NINTENDO" 
    267267        puts 9 17 "> 1 PLAYER GAME" 
    268268--      puts 9 19 "  2 PLAYER GAME" 
  • lang/haskell/nario/Player.hs

    r20775 r20811  
    1010        addScore, 
    1111        getScrollPos, 
    12         getPlayerYPos, 
     12        getPlayerX, 
     13        getPlayerY, 
    1314        getPlayerVY, 
    1415        getPlayerHitRect, 
     
    3233 
    3334 
    34 walkVx = one * 3 `div` 2 
    35 runVx = one * 3 
    36 maxVy = one * 6 
    37 acc = one `div` 6 
    38 jumpVy = -13 * gravity 
    39 scrollMinX = 5 * chrSize 
     35walkVx = one * 4 `div` 2 
     36runVx = one * 11 `div` 4 
     37maxVy = one * 5 
     38acc = one `div` 32 
     39acc2 = one `div` 14 
     40jumpVy = -12 * gravity 
     41jumpVy2 = -13 * gravity 
     42scrollMinX = 5 * chrSize + 6 
    4043scrollMaxX = 8 * chrSize 
    41 gravity2 = one `div` 4          -- Aを長押ししたときの重力 
     44gravity2 = one `div` 6          -- Aを長押ししたときの重力 
    4245stampVy = -8 * gravity 
    4346undeadFrame = frameRate * 2 
     
    121124                else self' 
    122125        where 
    123                 ax = if padd then 0 else (-padl + padr) * acc 
     126                axtmp = if padd then 0 else (-padl + padr) * nowacc 
     127                ax = if sgn (axtmp * vx self) < 0 then axtmp * 2 else axtmp 
    124128                vx' 
    125129                        | ax /= 0                       = rangeadd (vx self) ax (-maxspd) maxspd 
     
    127131                        | otherwise                     = vx self 
    128132                x' = max xmin $ (x self) + vx' 
    129                 scrx' 
    130                         | vx' > 0 && (x' - (scrx self)) `div` one > scrollPos   = (scrx self) + vx' 
    131                         | otherwise                                                                                             = (scrx self) 
    132  
    133                 scrollPos = (max vx' 0) * (scrollMaxX - scrollMinX) `div` runVx + scrollMinX 
    134133 
    135134                padd = if isPressed (kp PadD) then True else False 
     
    138137                maxspd 
    139138                        | not $ stand self      = walkVx `div` 2 
    140                         | isPressed (kp PadB)   = walkVx * 2 
     139                        | isPressed (kp PadB)   = runVx 
    141140                        | otherwise                             = walkVx 
    142                 xmin = (scrx self) + chrSize `div` 2 * one 
    143  
    144                 self' = self { x = x', vx = vx', scrx = scrx' } 
     141                nowacc 
     142                        | isPressed (kp PadB)   = acc2 
     143                        | otherwise                             = acc 
     144                xmin = (scrx self + chrSize `div` 2) * one 
     145 
     146                self' = self { x = x', vx = vx' } 
    145147 
    146148                lr' = 
     
    160162                anmCnt = walkVx * 3 
    161163 
    162  
    163164-- 横移動チェック 
    164165checkX :: Field -> Player -> Player 
     
    177178                                ofsx   1  =  5 * one 
    178179 
     180-- スクロール 
     181scroll :: Player -> Player -> Player 
     182scroll opl self = self { scrx = scrx' } 
     183        where 
     184                odx = x opl `div` one - scrx opl 
     185                dx = (max 0 $ vx self) * (scrollMaxX - scrollMinX) `div` runVx + scrollMinX 
     186                scrx' 
     187                        | d > 0         = scrx self + d 
     188                        | otherwise     = scrx self 
     189                d = x self `div` one - scrx self - (max odx dx) 
     190 
    179191 
    180192-- 重力による落下 
     
    222234                y' = ((cy + 1) * chrSize + yofs) * one 
    223235 
    224  
    225236-- ジャンプする? 
    226237doJump :: KeyProc -> Player -> Player 
    227238doJump kp self 
    228         | stand self && kp PadA == Pushed       = self { vy = jumpVy, stand = False, pat = patJump } 
     239        | stand self && kp PadA == Pushed       = self { vy = vy', stand = False, pat = patJump } 
    229240        | otherwise                                                     = self 
    230  
     241        where 
     242                vy' = (jumpVy2 - jumpVy) * (abs $ vx self) `div` runVx + jumpVy 
    231243 
    232244-- 更新処理 
     
    243255updateNormal :: KeyProc -> Field -> Player -> (Player, [Event]) 
    244256updateNormal kp fld self = 
    245         moveY $ checkX fld $ moveX kp self 
     257        moveY $ scroll self $ checkX fld $ moveX kp self 
    246258        where 
    247259                moveY = checkCeil fld . doJump kp . checkFloor fld . fall (isPressed $ kp PadA) 
     
    253265-- スクロール位置取得 
    254266getScrollPos :: Player -> Int 
    255 getScrollPos self = (scrx self) `div` one 
     267getScrollPos = scrx 
     268 
     269-- X座標取得 
     270getPlayerX :: Player -> Int 
     271getPlayerX = x 
    256272 
    257273-- Y座標取得 
    258 getPlayerYPos :: Player -> Int 
    259 getPlayerYPos = (`div` one) . y 
     274getPlayerY :: Player -> Int 
     275getPlayerY = y 
    260276 
    261277-- Y速度取得 
  • lang/haskell/nario/README.txt

    r20680 r20811  
    6767        存在型 
    6868        http://d.hatena.ne.jp/syd_syd/20080805#p2 
     69 
     70        Haskellの循環import問題 - ABAの日誌 
     71        http://d.hatena.ne.jp/ABA/20060627#p1 
  • lang/haskell/nario/data/stage0.map

    r20670 r20811  
    1111  _                                   []      l|  _      l|                                      k_k                                    XX  XX    _   XXX  XX                          XXXXXXX    _   !          
    1212 /,\             _          []        l|      l| /,\     l|      _                               /,\             _                     XXX  XXX  /,\ XXXX  XXX   _ []              [] XXXXXXXX   /,\  !   OO OO  
    13 /,.,\      78889/,\ k  789  l|        l|k7889 l|/,.,\k k l|78889/,\    789                      /,.,\     n78889/,\k k 789  k k  k k  XXXX  XXXX/,.,XXXXX  XXXX9/,\l|  789    k k  l|XXXXXXXXX  /,.,\ X   OO OO9 
     13/,.,\      78889/,\ k  789  l|        l|k7889 l|/,.,\k k l|78889/,\    789                      /,.,\     n78889/,\k k 789  k k  k    XXXX  XXXX/,.,XXXXX  XXXX9/,\l|  789    k k  l|XXXXXXXXX  /,.,\ X   OO OO9 
    1414@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@  @@@@@@@@@@@@@@@   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@  @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 
    1515@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@  @@@@@@@@@@@@@@@   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@  @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@