Changeset 19996 for lang/haskell

Show
Ignore:
Timestamp:
09/27/08 07:28:08 (2 months ago)
Author:
mokehehe
Message:

モジュール名とファイル名が合うように大文字小文字を修正

Location:
lang/haskell/nario
Files:
4 added
3 moved

Legend:

Unmodified
Added
Removed

  • lang/haskell/nario/Main.lhs

    r19989 r19996  
    1111import SDLUtil 
    1212import Util 
     13import Player 
    1314 
    1415----------------------------------- 
    … …  
    2021wndSize  = sz 256 240 
    2122 
    22  
    23 -- �摜 
    24 data ImageType = 
    25                 ImgNario00 | ImgNario01 | ImgNario02 | ImgNario03 | ImgNario04 
    26         |       ImgNario10 | ImgNario11 | ImgNario12 | ImgNario13 | ImgNario14 
    27         |       ImgBlock1 | ImgBlock2 | ImgBlock3 | ImgBlock4 | ImgBlock5 
    28         deriving Eq 
    29  
    30 imageFn ImgNario00 = "nario00.bmp" 
    31 imageFn ImgNario01 = "nario01.bmp" 
    32 imageFn ImgNario02 = "nario02.bmp" 
    33 imageFn ImgNario03 = "nario03.bmp" 
    34 imageFn ImgNario04 = "nario04.bmp" 
    35 imageFn ImgNario10 = "nario10.bmp" 
    36 imageFn ImgNario11 = "nario11.bmp" 
    37 imageFn ImgNario12 = "nario12.bmp" 
    38 imageFn ImgNario13 = "nario13.bmp" 
    39 imageFn ImgNario14 = "nario14.bmp" 
    40 imageFn ImgBlock1 = "block1.bmp" 
    41 imageFn ImgBlock2 = "block2.bmp" 
    42 imageFn ImgBlock3 = "block3.bmp" 
    43 imageFn ImgBlock4 = "block4.bmp" 
    44 imageFn ImgBlock5 = "block5.bmp" 
    45  
    46 images = [ 
    47         ImgNario00, ImgNario01, ImgNario02, ImgNario03, ImgNario04, 
    48         ImgNario10, ImgNario11, ImgNario12, ImgNario13, ImgNario14, 
    49         ImgBlock1, ImgBlock2, ImgBlock3, ImgBlock4, ImgBlock5 
    50         ] 
     23-- �w�i�F 
     24backColor = 0x2891ff            -- �� 
    5125 
    5226 
    5327 
    54 type ImageResource = [(ImageType, Surface)] 
    5528 
    5629 
    5730 
     31-- �}�b�v 
    5832 
    5933fieldMap = [ 
    … …  
    9266 
    9367 
    94 data Player = Player { 
    95         x :: Int, 
    96         y :: Int, 
    97         lr :: Int 
    98         } 
    9968 
    100 one = 256 
    101  
    102 newPlayer = Player { 
    103         x = 1 * 16 * one, 
    104         y = 12 * 16 * one, 
    105         lr = 1 
    106         } 
    107  
    108 updatePlayer :: Player -> KeyProc -> Player 
    109 updatePlayer player kp = 
    110         player { x = x', y = y', lr = lr' } 
    111         where 
    112                 x' 
    113                         | isPressed (kp GKLeft)         = (x player) - 1 * one 
    114                         | isPressed (kp GKRight)        = (x player) + 1 * one 
    115                         | otherwise                                     = x player 
    116                 y' 
    117                         | isPressed (kp GKUp)           = (y player) - 1 * one 
    118                         | isPressed (kp GKDown)         = (y player) + 1 * one 
    119                         | otherwise                                     = y player 
    120                 lr' 
    121                         | isPressed (kp GKLeft)         = 0 
    122                         | isPressed (kp GKRight)        = 1 
    123                         | otherwise                                     = lr player 
    124  
    125 renderPlayer sur player imgres = 
    126         blitSurface (getImageSurface imgres chr) Nothing sur pos 
    127         where 
    128                 pos = pt ((x player) `div` one) ((y player) `div` one) 
    129                 chr = if (lr player) == 0 
    130                                 then ImgNario00 
    131                                 else ImgNario10 
    132  
    133  
    134 -- �摜���\�[�X�ǂݍ��� 
    135 loadImageResource :: IO ImageResource 
    136 loadImageResource = mapM load images 
    137         where 
    138                 load imgtype = do 
    139                         sur <- loadBMP $ ("img/" ++) $ imageFn imgtype 
    140 --                      colorKey <- mapRGB (surfacePixelFormat sur) $ Color r g b a 
    141                         setColorKey sur [SRCCOLORKEY] 0 
    142                         return (imgtype, sur) 
    143                 r = 0 
    144                 g = 0 
    145                 b = 0 
    146                 a = 255 
    147  
    148  
    149 getImageSurface :: ImageResource -> ImageType -> Surface 
    150 getImageSurface imgres t = fromJust $ lookup t imgres 
    15169 
    15270-- ���C�����[�v 
    … …  
    17189 
    17290checkEvent = do 
    173   ev <- pollEvent 
    174   case ev of 
    175     Just QuitEvent -> return True 
    176     Just (KeyboardEvent { kbPress = True, kbKeysym = Keysym { ksSym = ks, ksMod = km } }) 
    177       | ks == SDLK_ESCAPE -> return True 
    178       | ks == SDLK_F4 && (KMOD_LALT `elem` km || 
    179                           KMOD_RALT `elem` km) -> return True 
    180     Nothing        -> return False 
    181     _              -> checkEvent 
     91        ev <- pollEvent 
     92        case ev of 
     93                Just QuitEvent -> return True 
     94                Just (KeyboardEvent { kbPress = True, kbKeysym = Keysym { ksSym = ks, ksMod = km } }) 
     95                        | ks == SDLK_ESCAPE -> return True 
     96                        | ks == SDLK_F4 && (KMOD_LALT `elem` km || 
     97                                                                KMOD_RALT `elem` km) -> return True 
     98                Nothing        -> return False 
     99                _              -> checkEvent 
    182100 
    183101 
    … …  
    209127 
    210128 
    211 {- 
    212   wav <- loadWAV "snd/jump.wav" 
    213  
    214 playAudioData ad = do 
    215         case audioSpec ad of 
    216                 Just spec -> do 
    217                         let freq = asFreq spec 
    218                         let format = asFormat spec 
    219                         let channel = asChannels spec 
    220                         let samples = asSamples spec 
    221                         print (unlines [show freq, show format, show channel, show samples]) 
    222                         openAudio freq format channel samples cb 
    223                         return () 
    224                 Nothing -> do 
    225                         print "audioSpec error" 
    226                         return () 
    227         where 
    228                 cb x = return [ad] 
    229 -} 
    230  
    231  
    232 backColor = 0x2891ff 
    233  
    234  
    235129-- �`�揈�� 
    236130onDraw :: Surface -> ImageResource -> GameState -> IO () 

  • lang/haskell/nario/Util.lhs

    r19989 r19996  
    66import Multimedia.SDL 
    77 
     8import Const 
     9 
    810-- �L�[�{�[�h���� 
    911 
    10 data GameKey = 
    11         GKUp | GKDown | GKLeft | GKRight | GKRotate 
    12         deriving (Eq,Show,Enum) 
     12data PadBtn = 
     13        PadU | PadD | PadL | PadR | PadA | PadB 
     14        deriving (Eq, Show, Enum) 
    1315 
    1416data KeyState = 
    1517        Pushed | Pushing | Released | Releasing 
    16         deriving (Eq,Show) 
     18        deriving (Eq, Show) 
    1719 
    1820isPressed Pushed  = True 
    … …  
    2022isPressed _       = False 
    2123 
    22 type KeyProc = GameKey -> KeyState 
     24type KeyProc = PadBtn -> KeyState 
    2325 
    2426keyProc bef cur gk 
    … …  
    2830        | bp     && cp     = Pushing 
    2931        where 
    30                 bp = (mapPhyKey gk) `elem` bef 
    31                 cp = (mapPhyKey gk) `elem` cur 
     32                bp = any (flip elem bef) phykeys 
     33                cp = any (flip elem cur) phykeys 
     34                phykeys = mapPhyKey gk 
    3235 
    33 mapPhyKey GKUp     = SDLK_UP 
    34 mapPhyKey GKDown   = SDLK_DOWN 
    35 mapPhyKey GKLeft   = SDLK_LEFT 
    36 mapPhyKey GKRight  = SDLK_RIGHT 
    37 mapPhyKey GKRotate = SDLK_z 
     36mapPhyKey PadU = [SDLK_UP, SDLK_i] 
     37mapPhyKey PadD = [SDLK_DOWN, SDLK_k] 
     38mapPhyKey PadL = [SDLK_LEFT, SDLK_j] 
     39mapPhyKey PadR = [SDLK_RIGHT, SDLK_l] 
     40mapPhyKey PadA = [SDLK_SPACE] 
     41mapPhyKey PadB = [SDLK_LSHIFT, SDLK_RSHIFT] 
    3842 
    3943-- ���Ԓ��� 
    … …  
    6266    toPsec dt = toInteger (tdMin dt * 60 + tdSec dt) * picosec + tdPicosec dt 
    6367    picosec = 1000000000000 
     68 
     69 
     70 
     71-- �摜���\�[�X 
     72type ImageResource = [(ImageType, Surface)] 
     73 
     74 
     75-- �摜���\�[�X�ǂݍ��� 
     76loadImageResource :: IO ImageResource 
     77loadImageResource = mapM load images 
     78        where 
     79                load imgtype = do 
     80                        sur <- loadBMP $ ("img/" ++) $ imageFn imgtype 
     81--                      colorKey <- mapRGB (surfacePixelFormat sur) $ Color r g b a 
     82                        setColorKey sur [SRCCOLORKEY] 0 
     83                        return (imgtype, sur) 
     84                r = 0 
     85                g = 0 
     86                b = 0 
     87                a = 255 
     88 
     89 
     90getImageSurface :: ImageResource -> ImageType -> Surface 
     91getImageSurface imgres t = fromJust $ lookup t imgres