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