edge-0.8.4: Display.hs
{-# LANGUAGE ExistentialQuantification #-}
module Display (displayUniverse) where
import Animation
import Universe
import Lance
import Data.Maybe
import Moving
import Star
import Data.WrapAround
import Graphics.Gloss.Interface.IO.Game
import GHC.Float
import Combat
import AfterEffect ( AfterEffect ( AfterEffect ) )
import Unit
import Item
import ResourceTracker
import Trigonometry
data Displayable = forall a. (Locatable a, Animation a) => Displayable a
displayUniverse u
= let arena' = arena u in
let wmap = Universe.wrapMap arena' in
let pactiv x y = if panelActivationTimer u < x
then Blank
else y in
let pship = do lance' <- lance arena'
Just (image lance' undefined) in
let pship' = fromMaybe Blank pship in
let viewCenterWp = case lance arena' of
Just x -> Moving.center x
Nothing -> lastFocus arena' in
let displayables =
do (Displayable displayable)
<- map Displayable (stars arena')
++ map Displayable (asteroids arena')
++ [ Displayable a
| Projectile a <- lanceProjectiles arena'
++ unitProjectiles arena'
]
++ [ case effect of
AfterEffect a -> Displayable a
| effect <- afterFX arena' ]
++ [ Displayable a | SimpleUnit a <- simpleUnits arena' ]
++ [ Displayable a | SmartUnit a <- smartUnits arena' ]
++ [ Displayable a | a <- items arena' ]
let wp = Moving.center displayable in
let (x, y) = vectorRelation wmap wp viewCenterWp in
let pic = image displayable undefined in
[ Translate (double2Float x) (double2Float y) pic ] in
let lanceLives x = if isNothing (lance arena')
then Blank else x in
let deflectorBar' = Translate 65.0 370.0
(case lance arena' of
Just x -> deflectorBar (deflectorCharge x)
Nothing -> deflectorBar 0.8
) in
let deflectorText' = Translate (-65.0) 365.0 deflectorText in
let levelText = Translate 140.0 365.0
(Color white
(Scale 0.14 0.14
(Text ("level " ++ show (level u + 1))))) in
let livesText = Translate (-140.0) 365.0
(Color white
(Scale 0.14 0.14
(Text (show (lives u) ++ " lives")))) in
let godText = case lance arena' of
Nothing -> Blank
Just l -> if not (godMode l)
then Blank
else Translate (-20.0) 335.0
(Color yellow
(Scale 0.14 0.14
(Text "god mode"))) in
let integrityText = Translate (-500.0) 365.0
(Color white
(Scale 0.14 0.14
(Text "structural integrity"))) in
let integrityAssessment =
case lance arena' of
Nothing -> Blank
Just l -> if integrity l >= 3.0
then Color green (Text "optimal")
else if integrity l >= 2.0
then Color yellow (Text "light damage")
else Color red (Text "heavy damage") in
let integrityTextL2 = Translate (-330.0) 365.0
(Scale 0.14 0.14
integrityAssessment) in
let sP = Translate 420.0 300.0
(sensorPanel arena' (150.0, 150.0)) in
let levelMessage = case levelMessageTimer u of
Nothing -> Blank
Just mt -> if mt `doubleRem` 0.5 < 0.25
then Blank
else Translate (-200.0) 150.0
(Text
("level "
++ show (level u + 1))) in
let sgt x y = if startGameTimer u < x then y else Blank in
return $ Pictures $ displayables
++ [ pship'
, lanceLives $ pactiv 0.5 deflectorText'
, lanceLives $ pactiv 0.5 deflectorBar'
, lanceLives $ pactiv 0.5 levelText
, lanceLives $ pactiv 0.5 livesText
, lanceLives $ pactiv 1.5 sP
, godText
, lanceLives $ pactiv 1.0 integrityText
, lanceLives $ pactiv 1.0 integrityTextL2
, lanceLives $ Translate (-400.0) 340.0
(inventoryDisplay
(lance arena')
(resourceTracker u))
, lanceLives $ levelMessage
, pactiv 2.0 $ sgt 20.0 $ Translate
(-100.0)
(-100.0)
helpColumn2
, pactiv 2.0 $ sgt 20.0 $ Translate
(-120.0)
(-190.0)
helpColumn1
]
helpColumn1 =
Color cyan $
Rotate 270.0 $
Scale 0.13 0.13 $
Text "CONTROLS"
helpColumn2 =
Color white $
Pictures $
lineFormatting
[ "A, 0 to fire"
, "L-ARROW, 4 for port"
, "R-ARROW, 6 for starboard"
, "U-ARROW, 8 to accelerate"
, "TAB, 5 to switch weapons"
, "SPACEBAR, ENTER for deflector"
]
lineFormatting ys = lineFormatting' 20 0 ys
lineFormatting' _ _ [] = []
lineFormatting' x z (y:ys) =
Translate
0.0
((-x) * z)
(Scale 0.14 0.14
(Text y)) : lineFormatting' x (z + 1) ys
inventoryDisplay :: Maybe Lance -> ResourceTracker -> Picture
inventoryDisplay mLance rt =
let spacing = 40.0 in
case mLance of
Nothing -> Blank
Just l -> let i = inventory l in
let pFourWay =
if not (i !! 0)
then Blank
else let p = fromMaybe Blank
(getImage rt "item-fourway.bmp") in
Translate ((-2.0) * spacing) 0.0 p in
let pCannon =
if not (i !! 1)
then Blank
else let p = fromMaybe Blank
(getImage rt "item-cannon.bmp") in
Translate ((-1.0) * spacing) 0.0 p in
let pSpread =
if not (i !! 2)
then Blank
else let p = fromMaybe Blank
(getImage rt "item-spread.bmp") in
p in
let pRapidFire =
if not (i !! 3)
then Blank
else let p = fromMaybe Blank
(getImage rt "item-rapidfire.bmp") in
Translate spacing 0.0 p in
let pNuke =
if not (i !! 4)
then Blank
else let p = fromMaybe Blank
(getImage rt "item-nuke.bmp") in
Translate (2.0 * spacing) 0.0 p in
let c = currentWeapon l in
let pSelected =
if c == 0
then Blank
else Translate
((fromIntegral c - 3.0) * spacing) 0.0
(Line [ (12.0, 13.0)
, (12.0, -12.0)
, (-13.0, -12.0)
, (-13.0, 13.0)
, (12.0, 13.0)
]) in
Pictures [ pFourWay
, pCannon, pSpread, pRapidFire, pNuke, pSelected]
sensorPanel :: Arena -> (Double, Double) -> Picture
sensorPanel arena (w, h) =
let wmap = wrapmap w h in
let (w', h') = (double2Float w, double2Float h) in
let (w'', h'') = (w' * 0.5, h' * 0.5) in
-- let outline = Color white (Line [ (w' * 0.5, h' * 0.5)
-- , (w' * 0.5, (-h') * 0.5)
-- , ((-w') * 0.5,(-h') * 0.5)
-- , ((-w') * 0.5, h' * 0.5)
-- , (w' * 0.5, h' * 0.5)
-- ]) in
let outline = Color white
(Pictures
[ (Line [ (w'' - 4.0, h'')
, (w'', h'')
, (w'', h'' - 4.0)
])
, (Line [ (w'', (-h'') + 4.0)
, (w'', (-h''))
, (w'' - 4.0, (-h''))
])
, (Line [ ((-w''), (-h'') + 4.0)
, ((-w''), (-h''))
, ((-w'') + 4.0, (-h''))
])
, (Line [ ((-w''), h'' - 4.0)
, ((-w''), h'')
, ((-w'') + 4.0, h'')
])
]) in
let focalPoint = Color white (Line [ (2.0, 0.0)
, (0.0, 2.0)
, (-2.0, 0.0)
, (0.0, -2.0)
, (2.0, 0.0)
]) in
let unitDots =
[ let cp = case lance arena of
Nothing -> lastFocus arena
Just l -> Moving.center l in
let (x, y) = vectorRelation wmap cp c in
Translate
(double2Float (-x))
(double2Float (-y))
(Color white (Polygon [ (2.0, 0.0)
, (0.0, 2.0)
, (-2.0, 0.0)
, (0.0, -2.0)
]))
| c <- map Moving.center (simpleUnits arena)
++ map Moving.center (smartUnits arena)
] in
let itemDots =
[ let cp = case lance arena of
Nothing -> lastFocus arena
Just l -> Moving.center l in
let (x, y) = vectorRelation wmap cp c in
Translate
(double2Float (-x))
(double2Float (-y))
(Color cyan (Polygon [ (2.0, 0.0)
, (0.0, 2.0)
, (-2.0, 0.0)
, (0.0, -2.0)
]))
| c <- map Moving.center (items arena)
] in
Pictures $ [ outline
, focalPoint
] ++ unitDots ++ itemDots
deflectorText = Color white (Scale 0.14 0.14 (Text "deflector"))
deflectorBar charge =
let width = 100.0 in
let height = 20.0 in
let outline = Line [ ((-width) / 2.0, height / 2.0)
, (width / 2.0, height / 2.0)
, (width / 2.0, (-height) / 2.0)
, ((-width) / 2.0, (-height) / 2.0)
, ((-width) / 2.0, height / 2.0)
] in
let portion = (double2Float charge - 0.8) / (2.0 - 0.8) in
let barColor = if charge < 1.0 then red
else white in
let bar = Polygon [ ((-width) / 2.0, height / 2.0)
, ((-width) / 2.0 + portion * width, height / 2.0)
, ((-width) / 2.0 + portion * width, (-height) / 2.0)
, ((-width) / 2.0, (-height) / 2.0)
] in
Pictures [Color barColor bar
, Color white outline
]