Changeset 20025 for lang/haskell

Show
Ignore:
Timestamp:
09/27/08 13:12:58 (2 months ago)
Author:
mokehehe
Message:

画面をスクロールさせる

Location:
lang/haskell/nario
Files:
6 modified

Legend:

Unmodified
Added
Removed

  • lang/haskell/nario/Const.hs

    r20004 r20025  
    1313-- 画像 
    1414data ImageType = 
    15                 ImgNario00 | ImgNario01 | ImgNario02 | ImgNario03 | ImgNario04 
    16         |       ImgNario10 | ImgNario11 | ImgNario12 | ImgNario13 | ImgNario14 
    17         |       ImgBlock1 | ImgBlock2 | ImgBlock3 | ImgBlock4 | ImgBlock5 
     15          ImgNario00 | ImgNario01 | ImgNario02 | ImgNario03 | ImgNario04 
     16        | ImgNario10 | ImgNario11 | ImgNario12 | ImgNario13 | ImgNario14 
     17        | ImgBlock1 | ImgBlock2 | ImgBlock3 | ImgBlock4 | ImgBlock5 
     18        | ImgMt02 | ImgMt11 | ImgMt12 | ImgMt13 | ImgMt22 
     19        | ImgCloud00 | ImgCloud01 | ImgCloud02 | ImgCloud10 | ImgCloud11 | ImgCloud12 
     20        | ImgDk00 | ImgDk01 | ImgDk10 | ImgDk11 
     21        | ImgGrass00 | ImgGrass01 | ImgGrass02 
    1822        deriving Eq 
    1923 
    … …  
    3438imageFn ImgBlock4 = "block4.bmp" 
    3539imageFn ImgBlock5 = "block5.bmp" 
     40imageFn ImgMt02 = "mt02.bmp" 
     41imageFn ImgMt11 = "mt11.bmp" 
     42imageFn ImgMt12 = "mt12.bmp" 
     43imageFn ImgMt13 = "mt13.bmp" 
     44imageFn ImgMt22 = "mt22.bmp" 
     45imageFn ImgCloud00 = "cloud00.bmp" 
     46imageFn ImgCloud01 = "cloud01.bmp" 
     47imageFn ImgCloud02 = "cloud02.bmp" 
     48imageFn ImgCloud10 = "cloud10.bmp" 
     49imageFn ImgCloud11 = "cloud11.bmp" 
     50imageFn ImgCloud12 = "cloud12.bmp" 
     51imageFn ImgDk00 = "dk00.bmp" 
     52imageFn ImgDk01 = "dk01.bmp" 
     53imageFn ImgDk10 = "dk10.bmp" 
     54imageFn ImgDk11 = "dk11.bmp" 
     55imageFn ImgGrass00 = "grass00.bmp" 
     56imageFn ImgGrass01 = "grass01.bmp" 
     57imageFn ImgGrass02 = "grass02.bmp" 
    3658 
    3759images = [ 
    3860        ImgNario00, ImgNario01, ImgNario02, ImgNario03, ImgNario04, 
    3961        ImgNario10, ImgNario11, ImgNario12, ImgNario13, ImgNario14, 
    40         ImgBlock1, ImgBlock2, ImgBlock3, ImgBlock4, ImgBlock5 
     62        ImgBlock1, ImgBlock2, ImgBlock3, ImgBlock4, ImgBlock5, 
     63        ImgMt02, ImgMt11, ImgMt12, ImgMt13, ImgMt22, 
     64        ImgCloud00, ImgCloud01, ImgCloud02, ImgCloud10, ImgCloud11, ImgCloud12, 
     65        ImgDk00, ImgDk01, ImgDk10, ImgDk11, 
     66        ImgGrass00, ImgGrass01, ImgGrass02 
    4167        ] 

  • lang/haskell/nario/Field.hs

    r20004 r20025  
    2121fieldMap :: Field 
    2222fieldMap = [ 
    23         "                ", 
    24         "                ", 
    25         "                ", 
    26         "                ", 
    27         "                ", 
    28         "                ", 
    29         "        O?O     ", 
    30         "                ", 
    31         "                ", 
    32         "       O?O?O    ", 
    33         "                ", 
    34         "                ", 
    35         "                ", 
    36         "@@@@@@@@@@@@@@@@", 
    37         "@@@@@@@@@@@@@@@@" 
     23--       111111111111111122222222222222223333333333333333 
     24        "                                                ", 
     25        "                  123               1223        ", 
     26        "        123       456      12223    4556        ", 
     27        "        456                45556                ", 
     28        "                                                ", 
     29        "                      ?                         ", 
     30        "                                                ", 
     31        "                                                ", 
     32        "                                                ", 
     33        "   _            ?   O?O?O                     []", 
     34        "  /,`                                 []      l|", 
     35        " /,.,`           _          []        l|      l|", 
     36        "/.....`    78889/,`    789  l|        l| 7889 l|", 
     37        "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@", 
     38        "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@" 
    3839        ] 
    3940 
    … …  
    4546chr2img 'O' = ImgBlock2 
    4647chr2img '?' = ImgBlock4 
     48chr2img '_' = ImgMt02 
     49chr2img '/' = ImgMt11 
     50chr2img ',' = ImgMt12 
     51chr2img '`' = ImgMt13 
     52chr2img '.' = ImgMt22 
     53chr2img '1' = ImgCloud00 
     54chr2img '2' = ImgCloud01 
     55chr2img '3' = ImgCloud02 
     56chr2img '4' = ImgCloud10 
     57chr2img '5' = ImgCloud11 
     58chr2img '6' = ImgCloud12 
     59chr2img '7' = ImgGrass00 
     60chr2img '8' = ImgGrass01 
     61chr2img '9' = ImgGrass02 
     62chr2img '[' = ImgDk00 
     63chr2img ']' = ImgDk01 
     64chr2img 'l' = ImgDk10 
     65chr2img '|' = ImgDk11 
    4766 
    4867 
    4968isBlock :: Cell -> Bool 
    50 isBlock c = c `elem` "@O?" 
     69isBlock c = c `elem` "@O?[]l|" 
    5170 
    5271inField :: Field -> Int -> Int -> Bool 
    … …  
    5978 
    6079 
    61 renderField sur imgres = sequence_ $ concatMap lineProc $ zip [0..] fieldMap 
     80renderField sur imgres scrx = sequence_ $ concatMap lineProc $ zip [0..] fieldMap 
    6281        where 
    6382                lineProc (y, ln) = map (cellProc y) $ zip [0..] ln 
    … …  
    6685                                then return () 
    6786                                else do 
    68                                         blitSurface (getImageSurface imgres $ chr2img c) Nothing sur $ pt (x*16) (y*16) 
     87                                        blitSurface (getImageSurface imgres $ chr2img c) Nothing sur $ pt (x*16 - scrx) (y*16) 
    6988                                        return () 
    7089 

  • lang/haskell/nario/Main.hs

    r20004 r20025  
    9797        fillRect sur Nothing backColor 
    9898 
    99         renderField sur imgres 
    100         renderPlayer sur (pl gs) imgres 
     99        let scrx = getScrollPos (pl gs) 
     100 
     101        renderField sur imgres scrx 
     102        renderPlayer sur imgres scrx (pl gs) 
    101103 
    102104        flipSurface sur 

  • lang/haskell/nario/Player.hs

    r20004 r20025  
    66        newPlayer, 
    77        updatePlayer, 
    8         renderPlayer 
     8        renderPlayer, 
     9        getScrollPos 
    910) where 
    1011 
    … …  
    2829        vx :: Int, 
    2930        vy :: Int, 
     31        scrx :: Int, 
    3032        stand :: Bool, 
    3133 
    … …  
    4042        vx = 0, 
    4143        vy = 0, 
     44        scrx = 0, 
    4245        stand = False, 
    4346 
    … …  
    7073                        | ax /= 0       = rangeadd (vx player) ax (-maxspd) maxspd 
    7174                        | otherwise     = friction (vx player) acc 
    72                 x' = (x player) + vx' 
     75                x' = max xmin $ (x player) + vx' 
     76                scrx' 
     77                        | vx' > 0 && (x' - (scrx player)) `div` one > 160       = (scrx player) + vx' 
     78                        | otherwise                                                                                     = (scrx player) 
     79 
    7380                padl = if isPressed (kp PadL) then 1 else 0 
    7481                padr = if isPressed (kp PadR) then 1 else 0 
    … …  
    7683                        | isPressed (kp PadB)   = maxVx * 2 
    7784                        | otherwise                             = maxVx 
     85                xmin = (scrx player) + chrSize `div` 2 * one 
    7886 
    79                 player' = player { x = x', vx = vx' } 
     87                player' = player { x = x', vx = vx', scrx = scrx' } 
    8088 
    8189                lr' = 
    … …  
    145153 
    146154 
    147 renderPlayer sur player imgres = do 
     155getScrollPos :: Player -> Int 
     156getScrollPos player = (scrx player) `div` one 
     157 
     158renderPlayer sur imgres scrx player = do 
    148159        blitSurface (getImageSurface imgres imgtype) Nothing sur pos 
    149160        where 
    150                 pos = pt ((x player) `div` one - chrSize `div` 2) ((y player) `div` one - chrSize) 
     161                pos = pt ((x player) `div` one - chrSize `div` 2 - scrx) ((y player) `div` one - chrSize) 
    151162                imgtype = imgTable !! (lr player) !! (pat player) 

  • lang/haskell/nario/README.txt

    r19999 r20025  
    2020                B�{�^�� 
    2121 
     22        �G�X�P�[�v�L�[ 
     23                �I�� 
     24 

  • lang/haskell/nario/Util.hs

    r20004 r20025  
    100100                        sur <- loadBMP $ ("img/" ++) $ imageFn imgtype 
    101101--                      colorKey <- mapRGB (surfacePixelFormat sur) $ Color r g b a 
    102                         setColorKey sur [SRCCOLORKEY] 0 
     102                        let colorKey = 0xff00ff 
     103                        setColorKey sur [SRCCOLORKEY] colorKey 
    103104                        return (imgtype, sur) 
    104                 r = 0 
     105                r = 255 
    105106                g = 0 
    106                 b = 0 
     107                b = 255 
    107108                a = 255 
    108109