![(please configure the [header_logo] section in trac.ini)](/share/chrome/site/your_project_logo.png){kind=logo}
Changeset 20670
- Timestamp:
- 10/04/08 13:02:36 (3 months ago)
- Location:
- lang/haskell/nario
- Files:
-
- 2 added
- 13 modified
-
Actor.hs (modified) (3 diffs)
-
Actor/AnimBlock.hs (modified) (3 diffs)
-
Actor/Kinoko.hs (added)
-
Actor/Kuribo.hs (modified) (4 diffs)
-
Actor/Nokonoko.hs (added)
-
Const.hs (modified) (2 diffs)
-
Event.hs (modified) (2 diffs)
-
Field.hs (modified) (1 diff)
-
Font.hs (modified) (1 diff)
-
Images.hs (modified) (1 diff)
-
Main.hs (modified) (6 diffs)
-
Makefile (modified) (1 diff)
-
Player.hs (modified) (2 diffs)
-
Util.hs (modified) (1 diff)
-
data/stage0.map (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
lang/haskell/nario/Actor.hs
r20661 r20670 2 2 3 3 module Actor ( 4 Actor 5 ObjWrapper 4 Actor(..), 5 ObjWrapper(..), 6 6 updateActors, 7 7 filterActors, … … 13 13 import Event 14 14 import AppUtil 15 import Field 15 16 16 17 17 18 class Actor a where 18 update :: a -> (a, [Event])19 update :: Field -> a -> (a, [Event]) 19 20 render :: a -> ImageResource -> Int -> Surface -> IO () 20 21 bDead :: a -> Bool 21 22 bDead _ = False 22 23 23 24 -- ============================================================================ … … 26 27 data ObjWrapper = forall a. Actor a => ObjWrapper a -- 存在型aの動く範囲を型クラスに制限 27 28 28 updateActors :: [ObjWrapper] -> [(ObjWrapper, [Event])]29 updateActors = map (\(ObjWrapper x) -> let (x', ev') = updatex in (ObjWrapper x', ev'))29 updateActors :: Field -> [ObjWrapper] -> [(ObjWrapper, [Event])] 30 updateActors fld = map (\(ObjWrapper x) -> let (x', ev') = update fld x in (ObjWrapper x', ev')) 30 31 31 32 filterActors :: [ObjWrapper] -> [ObjWrapper] -
lang/haskell/nario/Actor/AnimBlock.hs
r20661 r20670 7 7 import Multimedia.SDL hiding (Event) 8 8 9 import Actor 9 import Actor (Actor(..)) 10 10 import Const 11 11 import AppUtil … … 27 27 28 28 instance Actor AnimBlock where 29 update self29 update fld self 30 30 | not (bDead self) = (self', ev') 31 31 | otherwise = (self, []) … … 51 51 cc = case c of 52 52 '?' -> '#' 53 'K' -> '#' 53 54 x -> x -
lang/haskell/nario/Actor/Kuribo.hs
r20661 r20670 1 -- クリボー 2 1 3 module Actor.Kuribo ( 2 4 newKuribo … … 5 7 import Multimedia.SDL hiding (Event) 6 8 7 import Actor 9 import Actor (Actor(..)) 8 10 import Const 9 11 import AppUtil 10 12 import Images 11 13 12 13 -- ============================================================================14 -- Kuribo15 -- クリボー16 14 17 15 data Kuribo = Kuribo { … … 24 22 25 23 instance Actor Kuribo where 26 update self = (self { x = x self + vx self, cnt = cnt self + 1 }, [])24 update fld self = (self { x = x self + vx self, cnt = cnt self + 1 }, []) 27 25 28 26 render self imgres scrx sur = do … … 32 30 imgtype = [ImgKuri0, ImgKuri1] !! (cnt self `mod` 16 `div` 8) 33 31 34 bDead self = False35 36 32 newKuribo :: Int -> Int -> Kuribo 37 33 newKuribo cx cy = -
lang/haskell/nario/Const.hs
r20397 r20670 1 1 module Const where 2 3 -- ウィンドウ周り 4 wndTitle = "NARIO in Haskell" 5 screenWidth = 256 :: Int 6 screenHeight = 224 :: Int 7 wndBpp = 32 :: Int 8 9 frameRate = 60 :: Int 2 10 3 11 … … 5 13 one = 256 :: Int 6 14 7 -- 1キャラのサイズ15 -- １キャラのサイズ 8 16 chrSize = 16 :: Int 9 17 10 18 -- 重力 11 19 gravity = one `div` 2 12 gravity2 = one `div` 413 14 {-15 -- 画像16 data ImageType =17 ImgNarioLStand | ImgNarioLWalk1 | ImgNarioLWalk2 | ImgNarioLWalk3 | ImgNarioLJump | ImgNarioLSlip18 | ImgNarioRStand | ImgNarioRWalk1 | ImgNarioRWalk2 | ImgNarioRWalk3 | ImgNarioRJump | ImgNarioRSlip19 | ImgBlock1 | ImgBlock2 | ImgBlock3 | ImgBlock4 | ImgBlock520 | ImgMt02 | ImgMt11 | ImgMt12 | ImgMt13 | ImgMt2221 | ImgCloud00 | ImgCloud01 | ImgCloud02 | ImgCloud10 | ImgCloud11 | ImgCloud1222 | ImgDk00 | ImgDk01 | ImgDk10 | ImgDk1123 | ImgGrass0 | ImgGrass1 | ImgGrass224 | ImgPole0 | ImgPole125 | ImgFont26 | ImgTitle27 deriving Eq28 29 30 imageFn ImgNarioLStand = "narioLStand.bmp"31 imageFn ImgNarioLWalk1 = "narioLWalk1.bmp"32 imageFn ImgNarioLWalk2 = "narioLWalk2.bmp"33 imageFn ImgNarioLWalk3 = "narioLWalk3.bmp"34 imageFn ImgNarioLJump = "narioLJump.bmp"35 imageFn ImgNarioLSlip = "narioLSlip.bmp"36 imageFn ImgNarioRStand = "narioRStand.bmp"37 imageFn ImgNarioRWalk1 = "narioRWalk1.bmp"38 imageFn ImgNarioRWalk2 = "narioRWalk2.bmp"39 imageFn ImgNarioRWalk3 = "narioRWalk3.bmp"40 imageFn ImgNarioRJump = "narioRJump.bmp"41 imageFn ImgNarioRSlip = "narioRSlip.bmp"42 imageFn ImgBlock1 = "block1.bmp"43 imageFn ImgBlock2 = "block2.bmp"44 imageFn ImgBlock3 = "block3.bmp"45 imageFn ImgBlock4 = "block4.bmp"46 imageFn ImgBlock5 = "block5.bmp"47 imageFn ImgMt02 = "mt02.bmp"48 imageFn ImgMt11 = "mt11.bmp"49 imageFn ImgMt12 = "mt12.bmp"50 imageFn ImgMt13 = "mt13.bmp"51 imageFn ImgMt22 = "mt22.bmp"52 imageFn ImgCloud00 = "cloud00.bmp"53 imageFn ImgCloud01 = "cloud01.bmp"54 imageFn ImgCloud02 = "cloud02.bmp"55 imageFn ImgCloud10 = "cloud10.bmp"56 imageFn ImgCloud11 = "cloud11.bmp"57 imageFn ImgCloud12 = "cloud12.bmp"58 imageFn ImgDk00 = "dk00.bmp"59 imageFn ImgDk01 = "dk01.bmp"60 imageFn ImgDk10 = "dk10.bmp"61 imageFn ImgDk11 = "dk11.bmp"62 imageFn ImgGrass0 = "grass0.bmp"63 imageFn ImgGrass1 = "grass1.bmp"64 imageFn ImgGrass2 = "grass2.bmp"65 imageFn ImgPole0 = "pole0.bmp"66 imageFn ImgPole1 = "pole1.bmp"67 imageFn ImgFont = "font.bmp"68 imageFn ImgTitle = "title.bmp"69 70 images = [71 ImgNarioLStand, ImgNarioLWalk1, ImgNarioLWalk2, ImgNarioLWalk3, ImgNarioLJump, ImgNarioLSlip,72 ImgNarioRStand, ImgNarioRWalk1, ImgNarioRWalk2, ImgNarioRWalk3, ImgNarioRJump, ImgNarioRSlip,73 ImgBlock1, ImgBlock2, ImgBlock3, ImgBlock4, ImgBlock5,74 ImgMt02, ImgMt11, ImgMt12, ImgMt13, ImgMt22,75 ImgCloud00, ImgCloud01, ImgCloud02, ImgCloud10, ImgCloud11, ImgCloud12,76 ImgDk00, ImgDk01, ImgDk10, ImgDk11,77 ImgGrass0, ImgGrass1, ImgGrass2,78 ImgPole0, ImgPole1,79 ImgFont,80 ImgTitle81 ]82 -} -
lang/haskell/nario/Event.hs
r20661 r20670 1 2 1 module Event where 3 2 … … 7 6 8 7 data Event = 8 -- ブロックをたたいた 9 9 EvHitBlock ImageType Int Int 10 11 -- フィールドを変更 10 12 | EvSetField Int Int Cell 13 14 -- 敵登場 11 15 | EvAppearEnemy Int Int Cell -
lang/haskell/nario/Field.hs
r20641 r20670 64 64 chr2img '!' = ImgPole1 65 65 66 chr2img 'K' = ImgBlock4 66 67 67 68 68 69 isBlock :: Cell -> Bool 69 isBlock = (`elem` "@OX?#[]l|* ")70 isBlock = (`elem` "@OX?#[]l|*K") 70 71 71 72 hardBlock :: Cell -> Bool -
lang/haskell/nario/Font.hs
r20175 r20670 13 13 fontXN = 16 14 14 15 -- 文字列表示 15 16 fontPut sur imgsur x y str = zipWithM_ (\i c -> fontPutc sur imgsur i y c) [x..] str 16 17 18 -- １文字表示 17 19 fontPutc sur imgsur x y c = do 18 20 blitSurface imgsur (Just rc) sur pos -
lang/haskell/nario/Images.hs
r20661 r20670 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 | ImgK uri0 | 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, ImgK uri0, 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", "k uri0.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"]3 data ImageType = ImgBlock1 | ImgBlock2 | ImgBlock3 | ImgBlock4 | ImgBlock5 | ImgCloud00 | ImgCloud01 | ImgCloud02 | ImgCloud10 | ImgCloud11 | ImgCloud12 | ImgDk00 | ImgDk01 | ImgDk10 | ImgDk11 | ImgFlag | ImgFont | ImgGrass0 | ImgGrass1 | ImgGrass2 | ImgKinoko | ImgKuri0 | ImgKuri1 | ImgMt02 | ImgMt11 | ImgMt12 | ImgMt13 | ImgMt22 | ImgNarioDie | ImgNarioLJump | ImgNarioLSlip | ImgNarioLStand | ImgNarioLWalk1 | ImgNarioLWalk2 | ImgNarioLWalk3 | ImgNarioRJump | ImgNarioRSlip | ImgNarioRStand | ImgNarioRWalk1 | ImgNarioRWalk2 | ImgNarioRWalk3 | ImgNoko0 | ImgPole0 | ImgPole1 | ImgSnarioLJump | ImgSnarioLStand | ImgSnarioLWalk1 | ImgSnarioLWalk2 | ImgSnarioLWalk3 | ImgSnarioRJump | ImgSnarioRStand | ImgSnarioRWalk1 | ImgSnarioRWalk2 | ImgSnarioRWalk3 | 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, ImgKinoko, ImgKuri0, ImgKuri1, ImgMt02, ImgMt11, ImgMt12, ImgMt13, ImgMt22, ImgNarioDie, ImgNarioLJump, ImgNarioLSlip, ImgNarioLStand, ImgNarioLWalk1, ImgNarioLWalk2, ImgNarioLWalk3, ImgNarioRJump, ImgNarioRSlip, ImgNarioRStand, ImgNarioRWalk1, ImgNarioRWalk2, ImgNarioRWalk3, ImgNoko0, ImgPole0, ImgPole1, ImgSnarioLJump, ImgSnarioLStand, ImgSnarioLWalk1, ImgSnarioLWalk2, ImgSnarioLWalk3, ImgSnarioRJump, ImgSnarioRStand, ImgSnarioRWalk1, ImgSnarioRWalk2, ImgSnarioRWalk3, 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", "kinoko.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", "noko0.bmp", "pole0.bmp", "pole1.bmp", "snarioLJump.bmp", "snarioLStand.bmp", "snarioLWalk1.bmp", "snarioLWalk2.bmp", "snarioLWalk3.bmp", "snarioRJump.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
r20661 r20670 1 {-# OPTIONS_GHC -fglasgow-exts #-}2 3 1 -- Nario 4 2 … … 22 20 import Actor.AnimBlock 23 21 import Actor.Kuribo 24 25 wndTitle = "NARIO in Haskell" 26 screenWidth = 256 27 screenHeight = 224 28 wndBpp = 32 29 30 frameRate = 60 22 import Actor.Nokonoko 23 import Actor.Kinoko 31 24 32 25 -- 背景色 … … 129 122 cols = map (!! cx) fld 130 123 event cy c 131 | c `elem` "k " = Just $ EvAppearEnemy cx cy c124 | c `elem` "kn" = Just $ EvAppearEnemy cx cy c 132 125 | otherwise = Nothing 133 126 … … 155 148 156 149 (pl', plev) = updatePlayer kp fld' (pl gs) 157 actors_updates = updateActors ( actors gs)150 actors_updates = updateActors (fld gs) (actors gs) 158 151 actors' = filterActors $ map fst actors_updates 159 152 ev' = concatMap snd actors_updates … … 176 169 where 177 170 c = fieldRef (fld gs) cx cy 178 actors' = actors gs ++ [ObjWrapper $ newAnimBlock cx cy $ fieldRef (fld gs) cx cy] 171 items 172 | c == 'K' = [ObjWrapper $ newKinoko cx cy] 173 | otherwise = [] 174 actors' = actors gs ++ [ObjWrapper $ newAnimBlock cx cy $ fieldRef (fld gs) cx cy] ++ items 179 175 fld' = fieldSet (fld gs) cx cy '*' 180 176 proc gs (EvSetField cx cy c) = gs { fld = fieldSet (fld gs) cx cy c } … … 183 179 ene = case c of 184 180 'k' -> ObjWrapper $ newKuribo cx cy 181 'n' -> ObjWrapper $ newNokonoko cx cy 185 182 186 183 -
lang/haskell/nario/Makefile
r20661 r20670 24 24 imgs: 25 25 runghc -itool tool/listup-imgs.hs data/img > Images.hs 26 27 count: 28 find -name "*.hs" | xargs cat | wc -
lang/haskell/nario/Player.hs
r20420 r20670 1 2 1 -- プレーヤー 3 2 … … 30 29 scrollMinX = 5 * chrSize 31 30 scrollMaxX = 8 * chrSize 31 gravity2 = one `div` 4 -- Aを長押ししたときの重力 32 32 33 33 data Player = Player { -
lang/haskell/nario/Util.hs
r20397 r20670 1 1 module Util where 2 3 2 4 3 -- ユーティリティ関数 -
lang/haskell/nario/data/stage0.map
r20661 r20670 3 3 123 1223 123 1223 123 1223 123 1223 o 123 4 4 123 456 12223 4556 123 456 12223 4556 123 456 12223 4556 123 456 12223 4556 ! 456 5 456 45556 456 45556 5 456 45556 456 45556k k 456 45556 456 45556 ! 6 6 ? OOOOOOOO OOO? ? OOO O??O XX ! 7 7 XXX ! 8 8 XXXX ! 9 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 _ !10 ? OKO?O [] [] OKO O OO ? ? ? O OO X X XX X OO?O XXXXXX ! 11 _ [] l| _ l| k_k XX XX _ XXX XX XXXXXXX _ ! 12 12 /,\ _ [] l| l| /,\ l| _ /,\ _ XXX XXX /,\ XXXX XXX _ [] [] XXXXXXXX /,\ ! OO OO 13 /,.,\ 78889/,\ k 789 l| l| 7889 l|/,.,\ l|78889/,\ 789 /,.,\ 78889/,\ 789 XXXX XXXX/,.,XXXXX XXXX9/,\l| 789l|XXXXXXXXX /,.,\ X OO OO913 /,.,\ 78889/,\ k 789 l| l|k7889 l|/,.,\k k l|78889/,\ 789 /,.,\ n78889/,\k k 789 k k k k XXXX XXXX/,.,XXXXX XXXX9/,\l| 789 k k l|XXXXXXXXX /,.,\ X OO OO9 14 14 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 15 15 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
