Changeset 20004

Show
Ignore:
Timestamp:
09/27/08 10:16:04 (6 years ago)
Author:
mokehehe
Message:

ジャンプの処理
フィールドとの当たり判定

Location:
lang/haskell/nario
Files:
1 added
4 modified

Legend:

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

    r19999 r20004  
    88chrSize = 16 :: Int 
    99 
     10-- 重力 
     11gravity = one `div` 2 
    1012 
    1113-- 画像 
  • lang/haskell/nario/Main.hs

    r19999 r20004  
    1111import Util 
    1212import Player 
     13import Field 
    1314import Const 
    1415 
     
    2425-- 背景色 
    2526backColor = 0x2891ff            -- 青 
    26  
    27  
    28  
    29  
    30  
    31  
    32 -- マップ 
    33  
    34 fieldMap = [ 
    35         "                ", 
    36         "                ", 
    37         "                ", 
    38         "                ", 
    39         "                ", 
    40         "                ", 
    41         "        O?O     ", 
    42         "                ", 
    43         "                ", 
    44         "       O?O?O    ", 
    45         "                ", 
    46         "                ", 
    47         "                ", 
    48         "@@@@@@@@@@@@@@@@", 
    49         "@@@@@@@@@@@@@@@@" 
    50         ] 
    51  
    52 chr2img '@' = ImgBlock1 
    53 chr2img 'O' = ImgBlock2 
    54 chr2img '?' = ImgBlock4 
    55  
    56 renderMap sur imgres = sequence_ $ concatMap lineProc $ zip [0..] fieldMap 
    57         where 
    58                 lineProc (y, ln) = map (cellProc y) $ zip [0..] ln 
    59                 cellProc y (x, c) = do 
    60                         if c == ' ' 
    61                                 then return () 
    62                                 else do 
    63                                         blitSurface (getImageSurface imgres $ chr2img c) Nothing sur $ pt (x*16) (y*16) 
    64                                         return () 
    65  
    66  
    6727 
    6828 
     
    9252        ev <- pollEvent 
    9353        case ev of 
    94                 Just QuitEvent -> return True 
     54                Just QuitEvent  -> return True 
    9555                Just (KeyboardEvent { kbPress = True, kbKeysym = Keysym { ksSym = ks, ksMod = km } }) 
    9656                        | ks == SDLK_ESCAPE -> return True 
    9757                        | ks == SDLK_F4 && (KMOD_LALT `elem` km || 
    9858                                                                KMOD_RALT `elem` km) -> return True 
    99                 Nothing        -> return False 
    100                 _              -> checkEvent 
     59                Nothing                 -> return False 
     60                _                               -> checkEvent 
    10161 
    10262 
     
    11171data GameState = 
    11272        GameState { 
    113                 pl :: Player 
     73                pl :: Player, 
     74                fld :: Field 
    11475        } 
    11576 
     
    11879initState = 
    11980        GameState { 
    120                 pl = newPlayer 
     81                pl = newPlayer, 
     82                fld = getField stage 
    12183                } 
     84        where 
     85                stage = 0 
    12286 
    12387 
     
    12589onProcess :: KeyProc -> GameState -> GameState 
    12690onProcess kp gs 
    127         | otherwise             = gs { pl = updatePlayer kp (pl gs) } 
     91        | otherwise             = gs { pl = updatePlayer kp (fld gs) (pl gs) } 
    12892 
    12993 
     
    13397        fillRect sur Nothing backColor 
    13498 
    135         renderMap sur imgres 
     99        renderField sur imgres 
    136100        renderPlayer sur (pl gs) imgres 
    137101 
  • lang/haskell/nario/Player.hs

    r19999 r20004  
    1414import SDLUtil 
    1515import Const 
     16import Field 
     17 
     18 
     19maxVx = one * 3 
     20maxVy = one * 8 
     21acc = one `div` 6 
     22jumpVy = -17 * gravity 
    1623 
    1724 
     
    3037newPlayer = Player { 
    3138        x = 1 * chrSize * one, 
    32         y = 13 * chrSize * one - 1, 
     39        y = 1 * chrSize * one, 
    3340        vx = 0, 
    3441        vy = 0, 
    35         stand = True, 
     42        stand = False, 
    3643 
    3744        lr = 1, 
     
    3946        anm = 0 
    4047        } 
    41  
    42 maxVx = one * 3 
    43 acc = one `div` 6 
    4448 
    4549 
     
    5660 
    5761-- 横移動 
    58 moveLR :: KeyProc -> Player -> Player 
    59 moveLR kp player = 
    60         player { x = x', vx = vx', lr = lr', pat = pat', anm = anm' } 
     62moveX :: KeyProc -> Player -> Player 
     63moveX kp player = 
     64        if (stand player) 
     65                then player' { lr = lr', pat = pat', anm = anm' } 
     66                else player' 
    6167        where 
    6268                ax = (-padl + padr) * acc 
     
    7076                        | isPressed (kp PadB)   = maxVx * 2 
    7177                        | otherwise                             = maxVx 
     78 
     79                player' = player { x = x', vx = vx' } 
    7280 
    7381                lr' = 
     
    8593 
    8694 
    87 -- 縦移動 
    88 jumpOrFall :: KeyProc -> Player -> Player 
    89 jumpOrFall kp player = 
    90         player { y = y' } 
    91         where 
    92                 y' 
    93                         | isPressed (kp PadU)   = (y player) - 1 * one 
    94                         | isPressed (kp PadD)   = (y player) + 1 * one 
    95                         | otherwise                             = y player 
     95cellCrd :: Int -> Int 
     96cellCrd x = x `div` (chrSize * one) 
    9697 
    9798 
    98 updatePlayer :: KeyProc -> Player -> Player 
    99 updatePlayer kp = 
    100         jumpOrFall kp . moveLR kp 
     99-- ジャンプ中 
     100jump :: Field -> Player -> Player 
     101jump fld player = 
     102        player { y = y', vy = vy', stand = stand' } 
     103        where 
     104                vytmp = min maxVy $ (vy player) + gravity 
     105                ytmp = (y player) + vytmp 
     106 
     107                y' = if isGround ytmp then yground ytmp else ytmp 
     108                vy' = if isGround ytmp then 0 else vytmp 
     109                stand' = isGround ytmp 
     110 
     111                isGround y = isBlock $ fieldRef fld (cellCrd (x player)) (cellCrd y) 
     112                yground y = (cellCrd y) * (chrSize * one) 
     113 
     114 
     115-- 通常時:地面をチェック 
     116checkFall :: KeyProc -> Field -> Player -> Player 
     117checkFall kp fld player = 
     118        player { stand = stand', vy = vy', pat = pat' } 
     119        where 
     120                ytmp = (y player) + one 
     121 
     122                stand' 
     123                        | isGround ytmp         = not dojump 
     124                        | otherwise                     = False         -- 落下開始 
     125                vy' 
     126                        | not stand' && dojump  = jumpVy 
     127                        | otherwise                             = 0 
     128                pat' 
     129                        | dojump        = patJump 
     130                        | otherwise     = pat player 
     131 
     132                dojump = kp PadA == Pushed 
     133 
     134                isGround y = isBlock $ fieldRef fld (cellCrd (x player)) (cellCrd y) 
     135                yground y = (cellCrd y) * (chrSize * one) 
     136 
     137 
     138updatePlayer :: KeyProc -> Field -> Player -> Player 
     139updatePlayer kp fld player = 
     140        moveY $ moveX kp player 
     141        where 
     142                moveY 
     143                        | (stand player)        = checkFall kp fld 
     144                        | otherwise                     = jump fld 
    101145 
    102146 
     
    104148        blitSurface (getImageSurface imgres imgtype) Nothing sur pos 
    105149        where 
    106                 pos = pt ((x player) `div` one) ((y player) `div` one - chrSize) 
     150                pos = pt ((x player) `div` one - chrSize `div` 2) ((y player) `div` one - chrSize) 
    107151                imgtype = imgTable !! (lr player) !! (pat player) 
  • lang/haskell/nario/Util.hs

    r19999 r20004  
    1515-- もとから範囲外だったときはそれ以上遠ざからないように 
    1616rangeadd x d x0 x1 
    17         | d > 0         = if x < x1 then min (x + d) x1 else x 
    18         | d < 0         = if x > x0 then max (x + d) x0 else x 
     17        | d > 0 && x < x1       = min (x + d) x1 
     18        | d < 0 && x > x0       = max (x + d) x0 
    1919        | otherwise     = x 
    2020