root/lang/haskell/nario/Player.hs @ 20045

Revision 20045, 3.3 kB (checked in by mokehehe, 6 years ago)

1-1のマップ作成

Line 
1
2-- プレーヤー
3
4module Player (
5        Player(..),
6        newPlayer,
7        updatePlayer,
8        renderPlayer,
9        getScrollPos
10) where
11
12import Multimedia.SDL
13
14import Util
15import SDLUtil
16import Const
17import Field
18
19
20maxVx = one * 3
21maxVy = one * 8
22acc = one `div` 6
23jumpVy = -17 * gravity
24
25
26data Player = Player {
27        x :: Int,
28        y :: Int,
29        vx :: Int,
30        vy :: Int,
31        scrx :: Int,
32        stand :: Bool,
33
34        lr :: Int,
35        pat :: Int,
36        anm :: Int
37        }
38
39newPlayer = Player {
40        x = 3 * chrSize * one,
41        y = 13 * chrSize * one,
42        vx = 0,
43        vy = 0,
44        scrx = 0,
45        stand = False,
46
47        lr = 1,
48        pat = 0,
49        anm = 0
50        }
51
52
53patStop = 0
54patWalk = 1
55walkPatNum = 3
56patJump = patWalk + walkPatNum
57
58imgTable = [
59        [ImgNario00, ImgNario01, ImgNario02, ImgNario03, ImgNario04],
60        [ImgNario10, ImgNario11, ImgNario12, ImgNario13, ImgNario14]
61        ]
62
63
64cellCrd :: Int -> Int
65cellCrd x = x `div` (chrSize * one)
66
67
68-- 横移動
69moveX :: KeyProc -> Player -> Player
70moveX kp player =
71        if (stand player)
72                then player' { lr = lr', pat = pat', anm = anm' }
73                else player'
74        where
75                ax = (-padl + padr) * acc
76                vx'
77                        | ax /= 0       = rangeadd (vx player) ax (-maxspd) maxspd
78                        | otherwise     = friction (vx player) acc
79                x' = max xmin $ (x player) + vx'
80                scrx'
81                        | vx' > 0 && (x' - (scrx player)) `div` one > 160       = (scrx player) + vx'
82                        | otherwise                                                                                     = (scrx player)
83
84                padl = if isPressed (kp PadL) then 1 else 0
85                padr = if isPressed (kp PadR) then 1 else 0
86                maxspd
87                        | isPressed (kp PadB)   = maxVx * 2
88                        | otherwise                             = maxVx
89                xmin = (scrx player) + chrSize `div` 2 * one
90
91                player' = player { x = x', vx = vx', scrx = scrx' }
92
93                lr' =
94                        case (-padl + padr) of
95                                0       -> lr player
96                                -1      -> 0
97                                1       -> 1
98                pat'
99                        | vx' == 0              = patStop
100                        | otherwise             = (anm' `div` anmCnt) + patWalk
101                anm'
102                        | vx' == 0              = 0
103                        | otherwise             = ((anm player) + (abs vx')) `mod` (walkPatNum * anmCnt)
104                anmCnt = maxVx * 3
105
106
107-- ジャンプ中
108jump :: Field -> Player -> Player
109jump fld player =
110        player { y = y', vy = vy', stand = stand' }
111        where
112                vytmp = min maxVy $ (vy player) + gravity
113                ytmp = (y player) + vytmp
114
115                y' = if isGround ytmp then yground ytmp else ytmp
116                vy' = if isGround ytmp then 0 else vytmp
117                stand' = isGround ytmp
118
119                isGround y = isBlock $ fieldRef fld (cellCrd (x player)) (cellCrd y)
120                yground y = (cellCrd y) * (chrSize * one)
121
122
123-- 通常時:地面をチェック
124checkFall :: KeyProc -> Field -> Player -> Player
125checkFall kp fld player =
126        player { stand = stand', vy = vy', pat = pat' }
127        where
128                ytmp = (y player) + one
129
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)
144
145-- 更新処理
146updatePlayer :: KeyProc -> Field -> Player -> Player
147updatePlayer kp fld player =
148        moveY $ moveX kp player
149        where
150                moveY
151                        | (stand player)        = checkFall kp fld
152                        | otherwise                     = jump fld
153
154-- スクロール位置取得
155getScrollPos :: Player -> Int
156getScrollPos player = (scrx player) `div` one
157
158-- 描画
159renderPlayer sur imgres scrx player = do
160        blitSurface (getImageSurface imgres imgtype) Nothing sur pos
161        where
162                pos = pt ((x player) `div` one - chrSize `div` 2 - scrx) ((y player) `div` one - chrSize)
163                imgtype = imgTable !! (lr player) !! (pat player)
Note: See TracBrowser for help on using the browser.