39 lines
1.3 KiB
Haskell
39 lines
1.3 KiB
Haskell
module Dodge.LinearShockwave.Draw where
|
|
|
|
import Data.Maybe
|
|
import Dodge.Data.LinearShockwave
|
|
import Geometry.Data
|
|
import Geometry.Vector
|
|
import ListHelp
|
|
import Picture
|
|
|
|
drawLinearShockwave :: LinearShockwave -> Picture
|
|
drawLinearShockwave lw =
|
|
setLayer BloomLayer $
|
|
setDepth 20 $
|
|
pictures $
|
|
theArc
|
|
++ [ lineCol $ zip (reverse lps) $ map (`withAlpha` white) [0, 0.05 ..]
|
|
, lineCol $ zip (reverse rps) $ map (`withAlpha` white) [0, 0.05 ..]
|
|
]
|
|
where
|
|
-- drawing half a circle here is not perfect, a slightly smaller arc would fit
|
|
-- better, but this depends upon the angle formed by the following lines, which
|
|
-- is not fixed (it varies with speed and angle of last turn)
|
|
theArc = maybeToList $ do
|
|
(hp, hv) <- safeHead pvs
|
|
r <- safeHead xs
|
|
return $
|
|
color (snd $ last lpairs) $
|
|
uncurryV translate hp $
|
|
arc (argV hv - pi / 2) (argV hv + pi / 2) $ r * magV hv
|
|
cols = map (`withAlpha` white) [0, 0.05 ..]
|
|
lpairs = zip (reverse lps) cols
|
|
pvs = _lwPoints lw
|
|
t = _lwTimer lw
|
|
xs = take t $ drop (20 - t) [1, 1.2 ..]
|
|
lps = zipWith f pvs xs
|
|
rps = zipWith g pvs xs
|
|
f (p, v) x = p +.+ x *.* vNormal v
|
|
g (p, v) x = p -.- x *.* vNormal v
|