![(please configure the [header_logo] section in trac.ini)](/share/chrome/site/your_project_logo.png){kind=logo}
Changeset 20680 for lang/haskell/nario/Player.hs
- Timestamp:
- 10/04/08 16:01:22 (3 months ago)
- Files:
-
- 1 modified
-
lang/haskell/nario/Player.hs (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
lang/haskell/nario/Player.hs
r20673 r20680 3 3 module Player ( 4 4 Player(..), 5 PlayerType(..), 5 6 newPlayer, 6 7 updatePlayer, … … 10 11 getPlayerHitRect, 11 12 getPlayerMedal, 12 getPlayerScore 13 getPlayerScore, 14 getPlayerType, 15 setPlayerType 13 16 ) where 14 17 … … 32 35 gravity2 = one `div` 4 -- Aを長押ししたときの重力 33 36 37 data PlayerType = SmallNario | SuperNario | FireNario 38 deriving (Eq) 39 34 40 data Player = Player { 41 pltype :: PlayerType, 35 42 x :: Int, 36 43 y :: Int, … … 49 56 50 57 newPlayer = Player { 58 pltype = SmallNario, 51 59 x = 3 * chrSize * one, 52 60 y = 13 * chrSize * one, … … 70 78 patJump = patWalk + walkPatNum 71 79 patSlip = patJump + 1 72 73 imgTable = [ 74 [ImgNarioLStand, ImgNarioLWalk1, ImgNarioLWalk2, ImgNarioLWalk3, ImgNarioLJump, ImgNarioLSlip], 75 [ImgNarioRStand, ImgNarioRWalk1, ImgNarioRWalk2, ImgNarioRWalk3, ImgNarioRJump, ImgNarioRSlip] 80 patSit = patSlip + 1 81 patShot = patSit + 1 82 83 imgTableSmall = [ 84 [ImgNarioLStand, ImgNarioLWalk1, ImgNarioLWalk2, ImgNarioLWalk3, ImgNarioLJump, ImgNarioLSlip, ImgNarioLStand], 85 [ImgNarioRStand, ImgNarioRWalk1, ImgNarioRWalk2, ImgNarioRWalk3, ImgNarioRJump, ImgNarioRSlip, ImgNarioRStand] 86 ] 87 imgTableSuper = [ 88 [ImgSNarioLStand, ImgSNarioLWalk1, ImgSNarioLWalk2, ImgSNarioLWalk3, ImgSNarioLJump, ImgSNarioLSlip, ImgSNarioLSit], 89 [ImgSNarioRStand, ImgSNarioRWalk1, ImgSNarioRWalk2, ImgSNarioRWalk3, ImgSNarioRJump, ImgSNarioRSlip, ImgSNarioRSit] 90 ] 91 imgTableFire = [ 92 [ImgFNarioLStand, ImgFNarioLWalk1, ImgFNarioLWalk2, ImgFNarioLWalk3, ImgFNarioLJump, ImgFNarioLSlip, ImgFNarioLSit, ImgFNarioLShot], 93 [ImgFNarioRStand, ImgFNarioRWalk1, ImgFNarioRWalk2, ImgFNarioRWalk3, ImgFNarioRJump, ImgFNarioRSlip, ImgFNarioRSit, ImgFNarioRShot] 76 94 ] 77 95 … … 79 97 -- 横移動 80 98 moveX :: KeyProc -> Player -> Player 81 moveX kp player=82 if (stand player)83 then player' { lr = lr', pat = pat', anm = anm' }84 else player'99 moveX kp self = 100 if (stand self) 101 then self' { lr = lr', pat = pat', anm = anm' } 102 else self' 85 103 where 86 104 ax = (-padl + padr) * acc 87 105 vx' 88 | ax /= 0 = rangeadd (vx player) ax (-maxspd) maxspd89 | stand player = friction (vx player) acc90 | otherwise = vx player91 x' = max xmin $ (x player) + vx'106 | ax /= 0 = rangeadd (vx self) ax (-maxspd) maxspd 107 | stand self = friction (vx self) acc 108 | otherwise = vx self 109 x' = max xmin $ (x self) + vx' 92 110 scrx' 93 | vx' > 0 && (x' - (scrx player)) `div` one > scrollPos = (scrx player) + vx'94 | otherwise = (scrx player)111 | vx' > 0 && (x' - (scrx self)) `div` one > scrollPos = (scrx self) + vx' 112 | otherwise = (scrx self) 95 113 96 114 scrollPos = (max vx' 0) * (scrollMaxX - scrollMinX) `div` runVx + scrollMinX … … 99 117 padr = if isPressed (kp PadR) then 1 else 0 100 118 maxspd 101 | not $ stand player= walkVx `div` 2119 | not $ stand self = walkVx `div` 2 102 120 | isPressed (kp PadB) = walkVx * 2 103 121 | otherwise = walkVx 104 xmin = (scrx player) + chrSize `div` 2 * one105 106 player' = player{ x = x', vx = vx', scrx = scrx' }122 xmin = (scrx self) + chrSize `div` 2 * one 123 124 self' = self { x = x', vx = vx', scrx = scrx' } 107 125 108 126 lr' = 109 127 case (-padl + padr) of 110 0 -> lr player128 0 -> lr self 111 129 -1 -> 0 112 130 1 -> 1 … … 118 136 anm' 119 137 | vx' == 0 = 0 120 | otherwise = ((anm player) + (abs vx')) `mod` (walkPatNum * anmCnt)138 | otherwise = ((anm self) + (abs vx')) `mod` (walkPatNum * anmCnt) 121 139 anmCnt = walkVx * 3 122 140 … … 124 142 -- 横移動チェック 125 143 checkX :: Field -> Player -> Player 126 checkX fld player127 | dir == 0 = check (-1) $ check 1 $ player128 | otherwise = check dir $ player129 where 130 dir = sgn $ vx player131 check dx player132 | isBlock $ fieldRef fld cx cy = player { x = (x player) - dx * one, vx = 0 }133 | otherwise = player144 checkX fld self 145 | dir == 0 = check (-1) $ check 1 $ self 146 | otherwise = check dir $ self 147 where 148 dir = sgn $ vx self 149 check dx self 150 | isBlock $ fieldRef fld cx cy = self { x = (x self) - dx * one, vx = 0 } 151 | otherwise = self 134 152 where 135 cx = cellCrd (x player+ ofsx dx)136 cy = cellCrd (y player- chrSize `div` 2 * one)153 cx = cellCrd (x self + ofsx dx) 154 cy = cellCrd (y self - chrSize `div` 2 * one) 137 155 ofsx (-1) = -6 * one 138 156 ofsx 1 = 5 * one … … 141 159 -- 重力による落下 142 160 fall :: KeyProc -> Player -> Player 143 fall kp player144 | stand player = player145 | otherwise = player{ y = y', vy = vy' }161 fall kp self 162 | stand self = self 163 | otherwise = self { y = y', vy = vy' } 146 164 where 147 165 ay 148 | vy player< 0 && isPressed (kp PadA) = gravity2166 | vy self < 0 && isPressed (kp PadA) = gravity2 149 167 | otherwise = gravity 150 vy' = min maxVy $ vy player+ ay151 y' = y player+ vy'168 vy' = min maxVy $ vy self + ay 169 y' = y self + vy' 152 170 153 171 154 172 -- 床をチェック 155 173 checkFloor :: Field -> Player -> Player 156 checkFloor fld player157 | stand' = player{ stand = stand', y = ystand, vy = 0 }158 | otherwise = player{ stand = stand' }174 checkFloor fld self 175 | stand' = self { stand = stand', y = ystand, vy = 0 } 176 | otherwise = self { stand = stand' } 159 177 where 160 178 stand' 161 | vy player>= 0 = isGround (-6) || isGround 5162 | otherwise = stand player163 ystand = (cellCrd $ y player) * (chrSize * one)164 165 isGround ofsx = isBlock $ fieldRef fld (cellCrd $ x player + ofsx * one) (cellCrd (y player))179 | vy self >= 0 = isGround (-6) || isGround 5 180 | otherwise = stand self 181 ystand = (cellCrd $ y self) * (chrSize * one) 182 183 isGround ofsx = isBlock $ fieldRef fld (cellCrd $ x self + ofsx * one) (cellCrd (y self)) 166 184 167 185 -- 上をチェック 168 186 checkCeil :: Field -> Player -> (Player, [Event]) 169 checkCeil fld player 170 | stand player || vy player >= 0 || not isCeil = (player, []) 171 | otherwise = (player { vy = 0, score = (score player) + 10 }, [EvHitBlock ImgBlock2 cx cy]) 172 where 173 ytmp = y player - one * chrSize 174 175 cx = cellCrd $ x player 187 checkCeil fld self 188 | stand self || vy self >= 0 || not isCeil = (self, []) 189 | otherwise = (self { vy = 0, score = (score self) + 10 }, [EvHitBlock ImgBlock2 cx cy (pltype self /= SmallNario)]) 190 where 191 yofs = case pltype self of 192 SmallNario -> 15 193 SuperNario -> 30 194 FireNario -> 30 195 ytmp = y self - yofs * one 196 197 cx = cellCrd $ x self 176 198 cy = cellCrd ytmp 177 199 isCeil = isBlock $ fieldRef fld cx cy … … 181 203 -- ジャンプする？ 182 204 doJump :: KeyProc -> Player -> Player 183 doJump kp player184 | stand player && kp PadA == Pushed = player{ vy = jumpVy, stand = False, pat = patJump }185 | otherwise = player205 doJump kp self 206 | stand self && kp PadA == Pushed = self { vy = jumpVy, stand = False, pat = patJump } 207 | otherwise = self 186 208 187 209 188 210 -- 更新処理 189 211 updatePlayer :: KeyProc -> Field -> Player -> (Player, [Event]) 190 updatePlayer kp fld player=191 moveY $ checkX fld $ moveX kp player212 updatePlayer kp fld self = 213 moveY $ checkX fld $ moveX kp self 192 214 where 193 215 moveY = checkCeil fld . doJump kp . checkFloor fld . fall kp … … 195 217 -- スクロール位置取得 196 218 getScrollPos :: Player -> Int 197 getScrollPos player = (scrx player) `div` one219 getScrollPos self = (scrx self) `div` one 198 220 199 221 -- Ｙ座標取得 … … 216 238 getPlayerScore = score 217 239 240 -- タイプ取得 241 getPlayerType :: Player -> PlayerType 242 getPlayerType = pltype 243 244 -- タイプ設定 245 setPlayerType :: PlayerType -> Player -> Player 246 setPlayerType t self = self { pltype = t } 247 218 248 -- 描画 219 renderPlayer sur imgres scrx player= do249 renderPlayer sur imgres scrx self = do 220 250 blitSurface (getImageSurface imgres imgtype) Nothing sur pos 221 251 where 222 pos = pt ((x player) `div` one - chrSize `div` 2 - scrx) ((y player) `div` one - chrSize+1 - 8) 223 imgtype = imgTable !! (lr player) !! (pat player) 252 pos = case pltype self of 253 SmallNario -> pt sx $ sy - chrSize + 1 254 otherwise -> pt sx $ sy - chrSize * 2 + 1 255 imgtype = imgtbl !! lr self !! pat self 256 imgtbl = case pltype self of 257 SmallNario -> imgTableSmall 258 SuperNario -> imgTableSuper 259 FireNario -> imgTableFire 260 sx = x self `div` one - chrSize `div` 2 - scrx 261 sy = y self `div` one - 8
