Changeset 20811 for lang/haskell
- Timestamp:
- 10/05/08 22:27:31 (2 months ago)
- Location:
- lang/haskell/nario
- Files:
-
- 3 added
- 16 modified
-
Actor.hs (modified) (1 diff)
-
Actor.hs-boot (added)
-
Actor/AnimBlock.hs (modified) (1 diff)
-
Actor/BrokenBlock.hs (modified) (1 diff)
-
Actor/CoinGet.hs (modified) (2 diffs)
-
Actor/Common.hs (added)
-
Actor/Flower.hs (modified) (4 diffs)
-
Actor/Kinoko.hs (modified) (5 diffs)
-
Actor/Koura.hs (added)
-
Actor/Kuribo.hs (modified) (4 diffs)
-
Actor/Nokonoko.hs (modified) (3 diffs)
-
Actor/ScoreAdd.hs (modified) (3 diffs)
-
Const.hs (modified) (1 diff)
-
Event.hs (modified) (2 diffs)
-
Images.hs (modified) (1 diff)
-
Main.hs (modified) (8 diffs)
-
Player.hs (modified) (10 diffs)
-
README.txt (modified) (1 diff)
-
data/stage0.map (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
lang/haskell/nario/Actor.hs
r20691 r20811 27 27 getHitRect _ = Nothing 28 28 29 onHit :: Player -> a -> (Player, Maybe ActorWrapper )30 onHit pl ac = (pl, Nothing )29 onHit :: Player -> a -> (Player, Maybe ActorWrapper, [Event]) 30 onHit pl ac = (pl, Nothing, []) 31 31 32 32 -- ============================================================================ -
lang/haskell/nario/Actor/AnimBlock.hs
r20775 r20811 1 -- -*- mode: haskell; Encoding: UTF-8 -*- 1 2 -- ブロックを叩いたときのバウンド演出 2 3 -
lang/haskell/nario/Actor/BrokenBlock.hs
r20775 r20811 1 -- -*- mode: haskell; Encoding: UTF-8 -*- 1 2 -- ブロックを叩いたときのバウンド演出 2 3 -
lang/haskell/nario/Actor/CoinGet.hs
r20775 r20811 1 -- -*- mode: haskell; Encoding: UTF-8 -*- 1 2 -- コインを取ったときの演出コイン 2 3 … … 26 27 instance Actor CoinGet where 27 28 update _ self 28 | bDead self' = (self', [EvScoreAddEfe (sx self) (y self `div` one) Img1000])29 | bDead self' = (self', [EvScoreAddEfe (sx self) (y self `div` one) pointGetCoin]) 29 30 | otherwise = (self', []) 30 31 where -
lang/haskell/nario/Actor/Flower.hs
r20680 r20811 1 -- -*- mode: haskell; Encoding: UTF-8 -*- 1 2 -- フラワー 2 3 … … 13 14 import Images 14 15 import Field 15 import Player (PlayerType(..), getPlayerType, setPlayerType) 16 17 maxVy = one * 6 16 import Player (PlayerType(..), getPlayerType, setPlayerType, addScore) 17 import Event (Event(..)) 18 18 19 19 … … 37 37 yy = y self `div` one 38 38 39 onHit pl self = ( setPlayerType nt pl, Nothing)39 onHit pl self = (addScore pointFlower $ setPlayerType nt pl, Nothing, ev) 40 40 where 41 41 nt = case typ of … … 44 44 otherwise -> typ 45 45 typ = getPlayerType pl 46 ev = [EvScoreAddEfe (x self `div` one) (y self `div` one - chrSize * 2) pointFlower] 46 47 47 48 -
lang/haskell/nario/Actor/Kinoko.hs
r20775 r20811 1 -- -*- mode: haskell; Encoding: UTF-8 -*- 1 2 -- きのこ 2 3 … … 8 9 9 10 import Actor (Actor(..)) 11 import Actor.Common (updateActorBase) 10 12 import Const 11 import Util (sgn)12 13 import AppUtil (getImageSurface, cellCrd, Rect(..)) 13 14 import Images 14 15 import Field 15 16 import Player (PlayerType(..), getPlayerType, setPlayerType, addScore) 17 import Event (Event(..)) 16 18 17 maxVy = one * 6 18 19 pointKinoko = 1000 19 ofsH = 15 20 20 21 21 … … 28 28 29 29 instance Actor Kinoko where 30 update fld self 31 | isGround = (self { x = x', vx = vx', y = (cellCrd y') * one * chrSize, vy = 0 }, []) 32 | otherwise = (self { x = x', vx = vx', y = y', vy = vy' }, []) 30 update fld self = (self', []) 33 31 where 34 x' = x self + vx self 35 sideWall = isBlock $ fieldRef fld (cellCrd $ x' + sgn (vx self) * 6 * one) (cellCrd $ y self - chrSize * one `div` 2) 36 vx' 37 | sideWall = -(vx self) 38 | otherwise = vx self 39 40 vy' = min maxVy $ vy self + gravity 41 y' = y self + vy' 42 isGround = isBlock $ fieldRef fld (cellCrd $ x') (cellCrd y') 32 self' = self { x = x', y = y', vx = vx', vy = vy' } 33 (x', y', vx', vy') = updateActorBase fld (x self, y self, vx self, vy self) 43 34 44 35 render self imgres scrx sur = do 45 blitSurface (getImageSurface imgres imgtype) Nothing sur (pt ((x self) `div` one - chrSize `div` 2 - scrx) ((y self) `div` one - 15- 8))36 blitSurface (getImageSurface imgres imgtype) Nothing sur (pt ((x self) `div` one - chrSize `div` 2 - scrx) ((y self) `div` one - ofsH - 8)) 46 37 return () 47 38 where 48 39 imgtype = ImgKinoko 49 40 50 bDead self = y self `div` one >= screenHeight + chrSize * 341 bDead self = y self >= (screenHeight + chrSize * 3) * one || x self <= -chrSize * one 51 42 52 43 getHitRect self = Just $ Rect (xx - 8) (yy - 16) (xx + 8) yy … … 55 46 yy = y self `div` one 56 47 57 onHit pl self = (addScore pointKinoko $ setPlayerType nt pl, Nothing )48 onHit pl self = (addScore pointKinoko $ setPlayerType nt pl, Nothing, ev) 58 49 where 59 50 nt = case typ of … … 61 52 otherwise -> typ 62 53 typ = getPlayerType pl 63 54 ev = [EvScoreAddEfe (x self `div` one) (y self `div` one - chrSize * 2) pointKinoko] 64 55 65 56 newKinoko :: Int -> Int -> Kinoko -
lang/haskell/nario/Actor/Kuribo.hs
r20691 r20811 1 -- -*- mode: haskell; Encoding: UTF-8 -*- 1 2 -- クリボー 2 3 … … 8 9 9 10 import Actor (Actor(..), ActorWrapper(..)) 11 import Actor.Common (updateActorBase, stamp) 10 12 import Const 11 import AppUtil 13 import AppUtil (getImageSurface, cellCrd, Rect(..)) 12 14 import Images 13 import Player (setPlayerDamage, getPlayerVY, stampPlayer) 15 import Player (setPlayerDamage, stampPlayer, addScore) 16 import Event (Event(..)) 14 17 18 ofsH = 15 15 19 16 20 data Kuribo = Kuribo { … … 23 27 24 28 instance Actor Kuribo where 25 update fld self = (self { x = x self + vx self, cnt = cnt self + 1 }, []) 29 update fld self = (self', []) 30 where 31 self' = self { x = x', y = y', vx = vx', vy = vy', cnt = cnt self + 1 } 32 (x', y', vx', vy') = updateActorBase fld (x self, y self, vx self, vy self) 26 33 27 34 render self imgres scrx sur = do 28 blitSurface (getImageSurface imgres imgtype) Nothing sur (pt (x self `div` one - chrSize `div` 2 - scrx) (y self `div` one - 15- 8))35 blitSurface (getImageSurface imgres imgtype) Nothing sur (pt (x self `div` one - chrSize `div` 2 - scrx) (y self `div` one - ofsH - 8)) 29 36 return () 30 37 where 31 38 imgtype = [ImgKuri0, ImgKuri1] !! (cnt self `mod` 16 `div` 8) 39 40 bDead self = y self >= (screenHeight + chrSize * 3) * one || x self <= -chrSize * one 32 41 33 42 getHitRect self = Just $ Rect (xx - 8) (yy - 16) (xx + 8) yy … … 37 46 38 47 onHit pl self 39 | stamp = (stampPlayer pl, Just $ ActorWrapper $ newStampedKuribo (x self `div` one - chrSize `div` 2) (y self `div` one))40 | otherwise = (setPlayerDamage pl, Just $ ActorWrapper self )48 | stamp pl (x self, y self) = (addScore pointKuribo $ stampPlayer pl, Just $ ActorWrapper $ newStampedKuribo (x self `div` one - chrSize `div` 2) (y self `div` one), ev) 49 | otherwise = (setPlayerDamage pl, Just $ ActorWrapper self, []) 41 50 where 42 stamp = getPlayerVY pl > 051 ev = [EvScoreAddEfe (x self `div` one) (y self `div` one - chrSize * 2) pointKuribo] 43 52 44 53 newKuribo :: Int -> Int -> Kuribo -
lang/haskell/nario/Actor/Nokonoko.hs
r20680 r20811 1 -- クリボー 1 -- -*- mode: haskell; Encoding: UTF-8 -*- 2 -- ノコノコ 2 3 3 4 module Actor.Nokonoko ( … … 5 6 ) where 6 7 7 import Multimedia.SDL hiding (Event)8 import Multimedia.SDL (blitSurface, pt) 8 9 9 import Actor (Actor(..)) 10 import Actor (Actor(..), ActorWrapper(..)) 11 import Actor.Common (updateActorBase, stamp) 12 import Actor.Koura 10 13 import Const 11 import AppUtil 14 import AppUtil (getImageSurface, cellCrd, Rect(..)) 12 15 import Images 16 import Player (setPlayerDamage, stampPlayer, addScore) 17 import Event (Event(..)) 13 18 19 ofsH = 23 14 20 15 21 data Nokonoko = Nokonoko { … … 22 28 23 29 instance Actor Nokonoko where 24 update fld self = (self { x = x self + vx self, cnt = cnt self + 1 }, []) 30 update fld self = (self', []) 31 where 32 self' = self { x = x', y = y', vx = vx', vy = vy', cnt = cnt self + 1 } 33 (x', y', vx', vy') = updateActorBase fld (x self, y self, vx self, vy self) 25 34 26 35 render self imgres scrx sur = do 27 blitSurface (getImageSurface imgres imgtype) Nothing sur (pt ( (x self) `div` one - scrx) ((y self) `div` one- 8))36 blitSurface (getImageSurface imgres imgtype) Nothing sur (pt (x self `div` one - chrSize `div` 2 - scrx) (y self `div` one - ofsH - 8)) 28 37 return () 29 38 where 30 39 imgtype = [ImgNoko0, ImgNoko1] !! (cnt self `mod` 16 `div` 8) 31 40 41 bDead self = y self >= (screenHeight + chrSize * 3) * one || x self <= -chrSize * one 42 43 getHitRect self = Just $ Rect (xx - 8) (yy - 16) (xx + 8) yy 44 where 45 xx = x self `div` one 46 yy = y self `div` one 47 48 onHit pl self 49 | stamp pl (x self, y self) = (addScore pointNokonoko $ stampPlayer pl, Just $ ActorWrapper $ newKoura (x self) (y self), ev) 50 | otherwise = (setPlayerDamage pl, Just $ ActorWrapper self, []) 51 where 52 ev = [EvScoreAddEfe (x self `div` one) (y self `div` one - chrSize * 2) pointNokonoko] 53 32 54 newNokonoko :: Int -> Int -> Nokonoko 33 55 newNokonoko cx cy = -
lang/haskell/nario/Actor/ScoreAdd.hs
r20775 r20811 1 -- -*- mode: haskell; Encoding: UTF-8 -*- 1 2 -- スコアが増えるときの増分表示 2 3 … … 15 16 16 17 data ScoreAdd = ScoreAdd { 17 imgtype :: ImageType,18 pnt :: Int, 18 19 sx :: Int, 19 20 sy :: Int, … … 26 27 27 28 render self imgres scrx sur = do 28 blitSurface (getImageSurface imgres $ imgtype self) Nothing sur (pt (sx self - scrx) (sy self))29 blitSurface (getImageSurface imgres imgtype) Nothing sur (pt (sx self - scrx) (sy self)) 29 30 return () 31 where 32 imgtype = case pnt self of 33 100 -> Img100 34 200 -> Img200 35 400 -> Img400 36 500 -> Img500 37 1000 -> Img1000 30 38 31 39 bDead self = cnt self >= frameRate `div` 2 32 40 33 newScoreAdd :: Int -> Int -> I mageType-> ScoreAdd34 newScoreAdd sx' sy' imgtype' =35 ScoreAdd { imgtype = imgtype', sx = sx', sy = sy', cnt = 0 }41 newScoreAdd :: Int -> Int -> Int -> ScoreAdd 42 newScoreAdd sx' sy' pnt' = 43 ScoreAdd { pnt = pnt', sx = sx', sy = sy', cnt = 0 } -
lang/haskell/nario/Const.hs
r20670 r20811 17 17 18 18 -- 重力 19 gravity = one `div` 2 19 gravity = one * 2 `div` 5 20 21 22 -- ポイント 23 pointKuribo = 100 :: Int 24 pointNokonoko = 100 :: Int 25 pointKinoko = 1000 :: Int 26 pointFlower = 1000 :: Int 27 pointBreakBlock = 50 :: Int 28 pointGetCoin = 200 :: Int 29 pointKoura = 400 :: Int -
lang/haskell/nario/Event.hs
r20775 r20811 1 1 module Event where 2 2 3 import Const4 import Images5 import Field3 import Images (ImageType) 4 import Field (Cell) 5 import {-# SOURCE #-} Actor (Actor(..), ActorWrapper(..)) 6 6 7 7 data Event = … … 12 12 | EvSetField Int Int Cell 13 13 14 -- 敵登場15 | EvA ppearEnemy Int Int Cell14 -- アクター追加 15 | EvAddActor ActorWrapper 16 16 17 17 -- スコア加算エフェクト 18 | EvScoreAddEfe Int Int I mageType18 | EvScoreAddEfe Int Int Int -
lang/haskell/nario/Images.hs
r20775 r20811 1 1 module Images (ImageType(..), imageTypes, imageFn) where 2 2 import Maybe (fromJust) 3 data ImageType = Img100 | Img1000 | Img200 | Img 500 | ImgBlock1 | ImgBlock2 | ImgBlock3 | ImgBlock4 | ImgBlock5 | ImgBroken | ImgCloud00 | ImgCloud01 | ImgCloud02 | ImgCloud10 | ImgCloud11 | ImgCloud12 | ImgCoin0 | ImgCoin1 | ImgCoin2 | ImgCoin3 | ImgDk00 | ImgDk01 | ImgDk10 | ImgDk11 | ImgFlag | ImgFlower | ImgFNarioLJump | ImgFNarioLShot | ImgFNarioLSit | ImgFNarioLSlip | ImgFNarioLStand | ImgFNarioLWalk1 | ImgFNarioLWalk2 | ImgFNarioLWalk3 | ImgFNarioRJump | ImgFNarioRShot | ImgFNarioRSit | ImgFNarioRSlip | ImgFNarioRStand | ImgFNarioRWalk1 | ImgFNarioRWalk2 | ImgFNarioRWalk3 | ImgFont | ImgGrass0 | ImgGrass1 | ImgGrass2 | ImgKinoko| ImgKuri0 | ImgKuri1 | ImgKuriDead | ImgMt02 | ImgMt11 | ImgMt12 | ImgMt13 | ImgMt22 | ImgNarioDead | ImgNarioLJump | ImgNarioLSlip | ImgNarioLStand | ImgNarioLWalk1 | ImgNarioLWalk2 | ImgNarioLWalk3 | ImgNarioRJump | ImgNarioRSlip | ImgNarioRStand | ImgNarioRWalk1 | ImgNarioRWalk2 | ImgNarioRWalk3 | ImgNoko0 | ImgNoko1 | ImgPole0 | ImgPole1 | ImgSNarioLJump | ImgSNarioLSit | ImgSNarioLSlip | ImgSNarioLStand | ImgSNarioLWalk1 | ImgSNarioLWalk2 | ImgSNarioLWalk3 | ImgSNarioRJump | ImgSNarioRSit | ImgSNarioRSlip | ImgSNarioRStand | ImgSNarioRWalk1 | ImgSNarioRWalk2 | ImgSNarioRWalk3 | ImgTitle deriving (Eq)4 imageTypes = [Img100, Img1000, Img200, Img 500, ImgBlock1, ImgBlock2, ImgBlock3, ImgBlock4, ImgBlock5, ImgBroken, ImgCloud00, ImgCloud01, ImgCloud02, ImgCloud10, ImgCloud11, ImgCloud12, ImgCoin0, ImgCoin1, ImgCoin2, ImgCoin3, ImgDk00, ImgDk01, ImgDk10, ImgDk11, ImgFlag, ImgFlower, ImgFNarioLJump, ImgFNarioLShot, ImgFNarioLSit, ImgFNarioLSlip, ImgFNarioLStand, ImgFNarioLWalk1, ImgFNarioLWalk2, ImgFNarioLWalk3, ImgFNarioRJump, ImgFNarioRShot, ImgFNarioRSit, ImgFNarioRSlip, ImgFNarioRStand, ImgFNarioRWalk1, ImgFNarioRWalk2, ImgFNarioRWalk3, ImgFont, ImgGrass0, ImgGrass1, ImgGrass2, ImgKinoko, ImgKuri0, ImgKuri1, ImgKuriDead, ImgMt02, ImgMt11, ImgMt12, ImgMt13, ImgMt22, ImgNarioDead, ImgNarioLJump, ImgNarioLSlip, ImgNarioLStand, ImgNarioLWalk1, ImgNarioLWalk2, ImgNarioLWalk3, ImgNarioRJump, ImgNarioRSlip, ImgNarioRStand, ImgNarioRWalk1, ImgNarioRWalk2, ImgNarioRWalk3, ImgNoko0, ImgNoko1, ImgPole0, ImgPole1, ImgSNarioLJump, ImgSNarioLSit, ImgSNarioLSlip, ImgSNarioLStand, ImgSNarioLWalk1, ImgSNarioLWalk2, ImgSNarioLWalk3, ImgSNarioRJump, ImgSNarioRSit, ImgSNarioRSlip, ImgSNarioRStand, ImgSNarioRWalk1, ImgSNarioRWalk2, ImgSNarioRWalk3, ImgTitle]5 imageFilenames = ["100.bmp", "1000.bmp", "200.bmp", " 500.bmp", "block1.bmp", "block2.bmp", "block3.bmp", "block4.bmp", "block5.bmp", "broken.bmp", "cloud00.bmp", "cloud01.bmp", "cloud02.bmp", "cloud10.bmp", "cloud11.bmp", "cloud12.bmp", "coin0.bmp", "coin1.bmp", "coin2.bmp", "coin3.bmp", "dk00.bmp", "dk01.bmp", "dk10.bmp", "dk11.bmp", "flag.bmp", "flower.bmp", "fNarioLJump.bmp", "fNarioLShot.bmp", "fNarioLSit.bmp", "fNarioLSlip.bmp", "fNarioLStand.bmp", "fNarioLWalk1.bmp", "fNarioLWalk2.bmp", "fNarioLWalk3.bmp", "fNarioRJump.bmp", "fNarioRShot.bmp", "fNarioRSit.bmp", "fNarioRSlip.bmp", "fNarioRStand.bmp", "fNarioRWalk1.bmp", "fNarioRWalk2.bmp", "fNarioRWalk3.bmp", "font.bmp", "grass0.bmp", "grass1.bmp", "grass2.bmp", "kinoko.bmp", "kuri0.bmp", "kuri1.bmp", "kuriDead.bmp", "mt02.bmp", "mt11.bmp", "mt12.bmp", "mt13.bmp", "mt22.bmp", "narioDead.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", "noko0.bmp", "noko1.bmp", "pole0.bmp", "pole1.bmp", "sNarioLJump.bmp", "sNarioLSit.bmp", "sNarioLSlip.bmp", "sNarioLStand.bmp", "sNarioLWalk1.bmp", "sNarioLWalk2.bmp", "sNarioLWalk3.bmp", "sNarioRJump.bmp", "sNarioRSit.bmp", "sNarioRSlip.bmp", "sNarioRStand.bmp", "sNarioRWalk1.bmp", "sNarioRWalk2.bmp", "sNarioRWalk3.bmp", "title.bmp"]3 data ImageType = Img100 | Img1000 | Img200 | Img400 | Img500 | ImgBlock1 | ImgBlock2 | ImgBlock3 | ImgBlock4 | ImgBlock5 | ImgBroken | ImgCloud00 | ImgCloud01 | ImgCloud02 | ImgCloud10 | ImgCloud11 | ImgCloud12 | ImgCoin0 | ImgCoin1 | ImgCoin2 | ImgCoin3 | ImgDk00 | ImgDk01 | ImgDk10 | ImgDk11 | ImgFlag | ImgFlower | ImgFNarioLJump | ImgFNarioLShot | ImgFNarioLSit | ImgFNarioLSlip | ImgFNarioLStand | ImgFNarioLWalk1 | ImgFNarioLWalk2 | ImgFNarioLWalk3 | ImgFNarioRJump | ImgFNarioRShot | ImgFNarioRSit | ImgFNarioRSlip | ImgFNarioRStand | ImgFNarioRWalk1 | ImgFNarioRWalk2 | ImgFNarioRWalk3 | ImgFont | ImgGrass0 | ImgGrass1 | ImgGrass2 | ImgKinoko | ImgKoura | ImgKoura2 | ImgKuri0 | ImgKuri1 | ImgKuriDead | ImgMt02 | ImgMt11 | ImgMt12 | ImgMt13 | ImgMt22 | ImgNarioDead | ImgNarioLJump | ImgNarioLSlip | ImgNarioLStand | ImgNarioLWalk1 | ImgNarioLWalk2 | ImgNarioLWalk3 | ImgNarioRJump | ImgNarioRSlip | ImgNarioRStand | ImgNarioRWalk1 | ImgNarioRWalk2 | ImgNarioRWalk3 | ImgNoko0 | ImgNoko1 | ImgPole0 | ImgPole1 | ImgSNarioLJump | ImgSNarioLSit | ImgSNarioLSlip | ImgSNarioLStand | ImgSNarioLWalk1 | ImgSNarioLWalk2 | ImgSNarioLWalk3 | ImgSNarioRJump | ImgSNarioRSit | ImgSNarioRSlip | ImgSNarioRStand | ImgSNarioRWalk1 | ImgSNarioRWalk2 | ImgSNarioRWalk3 | ImgTitle deriving (Eq) 4 imageTypes = [Img100, Img1000, Img200, Img400, Img500, ImgBlock1, ImgBlock2, ImgBlock3, ImgBlock4, ImgBlock5, ImgBroken, ImgCloud00, ImgCloud01, ImgCloud02, ImgCloud10, ImgCloud11, ImgCloud12, ImgCoin0, ImgCoin1, ImgCoin2, ImgCoin3, ImgDk00, ImgDk01, ImgDk10, ImgDk11, ImgFlag, ImgFlower, ImgFNarioLJump, ImgFNarioLShot, ImgFNarioLSit, ImgFNarioLSlip, ImgFNarioLStand, ImgFNarioLWalk1, ImgFNarioLWalk2, ImgFNarioLWalk3, ImgFNarioRJump, ImgFNarioRShot, ImgFNarioRSit, ImgFNarioRSlip, ImgFNarioRStand, ImgFNarioRWalk1, ImgFNarioRWalk2, ImgFNarioRWalk3, ImgFont, ImgGrass0, ImgGrass1, ImgGrass2, ImgKinoko, ImgKoura, ImgKoura2, ImgKuri0, ImgKuri1, ImgKuriDead, ImgMt02, ImgMt11, ImgMt12, ImgMt13, ImgMt22, ImgNarioDead, ImgNarioLJump, ImgNarioLSlip, ImgNarioLStand, ImgNarioLWalk1, ImgNarioLWalk2, ImgNarioLWalk3, ImgNarioRJump, ImgNarioRSlip, ImgNarioRStand, ImgNarioRWalk1, ImgNarioRWalk2, ImgNarioRWalk3, ImgNoko0, ImgNoko1, ImgPole0, ImgPole1, ImgSNarioLJump, ImgSNarioLSit, ImgSNarioLSlip, ImgSNarioLStand, ImgSNarioLWalk1, ImgSNarioLWalk2, ImgSNarioLWalk3, ImgSNarioRJump, ImgSNarioRSit, ImgSNarioRSlip, ImgSNarioRStand, ImgSNarioRWalk1, ImgSNarioRWalk2, ImgSNarioRWalk3, ImgTitle] 5 imageFilenames = ["100.bmp", "1000.bmp", "200.bmp", "400.bmp", "500.bmp", "block1.bmp", "block2.bmp", "block3.bmp", "block4.bmp", "block5.bmp", "broken.bmp", "cloud00.bmp", "cloud01.bmp", "cloud02.bmp", "cloud10.bmp", "cloud11.bmp", "cloud12.bmp", "coin0.bmp", "coin1.bmp", "coin2.bmp", "coin3.bmp", "dk00.bmp", "dk01.bmp", "dk10.bmp", "dk11.bmp", "flag.bmp", "flower.bmp", "fNarioLJump.bmp", "fNarioLShot.bmp", "fNarioLSit.bmp", "fNarioLSlip.bmp", "fNarioLStand.bmp", "fNarioLWalk1.bmp", "fNarioLWalk2.bmp", "fNarioLWalk3.bmp", "fNarioRJump.bmp", "fNarioRShot.bmp", "fNarioRSit.bmp", "fNarioRSlip.bmp", "fNarioRStand.bmp", "fNarioRWalk1.bmp", "fNarioRWalk2.bmp", "fNarioRWalk3.bmp", "font.bmp", "grass0.bmp", "grass1.bmp", "grass2.bmp", "kinoko.bmp", "koura.bmp", "koura2.bmp", "kuri0.bmp", "kuri1.bmp", "kuriDead.bmp", "mt02.bmp", "mt11.bmp", "mt12.bmp", "mt13.bmp", "mt22.bmp", "narioDead.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", "noko0.bmp", "noko1.bmp", "pole0.bmp", "pole1.bmp", "sNarioLJump.bmp", "sNarioLSit.bmp", "sNarioLSlip.bmp", "sNarioLStand.bmp", "sNarioLWalk1.bmp", "sNarioLWalk2.bmp", "sNarioLWalk3.bmp", "sNarioRJump.bmp", "sNarioRSit.bmp", "sNarioRSlip.bmp", "sNarioRStand.bmp", "sNarioRWalk1.bmp", "sNarioRWalk2.bmp", "sNarioRWalk3.bmp", "title.bmp"] 6 6 imageFn = fromJust . flip lookup (zip imageTypes imageFilenames) -
lang/haskell/nario/Main.hs
r20775 r20811 34 34 35 35 36 pointBreakBlock = 5037 pointGetCoin = 20038 39 40 36 -- エントリ 41 37 main :: IO () … … 130 126 cols = map (!! cx) fld 131 127 event cy c 132 | c `elem` "kn" = Just $ EvA ppearEnemy cx cyc128 | c `elem` "kn" = Just $ EvAddActor $ genActor c 133 129 | otherwise = Nothing 130 where 131 genActor c = case c of 132 'k' -> ActorWrapper $ newKuribo cx cy 133 'n' -> ActorWrapper $ newNokonoko cx cy 134 134 135 135 136 136 137 -- 当たり判定 137 hitcheck :: Player -> [ActorWrapper] -> (Player, [ActorWrapper] )138 hitcheck player actors = foldl proc (player, [] ) actors139 where 140 proc (pl, ac ) (ActorWrapper a) = case getHitRect a of138 hitcheck :: Player -> [ActorWrapper] -> (Player, [ActorWrapper], [Event]) 139 hitcheck player actors = foldl proc (player, [], []) actors 140 where 141 proc (pl, ac, ev) (ActorWrapper a) = case getHitRect a of 141 142 Nothing -> nothingHappened 142 143 Just rc -> 143 144 if not $ ishit plrc rc 144 145 then nothingHappened 145 else (pl', ac' )146 where 147 nothingHappened = (pl, ac ++ [ActorWrapper a] )146 else (pl', ac', ev') 147 where 148 nothingHappened = (pl, ac ++ [ActorWrapper a], ev) 148 149 plrc = getPlayerHitRect player 149 (pl', a' ) = onHit pl a150 (pl', a', evtmp) = onHit pl a 150 151 ac' = case a' of 151 152 Just a'' -> ac ++ [a''] 152 153 Nothing -> ac 153 154 ev' = ev ++ evtmp 155 156 157 timeBase = 22 154 158 155 159 -- ゲーム … … 161 165 where 162 166 (scr', gs') = updateProc (keyProc bef ks) gs 163 isPlayerDead = getPlayerY Pos (pl gs') >= screenHeight + chrSize * 2167 isPlayerDead = getPlayerY (pl gs') >= (screenHeight + chrSize * 2) * one 164 168 timeOver = time gs' <= 0 165 169 … … 172 176 updateProc kp gs = (renderProc gs', gs') 173 177 where 174 time' = max 0 (time gs - one `div` 25)178 time' = max 0 (time gs - 1) 175 179 (fld', screv') = scrollEvent (fld gs) $ getScrollPos (pl gs) `div` chrSize + 18 176 180 … … 180 184 ev' = concatMap snd actors_updates 181 185 182 (pl'', actors'' ) = hitcheck pl' actors'186 (pl'', actors'', ev'') = hitcheck pl' actors' 183 187 184 188 gstmp = gs { pl = pl'', fld = fld', actors = actors'', time = time' } 185 gs' = procEvent gstmp (plev ++ ev' ++ screv' )186 187 initialState = GameGame { pl = newPlayer, fld = fldmap, actors = [], time = 400 * one }189 gs' = procEvent gstmp (plev ++ ev' ++ screv' ++ ev'') 190 191 initialState = GameGame { pl = newPlayer, fld = fldmap, actors = [], time = 400 * timeBase } 188 192 189 193 -- ゲームオーバー … … 221 225 222 226 proc gs (EvSetField cx cy c) = gs { fld = fieldSet (fld gs) cx cy c } 223 proc gs (EvAppearEnemy cx cy c) = gs { actors = actors gs ++ [ene] } 224 where 225 ene = case c of 226 'k' -> ActorWrapper $ newKuribo cx cy 227 'n' -> ActorWrapper $ newNokonoko cx cy 228 proc gs (EvScoreAddEfe sx sy imgtype) = gs { actors = actors gs ++ [ActorWrapper $ newScoreAdd sx sy imgtype] } 227 proc gs (EvAddActor act) = gs { actors = actors gs ++ [act] } 228 proc gs (EvScoreAddEfe sx sy pnt) = gs { actors = actors gs ++ [ActorWrapper $ newScoreAdd sx sy pnt] } 229 229 230 230 -- 描画 … … 255 255 puts 19 2 "1-1" 256 256 puts 25 1 "TIME" 257 puts 26 2 $ deciWide 3 ' ' ((time gs + one-1) `div` one)257 puts 26 2 $ deciWide 3 '0' ((time gs + timeBase-1) `div` timeBase) 258 258 259 259 where … … 264 264 renderTitle imgres sur = do 265 265 blitSurface (getImageSurface imgres ImgTitle) Nothing sur (pt (5*8) (3*8)) 266 puts 13 14 "@1985 NINTENDO"266 -- puts 13 14 "@1985 NINTENDO" 267 267 puts 9 17 "> 1 PLAYER GAME" 268 268 -- puts 9 19 " 2 PLAYER GAME" -
lang/haskell/nario/Player.hs
r20775 r20811 10 10 addScore, 11 11 getScrollPos, 12 getPlayerYPos, 12 getPlayerX, 13 getPlayerY, 13 14 getPlayerVY, 14 15 getPlayerHitRect, … … 32 33 33 34 34 walkVx = one * 3 `div` 2 35 runVx = one * 3 36 maxVy = one * 6 37 acc = one `div` 6 38 jumpVy = -13 * gravity 39 scrollMinX = 5 * chrSize 35 walkVx = one * 4 `div` 2 36 runVx = one * 11 `div` 4 37 maxVy = one * 5 38 acc = one `div` 32 39 acc2 = one `div` 14 40 jumpVy = -12 * gravity 41 jumpVy2 = -13 * gravity 42 scrollMinX = 5 * chrSize + 6 40 43 scrollMaxX = 8 * chrSize 41 gravity2 = one `div` 4-- Aを長押ししたときの重力44 gravity2 = one `div` 6 -- Aを長押し
![(please configure the [header_logo] section in trac.ini)](/share/chrome/site/your_project_logo.png)