edge-0.9.0.1: Display.hs
{-# LANGUAGE ExistentialQuantification #-}
module Display (displayUniverse, AWS(..)) where
import Animation
import Universe
import Lance
import Data.Maybe
import Moving
import qualified Moving as M
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 Math
import Resources
import Common (pairDup)
data Displayable = forall a. (Locatable a, Animation a) => Displayable a
-- |Assumed Window Size.
data AWS = W1280 | W1024
deriving (Show)
displayUniverse u
= return $ Pictures $
[ let (x, y) = k displayable in
let pic = image displayable undefined in
Translate (double2Float x) (double2Float y) pic
| (Displayable displayable) <- map Displayable stars
++ map Displayable (asteroids r)
++ [ Displayable a
| Projectile a <- lanceProjectiles r ++ unitProjectiles r
]
++ [ case effect of AfterEffect a -> Displayable a
| effect <- afterFX r ]
++ [ Displayable a | SimpleUnit a <- simpleUnits r ]
++ [ Displayable a | SmartUnit a <- smartUnits r ]
++ [ Displayable a | a <- items r ]
, let (x, y) = k displayable in
abs x <= 700 && abs y <= 600
]
++ case lance r of
Nothing -> []
Just l -> if all id (inventory l)
then [ let (x, y) = vectorRelation w
(M.center a)
(focus r) in
Translate
(double2Float x)
(double2Float y)
s
| a <- items r
, case a of
(Item Health _ _) -> False
otherwise -> True
]
else []
++ [ fromMaybe Blank (do lance' <- lance r
Just (image lance' undefined))
, f 0.5 (Translate (-65) (ap 365) deflectorText)
, f 0.5 (Translate 65.0 (ap 370) $
case lance r of
Just x -> deflectorBar (deflectorCharge x)
Nothing -> deflectorBar 0.8)
, f 0.5 (Translate 140 (ap 365) (levelText (level u)))
, f 0.5 (Translate (-140) (ap 365) (livesText (lives u)))
, f 1.5 (Translate (ap 420) (ap 300)
(sensorPanel r (150, 150)))
, case lance r of
Nothing -> Blank
Just l -> if not (godMode l)
then Blank
else Translate (-20) (ap 335) godText
, f 1 (Translate (am (-500)) (ap 365)
(Color white
(Scale 0.14 0.14 (Text "structural integrity"))))
, f 1 (case lance r of
Nothing -> Blank
Just l -> Translate (am (-330)) (ap 365)
(Scale 0.14 0.14
(integrityAssessment (integrity l))))
, g (Translate (am (-400)) (ap 340)
(inventoryDisplay (lance r) (resourceTracker u)))
, g (Translate (-200) 150 (levelMessage (levelMessageTimer u) (level u)))
, h 2.5 (i 20 (Translate (ap (220)) (am (-300)) helpColumn3))
, h 2 (i 20 (Translate (am (-450)) (am (-230)) helpColumn2))
, h 2 (i 20 (Translate (am (-470)) (am (-320)) helpColumn1))
]
where f x = g . h x
g x = if isNothing (lance (arena u)) then Blank else x
h x y = if panelActivationTimer u < x then Blank else y
i x y = if startGameTimer u < x then y else Blank
r = arena u
w = Universe.wrapMap r
s = fromMaybe Blank (getImage (resourceTracker u) "item-sigma.bmp")
k x = vectorRelation w (M.center x) (focus r)
ap = case aws u of W1024 -> id; W1280 -> (+ 116)
am = case aws u of W1024 -> id; W1280 -> (\x -> x - 116)
livesText n = Color white
(Scale 0.14 0.14
(Text (show n ++ " lives")))
levelText n = (Color white
(Scale 0.14 0.14
(Text ("level " ++ show (n + 1)))))
integrityAssessment n = if n >= 3.0
then Color green (Text "optimal")
else if n >= 2.0
then Color yellow (Text "light damage")
else Color red (Text "heavy damage")
godText = Color yellow (Scale 0.14 0.14 (Text "god mode"))
deflectorText = (Color white (Scale 0.14 0.14 (Text "deflector")))
levelMessage a b = case a of
Nothing -> Blank
Just mt -> if mt `remF` 0.5 < 0.25
then Blank
else Text ("level " ++ show (b + 1))
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"
]
helpColumn3 =
Color white $
Pictures $
lineFormatting
[ "Enjoy the game? To donate"
, "visit <frigidcode.com/donate>."
]
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
box w h = [ (-q, r), (q, r), (q, -r), (-q, -r), (-q, r) ]
where (q, r) = appPair (* 0.5) (w, h)
swBar l =
let w = 150.0 in
let h = 17.0 in
let outline = Line (box w h) in
let trem = max (swTimeLimit - swClock l) 0.0 in
let portion = double2Float (trem / swTimeLimit) in
let barColor = if portion < 0.2 then red
else white in
let bar = Polygon [ ((-w) * 0.5, h * 0.5)
, ((-w) * 0.5 + portion * w, h * 0.5)
, ((-w) * 0.5 + portion * w, (-h) * 0.5)
, ((-w) * 0.5, (-h) * 0.5)
] in
Pictures [Color barColor bar
, Color white outline
]
inventoryDisplay m rt =
case m of
Nothing -> Blank
Just l ->
if swClock l < swTimeLimit && all id (inventory l)
then let p = fromMaybe Blank
(getImage rt "item-sigma.bmp") in
Pictures [ Translate (-80) 0 p
, Translate 10 0 (swBar l)
]
else let i = inventory l in
let c = currentWeapon l in
Pictures [ f 0 (-2) "item-fourway.bmp" i
, f 1 (-1) "item-cannon.bmp" i
, f 2 0 "item-spread.bmp" i
, f 3 1 "item-rapidfire.bmp" i
, f 4 2 "item-nuke.bmp" i
, if c == 0
then Blank
else Translate
((fromIntegral c - 3) * q) 0
(Line [ (12, 13), (12, -12)
, (-13, -12), (-13, 13), (12, 13) ])
]
where f x y z u = if not (u !! x)
then Blank
else let p = fromMaybe Blank
(getImage rt z) in
Translate (y * q) 0 p
q = 40
sensorPanel arena (w, h) = Pictures [ d, e, i, j ]
where a = wrapmap w h
(q, r) = appPair ((* 0.5) . double2Float) (w, h)
d = Color white (Pictures
([ (Line [ (q - 4, r), (q, r), (q, r - 4.0) ])
, (Line [ (q, 4 - r), (q, -r), (q - 4.0, -r) ])
, (Line [ (-q, 4 - r), (-q, -r), (-q + 4, -r) ])
, (Line [ (-q, r - 4.0), (-q, r), (4 - q, r) ])
]))
e = Color white (Line [ (2, 0), (0, 2), (-2, 0), (0, -2), (2, 0) ])
i = Pictures
[ f white [ (2, 0), (0, 2), (-2, 0), (0, -2) ] c
| c <- map M.center (simpleUnits arena)
++ map M.center (smartUnits arena)
]
j = Pictures
[ f cyan [ (2, 0), (0, 2), (-2, 0), (0, -2) ] c
| c <- map M.center (items arena)
]
g m = double2Float (-m)
f m n o = let (x, y) = vectorRelation a (focus arena) o in
Translate (g x) (g y) (Color m (Polygon n))
deflectorBar c =
Pictures [Color (if c < 1.0 then red else white)
(Polygon [ (-q, r), (-q + p * w, r), (-q + p * w, -r), (-q, -r) ])
, Color white (Line [ (-q, r), (q, r), (q, -r), (-q, -r), (-q, r) ])
]
where w = 100
h = 20
q = w / 2
r = h / 2
p = (double2Float c - 0.8) / (2 - 0.8)