Refactor, try to limit dependencies

This commit is contained in:
2022-07-28 00:59:56 +01:00
parent 8aa5c17ab9
commit 160560af5f
418 changed files with 15104 additions and 13342 deletions
+26 -22
View File
@@ -1,34 +1,38 @@
module Dodge.LinearShockwave.Draw
where
import Geometry.Vector
import Geometry.Data
import ListHelp
import Dodge.Data.LinearShockwave
import Picture
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..]
]
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)
-- 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
(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..]
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..]
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
f (p, v) x = p +.+ x *.* vNormal v
g (p, v) x = p -.- x *.* vNormal v
+1 -1
View File
@@ -1,6 +1,6 @@
module Dodge.LinearShockwave.Update
where
import Dodge.Data
import Dodge.Data.World
import qualified IntMapHelp as IM
import Control.Lens