![(please configure the [header_logo] section in trac.ini)](/share/chrome/site/your_project_logo.png){kind=logo}
Changeset 20661
- Timestamp:
- 10/04/08 07:57:29 (3 months ago)
- Location:
- lang/haskell/nario
- Files:
-
- 3 added
- 1 removed
- 7 modified
-
Actor (added)
-
Actor.hs (modified) (2 diffs)
-
Actor/AnimBlock.hs (added)
-
Actor/Kuribo.hs (added)
-
Event.hs (modified) (1 diff)
-
Images.hs (modified) (1 diff)
-
Main.hs (modified) (6 diffs)
-
Makefile (modified) (2 diffs)
-
README.txt (modified) (4 diffs)
-
Sound.hs (deleted)
-
data/stage0.map (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
lang/haskell/nario/Actor.hs
r20641 r20661 1 1 {-# OPTIONS_GHC -fglasgow-exts #-} 2 2 3 module Actor where 3 module Actor ( 4 Actor (..), 5 ObjWrapper (..), 6 updateActors, 7 filterActors, 8 renderActors 9 ) where 4 10 5 import Multimedia.SDL hiding (Event)11 import Multimedia.SDL (Surface) 6 12 7 import Const 8 import Images 9 import Util 13 import Event 10 14 import AppUtil 11 import Event 12 import Field 15 13 16 14 17 class Actor a where … … 19 22 20 23 -- ============================================================================ 21 -- AnimBlock22 -- ブロックを叩いたときのバウンド演出23 24 data AnimBlock = AnimBlock {25 startcy :: Int,26 x :: Int,27 y :: Int,28 vy :: Int,29 chr :: Cell30 }31 32 instance Actor AnimBlock where33 update self34 | not (bDead self) = (self', ev')35 | otherwise = (self, [])36 37 where38 vy' = vy self + gravity39 y' = y self + vy'40 self' = self { vy = vy', y = y' }41 ev' = if (bDead self')42 then [EvSetField (cellCrd $ x self) (startcy self) $ chr self]43 else []44 45 render self imgres scrx sur = do46 blitSurface (getImageSurface imgres $ chr2img $ chr self) Nothing sur (pt ((x self) `div` one - scrx) ((y self) `div` one - 8))47 return ()48 49 bDead self = vy self > 0 && y self >= startcy self * chrSize * one50 51 newAnimBlock :: Int -> Int -> Cell -> AnimBlock52 newAnimBlock cx cy c =53 AnimBlock { startcy = cy, x = cx * chrSize * one, y = cy * chrSize * one, vy = -3 * one, chr = cc }54 where55 cc = case c of56 '?' -> '#'57 x -> x58 59 60 -- ============================================================================61 24 62 25 ---- 63 data ObjWrapper = forall a. Actor a => ObjWrapper a -- ^a͈̓͂잃NXDuckɐ26 data ObjWrapper = forall a. Actor a => ObjWrapper a -- 存在型aの動く範囲を型クラスに制限 64 27 65 28 updateActors :: [ObjWrapper] -> [(ObjWrapper, [Event])] -
lang/haskell/nario/Event.hs
r20397 r20661 9 9 EvHitBlock ImageType Int Int 10 10 | EvSetField Int Int Cell 11 | EvAppearEnemy Int Int Cell -
lang/haskell/nario/Images.hs
r20534 r20661 1 1 module Images (ImageType(..), imageTypes, imageFn) where 2 2 import Maybe (fromJust) 3 data ImageType = ImgBlock1 | ImgBlock2 | ImgBlock3 | ImgBlock4 | ImgBlock5 | ImgCloud00 | ImgCloud01 | ImgCloud02 | ImgCloud10 | ImgCloud11 | ImgCloud12 | ImgDk00 | ImgDk01 | ImgDk10 | ImgDk11 | ImgFlag | ImgFont | ImgGrass0 | ImgGrass1 | ImgGrass2 | Img Mt02 | ImgMt11 | ImgMt12 | ImgMt13 | ImgMt22 | ImgNarioDie | ImgNarioLJump | ImgNarioLSlip | ImgNarioLStand | ImgNarioLWalk1 | ImgNarioLWalk2 | ImgNarioLWalk3 | ImgNarioRJump | ImgNarioRSlip | ImgNarioRStand | ImgNarioRWalk1 | ImgNarioRWalk2 | ImgNarioRWalk3 | ImgPole0 | ImgPole1 | ImgTitle deriving (Eq)4 imageTypes = [ImgBlock1, ImgBlock2, ImgBlock3, ImgBlock4, ImgBlock5, ImgCloud00, ImgCloud01, ImgCloud02, ImgCloud10, ImgCloud11, ImgCloud12, ImgDk00, ImgDk01, ImgDk10, ImgDk11, ImgFlag, ImgFont, ImgGrass0, ImgGrass1, ImgGrass2, Img Mt02, ImgMt11, ImgMt12, ImgMt13, ImgMt22, ImgNarioDie, ImgNarioLJump, ImgNarioLSlip, ImgNarioLStand, ImgNarioLWalk1, ImgNarioLWalk2, ImgNarioLWalk3, ImgNarioRJump, ImgNarioRSlip, ImgNarioRStand, ImgNarioRWalk1, ImgNarioRWalk2, ImgNarioRWalk3, ImgPole0, ImgPole1, ImgTitle]5 imageFilenames = ["block1.bmp", "block2.bmp", "block3.bmp", "block4.bmp", "block5.bmp", "cloud00.bmp", "cloud01.bmp", "cloud02.bmp", "cloud10.bmp", "cloud11.bmp", "cloud12.bmp", "dk00.bmp", "dk01.bmp", "dk10.bmp", "dk11.bmp", "flag.bmp", "font.bmp", "grass0.bmp", "grass1.bmp", "grass2.bmp", " mt02.bmp", "mt11.bmp", "mt12.bmp", "mt13.bmp", "mt22.bmp", "narioDie.bmp", "narioLJump.bmp", "narioLSlip.bmp", "narioLStand.bmp", "narioLWalk1.bmp", "narioLWalk2.bmp", "narioLWalk3.bmp", "narioRJump.bmp", "narioRSlip.bmp", "narioRStand.bmp", "narioRWalk1.bmp", "narioRWalk2.bmp", "narioRWalk3.bmp", "pole0.bmp", "pole1.bmp", "title.bmp"]3 data ImageType = ImgBlock1 | ImgBlock2 | ImgBlock3 | ImgBlock4 | ImgBlock5 | ImgCloud00 | ImgCloud01 | ImgCloud02 | ImgCloud10 | ImgCloud11 | ImgCloud12 | ImgDk00 | ImgDk01 | ImgDk10 | ImgDk11 | ImgFlag | ImgFont | ImgGrass0 | ImgGrass1 | ImgGrass2 | ImgKuri0 | ImgKuri1 | ImgMt02 | ImgMt11 | ImgMt12 | ImgMt13 | ImgMt22 | ImgNarioDie | ImgNarioLJump | ImgNarioLSlip | ImgNarioLStand | ImgNarioLWalk1 | ImgNarioLWalk2 | ImgNarioLWalk3 | ImgNarioRJump | ImgNarioRSlip | ImgNarioRStand | ImgNarioRWalk1 | ImgNarioRWalk2 | ImgNarioRWalk3 | ImgPole0 | ImgPole1 | ImgTitle deriving (Eq) 4 imageTypes = [ImgBlock1, ImgBlock2, ImgBlock3, ImgBlock4, ImgBlock5, ImgCloud00, ImgCloud01, ImgCloud02, ImgCloud10, ImgCloud11, ImgCloud12, ImgDk00, ImgDk01, ImgDk10, ImgDk11, ImgFlag, ImgFont, ImgGrass0, ImgGrass1, ImgGrass2, ImgKuri0, ImgKuri1, ImgMt02, ImgMt11, ImgMt12, ImgMt13, ImgMt22, ImgNarioDie, ImgNarioLJump, ImgNarioLSlip, ImgNarioLStand, ImgNarioLWalk1, ImgNarioLWalk2, ImgNarioLWalk3, ImgNarioRJump, ImgNarioRSlip, ImgNarioRStand, ImgNarioRWalk1, ImgNarioRWalk2, ImgNarioRWalk3, ImgPole0, ImgPole1, ImgTitle] 5 imageFilenames = ["block1.bmp", "block2.bmp", "block3.bmp", "block4.bmp", "block5.bmp", "cloud00.bmp", "cloud01.bmp", "cloud02.bmp", "cloud10.bmp", "cloud11.bmp", "cloud12.bmp", "dk00.bmp", "dk01.bmp", "dk10.bmp", "dk11.bmp", "flag.bmp", "font.bmp", "grass0.bmp", "grass1.bmp", "grass2.bmp", "kuri0.bmp", "kuri1.bmp", "mt02.bmp", "mt11.bmp", "mt12.bmp", "mt13.bmp", "mt22.bmp", "narioDie.bmp", "narioLJump.bmp", "narioLSlip.bmp", "narioLStand.bmp", "narioLWalk1.bmp", "narioLWalk2.bmp", "narioLWalk3.bmp", "narioRJump.bmp", "narioRSlip.bmp", "narioRStand.bmp", "narioRWalk1.bmp", "narioRWalk2.bmp", "narioRWalk3.bmp", "pole0.bmp", "pole1.bmp", "title.bmp"] 6 6 imageFn = fromJust . flip lookup (zip imageTypes imageFilenames) -
lang/haskell/nario/Main.hs
r20641 r20661 20 20 import Event 21 21 import Actor 22 import Actor.AnimBlock 23 import Actor.Kuribo 22 24 23 25 wndTitle = "NARIO in Haskell" … … 113 115 | otherwise = loop kss 114 116 117 118 119 -- マップのスクロールに応じたイベント 120 scrollEvent :: Field -> Int -> (Field, [Event]) 121 scrollEvent fld cx 122 | cx < length (head fld) = foldl proc (fld, []) $ zip [0..] cols 123 | otherwise = (fld, []) 124 where 125 proc (f, e) (cy, c) = 126 case event cy c of 127 Just ev -> (fieldSet f cx cy ' ', ev : e) 128 Nothing -> (f, e) 129 cols = map (!! cx) fld 130 event cy c 131 | c `elem` "k" = Just $ EvAppearEnemy cx cy c 132 | otherwise = Nothing 133 115 134 -- ゲーム 116 135 doGame :: Field -> [[SDLKey]] -> [ImageResource -> Scr] … … 133 152 where 134 153 time' = max 0 (time gs - one `div` 25) 135 (pl', ev) = updatePlayer kp (fld gs) (pl gs) 154 (fld', screv') = scrollEvent (fld gs) $ getScrollPos (pl gs) `div` chrSize + 18 155 156 (pl', plev) = updatePlayer kp fld' (pl gs) 136 157 actors_updates = updateActors (actors gs) 137 158 actors' = filterActors $ map fst actors_updates 138 159 ev' = concatMap snd actors_updates 139 160 140 gstmp = gs { pl = pl', actors = actors', time = time' }141 gs' = procEvent gstmp ( ev ++ev')161 gstmp = gs { pl = pl', fld = fld', actors = actors', time = time' } 162 gs' = procEvent gstmp (plev ++ ev' ++ screv') 142 163 143 164 initialState = GameGame { pl = newPlayer, fld = fldmap, actors = [], time = 400 * one } … … 148 169 -- イベントを処理 149 170 procEvent :: GameGame -> [Event] -> GameGame 150 procEvent gs ev = foldl fgs ev151 where 152 fgs (EvHitBlock imgtype cx cy)171 procEvent gs ev = foldl proc gs ev 172 where 173 proc gs (EvHitBlock imgtype cx cy) 153 174 | hardBlock c = gs 154 175 | otherwise = gs { fld = fld', actors = actors' } … … 157 178 actors' = actors gs ++ [ObjWrapper $ newAnimBlock cx cy $ fieldRef (fld gs) cx cy] 158 179 fld' = fieldSet (fld gs) cx cy '*' 159 f gs (EvSetField cx cy c) = gs { fld = fld' } 160 where 161 fld' = fieldSet (fld gs) cx cy c 180 proc gs (EvSetField cx cy c) = gs { fld = fieldSet (fld gs) cx cy c } 181 proc gs (EvAppearEnemy cx cy c) = gs { actors = actors gs ++ [ene] } 182 where 183 ene = case c of 184 'k' -> ObjWrapper $ newKuribo cx cy 162 185 163 186 … … 190 213 puts 25 1 "TIME" 191 214 puts 26 2 $ deciWide 3 ' ' ((time gs + one-1) `div` one) 215 192 216 where 193 217 puts = fontPut sur fontsur -
lang/haskell/nario/Makefile
r20397 r20661 2 2 PROJECT = nario 3 3 4 SRCS = $(wildcard *.hs) 4 SRCS = $(wildcard *.hs) $(wildcard Actor/*.hs) 5 OBJS = $(subst .hs,.o,$(SRCS)) $(subst .hs,.hi,$(SRCS)) 5 6 6 7 all: $(PROJECT).exe … … 13 14 14 15 clean: 15 rm -f *.o 16 rm -f *.hi 16 rm -f $(OBJS) 17 17 rm -f *.manifest 18 18 rm -f *.exe -
lang/haskell/nario/README.txt
r20641 r20661 3 3 http://d.hatena.ne.jp/authorNari/20080422/1208880928 4 4 5 ��skell/HSDL �ō� 5 を Haskell/HSDL で作る 6 6 7 7 … … 10 10 11 11 12 ������ �J�[�\���L�[, ijkl 13 �㉺���E 12 ★操作 13 カーソルキー, ijkl 14 上下左右 14 15 15 �X�y�[�X�L�[, z16 A �{�^��16 スペースキー, z 17 Aボタン 17 18 18 �V�t�g�L�[19 B �{�^��19 シフトキー 20 Bボタン 20 21 21 �G�X�P�[�v�L�[22 �I��22 エスケープキー 23 終了 23 24 24 25 25 26 26 ���t�@�C���\�� 27 ★ファイル構成 27 28 data 28 �f�[�^29 データ 29 30 data/img 30 �摜�f�[�^31 画像データ 31 32 32 33 … … 35 36 36 37 37 ���Q�l 38 ★参考 38 39 Super Nario GC 39 40 http://d.hatena.ne.jp/authorNari/20080422/1208880928 40 41 41 1-1 �}�b�v42 1-1 マップ 42 43 http://www.geocities.co.jp/SiliconValley-Sunnyvale/6160/newtech/m11.htm 43 44 44 �t�H���g45 フォント 45 46 http://qtchicks.hp.infoseek.co.jp/fonts-nintendo.html 46 47 … … 48 49 http://d.hatena.ne.jp/tanakh/20040803#p1 49 50 50 ���^51 存在型 51 52 http://d.hatena.ne.jp/syd_syd/20080805#p2 -
lang/haskell/nario/data/stage0.map
r20233 r20661 1 1 2 2 3 3 123 1223 123 1223 123 1223 123 1223 o 123 … … 11 11 _ [] l| _ l| _ XX XX _ XXX XX XXXXXXX _ ! 12 12 /,\ _ [] l| l| /,\ l| _ /,\ _ XXX XXX /,\ XXXX XXX _ [] [] XXXXXXXX /,\ ! OO OO 13 /,.,\ 78889/,\ 13 /,.,\ 78889/,\ k 789 l| l| 7889 l|/,.,\ l|78889/,\ 789 /,.,\ 78889/,\ 789 XXXX XXXX/,.,XXXXX XXXX9/,\l| 789 l|XXXXXXXXX /,.,\ X OO OO9 14 14 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 15 15 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
