Show
Ignore:
Timestamp:
10/01/08 22:17:57 (3 months ago)
Author:
mokehehe
Message:

画像定義ファイルを自動に作成するように

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • lang/haskell/nario/Util.hs

    r20243 r20397  
    11module Util where 
    2  
    3 import System.Time (getClockTime, diffClockTimes, noTimeDiff, tdMin, tdSec, tdPicosec) 
    4 import Control.Concurrent (threadDelay) 
    5 import Data.Maybe (fromJust) 
    6 import Multimedia.SDL 
    7  
    8 import Const 
    92 
    103 
    … …  
    3427        | x < -d        = x + d 
    3528        | otherwise     = 0 
    36  
    37  
    38  
    39 -- キーボード処理 
    40  
    41 data PadBtn = 
    42         PadU | PadD | PadL | PadR | PadA | PadB 
    43         deriving (Eq, Show, Enum) 
    44  
    45 data KeyState = 
    46         Pushed | Pushing | Released | Releasing 
    47         deriving (Eq, Show) 
    48  
    49 isPressed Pushed  = True 
    50 isPressed Pushing = True 
    51 isPressed _       = False 
    52  
    53 type KeyProc = PadBtn -> KeyState 
    54  
    55 keyProc bef cur gk 
    56         | not bp && not cp = Releasing 
    57         | not bp && cp     = Pushed 
    58         | bp     && not cp = Released 
    59         | bp     && cp     = Pushing 
    60         where 
    61                 bp = any (flip elem bef) phykeys 
    62                 cp = any (flip elem cur) phykeys 
    63                 phykeys = mapPhyKey gk 
    64  
    65 mapPhyKey PadU = [SDLK_UP, SDLK_i] 
    66 mapPhyKey PadD = [SDLK_DOWN, SDLK_k] 
    67 mapPhyKey PadL = [SDLK_LEFT, SDLK_j] 
    68 mapPhyKey PadR = [SDLK_RIGHT, SDLK_l] 
    69 mapPhyKey PadA = [SDLK_SPACE, SDLK_z] 
    70 mapPhyKey PadB = [SDLK_LSHIFT, SDLK_RSHIFT] 
    71  
    72  
    73  
    74 -- 画像リソース 
    75 type ImageResource = [(ImageType, Surface)] 
    76  
    77  
    78 -- 画像リソース読み込み 
    79 loadImageResource :: [ImageType] -> IO ImageResource 
    80 loadImageResource = mapM load 
    81         where 
    82                 load imgtype = do 
    83                         sur <- loadBMP $ ("data/img/" ++) $ imageFn imgtype 
    84                         setNuki sur 
    85                         converted <- displayFormat sur 
    86                         freeSurface sur 
    87                         return (imgtype, converted) 
    88  
    89                 setNuki sur = do 
    90                         let fmt = surfacePixelFormat sur 
    91                         if not $ null $ pfPalette fmt 
    92                                 then setColorKey sur [SRCCOLORKEY] 0 >> return ()       -- パレット０番目をぬき色に 
    93                                 else return () 
    94  
    95 releaseImageResource :: ImageResource -> IO () 
    96 releaseImageResource = mapM_ (\(t, sur) -> freeSurface sur) 
    97  
    98 getImageSurface :: ImageResource -> ImageType -> Surface 
    99 getImageSurface imgres t = fromJust $ lookup t imgres 
    100  
    101  
    102 -- 固定座標系からセル座標系に 
    103 cellCrd :: Int -> Int 
    104 cellCrd x = x `div` (chrSize * one)