edge-0.9.1.0: Resources.hs
{-|
Module : Resources
Description : Preloading and initialization of various game resources
Copyright : (c) Christopher Howard, 2016
License : GPL-3
Maintainer : ch.howard@zoho.com
-}
module Resources where
import Prelude (map, return, (==), mapM, (++), pi, (+), (/), (*), zip, (.), foldr, ($))
import Graphics.Gloss.Data.Picture ( loadBMP )
import Graphics.Gloss.Data.Color ( yellow, white, violet, rose, orange, magenta, green, cyan, chartreuse, blue, azure, aquamarine )
import Data.WrapAround ( wrappoint, wm )
import Sound.ALUT ( SoundDataSource(File), createBuffer )
import System.Random ( Random(randomRIO) )
import Paths_edge ( getDataFileName )
import ResourceTracker
import SpaceJunk
import qualified Asteroid as Asteroid ( new )
import qualified BigAsteroid as BigAsteroid ( new )
import Star
import Universe
import Unit
import qualified Unit.Simple.Turret as Turret ( new )
import qualified Unit.Smart.Tank as Tank ( new )
import qualified Unit.Smart.ATank as ATank ( new )
import qualified Unit.Smart.STank as STank ( new )
import qualified Unit.Smart.Death as Death ( new )
import qualified Unit.Smart.DeathII as DeathII ( new )
import qualified Unit.Smart.Master as Master ( new )
import qualified Unit.Smart.Ninja as Ninja ( new )
import qualified Unit.Smart.Saucer as Saucer ( new )
import qualified Unit.Smart.Sniper as Sniper ( new )
import qualified Unit.Smart.Zeus as Zeus ( new )
import Combat
import qualified Projectile.Mine as Mine ( new )
import Item
import Math
initResources = let imageFiles = [ "asteroid.bmp"
, "asteroidbig.bmp"
, "atank.bmp"
, "blade.bmp"
, "death.bmp"
, "deathii.bmp"
, "deflector-1.bmp"
, "deflector-2.bmp"
, "interceptor-1.bmp"
, "interceptor-2.bmp"
, "interceptor-3.bmp"
, "item-default.bmp"
, "item-health.bmp"
, "item-fourway.bmp"
, "item-cannon.bmp"
, "item-spread.bmp"
, "item-rapidfire.bmp"
, "item-nuke.bmp"
, "item-sigma.bmp"
, "lance.bmp"
, "lance-thrusting.bmp"
, "master.bmp"
, "master-cloaking.bmp"
, "mine.bmp"
, "mine-explosion.bmp"
, "mine-lit.bmp"
, "ninja.bmp"
, "nuke-0.bmp"
, "nuke-1.bmp"
, "nuke-2.bmp"
, "nuke-3.bmp"
, "stank.bmp"
, "turret.bmp"
, "tank.bmp"
, "explosion-00.bmp"
, "explosion-01.bmp"
, "explosion-02.bmp"
, "explosion-03.bmp"
, "explosion-04.bmp"
, "explosion-05.bmp"
, "explosion-06.bmp"
, "saucer.bmp"
, "sniper.bmp"
, "zeus-base.bmp"
, "zeus-cannon.bmp"
] in
let imageFiles' = map ("image/" ++) imageFiles in
let soundFiles = [ "test.wav"
, "blip.wav"
, "energy-shot-02.wav"
, "explosion.wav"
, "music.wav"
, "simple-energy-shot.wav"
] in
let soundFiles' = map ("sound/" ++) soundFiles in
do imagePaths <- mapM getDataFileName imageFiles'
pics <- mapM loadBMP imagePaths
soundPaths <- mapM getDataFileName soundFiles'
sounds <- mapM (createBuffer . File) soundPaths
let rt = foldr go emptyResourceTracker
(zip imageFiles pics)
return $ foldr go' rt (zip soundFiles sounds)
where go (file, pic) rt = storeImage rt file pic
go' (file, sound) rt = storeSound rt file sound
-- loadBuffer path = do buf <- createBuffer (File path)
-- [source] <- genObjectNames 1
-- buffer source $= Just buf
-- return source
startingAsteroids rt wmap =
let positionsVelocities = [ ((1900, 500), (200, -120))
, (( 100, 2900), ( 90, 10))
, ((2500, 1100), (-100, 100))
, (( 700, 300), (80, 60))
, ((1300, 1400), (-30, 240))
, ((1000, 2400), (110, 100))
] in
map (\(p, v) -> Asteroid.new rt wmap (wrappoint wmap p) v) positionsVelocities
stars = map f
[ ((40, 93), rose )
, ((54, 74), white )
, ((86, 38), white )
, ((30, 52), white )
, (( 2, 24), orange )
, ((85, 76), white )
, ((27, 32), white )
, ((53, 94), white )
, ((66, 37), green )
, ((39, 73), white )
, ((88, 67), chartreuse )
, ((50, 50), white )
, ((93, 33), white )
, ((25, 57), white )
, ((36, 6), white )
, ((65, 61), white )
, ((43, 24), blue )
, ((54, 52), white )
, ((66, 45), white )
, ((41, 67), white )
, ((37, 25), white )
, ((62, 48), green )
, ((88, 73), white )
, (( 4, 54), white )
, ((59, 77), white )
, ((73, 83), yellow )
, ((34, 24), white )
, ((58, 48), white )
, ((03, 99), white )
, ((57, 46), aquamarine )
, ((66, 67), white )
, ((31, 2), white )
, ((85, 53), white )
, ((23, 77), white )
, ((97, 16), white )
, ((16, 83), white )
, ((42, 45), magenta )
, (( 9, 67), white )
, ((33, 33), azure )
, ((27, 75), violet )
, ((36, 64), white )
, ((74, 2), white )
, ((48, 46), cyan )
, ((20, 98), rose )
, ((52, 44), white )
, ((16, 38), white )
, ((32, 72), white )
, ((21, 23), orange )
, ((75, 86), white )
, ((67, 34), white )
, ((55, 64), white )
, ((46, 38), green )
, ((37, 73), white )
, ((38, 69), chartreuse )
, ((52, 90), white )
, ((43, 31), white )
, ((26, 27), white )
, ((86, 8), white )
, ((69, 91), white )
, ((13, 22), blue )
, ((58, 72), white )
, ((96, 48), white )
, ((42, 97), white )
, ((77, 28), white )
, ((63, 78), green )
, ((68, 71), white )
, (( 2, 84), white )
, ((49, 73), white )
, ((72, 83), yellow )
, ((94, 29), white )
, ((52, 98), white )
, ((73, 92), white )
, ((52, 36), aquamarine )
, ((46, 64), white )
, ((32, 82), white )
, ((35, 53), white )
, ((24, 87), white )
, ((87, 17), white )
, ((16, 93), white )
, ((72, 42), magenta )
, (( 4, 97), white )
, ((93, 33), azure )
, ((22, 5), violet )
, ((46, 68), white )
, ((76, 92), white )
, ((78, 41), cyan )
]
where f (x, y) = Star { Star.location = wrappoint (wm 100 100) x
, Star.color = y }
initLevels rt =
do let a = blankArena 3000 3000
let wmap = Universe.wrapMap a
let pL = [
-- 1
a { asteroids = asteroidGen rt wmap
[ ((1900, 500), (200, -120))
, (( 100, 2900), ( 90, 10))
]
, simpleUnits = turretGen rt wmap
[ ((-700.0, 300.0), 0.0, 7 * pi / 4)
, ((500.0, 800.0), pi / 3, 7 * pi / 4)
]
}
,
-- 2
a { asteroids = asteroidGen rt wmap
[ ((1900, 500), (200, -120))
, (( 100, 2900), ( 90, 10))
, ((2500, 1100), (-100, 100))
]
, simpleUnits = turretGen rt wmap
[ ((1000.0, 200.0), 0.0, pi / 3)
]
, smartUnits = tankGen rt wmap
[ ((-1000.0, 800.0), 0.0)
, ((-1200.0, 500.0), pi)
]
}
,
-- 3
a { asteroids = asteroidGen rt wmap
[ ((900, 340), (230, -120))
, ((1200, 1400), (110, 30))
, ((200, 500), (-180, 110))
]
, simpleUnits = turretGen rt wmap
[ ((-500.0, 200.0), 0.0, 3 * qArc )
]
, smartUnits = tankGen rt wmap
[ ((-1000.0, 800.0), 0.0)
, ((900.0, 600.0), pi)
, ((700.0, -500.0), qArc)
] ++
aTankGen rt wmap
[ ((-1100.0, -900.0), pi + pi / 3)
]
}
,
-- 4
a { asteroids = asteroidGen rt wmap
[ ((800, -340), (130, 120))
, ((700, 200), (10, -130))
, ((-300, 900), (70, 110))
]
, smartUnits = tankGen rt wmap
[ ((-700.0, 600.0), 0.0)
, ((500.0, -1100.0), qArc)
] ++
aTankGen rt wmap
[ ((-1000.0, 900.0), pi + pi / 3)
] ++
saucerGen rt wmap
[ ((400.0, 1400.0), 0.0) ]
}
,
-- 5
a { asteroids = asteroidGen rt wmap
[ ((800, -340), (130, 120))
, ((700, 200), (10, -130))
, ((-300, 900), (70, 110))
]
, smartUnits = tankGen rt wmap
[ ((-400.0, 900.0), 0.0)
] ++
aTankGen rt wmap
[ ((1400.0, -800.0), pi)
] ++
saucerGen rt wmap
[ ((400.0, 1400.0), 0.0)
, ((-1200.0, -1000.0), pi)
, ((100.0, -500.0), pi)
, ((-600.0, 800.0), 0.0)
]
}
,
-- 6
a { asteroids = asteroidGen rt wmap
[ ((800, -340), (-130, 120))
, ((700, 200), (-130, 120))
, ((-300, 900), (-130, 120))
, ((1340, -1230), (-130, 120))
, ((-420, 990), (-130, 120))
, ((370, -130), (-130, 120))
, ((-1220, 1090), (-130, 120))
, ((400, 1300), (-130, 120))
, ((-700, -500), (-130, 120))
, ((-1320, 1290), (-130, 120))
, ((100, 400), (-130, 120))
, ((-800, -400), (-130, 120))
, ((1440, -1330), (-130, 120))
, ((-520, 120), (-130, 120))
, ((1100, 40), (-130, 120))
, ((500, 100), (-130, 120))
, ((-1100, -20), (-130, 120))
, ((-520, -70), (-130, 120))
, ((40, 1100), (-130, 120))
, ((100, 500), (-130, 120))
, ((-20,-1100), (-130, 120))
, ((-70, -520), (-130, 120))
, ((-600, 1500), (-130, 120))
, ((-1000, 500), (-130, 120))
, ((-400, -600), (-130, 120))
, ((1200, -600), (-130, 120))
, ((500, -1400), (-130, 120))
] ++
bigAsteroidGen rt wmap
[ ((500, -840), (-130, 120))
, ((900, 300), (-130, 120))
, ((-200, 1100), (-130, 120))
, ((600, -200), (-130, 120))
, ((-600, 700), (-130, 120))
, ((-900, -1100), (-130, 120))
, ((-100, -900), (-130, 120))
, ((-200, -200), (-130, 120))
, ((600, 600), (-130, 120))
, ((900, -900), (-130, 120))
, ((-1400, -1400), (-130, 120))
, ((1100, 1300), (-130, 120))
, ((-1000, -800), (-130, 120))
, ((400, -600), (-130, 120))
, ((-500, -1300), (-130, 120))
]
, simpleUnits = turretGen rt wmap
[ ((700.0, 650.0), 0.0, pi )
, ((-550.0, -300.0), 0.0, 0.0 )
]
, smartUnits = tankGen rt wmap
[ ((-450.0, 821.0), 0.0)
] ++
aTankGen rt wmap
[ ((40.0, -1400.0), pi)
] ++
saucerGen rt wmap
[ ((540.0, 1320.0), 0.0)
, ((-1000.0, -1200.0), pi)
, ((40.0, 1200.0), pi)
, ((-200.0, -1000.0), 0)
]
}
,
-- 7
a { asteroids = asteroidGen rt wmap
[ ((800, -340), (-30, 20))
, ((-1320, 1290), (200, 100))
, ((-400, -600), (-80, -40))
, ((500, -1400), (30, 80))
] ++
bigAsteroidGen rt wmap
[ ((-100, -900), (40, 120))
, ((-1000, -800), (50, -60))
]
, simpleUnits = turretGen rt wmap
[ ((900.0, -650.0), 0.0, pi )
]
, smartUnits = tankGen rt wmap
[ ((-450.0, 821.0), 0.0)
, ((40.0, -1400.0), pi)
] ++
sniperGen rt wmap
[ ((-1200.0, 0.0), 0.0)
, ((1200.0, 0.0), 0.0)
]
, unitProjectiles = mineGen rt wmap
[ (300.0, 400.0)
, (-700.0, 200.0)
, (1300.0, -500.0)
]
}
,
-- 8
a { asteroids = asteroidGen rt wmap
[ ((840, -440), (-30, 20))
, ((-1320, 1290), (120, -100))
, ((600, 1400), (30, 80))
] ++
bigAsteroidGen rt wmap
[ ((-100, -900), (40, 30))
, ((-900, 800), (80, -60))
, ((-1000, 400), (-50, -80))
]
, smartUnits = ninjaGen rt wmap
[ ((100.0, 600.0), 0.0)
, ((-200.0, -700.0), pi)
, ((700.0, 800.0), 0.0)
, ((600.0, -900.0), pi)
, ((-800.0, 1300.0), 0.0)
, ((-1400.0, -1400.0), pi)
]
, unitProjectiles = mineGen rt wmap
[ (200.0, 800.0)
, (-500.0, -200.0)
, (-1300.0, 1000.0)
]
}
,
-- 9
a { asteroids = asteroidGen rt wmap
[ ((640, -440), (-20, 30))
, ((-1320, 1190), (110, -90))
, ((700, 1200), (40, 70))
] ++
bigAsteroidGen rt wmap
[ ((-100, -900), (30, 40))
, ((-500, 1000), (70, -70))
]
, smartUnits = deathGen rt wmap
[ ((0.0, -1000.0), 0.0)
]
}
,
-- 10
a { asteroids = asteroidGen rt wmap
[ ((1000, -300), (-50, 100))
, ((-1020, 1290), (120, 20))
, ((540, -1400), (90, 70))
] ++
bigAsteroidGen rt wmap
[ ((-400, -200), (40, 20))
, ((-1300, -850), (50, -160))
]
, simpleUnits = turretGen rt wmap
[ ((500.0, 650.0), 0.0, pi )
, ((-1300.0, -650.0), 0.0, pi )
]
, smartUnits = aTankGen rt wmap
[ ((-450.0, 821.0), 0.0)
, ((40.0, -1400.0), pi)
, ((600.0, 90.0), 0.0)
, ((900.0, -1200.0), pi)
] ++
sTankGen rt wmap
[ ((450.0, -721.0), 0.0)
, ((200.0, 1450.0), pi)
, ((-600.0, 190.0), 0.0)
, ((700.0, -1000.0), pi)
]
, unitProjectiles = mineGen rt wmap
[ (500.0, 1000.0)
, (-900.0, 700.0)
, (1300.0, -1400.0)
]
}
,
-- 11
a { smartUnits = zeusGen rt wmap
[ ((-1400, 1400.0), 0.0, 0)
] ++
sniperGen rt wmap
[ ((-1200.0, 0.0), 0.0)
, ((1200.0, 0.0), 0.0)
] ++
saucerGen rt wmap
[ ((1400.0, 1400.0), 0.0) ]
, unitProjectiles = mineGen rt wmap
[ (-1100.0, 1400.0)
, (-1700.0, 1400.0)
, (-1400.0, 1100.0)
, (-1400.0, 1700.0)
, (-1100.0, 1100.0)
, (-1700.0, 1700.0)
, (-1100.0, 1700.0)
, (-1700.0, 1100.0)
]
}
,
-- 12
a { smartUnits = masterGen rt wmap
[ ((-600, 600.0), 0.0, 10.0)
, ((800, 600.0), 0.0, 16.0)
, ((-800, 1000.0), 0.0, 13.0)
, ((1200, 1000.0), 0.0, 18.0)
, ((1400, 1300.0), 0.0, 10.0)
, ((-300, 900.0), 0.0, 20.0)
, ((700, -900.0), 0.0, 12.0)
, ((-1499, -1499.0), 0.0, 10.0)
]
, asteroids = asteroidGen rt wmap
[ ((1000, 600), (100, -140))
, ((-850, 1100), (100, -140))
, ((200, -900), (100, -140))
] ++
bigAsteroidGen rt wmap
[ ((-600, 1300), (100, -140))
, ((1400, -1000), (100, -140))
]
}
,
-- 13
a { smartUnits = sTankGen rt wmap
[ ((0, -500.0), qArc)
, ((-200, -700.0), qArc)
, ((200, -700.0), qArc)
, ((-400, -900.0), qArc)
, ((400, -900.0), qArc)
, ((-600, -1100.0), qArc)
, ((600, -1100.0), qArc)
, ((-800, -1300.0), qArc)
, ((800, -1300.0), qArc)
]
-- sniperGen rt wmap
-- [ ((-600.0, 1000.0), 0.0)
-- , ((600.0, 1000.0), 0.0)
-- ]
, simpleUnits = turretGen rt wmap
[ ((0.0, 1000.0), 0.0, qArc)
, ((-600.0, 1000.0), 0.0, - qArc)
, ((600.0, 1000.0), 0.0, - qArc)
]
, asteroids = asteroidGen rt wmap
[ ((1000, 600), (40, -40))
, ((200, -900), (-10, 30))
] ++
bigAsteroidGen rt wmap
[ ((-600, 1300), (60, -30))
, ((1400, -1000), (-20, 70))
]
}
,
-- 14
a { smartUnits = sTankGen rt wmap
[ ((0, -500.0), 0)
, ((800, -1300.0), 0)
] ++
sniperGen rt wmap
[ ((-650, 1200.0), 0.0)
] ++
masterGen rt wmap
[ ((-1400, 800.0), 0.0, 20.0)
, ((1000, 400.0), 0.0, 10.0)
] ++
ninjaGen rt wmap
[ ((-350.0, -1300.0), pi)
] ++
saucerGen rt wmap
[ ((600.0, 400.0), 0.0)
, ((450.0, -1400.0), 0.0)
] ++
zeusGen rt wmap
[ ((-1450, 1450.0), 0, 0) ]
, simpleUnits = turretGen rt wmap
[ ((-600, 1000), 0, - qArc)
, ((600, -1000), 0, qArc)
]
, asteroids = asteroidGen rt wmap
[ ((1200, 800), (50, -70))
, ((300, -600), (-20, 20))
] ++
bigAsteroidGen rt wmap
[ ((-900, 1100), (30, 30))
, ((1500, -1200), (30, -65))
]
, unitProjectiles = mineGen rt wmap
[ (850, 450)
, (-280, 770)
]
}
,
-- 15
a { asteroids = asteroidGen rt wmap
[ ((-540, -940), (-50, -40))
, ((1320, -1090), (70, -100))
] ++
bigAsteroidGen rt wmap
[ ((900, 500), (70, 20))
, ((-400, -1100), (-34, 60))
]
, smartUnits = deathGen rt wmap
[ ((-600, 1300.0), 0.0)
, ((600, 1300.0), 0.0)
] ++
deathGenII rt wmap
[ ((0, -1400), 0)
] ++
masterGen rt wmap
[ ((-700, 800), 0, 10)
, ((-1000, 1000), 0, 11)
, ((1200, -1000), 0, 12)
]
}
]
let addItems a = do (it1, it2) <- randomItemPair
x1 <- randomRIO (0, 2999)
x2 <- randomRIO (0, 2999)
y1 <- randomRIO (0, 2999)
y2 <- randomRIO (0, 2999)
let wp1 = wrappoint wmap (x1, y1)
let wp2 = wrappoint wmap (x2, y2)
let i1 = Item it1 rt wp1
let i2 = Item it2 rt wp2
return a { items = [i1, i2] }
mapM addItems pL
randomItemPair = do it1 <- randomItemType
it2 <- randomItemType
if it1 == it2
then randomItemPair
else return (it1, it2)
asteroidGen rt wmap p =
let positionsVelocities = p in
map (\(p, v) -> (SpaceJunk (Asteroid.new
rt
wmap
(wrappoint wmap p)
v)))
positionsVelocities
bigAsteroidGen rt wmap p =
let positionsVelocities = p in
map (\(p, v) -> (SpaceJunk (BigAsteroid.new
rt
wmap
(wrappoint wmap p)
v)))
positionsVelocities
turretGen rt wmap =
map (\(x, y, z) -> SimpleUnit (Turret.new rt wmap (wrappoint wmap x) y z))
tankGen rt wmap =
map (\(x, y) -> SmartUnit (Tank.new rt wmap (wrappoint wmap x) y))
aTankGen rt wmap =
map (\(x, y) -> SmartUnit (ATank.new rt wmap (wrappoint wmap x) y))
sTankGen rt wmap =
map (\(x, y) -> SmartUnit (STank.new rt wmap (wrappoint wmap x) y))
mineGen rt wmap =
map (\x -> Projectile (Mine.new rt wmap (wrappoint wmap x)))
sniperGen rt wmap =
map (\(x, y) -> SmartUnit (Sniper.new rt wmap (wrappoint wmap x) y))
zeusGen rt wmap =
map (\(x, y, z) -> SmartUnit (Zeus.new rt wmap (wrappoint wmap x) y z))
deathGen rt wmap =
map (\(x, y) -> SmartUnit (Death.new rt wmap (wrappoint wmap x) y))
deathGenII rt wmap =
map (\(x, y) -> SmartUnit (DeathII.new rt wmap (wrappoint wmap x) y))
saucerGen rt wmap =
map (\(x, y) -> SmartUnit (Saucer.new rt wmap (wrappoint wmap x) y))
ninjaGen rt wmap =
map (\(x, y) -> SmartUnit (Ninja.new rt wmap (wrappoint wmap x) y))
masterGen rt wmap =
map (\(x, y, z) -> SmartUnit (Master.new rt wmap (wrappoint wmap x) y z))