Changeset 20045 for lang/haskell
- Timestamp:
- 09/27/08 18:15:45 (2 months ago)
- Location:
- lang/haskell/nario
- Files:
-
- 6 modified
Legend:
- Unmodified
- Added
- Removed
-
lang/haskell/nario/Field.hs
r20026 r20045 28 28 chr2img '@' = ImgBlock1 29 29 chr2img 'O' = ImgBlock2 30 chr2img 'X' = ImgBlock3 30 31 chr2img '?' = ImgBlock4 31 32 chr2img '_' = ImgMt02 … … 48 49 chr2img '|' = ImgDk11 49 50 51 chr2img '!' = ImgDk11 52 chr2img 'o' = ImgDk11 53 50 54 51 55 isBlock :: Cell -> Bool 52 isBlock c = c `elem` "@O ?[]l|"56 isBlock c = c `elem` "@OX?[]l|" 53 57 54 58 inField :: Field -> Int -> Int -> Bool … … 61 65 62 66 63 renderField sur imgres scrx fld = sequence_ $ concatMap lineProc $ zip [0..] fld 67 renderField sur imgres scrx fld = 68 sequence_ $ concatMap lineProc $ zip [0..] fld 64 69 where 65 lineProc (y, ln) = map (cellProc y) $ zip [0..] ln 66 cellProc y (x, c) = do 67 if c == ' ' 68 then return () 69 else do 70 blitSurface (getImageSurface imgres $ chr2img c) Nothing sur $ pt (x*16 - scrx) (y*16) 71 return () 70 lineProc (y, ln) = map (cellProc y) $ zip [0..] $ window ln 71 cellProc _ (_, ' ') = return () 72 cellProc y (x, c) = putchr x y c >> return () 73 putchr x y c = blitSurface (getImageSurface imgres $ chr2img c) Nothing sur $ pt (x*chrSize - rx) (y*chrSize) 72 74 75 -- 表示される部分だけ取り出す 76 window = take w . drop qx 77 qx = scrx `div` chrSize 78 rx = scrx `mod` chrSize 79 w = 256 `div` chrSize + 1 -
lang/haskell/nario/Main.hs
r20026 r20045 23 23 wndSize = sz 256 240 24 24 25 frameRate = 60 26 25 27 -- 背景色 26 28 backColor = 0x2891ff -- 青 … … 36 38 imgres <- loadImageResource 37 39 38 et <- elapseTime 6040 et <- elapseTime frameRate 39 41 loop et gs onProcess (onDraw sur imgres) [] 40 42 … … 45 47 modifyIORef gs $ op $ keyProc bef ks 46 48 st <- readIORef gs 47 (fps, draw) <- et49 (fps, draw) <- et 48 50 when draw $ od st 49 51 loop et gs op od ks … … 57 59 | ks == SDLK_F4 && (KMOD_LALT `elem` km || 58 60 KMOD_RALT `elem` km) -> return True 59 Nothing -> return False 60 _ -> checkEvent 61 61 Nothing -> return False 62 _ -> checkEvent 62 63 63 64 sdlStart fs title (Size w h) p = do 64 65 True <- sdlInit fs 65 66 setCaption title title 66 sur <- setVideoMode w h 32 [HWSURFACE,DOUBLEBUF,ANYFORMAT]67 sur <- setVideoMode w h 32 [HWSURFACE, DOUBLEBUF, ANYFORMAT] 67 68 p sur 68 69 sdlQuit 70 69 71 70 72 -- ゲームの状態 -
lang/haskell/nario/Player.hs
r20025 r20045 38 38 39 39 newPlayer = Player { 40 x = 1* chrSize * one,41 y = 1 * chrSize * one,40 x = 3 * chrSize * one, 41 y = 13 * chrSize * one, 42 42 vx = 0, 43 43 vy = 0, … … 60 60 [ImgNario10, ImgNario11, ImgNario12, ImgNario13, ImgNario14] 61 61 ] 62 63 64 cellCrd :: Int -> Int 65 cellCrd x = x `div` (chrSize * one) 62 66 63 67 … … 101 105 102 106 103 cellCrd :: Int -> Int104 cellCrd x = x `div` (chrSize * one)105 106 107 107 -- ジャンプ中 108 108 jump :: Field -> Player -> Player … … 143 143 yground y = (cellCrd y) * (chrSize * one) 144 144 145 145 -- 更新処理 146 146 updatePlayer :: KeyProc -> Field -> Player -> Player 147 147 updatePlayer kp fld player = … … 152 152 | otherwise = jump fld 153 153 154 154 -- スクロール位置取得 155 155 getScrollPos :: Player -> Int 156 156 getScrollPos player = (scrx player) `div` one 157 157 158 -- 描画 158 159 renderPlayer sur imgres scrx player = do 159 160 blitSurface (getImageSurface imgres imgtype) Nothing sur pos -
lang/haskell/nario/README.txt
r20026 r20045 13 13 �㉺���E 14 14 15 �X�y�[�X�L�[ 15 �X�y�[�X�L�[, z 16 16 A�{�^�� 17 17 … … 30 30 �摜�f�[�^ 31 31 32 33 34 35 36 37 ���Q�l 38 Super Nario GC 39 http://d.hatena.ne.jp/authorNari/20080422/1208880928 40 41 1-1 �}�b�v 42 http://www.geocities.co.jp/SiliconValley-Sunnyvale/6160/newtech/m11.htm 43 -
lang/haskell/nario/Util.hs
r20026 r20045 58 58 mapPhyKey PadL = [SDLK_LEFT, SDLK_j] 59 59 mapPhyKey PadR = [SDLK_RIGHT, SDLK_l] 60 mapPhyKey PadA = [SDLK_SPACE ]60 mapPhyKey PadA = [SDLK_SPACE, SDLK_z] 61 61 mapPhyKey PadB = [SDLK_LSHIFT, SDLK_RSHIFT] 62 62 -
lang/haskell/nario/data/stage0.map
r20026 r20045 1 2 123 1223 3 123 456 12223 4556 4 456 45556 5 6 ? 7 8 9 10 _ ? O?O?O []11 /,\ [] l|12 /, .,\ _ [] l| l|13 / .....\ 78889/,\ 789 l| l| 7889 l|14 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 15 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 1 2 123 1223 123 1223 o 3 123 456 12223 4556 123 456 12223 4556 123 1223 123 1223 | 123 4 456 45556 456 45556 123 456 12223 4556 123 456 12223 4556 ! 456 5 456 45556 456 45556 ! 6 ? OOOOOOOO OOO? ? OOO O??O XX ! 7 XXX ! 8 XXXX ! 9 XXXXX ! 10 ? O?O?O [] [] O?O O OO ? ? ? O OO X X XX X OO?O XXXXXX ! 11 _ [] l| _ l| _ XX XX _ XXX XX XXXXXXX _ ! 12 /,\ _ [] l| l| /,\ l| _ /,\ _ XXX XXX /,\ XXXX XXX _ [] [] XXXXXXXX /,\ ! OO OO 13 /,.,\ 78889/,\ 789 l| l| 7889 l|/,.,\ l|78889/,\ 789 /,.,\ 78889/,\ 789 XXXX XXXX/,.,XXXXX XXXX9/,\l| 789 l|XXXXXXXXX /,.,\ X OO OO9 14 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 15 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
![(please configure the [header_logo] section in trac.ini)](/share/chrome/site/your_project_logo.png)