Prop reification/splitting

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -29,15 +29,8 @@ import Dodge.Base
 --import Dodge.Zone
 import Geometry
 import Picture
-import ShapePicture
 import LensHelp
---import Dodge.RandomHelp
---import MonadHelp
 
---import Data.Maybe
---import Data.List (sortOn)
---import System.Random
---import Data.Tuple
 import qualified IntMapHelp as IM
 import qualified Data.Map.Strict as M
 --import Control.Monad.State
@@ -353,8 +346,7 @@ dualRayAt bt itid w col dam phasev pos dir = basicBeamAt itid w col dam phasev p
     & bmType .~ bt
 
 aTractorBeam :: Item -> Creature -> World -> World
---aTractorBeam _ cr w = w & props %~  tractorBeamAt i spos outpos dir power
-aTractorBeam _ cr w = w & plNew props pjID (tractorBeamAt spos outpos dir power)
+aTractorBeam _ cr w = w & tractorBeams .:~ tractorBeamAt spos outpos dir power
   where 
     cpos = _crPos cr
     spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
@@ -363,71 +355,13 @@ aTractorBeam _ cr w = w & plNew props pjID (tractorBeamAt spos outpos dir power)
     outpos = fst $ collidePointWallsFilterStream (const True) cpos xpos w
     power = _attractionPower . _itParams $ _crInv cr IM.! crSel cr
 
-tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> Prop
-tractorBeamAt pos outpos dir power = ProjectileTimed
-    { _prPos = pos
-    , _pjStartPos = outpos
-    , _pjVel = d
-    , _prDraw = tractorSPic
-    , _pjID = 0
-    , _pjUpdate = updateTractor
-    , _pjTime = 10
+tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
+tractorBeamAt pos outpos dir power = TractorBeam
+    { _tbPos = pos
+    , _tbStartPos = outpos
+    , _tbVel = d
+    , _tbTime = 10
     }
   where 
     d  = unitVectorAtAngle dir * power
-{- |
-The interaction of this with objects, walls etc needs more thought.  -}
-updateTractor :: Prop -> World -> World
-updateTractor pj w
-    | _pjTime pj <= 0 = w & props %~ IM.delete i
-    | otherwise = w
-        & props . ix i . pjTime -~ 1
-        & creatures     %~ IM.map (tractCr   pullVel pos outpos)
-        & floorItems    %~ IM.map (tractFlIt pullVel pos outpos)
-  where 
-    i = _pjID pj
-    pullVel = _pjVel pj
-    pos = _prPos pj
-    outpos = _pjStartPos 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
-
-tractorSPic :: Prop -> SPic
-tractorSPic pj = (,) mempty $ 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 (_pjTime pj)
-    spos = _prPos pj
-    xpos = _pjStartPos pj
-    d = squashNormalizeV $ spos -.- xpos
-    n = vNormal d
-    col = mixColors 0.5 0.5 white blue

src/Dodge/Item/Weapon/Grenade.hs

@@ -1,15 +1,9 @@
 module Dodge.Item.Weapon.Grenade where
-import Dodge.Zoning.Wall
 import Dodge.Data
-import Dodge.Base
-import Dodge.SoundLogic
 import Picture
 import Geometry
 import ShapePicture
 import Shape
-import qualified IntMapHelp as IM
-
-import Control.Lens
 
 --grenade :: Item
 --grenade = Item
@@ -40,27 +34,27 @@ import Control.Lens
 --    fuseTime = 50
 --    f x = 50 / fromIntegral x
 
-moveGrenade :: Prop -> World -> World
-moveGrenade pj w
-    | _pjTimer pj <= 0 = w 
-        & props %~ IM.delete pID 
-        & _pjPayload pj (_prPos (_props w IM.! pID)) 
-                                                            -- this should maybe
-                                                            -- be wallsAlongLine
-                                                            -- or something vvv
-    | otherwise = case bounceBall 1 oldPos newPos 4 $ wlsNearPoint newPos w of
-        Nothing -> w & props . ix pID %~ normalUpdate
-        Just (p,v)  -> w
-            & soundStart (Tap 0) p tapQuietS Nothing
-            & props . ix pID %~ ( ( prPos .~ p ) . ( pjTimer -~ 1 ) . (pjVel .~ v) )
-  where 
-    pID = _pjID pj
-    normalUpdate = (pjTimer -~ 1) 
-        . (pjZ %~ (max 0 . (+ _pjVelZ pj))) 
-        . (pjVelZ -~ 0.1)
-        . ( prPos .~ newPos )
-    oldPos = _prPos pj
-    newPos = _pjVel pj +.+ oldPos
+--moveGrenade :: Prop -> World -> World
+--moveGrenade pj w
+--    | _pjTimer pj <= 0 = w 
+--        & props %~ IM.delete pID 
+--        & _pjPayload pj (_prPos (_props w IM.! pID)) 
+--                                                            -- this should maybe
+--                                                            -- be wallsAlongLine
+--                                                            -- or something vvv
+--    | otherwise = case bounceBall 1 oldPos newPos 4 $ wlsNearPoint newPos w of
+--        Nothing -> w & props . ix pID %~ normalUpdate
+--        Just (p,v)  -> w
+--            & soundStart (Tap 0) p tapQuietS Nothing
+--            & props . ix pID %~ ( ( prPos .~ p ) . ( pjTimer -~ 1 ) . (pjVel .~ v) )
+--  where 
+--    pID = _pjID pj
+--    normalUpdate = (pjTimer -~ 1) 
+--        . (pjZ %~ (max 0 . (+ _pjVelZ pj))) 
+--        . (pjVelZ -~ 0.1)
+--        . ( prPos .~ newPos )
+--    oldPos = _prPos pj
+--    newPos = _pjVel pj +.+ oldPos
 
 grenadePic :: Int -> SPic
 grenadePic time = 
@@ -72,9 +66,9 @@ grenadePic time =
         ]
     )
 
-grenadeDraw :: Float -> Prop -> SPic
-grenadeDraw dir prop = translateSPz (_pjZ prop) $ uncurryV translateSPf (_prPos prop) 
-    $ rotateSP dir $ grenadePic $ _pjTimer prop
+--grenadeDraw :: Float -> Prop -> SPic
+--grenadeDraw dir prop = translateSPz (_pjZ prop) $ uncurryV translateSPf (_prPos prop) 
+--    $ rotateSP dir $ grenadePic $ _pjTimer prop
 
 --throwGrenade 
 --    :: (Point2 -> World -> World)   -- ^ Payload