Changeset 20086 for lang/haskell

Show
Ignore:
Timestamp:
09/28/08 10:42:38 (8 weeks ago)
Author:
mokehehe
Message:

横移動、ジャンプの当たり判定

Location:
lang/haskell/nario
Files:
2 modified

Legend:

Unmodified
Added
Removed

  • lang/haskell/nario/Player.hs

    r20045 r20086  
    7575                ax = (-padl + padr) * acc 
    7676                vx' 
    77                         | ax /= 0       = rangeadd (vx player) ax (-maxspd) maxspd 
    78                         | otherwise     = friction (vx player) acc 
     77                        | ax /= 0                       = rangeadd (vx player) ax (-maxspd) maxspd 
     78                        | (stand player)        = friction (vx player) acc 
     79                        | otherwise                     = friction (vx player) (acc `div` 2) 
    7980                x' = max xmin $ (x player) + vx' 
    8081                scrx' 
    … …  
    8586                padr = if isPressed (kp PadR) then 1 else 0 
    8687                maxspd 
     88                        | not $ stand player    = maxVx `div` 2 
    8789                        | isPressed (kp PadB)   = maxVx * 2 
    8890                        | otherwise                             = maxVx 
    … …  
    105107 
    106108 
    107 -- ジャンプ中 
    108 jump :: Field -> Player -> Player 
    109 jump fld player = 
    110         player { y = y', vy = vy', stand = stand' } 
     109-- 横移動チェック 
     110checkX :: Field -> Player -> Player 
     111checkX fld player 
     112        | dir == 0      = check (-1) $ check 1 $ player 
     113        | otherwise = check dir $ player 
    111114        where 
    112                 vytmp = min maxVy $ (vy player) + gravity 
    113                 ytmp = (y player) + vytmp 
     115                dir = sgn $ vx player 
     116                check dx player 
     117                        | isBlock $ fieldRef fld cx cy  = player { x = (x player) - dx * one, vx = 0 } 
     118                        | otherwise                                             = player 
     119                        where 
     120                                cx = cellCrd (x player + dx * chrSize `div` 2 * one) 
     121                                cy = cellCrd (y player - chrSize `div` 2 * one) 
    114122 
    115                 y' = if isGround ytmp then yground ytmp else ytmp 
    116                 vy' = if isGround ytmp then 0 else vytmp 
    117                 stand' = isGround ytmp 
    118123 
    119                 isGround y = isBlock $ fieldRef fld (cellCrd (x player)) (cellCrd y) 
     124-- 重力による落下 
     125fall :: Player -> Player 
     126fall player 
     127        | stand player  = player 
     128        | otherwise             = player { y = y', vy = vy' } 
     129        where 
     130                vy' = min maxVy $ vy player + gravity 
     131                y' = y player + vy' 
     132 
     133 
     134-- 床をチェック 
     135checkFloor :: Field -> Player -> Player 
     136checkFloor fld player 
     137        | stand'        = player { stand = stand', y = ystand, vy = 0 } 
     138        | otherwise     = player { stand = stand' } 
     139        where 
     140                stand' = isGround $ y player 
     141                ystand = (cellCrd $ y player) * (chrSize * one) 
     142 
     143                isGround y = isBlock $ fieldRef fld (cellCrd $ x player) (cellCrd y) 
     144 
     145 
     146-- 上をチェック 
     147checkCeil :: Field -> Player -> Player 
     148checkCeil fld player 
     149        | stand player || vy player >= 0 || not isCeil  = player 
     150        | otherwise = player { vy = 0 } 
     151        where 
     152                ytmp = y player - one * chrSize 
     153 
     154                isCeil = isBlock $ fieldRef fld (cellCrd $ x player) (cellCrd ytmp) 
    120155                yground y = (cellCrd y) * (chrSize * one) 
    121156 
    122157 
    123 -- 通常時：地面をチェック 
    124 checkFall :: KeyProc -> Field -> Player -> Player 
    125 checkFall kp fld player = 
    126         player { stand = stand', vy = vy', pat = pat' } 
    127         where 
    128                 ytmp = (y player) + one 
     158-- ジャンプする？ 
     159doJump :: KeyProc -> Player -> Player 
     160doJump kp player 
     161        | stand player && kp PadA == Pushed     = player { vy = jumpVy, stand = False, pat = patJump } 
     162        | otherwise                                                     = player 
    129163 
    130                 stand' 
    131                         | isGround ytmp         = not dojump 
    132                         | otherwise                     = False         -- 落下開始 
    133                 vy' 
    134                         | not stand' && dojump  = jumpVy 
    135                         | otherwise                             = 0 
    136                 pat' 
    137                         | dojump        = patJump 
    138                         | otherwise     = pat player 
    139  
    140                 dojump = kp PadA == Pushed 
    141  
    142                 isGround y = isBlock $ fieldRef fld (cellCrd (x player)) (cellCrd y) 
    143                 yground y = (cellCrd y) * (chrSize * one) 
    144164 
    145165-- 更新処理 
    146166updatePlayer :: KeyProc -> Field -> Player -> Player 
    147167updatePlayer kp fld player = 
    148         moveY $ moveX kp player 
     168        moveY $ checkX fld $ moveX kp player 
    149169        where 
    150170                moveY 
    151                         | (stand player)        = checkFall kp fld 
    152                         | otherwise                     = jump fld 
     171                        | stand player  = doJump kp . checkFloor fld . fall 
     172                        | otherwise             = checkCeil fld . checkFloor fld . fall 
    153173 
    154174-- スクロール位置取得 

  • lang/haskell/nario/Util.hs

    r20045 r20086  
    1111 
    1212-- ユーティリティ関数 
     13 
     14-- 符号を返す 
     15sgn x 
     16        | x > 0         = 1 
     17        | x < 0         = -1 
     18        | otherwise     = 0 
    1319 
    1420-- x に d を加算した結果が x0～x1 の範囲内を超えないようにする