![(please configure the [header_logo] section in trac.ini)](/share/chrome/site/your_project_logo.png){kind=logo}
Changeset 19999 for lang/haskell
- Timestamp:
- 09/27/08 09:22:06 (2 months ago)
- Location:
- lang/haskell/nario
- Files:
-
- 4 modified
- 3 moved
-
Const.hs (modified) (1 diff)
-
Main.hs (moved) (moved from lang/haskell/nario/Main.lhs) (6 diffs)
-
Player.hs (modified) (2 diffs)
-
README.txt (modified) (1 diff)
-
SDLUtil.hs (moved) (moved from lang/haskell/nario/sdlutil.lhs)
-
Sound.hs (modified) (1 diff)
-
Util.hs (moved) (moved from lang/haskell/nario/Util.lhs) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
lang/haskell/nario/Const.hs
r19996 r19999 2 2 3 3 4 -- �Œ菬���_�ł̂P 5 one = 256 4 -- 固定小数点での１ 5 one = 256 :: Int 6 7 -- 1キャラのサイズ 8 chrSize = 16 :: Int 6 9 7 10 8 9 -- �摜 11 -- 画像 10 12 data ImageType = 11 13 ImgNario00 | ImgNario01 | ImgNario02 | ImgNario03 | ImgNario04 -
lang/haskell/nario/Main.hs
r19996 r19999 7 7 import Control.Monad (when) 8 8 import Data.IORef (newIORef, readIORef, writeIORef, modifyIORef) 9 import Data.Maybe (fromJust)10 9 11 10 import SDLUtil 12 11 import Util 13 12 import Player 13 import Const 14 14 15 15 ----------------------------------- 16 -- �V�X�e����----------------------------------- 16 -- システム周り 17 ----------------------------------- 17 18 18 -- ���̒�19 -- 種種の定義 19 20 20 21 wndTitle = "Nario in Haskell" 21 22 wndSize = sz 256 240 22 23 23 -- �w�i�F24 backColor = 0x2891ff -- ��24 -- 背景色 25 backColor = 0x2891ff -- 青 25 26 26 27 … … 29 30 30 31 31 -- �}�b�v32 -- マップ 32 33 33 34 fieldMap = [ … … 68 69 69 70 70 -- ���C�����[�v71 -- メインループ 71 72 72 73 main :: IO () … … 107 108 sdlQuit 108 109 109 -- �Q�[���̏�110 -- ゲームの状態 110 111 data GameState = 111 112 GameState { … … 113 114 } 114 115 115 -- �J�n��116 -- 開始状態 116 117 initState :: GameState 117 118 initState = … … 121 122 122 123 123 -- ���t���[���̏���124 -- 毎フレームの処理 124 125 onProcess :: KeyProc -> GameState -> GameState 125 126 onProcess kp gs 126 | otherwise = gs { pl = updatePlayer (pl gs) kp}127 | otherwise = gs { pl = updatePlayer kp (pl gs) } 127 128 128 129 129 -- �`�揈��130 -- 描画処理 130 131 onDraw :: Surface -> ImageResource -> GameState -> IO () 131 132 onDraw sur imgres gs = do -
lang/haskell/nario/Player.hs
r19996 r19999 1 module Player where 1 2 -- プレーヤー 3 4 module Player ( 5 Player(..), 6 newPlayer, 7 updatePlayer, 8 renderPlayer 9 ) where 2 10 3 11 import Multimedia.SDL … … 7 15 import Const 8 16 9 -- �v���[���[10 17 11 18 data Player = Player { 12 19 x :: Int, 13 20 y :: Int, 14 lr :: Int 21 vx :: Int, 22 vy :: Int, 23 stand :: Bool, 24 25 lr :: Int, 26 pat :: Int, 27 anm :: Int 15 28 } 16 29 17 30 newPlayer = Player { 18 x = 1 * 16 * one, 19 y = 12 * 16 * one, 20 lr = 1 31 x = 1 * chrSize * one, 32 y = 13 * chrSize * one - 1, 33 vx = 0, 34 vy = 0, 35 stand = True, 36 37 lr = 1, 38 pat = 0, 39 anm = 0 21 40 } 22 41 23 updatePlayer :: Player -> KeyProc -> Player 24 updatePlayer player kp = 25 player { x = x', y = y', lr = lr' } 42 maxVx = one * 3 43 acc = one `div` 6 44 45 46 patStop = 0 47 patWalk = 1 48 walkPatNum = 3 49 patJump = patWalk + walkPatNum 50 51 imgTable = [ 52 [ImgNario00, ImgNario01, ImgNario02, ImgNario03, ImgNario04], 53 [ImgNario10, ImgNario11, ImgNario12, ImgNario13, ImgNario14] 54 ] 55 56 57 -- 横移動 58 moveLR :: KeyProc -> Player -> Player 59 moveLR kp player = 60 player { x = x', vx = vx', lr = lr', pat = pat', anm = anm' } 26 61 where 27 x' 28 | isPressed (kp PadL) = (x player) - 1 * one 29 | isPressed (kp PadR) = (x player) + 1 * one 30 | otherwise = x player 62 ax = (-padl + padr) * acc 63 vx' 64 | ax /= 0 = rangeadd (vx player) ax (-maxspd) maxspd 65 | otherwise = friction (vx player) acc 66 x' = (x player) + vx' 67 padl = if isPressed (kp PadL) then 1 else 0 68 padr = if isPressed (kp PadR) then 1 else 0 69 maxspd 70 | isPressed (kp PadB) = maxVx * 2 71 | otherwise = maxVx 72 73 lr' = 74 case (-padl + padr) of 75 0 -> lr player 76 -1 -> 0 77 1 -> 1 78 pat' 79 | vx' == 0 = patStop 80 | otherwise = (anm' `div` anmCnt) + patWalk 81 anm' 82 | vx' == 0 = 0 83 | otherwise = ((anm player) + (abs vx')) `mod` (walkPatNum * anmCnt) 84 anmCnt = maxVx * 3 85 86 87 -- 縦移動 88 jumpOrFall :: KeyProc -> Player -> Player 89 jumpOrFall kp player = 90 player { y = y' } 91 where 31 92 y' 32 93 | isPressed (kp PadU) = (y player) - 1 * one 33 94 | isPressed (kp PadD) = (y player) + 1 * one 34 95 | otherwise = y player 35 lr'36 | isPressed (kp PadL) = 037 | isPressed (kp PadR) = 138 | otherwise = lr player39 96 40 renderPlayer sur player imgres = 41 blitSurface (getImageSurface imgres chr) Nothing sur pos 97 98 updatePlayer :: KeyProc -> Player -> Player 99 updatePlayer kp = 100 jumpOrFall kp . moveLR kp 101 102 103 renderPlayer sur player imgres = do 104 blitSurface (getImageSurface imgres imgtype) Nothing sur pos 42 105 where 43 pos = pt ((x player) `div` one) ((y player) `div` one) 44 chr = if (lr player) == 0 45 then ImgNario00 46 else ImgNario10 106 pos = pt ((x player) `div` one) ((y player) `div` one - chrSize) 107 imgtype = imgTable !! (lr player) !! (pat player) -
lang/haskell/nario/README.txt
r19996 r19999 9 9 http://fxp.hp.infoseek.co.jp/haskell/HSDL/ 10 10 11 12 13 ������ �J�[�\���L�[, ijkl 14 �㉺���E 15 16 �X�y�[�X�L�[ 17 A�{�^�� 18 19 �V�t�g�L�[ 20 B�{�^�� 21 -
lang/haskell/nario/Sound.hs
r19996 r19999 9 9 10 10 11 -- �����c11 -- 鳴らない… 12 12 playAudioData ad = do 13 13 case audioSpec ad of -
lang/haskell/nario/Util.hs
r19996 r19999 4 4 import Data.IORef (newIORef, readIORef, writeIORef, modifyIORef) 5 5 import Control.Concurrent (threadDelay) 6 import Data.Maybe (fromJust) 6 7 import Multimedia.SDL 7 8 8 9 import Const 9 10 10 -- �L�[�{�[�h���� 11 12 -- ユーティリティ関数 13 14 -- x に d を加算した結果が x0～x1 の範囲内を超えないようにする 15 -- もとから範囲外だったときはそれ以上遠ざからないように 16 rangeadd 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 19 | otherwise = x 20 21 22 -- 値を０に近づける 23 friction x d 24 | x > d = x - d 25 | x < -d = x + d 26 | otherwise = 0 27 28 29 30 -- キーボード処理 11 31 12 32 data PadBtn = … … 41 61 mapPhyKey PadB = [SDLK_LSHIFT, SDLK_RSHIFT] 42 62 43 -- ���Ԓ���63 -- 時間調節 44 64 45 65 elapseTime :: Integer -> IO (IO (Int,Bool)) … … 69 89 70 90 71 -- �摜���\�[�X91 -- 画像リソース 72 92 type ImageResource = [(ImageType, Surface)] 73 93 74 94 75 -- �摜���\�[�X�ǂݍ���95 -- 画像リソース読み込み 76 96 loadImageResource :: IO ImageResource 77 97 loadImageResource = mapM load images
