Prop reification/splitting

2022-07-24 13:45:05 +01:00
parent 5a2f529182
commit ac069d08f6
31 changed files with 585 additions and 458 deletions
@@ -0,0 +1,24 @@
+module Dodge.TractorBeam.Draw
+    where
+import Dodge.Data.TractorBeam
+import Geometry
+import Picture
+
+drawTractorBeam :: TractorBeam -> Picture
+drawTractorBeam = tractorSPic
+
+tractorSPic :: TractorBeam -> Picture
+tractorSPic pj = setLayer BloomNoZWrite $ setDepth 20 $ color (withAlpha 0.5 col) $ polygon 
+    [ spos  -- not sure if this is anticlockwise...
+    , spos +.+ size *.* (d +.+ n)
+    , xpos +.+ size *.* n
+    , xpos -.- size *.* n
+    , spos +.+ size *.* (d -.- n)
+    ]
+  where
+    size = fromIntegral (_tbTime pj)
+    spos = _tbPos pj
+    xpos = _tbStartPos pj
+    d = squashNormalizeV $ spos -.- xpos
+    n = vNormal d
+    col = mixColors 0.5 0.5 white blue
@@ -0,0 +1,45 @@
+module Dodge.TractorBeam.Update
+    where
+import Geometry
+import Dodge.Data
+import qualified IntMapHelp as IM
+import Control.Lens
+
+updateTractorBeam :: World -> TractorBeam -> (World, Maybe TractorBeam)
+updateTractorBeam w pj
+    | _tbTime pj <= 0 = (w, Nothing)
+    | otherwise = (w
+        & creatures     %~ IM.map (tractCr   pullVel pos outpos)
+        & floorItems    %~ IM.map (tractFlIt pullVel pos outpos)
+        , Just (pj & tbTime -~ 1))
+  where 
+    pullVel = _tbVel pj
+    pos     = _tbPos pj
+    outpos  = _tbStartPos pj
+
+tractFlIt :: Point2 -> Point2 -> Point2 -> FloorItem -> FloorItem
+tractFlIt q p1 outpos it 
+    | segOnCirc p1 outpos (_flItPos it) 10 = it & flItPos %~ tractorPullPos q p1
+    | otherwise = it
+
+tractCr :: Point2 -> Point2 -> Point2 -> Creature -> Creature
+tractCr q p1 outpos cr
+    | segOnCirc p1 outpos (_crPos cr) 10 = cr & crPos %~ tractorPullPos q p1
+    | otherwise = cr
+
+tractorPullPos :: Point2 -> Point2 -> Point2 -> Point2
+tractorPullPos q p1 p = p -.- m *.* (0.3/ x' *.* q +.+ g y *.* p4)
+  where
+    x' = abs y + 1
+    y = errorClosestPointOnLineParam 1 p1 p3 p
+    m | dist p p1 < 350 = 1
+      | otherwise        = (400 - dist p p1) / 50
+    g x | x > 5 = (10 - x) / 250
+        | x > 1 = 0.02
+        | x > -1 = x * 0.02
+        | x > -5 = -0.02
+        | otherwise = (x - 10) / 250
+    --p4 = vNormal p5
+    p4 = vNormal $ squashNormalizeV q
+    p3 = p1 +.+ p4
+