![(please configure the [header_logo] section in trac.ini)](/share/chrome/site/your_project_logo.png){kind=logo}
Changeset 20641
- Timestamp:
- 10/03/08 23:41:05 (3 months ago)
- Location:
- lang/haskell/nario
- Files:
-
- 4 modified
Legend:
- Unmodified
- Added
- Removed
-
lang/haskell/nario/Actor.hs
r20534 r20641 10 10 import AppUtil 11 11 import Event 12 import Field 12 13 13 14 class Actor a where … … 16 17 bDead :: a -> Bool 17 18 18 -- ============================================================================19 -- ActNull20 -- 死亡21 22 data AnimNull = AnimNull23 24 instance Actor AnimNull where25 update self = (self, [])26 render self imgres scrx sur = return ()27 bDead self = True28 29 19 30 20 -- ============================================================================ … … 32 22 -- ブロックを叩いたときのバウンド演出 33 23 34 data AnimBlock = AnimBlock { startcy :: Int, x :: Int, y :: Int, vy :: Int } 24 data AnimBlock = AnimBlock { 25 startcy :: Int, 26 x :: Int, 27 y :: Int, 28 vy :: Int, 29 chr :: Cell 30 } 35 31 36 32 instance Actor AnimBlock where 37 update self = result' 33 update self 34 | not (bDead self) = (self', ev') 35 | otherwise = (self, []) 36 38 37 where 39 result'40 | not bEnd = (self { vy = vy', y = y' }, [])41 | otherwise = (self, [EvSetField (cellCrd $ x self) (startcy self) '@'])42 43 38 vy' = vy self + gravity 44 39 y' = y self + vy' 45 bEnd = y' >= startcy self * chrSize * one 40 self' = self { vy = vy', y = y' } 41 ev' = if (bDead self') 42 then [EvSetField (cellCrd $ x self) (startcy self) $ chr self] 43 else [] 46 44 47 45 render self imgres scrx sur = do 48 blitSurface (getImageSurface imgres ImgBlock2) Nothing sur (pt ((x self) `div` one - scrx) ((y self) `div` one - 8))46 blitSurface (getImageSurface imgres $ chr2img $ chr self) Nothing sur (pt ((x self) `div` one - scrx) ((y self) `div` one - 8)) 49 47 return () 50 48 51 bDead self = False49 bDead self = vy self > 0 && y self >= startcy self * chrSize * one 52 50 53 54 newAnimBlock cx cy = AnimBlock { startcy = cy, x = cx * chrSize * one, y = cy * chrSize * one, vy = -3 * one } 55 51 newAnimBlock :: Int -> Int -> Cell -> AnimBlock 52 newAnimBlock cx cy c = 53 AnimBlock { startcy = cy, x = cx * chrSize * one, y = cy * chrSize * one, vy = -3 * one, chr = cc } 54 where 55 cc = case c of 56 '?' -> '#' 57 x -> x 56 58 57 59 58 60 -- ============================================================================ 59 61 60 {- 61 updateActor :: Actor -> (Actor, [Event]) 62 updateActor ActNull = updateNull 63 updateActor (ActAnimBlock a) = updateAnimBlock a 62 ---- 63 data ObjWrapper = forall a. Actor a => ObjWrapper a -- ^a͈̓͂잃NXDuckɐ 64 64 65 renderActor :: Actor -> ImageResource -> Int -> Surface -> IO () 66 renderActor ActNull = renderNull 67 renderActor (ActAnimBlock a) = renderAnimBlock a 65 updateActors :: [ObjWrapper] -> [(ObjWrapper, [Event])] 66 updateActors = map (\(ObjWrapper x) -> let (x', ev') = update x in (ObjWrapper x', ev')) 68 67 69 bDieActor :: Actor -> Bool 70 bDieActor ActNull = bDieNull 71 bDieActor (ActAnimBlock a) = bDieAnimBlock a 72 -} 68 filterActors :: [ObjWrapper] -> [ObjWrapper] 69 filterActors = filter (\(ObjWrapper x) -> not $ bDead x) 70 71 renderActors :: ImageResource -> Int -> Surface -> [ObjWrapper] -> IO () 72 renderActors imgres ofsx sur = mapM_ (\(ObjWrapper x) -> render x imgres ofsx sur) -
lang/haskell/nario/Field.hs
r20397 r20641 13 13 fieldSet, 14 14 isBlock, 15 renderField 15 renderField, 16 chr2img, 17 hardBlock 16 18 ) where 17 19 … … 40 42 chr2img 'X' = ImgBlock3 41 43 chr2img '?' = ImgBlock4 44 chr2img '#' = ImgBlock5 42 45 chr2img '_' = ImgMt02 43 46 chr2img '/' = ImgMt11 … … 64 67 65 68 isBlock :: Cell -> Bool 66 isBlock c = c `elem` "@OX?[]l|*" 69 isBlock = (`elem` "@OX?#[]l|*") 70 71 hardBlock :: Cell -> Bool 72 hardBlock = (`elem` "#X@*") 67 73 68 74 inField :: Field -> Int -> Int -> Bool -
lang/haskell/nario/Main.hs
r20534 r20641 75 75 _ -> checkSDLEvent 76 76 77 ----78 data ObjWrapper = forall a. Actor a => ObjWrapper a -- 存在型aの動く範囲を型クラスDuckに制限79 80 updateActors :: [ObjWrapper] -> [(ObjWrapper, [Event])]81 updateActors = map (\(ObjWrapper x) -> let (x', ev') = update x in (ObjWrapper x', ev'))82 83 renderActors :: ImageResource -> Int -> Surface -> [ObjWrapper] -> IO ()84 renderActors imgres ofsx sur = mapM_ (\(ObjWrapper x) -> render x imgres ofsx sur)85 86 77 87 78 -- 状態 … … 144 135 (pl', ev) = updatePlayer kp (fld gs) (pl gs) 145 136 actors_updates = updateActors (actors gs) 146 actors' = map fst actors_updates137 actors' = filterActors $ map fst actors_updates 147 138 ev' = concatMap snd actors_updates 148 139 … … 159 150 procEvent gs ev = foldl f gs ev 160 151 where 161 f gs (EvHitBlock imgtype cx cy) = gs { fld = fld', actors = actors' } 162 where 152 f gs (EvHitBlock imgtype cx cy) 153 | hardBlock c = gs 154 | otherwise = gs { fld = fld', actors = actors' } 155 where 156 c = fieldRef (fld gs) cx cy 157 actors' = actors gs ++ [ObjWrapper $ newAnimBlock cx cy $ fieldRef (fld gs) cx cy] 163 158 fld' = fieldSet (fld gs) cx cy '*' 164 actors' = (ObjWrapper $ newAnimBlock cx cy) : actors gs165 159 f gs (EvSetField cx cy c) = gs { fld = fld' } 166 160 where … … 189 183 renderInfo :: GameGame -> ImageResource -> Scr 190 184 renderInfo gs imgres sur = do 191 puts 3 1 " MARIO"185 puts 3 1 "NARIO" 192 186 puts 3 2 $ deciWide 6 '0' $ getPlayerScore (pl gs) 193 187 puts 11 2 ("?*" ++ deciWide 2 '0' (getPlayerMedal (pl gs))) -
lang/haskell/nario/README.txt
r20175 r20641 44 44 �t�H���g 45 45 http://qtchicks.hp.infoseek.co.jp/fonts-nintendo.html 46 47 unsafeInterleaveIO 48 http://d.hatena.ne.jp/tanakh/20040803#p1 49 50 ���^ 51 http://d.hatena.ne.jp/syd_syd/20080805#p2
