packages feed

Eternal10Seconds (empty) → 0.1

raw patch · 43 files changed

+941/−0 lines, 43 filesdep +SDLdep +SDL-mixerdep +basesetup-changedbinary-added

Dependencies added: SDL, SDL-mixer, base, haskell98

Files

+ Eternal.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Eternal where++import Foreign.C+import Data.Word+import Graphics.UI.SDL as SDL+import Graphics.UI.SDL.Mixer as SDLMixer+import Game+import GameState+import Resource+import Input+import Title+import Stage++foreign export ccall "hs_main" hs_main :: IO ()++hs_main :: IO ()+hs_main = do+    -- SDL初期化+    SDL.init [InitEverything]+    SDL.setCaption "Eternal10Seconds" ""+    SDL.setVideoMode screenWidth screenHeight 32 [SDL.SWSurface]+    +    -- SDLMixer初期化+    SDLMixer.openAudio 44100 AudioS16Sys 2 1024+    +    game <- initGame+    timerLoop game+    SDL.quit++-- メインループ+timerLoop :: Game -> IO ()+timerLoop game = do+    time <- adjustFps $ gameTime game+    getInput <- eventLoop $ gameInput game+    (stat, restInput) <- updateGameState (gameState game) getInput+    res <- updateResource (gameResource game) stat+    case stat of+        GamequitState Gamequit -> return ()+        otherwise -> do+        updateScreen stat res+        timerLoop $ Game stat res restInput time++-- ウェイトの挿入+adjustFps :: Word32 -> IO Word32+adjustFps prev = do+    now <- SDL.getTicks+    let elapsed = now - prev+    let rest = (floor $ 1000.0 / 60.0) - (toInteger elapsed)+    if rest > 0 then SDL.delay (fromInteger rest) else return ()+    next <- SDL.getTicks+    return next++-- イベントのポーリング+eventLoop :: Input -> IO Input+eventLoop input = do+    event <- SDL.pollEvent+    if event == SDL.NoEvent then return input else do+	let nextInput = updateInput input event+	eventLoop nextInput+
+ Eternal10Seconds.cabal view
@@ -0,0 +1,103 @@+-- Eternal10Seconds.cabal auto-generated by cabal init. For additional
+-- options, see
+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.
+-- The name of the package.
+Name:                Eternal10Seconds
+
+-- The package version. See the Haskell package versioning policy
+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for
+-- standards guiding when and how versions should be incremented.
+Version:             0.1
+
+-- A short (one-line) description of the package.
+Synopsis:            A 2-D shooting game
+
+-- A longer description of the package.
+Description:         A 2-D shooting game
+
+-- URL for the project homepage or repository.
+Homepage:            http://www.kryozahiro.org/eternal10/
+
+-- The license under which the package is released.
+License:             BSD3
+
+-- The file containing the license text.
+License-file:        LICENSE
+
+-- The package author(s).
+Author:              kryozahiro, gugugu, RE-Ya!
+
+-- An email address to which users can send suggestions, bug reports,
+-- and patches.
+Maintainer:          kryozahiro@gmail.com
+
+-- A copyright notice.
+-- Copyright:           
+
+Category:            Game
+
+Build-type:          Simple
+
+-- Extra files to be distributed with the package, such as examples or
+-- a README.
+Extra-source-files:
+  build.bat
+  c_main.c
+  Eternal_stub.c
+  Eternal_stub.h
+  Game.hs
+  Gameover.hs
+  GameState.hs
+  Input.hs
+  Number.hs
+  Pos.hs
+  Resource.hs
+  Score.hs
+  Stage.hs
+  Title.hs
+
+data-files:
+  score.dat
+  resource/image/bar.bmp
+  resource/image/black.bmp
+  resource/image/bullet.bmp
+  resource/image/bullets.bmp
+  resource/image/cursor.bmp
+  resource/image/enemy50.bmp
+  resource/image/enemy100.bmp
+  resource/image/enemy200.bmp
+  resource/image/extend.bmp
+  resource/image/gameover.bmp
+  resource/image/hiscores.bmp
+  resource/image/number.bmp
+  resource/image/number2.bmp
+  resource/image/player.bmp
+  resource/image/result.bmp
+  resource/image/score.bmp
+  resource/image/sep.bmp
+  resource/image/side.bmp
+  resource/image/stage.bmp
+  resource/image/title.bmp
+  resource/image/title_quit.bmp
+  resource/image/title_score.bmp
+  resource/image/title_start.bmp
+  resource/sound/002_STG_fly_high_oggmst.ogg
+
+-- Constraint on the version of Cabal needed to build this package.
+Cabal-version:       >=1.2
+
+
+Executable Eternal10Seconds
+  -- .hs or .lhs file containing the Main module.
+  Main-is:             Eternal.hs
+  Ghc-options:         -optc-O3 -no-hs-main c_main.c
+  
+  -- Packages needed in order to build this package.
+  Build-depends:       base < 5, haskell98, SDL, SDL-mixer
+  
+  -- Modules not exported by this package.
+  -- Other-modules:       
+  
+  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
+  -- Build-tools:         
+
+ Eternal_stub.c view
@@ -0,0 +1,24 @@+#define IN_STG_CODE 0
+#include "Rts.h"
+#include "Stg.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+ 
+extern StgClosure Eternal_zdfhszumainzua2Xj_closure;
+void hs_main(void)
+{
+Capability *cap;
+HaskellObj ret;
+cap = rts_lock();
+cap=rts_evalIO(cap,rts_apply(cap,(HaskellObj)runIO_closure,&Eternal_zdfhszumainzua2Xj_closure) ,&ret);
+rts_checkSchedStatus("hs_main",cap);
+rts_unlock(cap);
+}
+static void stginit_export_Eternal_zdfhszumainzua2Xj() __attribute__((constructor));
+static void stginit_export_Eternal_zdfhszumainzua2Xj()
+{getStablePtr((StgPtr) &Eternal_zdfhszumainzua2Xj_closure);}
+#ifdef __cplusplus
+}
+#endif
+
+ Eternal_stub.h view
@@ -0,0 +1,9 @@+#include "HsFFI.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern void hs_main(void);
+#ifdef __cplusplus
+}
+#endif
+
+ Game.hs view
@@ -0,0 +1,22 @@+module Game where++import GameState+import Resource+import Input+import Data.Word+import Title++-- ゲームプログラム全体+data Game = Game {+    gameState :: GameState,+    gameResource :: Resource,+    gameInput :: Input,+    gameTime :: Word32+}++-- 初期状態+initGame :: IO Game+initGame = do+    res <- addTitleResource (Resource { imageResource = [], soundResource = []} )+    return $ Game (TitleState initTitle) res emptyInput 0+
+ GameState.hs view
@@ -0,0 +1,95 @@+module GameState where++import Input+import Title+import Stage+import Gameover+import Score+import qualified Graphics.UI.SDL as SDL+import Resource++-- ゲームの状態+data GameState =+	TitleState Title |+    StageState Stage |+    GameoverState Gameover |+	ScoreState Score |+    GamequitState Gamequit++data Gamequit = Gamequit++-- 状態の更新+updateTitle :: Title -> Input -> IO GameState+updateTitle (Title i) input+    | hasKey input SDL.SDLK_DOWN = return $ TitleState $ Title (nextMenu i)+    | hasKey input SDL.SDLK_UP = return $ TitleState $ Title (prevMenu i)+updateTitle (Title 0) input | hasKey input SDL.SDLK_z = return $ StageState initStage+updateTitle (Title 1) input | hasKey input SDL.SDLK_z = return $ ScoreState Score+updateTitle (Title 2) input | hasKey input SDL.SDLK_z = return $ GamequitState Gamequit+updateTitle t _ = return $ TitleState t++updateGameover :: Gameover -> Input -> IO GameState+updateGameover g input | hasKey input SDL.SDLK_z = return $ TitleState initTitle+updateGameover g _ = return $ GameoverState g++updateStage :: Stage -> Input -> IO GameState+updateStage stage input = let+    moved = moveObjects (chargeAmmo stage) input in+	case filterAlive moved of+    (Just s@Stage { stagePlayer = p, stageEnemy = ems, stageBullet = bls, stageTime = t }) -> let+        (newBls, nextPly) = if hasKey input SDL.SDLK_z then createPlayerBullet p else ([], p) in do+        newEnemies <- createEnemies t+        return $ StageState s {+            stagePlayer = nextPly,+            stageEnemy = (newEnemies ++ ems),+            stageBullet = (newBls ++ bls),+            stageTime = (t+1)+        }+    els -> do+        writeScore $ milisec $ stageTime moved+        return $ GameoverState $ Gameover moved++updateScore :: Score -> Input -> IO GameState+updateScore s input | hasKey input SDL.SDLK_z = return $ TitleState $ Title 1+updateScore s _ = return $ ScoreState s++updateGameState :: GameState -> Input -> IO (GameState, Input)+updateGameState stat input | hasKey input SDL.SDLK_ESCAPE =+    return (GamequitState Gamequit, emptyInput)+updateGameState (TitleState t) input = do+    stat <- updateTitle t input+    return (stat, emptyInput)+updateGameState (StageState s) input = do+    stat <- updateStage s input+    return (stat, eraseKey input SDL.SDLK_z)+updateGameState (GameoverState g) input = do+    stat <- updateGameover g input+    return (stat, emptyInput)+updateGameState (ScoreState s) input = do+    stat <- updateScore s input+    return (stat, emptyInput)+updateGameState stat input = return (stat, input)++-- リソースの更新+updateResource :: Resource -> GameState -> IO Resource+updateResource res (TitleState t) = addTitleResource res+updateResource res (StageState s) = addStageResource res+updateResource res (GameoverState g) = addGameoverResource res+updateResource res (ScoreState r) = addScoreResource res+updateResource res _ = return res++-- 描画+updateScreen :: GameState -> Resource -> IO ()+updateScreen game res = do+    screen <- SDL.getVideoSurface+    renderGameState game screen res+    SDL.flip screen+    return ()++renderGameState :: GameState -> SDL.Surface -> Resource -> IO ()+renderGameState (TitleState t) surf res = renderTitle t surf res+renderGameState (StageState s) surf res = renderStage s surf res+renderGameState (GameoverState g) surf res = renderGameover g surf res+renderGameState (ScoreState s) surf res = renderScore s surf res+renderGameState _ _ _ = return ()+
+ Gameover.hs view
@@ -0,0 +1,42 @@+module Gameover where++import Monad+import qualified Graphics.UI.SDL as SDL+import Resource+import Stage+import Number++-- ゲームオーバー画面+data Gameover = Gameover {+    lastState :: Stage+}++gameoverPaint = (("./resource/image/gameover.bmp", Nothing), Just (SDL.Rect 250 200 300 150))+blackPaint = (("./resource/image/black.bmp", Nothing), Nothing)+resultPaint = (("./resource/image/result.bmp", Nothing), Just (SDL.Rect 300 450 200 50))++gameoverPaints = [gameoverPaint, blackPaint, resultPaint]+gameoverImgs = number2Bmp:map (fst.fst) gameoverPaints+++-- 描画+renderGameover :: Gameover -> SDL.Surface -> Resource -> IO ()+renderGameover g surf res = do+    renderStage (lastState g) surf res+    +    let ((filename, r1), r2) = blackPaint+        (Just imgSurf) = lookup filename (imageResource res) in do+    SDL.setAlpha imgSurf [SDL.SrcAlpha] 191+    SDL.blitSurface imgSurf r1 surf r2++    renderPaint res surf gameoverPaint+    renderPaint res surf resultPaint+    renderNumber surf res number2Bmp number2Size (450, 450) (milisec $ stageTime $ lastState g)++    return ()++-- リソースの更新+addGameoverResource :: Resource -> IO Resource+addGameoverResource res = do+    foldM addImageResource res gameoverImgs+
+ Input.hs view
@@ -0,0 +1,28 @@+module Input where++import qualified Graphics.UI.SDL as SDL++-- 入力+data Input = Input {+    inputKey :: [SDL.SDLKey],+    inputMouse :: (Bool, Bool, Bool)+}++emptyInput = Input [] (False, False, False)++hasKey :: Input -> SDL.SDLKey -> Bool+hasKey input key = elem key (inputKey input)++addKey :: Input -> SDL.SDLKey -> Input+addKey i@Input { inputKey = keys } key = if elem key keys then i else i { inputKey = key:keys }++eraseKey :: Input -> SDL.SDLKey -> Input+eraseKey i@Input { inputKey = keys } key = i { inputKey = filter (/= key) keys }++-- イベントによる更新+updateInput :: Input -> SDL.Event -> Input+updateInput input (SDL.KeyDown (SDL.Keysym key mod ucode)) = addKey input key+updateInput input (SDL.KeyUp (SDL.Keysym key mod ucode)) = eraseKey input key+updateInput input SDL.Quit = addKey input SDL.SDLK_ESCAPE+updateInput input _ = input+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2010, kryozahiro
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of kryozahiro nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Number.hs view
@@ -0,0 +1,27 @@+module Number where++import qualified Graphics.UI.SDL as SDL+import Resource+import Pos++numberBmp = "./resource/image/number.bmp"+numberSize = (15.0, 30.0)++number2Bmp = "./resource/image/number2.bmp"+number2Size = (17.4, 50.0)++numberPaints :: String -> RealPos -> Pos -> Int -> [Paint]+numberPaints filename (w, h) (x, y) n = let+    (iw, ih) = floorPos (w, h) :: Pos+    tips = map (\n -> (filename, Just (SDL.Rect (floor $ (fromIntegral n)*w) 0 iw ih))) (sepInt n) in+    zip tips [Just (SDL.Rect (floor $ (fromIntegral x)+dx) y iw ih) | dx <- [0,w..]]++sepInt :: Int -> [Int]+sepInt 0 = [0]+sepInt n = (case div n 10 of 0 -> []; u->sepInt u) ++ [mod n 10]++-- •`‰æ+-- ‰æ‘œƒtƒ@ƒCƒ‹E•¶ŽšƒTƒCƒYE•`‰æˆÊ’uE•\Ž¦’l+renderNumber :: SDL.Surface -> Resource -> String -> RealPos -> Pos -> Int -> IO ()+renderNumber surf res filename (w, h) (x, y) n = mapM_ (renderPaint res surf) (numberPaints filename (w, h) (x, y) n)+
+ Pos.hs view
@@ -0,0 +1,13 @@+module Pos where++-- ˆÊ’u+type Pos = (Int, Int)++type RealPos = (Double, Double)++fromPos :: Num a => Pos -> (a, a)+fromPos (x, y) = (fromIntegral x, fromIntegral y)++floorPos :: RealPos -> (Int, Int)+floorPos (x, y) = (floor x, floor y)+
+ Resource.hs view
@@ -0,0 +1,64 @@+module Resource where++import qualified Graphics.UI.SDL as SDL+import qualified Graphics.UI.SDL.Mixer as SDLMixer++-- リソース+data Resource = Resource {+    imageResource :: [Image],+    soundResource :: [Sound]+}++addImageResource :: Resource -> String -> IO Resource+addImageResource res filename = let imgRes = imageResource res in+    if lookup filename imgRes /= Nothing then return res else do+    img <- newImage filename+    return res { imageResource = (img:imgRes) }++addSoundResource :: Resource -> String -> IO Resource+addSoundResource res filename = let sndRes = soundResource res in+    if lookup filename sndRes /= Nothing then return res else do+    snd <- newSound filename+    return res { soundResource = (snd:sndRes) }++-- 画像+type Image = (String, SDL.Surface)++newImage :: String -> IO Image+newImage filename = do+    -- putStrLn $ "loading " ++ filename+    surface <- SDL.loadBMP filename+    pixel <- SDL.mapRGB (SDL.surfaceGetPixelFormat surface) 0 255 0+    SDL.setColorKey surface [SDL.SrcColorKey, SDL.RLEAccel] pixel+    display <- SDL.displayFormat surface+    return (filename, display)++-- 画像ファイルの一区画+type PaintTip = (String, Maybe SDL.Rect)++-- 画像と描画先+type Paint = (PaintTip, Maybe SDL.Rect)++renderPaint :: Resource -> SDL.Surface -> Paint -> IO Bool+renderPaint res surf ((filename, r1), r2) = let+    (Just imgSurf) = lookup filename (imageResource res) in do+    SDL.blitSurface imgSurf r1 surf r2++-- 音声+type Sound = (String, SDLMixer.Chunk)++newSound :: String -> IO Sound+newSound filename = do+    -- putStrLn $ "loading " ++ filename+    chunk <- SDLMixer.loadWAV filename+    return (filename, chunk)++playSound :: Resource -> String -> Int -> IO ()+playSound res filename times = let+    (Just chunk) = lookup filename (soundResource res) in do+    SDLMixer.playChannel (-1) chunk times+    return ()++haltSound :: IO ()+haltSound = SDLMixer.haltChannel (-1)+
+ Score.hs view
@@ -0,0 +1,63 @@+module Score where++import Monad+import IO+import Time+import qualified Graphics.UI.SDL as SDL+import Resource+import Number++-- ƒnƒCƒXƒRƒA‰æ–Ê+data Score = Score++hiscoresPaint = (("./resource/image/hiscores.bmp", Nothing), Nothing)+sepBmp = "./resource/image/sep.bmp"++scoreImgs = numberBmp:sepBmp:(fst.fst) hiscoresPaint:[]++slashPaint (x, y) = ((sepBmp, Just $ SDL.Rect 0 0 15 30), Just $ SDL.Rect x y 15 30)+colonPaint (x, y) = ((sepBmp, Just $ SDL.Rect 30 0 15 30), Just $ SDL.Rect x y 15 30)++scoreFile = "score.dat"++-- “ǂݍž‚Ý+readScore :: IO [[Int]]+readScore = do+    handle <- openFile scoreFile ReadMode+    file <- hGetContents handle+    return $! file -- ’x‰„‚³‚¹‚È‚¢+    hClose handle+    return [[read wd | wd <- words ln] | ln <- lines file]++-- ‘‚«ž‚Ý+writeScore :: Int -> IO ()+writeScore s = do+    clock <- getClockTime+    calendar <- toCalendarTime clock+    let record = [s, ctYear calendar, (fromEnum $ ctMonth calendar)+1, ctDay calendar, ctHour calendar, ctMin calendar, ctSec  calendar]+    +    scores <- readScore+    let (large, small) = span ((>=s).head) scores+    let newScores = init (large ++ [record] ++ small)+    +    writeFile scoreFile $ unlines $ map (unwords.map show) newScores++-- •`‰æ+renderRecord :: SDL.Surface -> Resource -> Int -> [Int] -> IO ()+renderRecord surf res n r = let+    numX = [100, 150, 300, 385, 440, 500, 555, 610]+    y = (50 + n * 30) in do+    sequence_ $ zipWith ($) [renderNumber surf res numberBmp numberSize (x, y) | x <- numX] (n:r)+    mapM_ (\x -> renderPaint res surf (slashPaint (x, y))) [365, 420]+    mapM_ (\x -> renderPaint res surf (colonPaint (x, y))) [535, 590]++renderScore :: Score -> SDL.Surface -> Resource -> IO ()+renderScore s surf res = do+    renderPaint res surf hiscoresPaint+    scores <- readScore+    sequence_ $ zipWith ($) [renderRecord surf res n | n <- [1..10]] scores++-- ƒŠƒ\[ƒX‚̍XV+addScoreResource :: Resource -> IO Resource+addScoreResource res = foldM addImageResource res scoreImgs+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain
+ Stage.hs view
@@ -0,0 +1,281 @@+module Stage where++import Maybe+import Monad+import Random+import qualified Graphics.UI.SDL as SDL+import Resource+import Input+import Pos+import Number++-- 画面サイズ+screenWidth = 800 :: Int+screenHeight = 600 :: Int++-- 自機+data Player = Player {+    playerPos :: Pos,+    playerAmmo :: Int+}++playerPaint p = let (x, y) = playerPos p in+    (playerTip, Just (SDL.Rect (x-15) (y-15) 30 30))++updatePlayer :: Bool -> Player -> SDL.SDLKey -> Player+updatePlayer isShift p key = let+    (x, y) = playerPos p+    speed = if isShift then 2 else 5 in+    case key of+        SDL.SDLK_UP -> boundArea $ p { playerPos = (x, y - speed) }+        SDL.SDLK_DOWN -> boundArea $ p { playerPos = (x, y + speed) }+        SDL.SDLK_LEFT -> boundArea $ p { playerPos = (x - speed, y) }+        SDL.SDLK_RIGHT -> boundArea $ p { playerPos = (x + speed, y) }+        otherwise -> p++-- 敵+data Enemy = Enemy {+    enemyPos :: Pos,+    enemySpeed :: Int,+    enemyType :: EnemyType+}++data EnemyType = Small | Normal | Large++enemySize :: Enemy -> (Int, Int)+enemySize em = case enemyType em of+    Small -> (50, 43)+    Normal -> (100, 87)+    Large -> (200, 173)++enemyTip :: Enemy -> PaintTip+enemyTip em = case enemyType em of+    Small -> enemy50Tip+    Normal -> enemy100Tip+    Large -> enemy200Tip++enemyPaint em = let+    (x, y) = enemyPos em+    (w, h) = enemySize em in+    (enemyTip em, Just $ SDL.Rect x y w h)++moveEnemy :: Enemy -> Enemy+moveEnemy (Enemy (x, y) spd t) = Enemy (x, y+spd) spd t+++-- 弾+data Bullet = Bullet {+    bulletPos :: Pos+}++bulletSpeed = 20++moveBullet :: Bullet -> Bullet+moveBullet b@Bullet { bulletPos = (x, y) } = b { bulletPos = (x, y-bulletSpeed) }++bulletPaint bl = let+    (x, y) = bulletPos bl in+    (bulletTip, Just (SDL.Rect (x-5) (y-5) 10 10))++-- 経過時間+type Time = Int++milisec :: Time -> Int+milisec time = div (time * 1000) 60++-- ステージ画面+data Stage = Stage {+    stagePlayer :: Player,+    stageEnemy :: [Enemy],+    stageBullet :: [Bullet],+    stageTime :: Time+}++initStage = Stage (Player (200, 500) 3) [] [] 0++stagePaint = (("./resource/image/stage.bmp", Nothing), Nothing)+sidePaint = (("./resource/image/side.bmp", Nothing), Just (SDL.Rect 500 0 300 600))+scorePaint = (("./resource/image/score.bmp", Nothing), Just (SDL.Rect 550 70 150 30))+bulletsPaint = (("./resource/image/bullets.bmp", Nothing), Just (SDL.Rect 550 170 150 30))+extendPaint = (("./resource/image/extend.bmp", Nothing), Just (SDL.Rect 550 260 100 20))+playerTip = ("./resource/image/player.bmp", Nothing)+enemy50Tip = ("./resource/image/enemy50.bmp", Nothing)+enemy100Tip = ("./resource/image/enemy100.bmp", Nothing)+enemy200Tip = ("./resource/image/enemy200.bmp", Nothing)+bulletTip = ("./resource/image/bullet.bmp", Nothing)++barBmp = "./resource/image/bar.bmp"++barPaint :: Time -> Paint+barPaint time = let+    width = 200 - (mod (div ((milisec time)*200) 10000) 200) in+    ((barBmp, Just (SDL.Rect 0 0 width 10)), Just (SDL.Rect 570 290 width 10))++stagePaints = [stagePaint, sidePaint, scorePaint, bulletsPaint, extendPaint]+stageTips = [playerTip, enemy50Tip, enemy100Tip, enemy200Tip, bulletTip]+stageBmps = [numberBmp, barBmp]+stageImgFiles = stageBmps ++ (map fst stageTips) ++ (map (fst.fst) stagePaints)++stageBgm = "./resource/sound/002_STG_fly_high_oggmst.ogg"+++-- 敵の生成+-- 60秒ごとにNormal、Small、Largeが多く出るように循環+createEnemyType :: Time -> IO EnemyType+createEnemyType time = let+    normal = (mod ((div (milisec time) 20000)+1) 3) * 85 - 80 in do+    gen <- getStdRandom (randomR (0::Int, 100))+    if gen < normal then return Small else do+    if gen < normal + 90 then return Normal else do+    return Large++-- 敵を生成するか+isCreateEnemy :: Time -> EnemyType -> IO Bool+isCreateEnemy time et = do+    gen <- getStdRandom (randomR (0::Int, 100))+    return $ case et of+        Small -> gen > 87 - div (milisec time) 60000 -- 71+        Normal -> gen > 92 - div (milisec time) 180000 -- 87+        Large -> gen > 97 - div (milisec time) 360000 -- 95++-- 敵の速度+-- 30秒ごとに増加するが180秒経過でリセット+createEnemySpeed :: Time -> IO Int+createEnemySpeed time = let+    base = 3 + (div (milisec time) 360000) in do+    getStdRandom (randomR (1, base + (div (mod (milisec time) 180000) 30000))) -- 10++createEnemies :: Time -> IO [Enemy]+createEnemies time = do+    et <- createEnemyType time+    +    flg <- isCreateEnemy time et+    if not flg then return [] else do+    +    speed <- createEnemySpeed time+    +    x <- getStdRandom (randomR (-80, 500))+    let cand = Enemy (x, 0) speed et+        (ew, eh) = enemySize cand+    return [cand { enemyPos = (x, -eh) }]++createPlayerBullet :: Player -> ([Bullet], Player)+createPlayerBullet p =+    if playerAmmo p > 0 then+    ([Bullet (playerPos p)],+        Player (playerPos p) ((playerAmmo p)-1)) else+    ([], p)+++-- 当り判定+isHitEnemy :: Enemy -> Pos -> Bool+isHitEnemy em (x, y) = let+    (ex, ey) = enemyPos em+    (ew, eh) = enemySize em+    (dx, dy) = (fromIntegral ((x - ex)::Int)::Float, fromIntegral ((y - ey)::Int)::Float) in+    and [dy > 0.0, (-(sqrt 3))*dx+dy < 0.0, (sqrt 3)*dx+dy < (sqrt 3)*(fromIntegral ew)]++isHitEnemyPlayer e p = isHitEnemy e (playerPos p)++isLineCross :: (Pos, Pos) -> (Pos, Pos) -> Bool+isLineCross (p1, p2) (p3, p4) = let -- 桁あふれ対策+    (x1, y1) = fromPos p1 :: RealPos+    (x2, y2) = fromPos p2 :: RealPos+    (x3, y3) = fromPos p3 :: RealPos+    (x4, y4) = fromPos p4 :: RealPos in+    ((x1-x2)*(y3-y1)+(y1-y2)*(x1-x3)) * ((x1-x2)*(y4-y1)+(y1-y2)*(x1-x4)) < 0 &&+    ((x3-x4)*(y1-y3)+(y3-y4)*(x3-x1)) * ((x3-x4)*(y2-y3)+(y3-y4)*(x3-x2)) < 0++isLineCrossYInv :: (Pos, Pos) -> (Pos, Pos) -> Bool+isLineCrossYInv ((x1, y1), (x2, y2)) ((x3, y3), (x4, y4)) =+    isLineCross ((x1, -y1), (x2, -y2)) ((x3, -y3), (x4, -y4))++isHitEnemyBullet :: Enemy -> Bullet -> Bool+isHitEnemyBullet em blt = let+    (ex, ey) = enemyPos em+    (ew, eh) = enemySize em+    (bx, by) = bulletPos blt in+    or $ isHitEnemy em (bx, by) : map (isLineCrossYInv ((bx, by), (bx, by+bulletSpeed)))+        [((ex, ey), (ex+ew, ey)),+        ((ex, ey), (ex+(div ew 2), ey+eh)),+        ((ex+ew, ey), (ex+(div ew 2), ey+eh))]++mostFrontEnemy :: [Enemy] -> Maybe Enemy+mostFrontEnemy [] = Nothing+mostFrontEnemy [e] = Just e+mostFrontEnemy (e:f:ems) = if (snd $ enemyPos e) > (snd $ enemyPos f) then+    mostFrontEnemy $ e:ems else+    mostFrontEnemy $ f:ems+++-- 更新+isInArea :: Pos -> Bool+isInArea (x, y) = if x >= 0 && x <= 500 && y >= 0 && y < screenHeight+15 then True+    else False++isInAreaEnemy :: Enemy -> Bool+isInAreaEnemy em = let+    (ex, ey) = enemyPos em+    (w, h) = enemySize em in+    isInArea (ex, ey) || isInArea (ex, ey+h) || isInArea (ex+w, ey) || isInArea (ex+w, ey+h)++boundArea :: Player -> Player+boundArea p = let+    (x, y) = playerPos p+    newX = if x < 0 then 0 else if x > 500 then 500 else x+    newY = if y < 0 then 0 else if y > screenHeight then screenHeight else y in+    Player (newX, newY) (playerAmmo p)++moveObjects :: Stage -> Input -> Stage+moveObjects s@Stage { stagePlayer = p, stageEnemy = ems, stageBullet = bls } input = let+    isShift = hasKey input SDL.SDLK_LSHIFT+    movedPly = foldl (updatePlayer isShift) p (inputKey input)+    movedEms = filter (isInAreaEnemy) $ map moveEnemy ems+    movedBls = filter (isInArea.bulletPos) $ map moveBullet bls in+    s { stagePlayer = movedPly, stageEnemy = movedEms, stageBullet = movedBls}++chargeAmmo :: Stage -> Stage+chargeAmmo s@Stage { stagePlayer = p, stageTime = t } = let+    ammo = playerAmmo p+    newAmmo = if t /= 0 && (mod t 600) == 0 then ammo + 1 else ammo in+    s { stagePlayer = (Player (playerPos p) newAmmo) }++filterAlive :: Stage -> Maybe Stage+filterAlive s@Stage { stagePlayer = p, stageEnemy = ems, stageBullet = bls } = let+    hits = mapMaybe (\b -> mostFrontEnemy [e|e<-ems, isHitEnemyBullet e b]) bls+    aliveEms = filter (\e -> and $ map (\h->(enemyPos h)/=(enemyPos e)) hits) ems+    aliveBls = filter (\b -> and $ map (not.(`isHitEnemyBullet` b)) ems) bls in+    if and $ map (not.(`isHitEnemyPlayer` p)) aliveEms then+        Just $ s { stageEnemy = aliveEms, stageBullet = aliveBls } else+        Nothing++-- 描画+renderTime :: Time -> SDL.Surface -> Resource -> IO ()+renderTime time surf res = renderNumber surf res numberBmp numberSize (600,100) (milisec time)++renderAmmo :: Player -> SDL.Surface -> Resource -> IO ()+renderAmmo p surf res = renderNumber surf res numberBmp numberSize (600,200) (playerAmmo p)++renderStage :: Stage -> SDL.Surface -> Resource -> IO ()+renderStage (Stage p ems bls time) surf res = do+    if time == 0 then playSound res stageBgm (-1) else return ()+    +    renderPaint res surf stagePaint+    +    renderPaint res surf $ playerPaint p+    mapM_ (renderPaint res surf) $ map enemyPaint ems+    mapM_ (renderPaint res surf) $ map bulletPaint bls+    +    mapM_ (renderPaint res surf) [sidePaint, bulletsPaint, scorePaint, extendPaint]+    renderAmmo p surf res    +    renderTime time surf res+    renderPaint res surf $ barPaint time+    +    return ()++-- リソースの更新+addStageResource :: Resource -> IO Resource+addStageResource res = do+    ires <- foldM addImageResource res stageImgFiles+    addSoundResource ires stageBgm+
+ Title.hs view
@@ -0,0 +1,42 @@+module Title where++import Monad+import qualified Graphics.UI.SDL as SDL+import Resource++-- タイトル画面+data Title = Title MenuIndex++initTitle = Title 0++type MenuIndex = Int+nextMenu index = mod (index + 1) 3+prevMenu index = mod (index - 1) 3++cursorRect :: MenuIndex -> SDL.Rect+cursorRect i = SDL.Rect (300+50*i) (400+50*i) 50 50++titlePaint = (("./resource/image/title.bmp", Nothing), Nothing)+titleStartPaint = (("./resource/image/title_start.bmp", Nothing), Just (SDL.Rect 350 400 200 50))+titleScorePaint = (("./resource/image/title_score.bmp", Nothing), Just (SDL.Rect 400 450 200 50))+titleQuitPaint = (("./resource/image/title_quit.bmp", Nothing), Just (SDL.Rect 450 500 200 50))+cursorTip = ("./resource/image/cursor.bmp", Nothing)+cursorStart = Just (SDL.Rect 300 400 50 50)+cursorEnd= Just (SDL.Rect 350 450 50 50)++titlePaints = [titlePaint, titleStartPaint, titleScorePaint, titleQuitPaint]+titleTips = [cursorTip]+titleImgFiles = (map fst titleTips) ++ (map (fst.fst) titlePaints)++-- 描画+renderTitle :: Title -> SDL.Surface -> Resource -> IO ()+renderTitle (Title i) surf res = do+    haltSound+    mapM_ (renderPaint res surf) titlePaints+    renderPaint res surf (cursorTip, Just $ cursorRect i)+    return ()++-- リソースの更新+addTitleResource :: Resource -> IO Resource+addTitleResource res = foldM addImageResource res titleImgFiles+
+ build.bat view
@@ -0,0 +1,1 @@+ghc -package SDL -package SDL-mixer --make -no-hs-main Eternal.hs c_main.c
+ c_main.c view
@@ -0,0 +1,24 @@+#if defined(__APPLE__) && defined(__MACH__)+#include <SDL/SDL.h>+#elif defined(WIN32)+#include <SDL.h>+#endif++#include "HsFFI.h"+#ifdef __GLASGOW_HASKELL__+#include "Eternal_stub.h"+extern void __stginit_Eternal(void);+#endif++int main(int argc, char* argv[]) {+	hs_init(&argc, &argv);++#ifdef __GLASGOW_HASKELL__+	hs_add_root(__stginit_Eternal);+#endif++	hs_main();+	hs_exit();+	return 0;+}+
+ resource/image/bar.bmp view

binary file changed (absent → 6054 bytes)

+ resource/image/black.bmp view

binary file changed (absent → 1440054 bytes)

+ resource/image/bullet.bmp view

binary file changed (absent → 374 bytes)

+ resource/image/bullets.bmp view

binary file changed (absent → 13614 bytes)

+ resource/image/cursor.bmp view

binary file changed (absent → 7654 bytes)

+ resource/image/enemy100.bmp view

binary file changed (absent → 26154 bytes)

+ resource/image/enemy200.bmp view

binary file changed (absent → 103854 bytes)

+ resource/image/enemy50.bmp view

binary file changed (absent → 6590 bytes)

+ resource/image/extend.bmp view

binary file changed (absent → 6054 bytes)

+ resource/image/gameover.bmp view

binary file changed (absent → 135054 bytes)

+ resource/image/hiscores.bmp view

binary file changed (absent → 1440054 bytes)

+ resource/image/number.bmp view

binary file changed (absent → 13614 bytes)

+ resource/image/number2.bmp view

binary file changed (absent → 60054 bytes)

+ resource/image/player.bmp view

binary file changed (absent → 2814 bytes)

+ resource/image/result.bmp view

binary file changed (absent → 30054 bytes)

+ resource/image/score.bmp view

binary file changed (absent → 13614 bytes)

+ resource/image/sep.bmp view

binary file changed (absent → 5454 bytes)

+ resource/image/side.bmp view

binary file changed (absent → 540054 bytes)

+ resource/image/stage.bmp view

binary file changed (absent → 1440054 bytes)

+ resource/image/title.bmp view

binary file changed (absent → 1440054 bytes)

+ resource/image/title_quit.bmp view

binary file changed (absent → 30054 bytes)

+ resource/image/title_score.bmp view

binary file changed (absent → 30054 bytes)

+ resource/image/title_start.bmp view

binary file changed (absent → 30054 bytes)

+ resource/sound/002_STG_fly_high_oggmst.ogg view

binary file changed (absent → 1331044 bytes)

+ score.dat view
@@ -0,0 +1,10 @@+500000 2010 1 2 3 4 5
+400000 2010 2 3 4 5 6
+300000 2010 3 4 5 6 7
+200000 2010 4 5 6 7 8
+100000 2010 5 6 7 8 9
+80000 2010 6 7 8 9 10
+60000 2010 7 8 9 10 11
+40000 2010 8 9 10 11 12
+20000 2010 9 10 11 12 13
+10416 2010 5 23 22 55 5