Refactor shells

src/Dodge/Data/Item/Use/Consumption/Ammo.hs

@@ -17,9 +17,6 @@ import Data.Aeson.TH
 import Dodge.Data.Bullet
 import Dodge.Data.Payload
 
-data ProjectileDraw = DrawShell | DrawRemoteShell | DrawDrone | DrawBlankProjectile
-    deriving (Show, Eq, Ord, Enum, Bounded, Read) --Generic, Flat)
-
 data ProjectileHoming 
     = NoHoming 
     | HomeUsingRemoteScreen {_phRemoteID :: NewInt ItmInt}
@@ -29,7 +26,8 @@ data ProjectileHoming
 data ProjectileUpdate
     = ThrustPU {_pjuStart :: Int, _pjuEnd :: Int, _pjuSmokeless :: Bool}
     | StartSpinPU {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
-    | RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int, _pjuControllerID :: ProjectileHoming}
+--    | RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int, _pjuControllerID :: ProjectileHoming}
+    | RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int}
     | ReduceSpinPU {_pjuReduceSpin :: Float}
     | DestroyPU {_pjuScreenID :: Maybe (NewInt ItmInt)
         ,_pjuTimer :: Int}
@@ -66,7 +64,6 @@ makeLenses ''AmmoType
 makeLenses ''ProjectileHoming
 deriveJSON defaultOptions ''GasFuel
 deriveJSON defaultOptions ''ProjectileHoming
-deriveJSON defaultOptions ''ProjectileDraw
 deriveJSON defaultOptions ''ProjectileUpdate
 deriveJSON defaultOptions ''GasCreate
 deriveJSON defaultOptions ''ForceFieldType

src/Dodge/Data/Projectile.hs

@@ -13,17 +13,15 @@ import Geometry.Data
 
 data ProjectileType
     = Grenade
-    | Rocket
+    | Rocket {_rocketHoming :: ProjectileHoming}
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data Projectile
     = Shell
         { _prjPos :: Point2
         , _prjVel :: Point2
---        , _prjAcc :: Point2
         , _prjDir :: Float
         , _prjSpin :: Float
-        , _prjDraw :: ProjectileDraw
         , _prjID :: Int
         , _prjPayload :: Payload
         , _prjTimer :: Int
@@ -35,5 +33,6 @@ data Projectile
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''Projectile
+makeLenses ''ProjectileType
 deriveJSON defaultOptions ''ProjectileType
 deriveJSON defaultOptions ''Projectile

src/Dodge/HeldUse.hs

@@ -299,7 +299,7 @@ useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cme
         MuzzleLaser -> shootLaser itmtree cr mz w
         MuzzleTesla -> shootTeslaArc itm cr mz w
         MuzzleTractor -> shootTractorBeam cr w
-        MuzzleRLauncher -> createProjectile Rocket magtree mz itmtree cr w
+        MuzzleRLauncher -> createProjectileR magtree mz itmtree cr w
         MuzzleGLauncher -> createProjectile Grenade magtree mz itmtree cr w
         MuzzleNozzle{} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w
         MuzzleShatter -> shootShatter itm cr w
@@ -606,6 +606,16 @@ determineProjectileTracking magtree itmtree = fromMaybe NoHoming $
         targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight)
         return $ HomeUsingTargeting (targetingtree ^. ldtValue . itID)
 
+createProjectileR ::
+    LabelDoubleTree ComposeLinkType Item ->
+    Muzzle ->
+    LabelDoubleTree ComposeLinkType Item ->
+    Creature ->
+    World ->
+    World
+createProjectileR magtree muz itmtree cr =
+    createProjectile (Rocket $ determineProjectileTracking magtree itmtree) magtree muz itmtree cr
+
 createProjectile ::
     ProjectileType ->
     LabelDoubleTree ComposeLinkType Item ->

src/Dodge/Projectile/Create.hs

@@ -12,12 +12,6 @@ import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
 
-homingDrawType :: ProjectileHoming -> ProjectileDraw
-homingDrawType ht = case ht of
-    NoHoming -> DrawShell
-    HomeUsingRemoteScreen {} -> DrawRemoteShell
-    HomeUsingTargeting {} -> DrawRemoteShell
-
 -- assumes the mscreen is in your inventory
 createShell :: ProjectileHoming 
     -> Maybe (NewInt ItmInt) 
@@ -34,7 +28,6 @@ createShell homing mdetonator mscreen smokestatus pjtype payload muz cr w = w
             , _prjZ = 20
             , _prjZVel = 5
             , _prjVel = rotateV dir (V2 speed 0) + cr ^. crPos - cr ^. crOldPos
-            , _prjDraw = homingDrawType homing
             , _prjID = i
 --            , _prjAcc = rotateV dir (V2 3 0)
             , _prjDir = dir
@@ -45,7 +38,7 @@ createShell homing mdetonator mscreen smokestatus pjtype payload muz cr w = w
                 [ CollisionEffectPU (homing ^? phRemoteID) mdetonator mscreen
                 , TimePU
                 , StartSpinPU (lifespan - 15) (_crID cr) spinamount
-                , RemoteDirectionPU (lifespan - thrustdelay) 0 homing
+                , RemoteDirectionPU (lifespan - thrustdelay) 0
                 , ReduceSpinPU (1 - spindrag * 2 / 200)
                 ] <> thrustorgrav
             , _prjType = pjtype
@@ -53,13 +46,13 @@ createShell homing mdetonator mscreen smokestatus pjtype payload muz cr w = w
   where
     speed = case pjtype of
         Grenade -> 4
-        Rocket -> 1
+        Rocket{} -> 1
     lifespan = case pjtype of
         Grenade -> 150
-        Rocket -> 350
+        Rocket{} -> 350
     thrustorgrav = case pjtype of
         Grenade -> [ApplyGravityPU]
-        Rocket -> [ThrustPU (lifespan - thrustdelay) 0 smokestatus]
+        Rocket{} -> [ThrustPU (lifespan - thrustdelay) 0 smokestatus]
     spindrag = 1
     spinamount = 2
     thrustdelay = 20

src/Dodge/Projectile/Draw.hs

@@ -9,16 +9,19 @@ import Geometry
 import Picture
 import Shape
 import ShapePicture
+import Control.Lens
 
 drawProjectile :: Projectile -> SPic
-drawProjectile prj = case _prjDraw prj of
+drawProjectile pj 
-    DrawShell -> drawShell prj
+    | Just (DestroyPU {}) <- pj ^? prjUpdates . ix 0 = mempty
-    DrawRemoteShell -> drawRemoteShell prj
+    | Just NoHoming <- pj ^? prjType . rocketHoming =
-    DrawDrone -> drawShell prj
+        drawShell Nothing pj
-    DrawBlankProjectile -> mempty
+    | Just _ <- pj ^? prjType . rocketHoming =
+        drawRemoteShell pj
+    | otherwise = drawShell Nothing pj
 
-drawShell :: Projectile -> SPic
+drawShell :: Maybe Color -> Projectile -> SPic
-drawShell pj =
+drawShell mcol pj =
     noPic
         . translateSHz (_prjZ pj)
         . uncurryV translateSHxy (_prjPos pj)

src/Dodge/Projectile/Update.hs

@@ -39,8 +39,8 @@ upProjectile pu pj = case pu of
     StartSpinPU t cid spinamount
         | time == t -> trySpinByCID cid spinamount pj
         | otherwise -> id
-    RemoteDirectionPU st et mscreenid
+    RemoteDirectionPU st et
-        | act st et -> pjRemoteSetDirection mscreenid pj
+        | act st et -> pjRemoteSetDirection (pj ^? prjType . rocketHoming) pj
         | otherwise -> id
     ReduceSpinPU x -> reduceSpinBy x (_prjID pj)
     DestroyPU mitid 0 -> destroyProjectile mitid (_prjID pj)
@@ -156,14 +156,14 @@ trySpinByCID cid i pj w = w & cWorld . lWorld . projectiles . ix pjid . prjSpin
     spinFactor = 5 * (6 - fromIntegral i)
 
 -- note this only allows YOU to remotely track projectiles
-pjRemoteSetDirection :: ProjectileHoming -> Projectile -> World -> World
+pjRemoteSetDirection :: Maybe ProjectileHoming -> Projectile -> World -> World
 pjRemoteSetDirection ph pj w = case ph of
-    HomeUsingRemoteScreen screenid
+    Just (HomeUsingRemoteScreen screenid)
         | lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
             == lw ^? itemLocations . ix (_unNInt screenid) . ilInvID ->
             w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjDir
                 .~ (w ^. wCam . camRot) + argV (w ^. input . mousePos)
-    HomeUsingTargeting itid
+    Just (HomeUsingTargeting itid)
         | Just tp <- w ^? pointerToItemID itid . itTargeting . itTgPos . _Just ->
             w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjDir
                 %~ turnTo 0.2 (_prjPos pj) tp
@@ -171,16 +171,6 @@ pjRemoteSetDirection ph pj w = case ph of
   where
     lw = w ^. cWorld . lWorld
 
---pjRemoteSetDirection mscreenid pj w = fromMaybe w $ do
---    screenid <- fmap _unNInt mscreenid
---    let newdir
---            | w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
---                    == w ^? cWorld . lWorld . itemLocations . ix screenid . ilInvID
---                = (w ^. wCam . camRot) + argV (_mousePos (_input w))
---            | otherwise = _prjDir pj
---        turntonewdir = magV (_prjAcc pj) *.* unitVectorAtAngle newdir
---    return $ w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc .~ turntonewdir
-
 reduceSpinBy :: Float -> Int -> World -> World
 reduceSpinBy x pjid = cWorld . lWorld . projectiles . ix pjid . prjSpin *~ x
 
@@ -189,7 +179,6 @@ decTimMvVel pj =
     cWorld . lWorld . projectiles . ix pjid
         %~ ( (prjTimer -~ 1)
                 . (prjPos %~ (+.+ vel))
-                --                . (prjAcc %~ rotateV rot)
                 . (prjDir +~ rot)
            )
   where
@@ -207,7 +196,7 @@ explodeShell ::
 explodeShell controlid mdetid screenid pj w =
     w
         & cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [DestroyPU screenid 30]
-        & cWorld . lWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
+--        & cWorld . lWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
         & usePayload (_prjPayload pj) (_prjPos pj) (_prjVel pj)
         & stopSoundFrom (ShellSound pjid)
         & updatedetonator

src/Dodge/SelectUse.hs

@@ -20,7 +20,6 @@ selectUse itm _ w = fromMaybe w $ do
     return $
         w
             & cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [DestroyPU (Just itid) 30] -- 69 is placeholder, should be removed
-            & cWorld . lWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
             --        & itPoint . itUse . heldUse .~ HeldDoNothing
             --        & itPoint . itUse . heldMods .~ DoNothingMod
             & usePayload (_prjPayload thepj) (_prjPos thepj) (_prjVel thepj)

tags

@@ -2871,7 +2871,6 @@ _preloadData	src/Dodge/Data/Universe.hs	32;"	f
 _pressPlates	src/Dodge/Data/LWorld.hs	134;"	f
 _pressedKeys	src/Dodge/Data/Input.hs	45;"	f
 _previousArcEffect	src/Dodge/Data/Item/Params.hs	26;"	f
-_prjAcc	src/Dodge/Data/Projectile.hs	23;"	f
 _prjDir	src/Dodge/Data/Projectile.hs	24;"	f
 _prjDraw	src/Dodge/Data/Projectile.hs	26;"	f
 _prjID	src/Dodge/Data/Projectile.hs	27;"	f
@@ -3367,7 +3366,7 @@ applyCME	src/Dodge/HeldUse.hs	126;"	f
 applyCreatureDamage	src/Dodge/Creature/Damage.hs	14;"	f
 applyDamageEffect	src/Dodge/Creature/Damage.hs	31;"	f
 applyEventIO	src/Loop.hs	89;"	f
-applyGravityPU	src/Dodge/Projectile/Update.hs	51;"	f
+applyGravityPU	src/Dodge/Projectile/Update.hs	55;"	f
 applyIndividualDamage	src/Dodge/Creature/Damage.hs	49;"	f
 applyIndividualDamage'	src/Dodge/Creature/Damage.hs	52;"	f
 applyInvLock	src/Dodge/HeldUse.hs	141;"	f
@@ -3830,7 +3829,7 @@ debugMenuOptions	src/Dodge/Menu.hs	119;"	f
 debugOn	src/Dodge/Data/Config.hs	151;"	f
 debugSelectCreatureList	src/Dodge/Debug.hs	86;"	f
 debugSelectCreatureMessage	src/Dodge/Debug.hs	77;"	f
-decTimMvVel	src/Dodge/Projectile/Update.hs	177;"	f
+decTimMvVel	src/Dodge/Projectile/Update.hs	187;"	f
 decodedtmap	src/Dodge/Terminal.hs	205;"	f
 decomposeSelfTree	src/Dodge/Tree/Compose.hs	60;"	f
 decomposeTree	src/Dodge/Tree/Compose.hs	57;"	f
@@ -3933,7 +3932,7 @@ destroyMatS	src/Dodge/Material/Sound.hs	7;"	f
 destroyMcType	src/Dodge/Machine/Destroy.hs	21;"	f
 destroyMount	src/Dodge/Block.hs	104;"	f
 destroyMounts	src/Dodge/Block.hs	101;"	f
-destroyProjectile	src/Dodge/Projectile/Update.hs	92;"	f
+destroyProjectile	src/Dodge/Projectile/Update.hs	103;"	f
 detV	src/Geometry/Vector.hs	93;"	f
 detector	src/Dodge/Item/Held/Utility.hs	41;"	f
 detectorColor	src/Dodge/Item/Draw/SPic.hs	434;"	f
@@ -4047,7 +4046,7 @@ doTerminalCommandEffect	src/Dodge/Terminal.hs	135;"	f
 doTestDrawing	src/Dodge/Render.hs	42;"	f
 doTextInputOver	src/Dodge/Update/Input/Text.hs	15;"	f
 doTextInputOverUniverse	src/Dodge/Update/Input/Text.hs	12;"	f
-doThrust	src/Dodge/Projectile/Update.hs	104;"	f
+doThrust	src/Dodge/Projectile/Update.hs	115;"	f
 doTimeScroll	src/Dodge/Update.hs	205;"	f
 doTmTm	src/Dodge/TmTm.hs	6;"	f
 doTmWdWd	src/Dodge/WorldEffect.hs	101;"	f
@@ -4254,7 +4253,7 @@ expandPolyCorners	src/Dodge/LevelGen/StaticWalls.hs	103;"	f
 expandToSquare	src/Dodge/LevelGen/StaticWalls/Deprecated.hs	83;"	f
 expireAndDamage	src/Dodge/Bullet.hs	195;"	f
 expireAndDamageFL	src/Dodge/Flame.hs	47;"	f
-explodeShell	src/Dodge/Projectile/Update.hs	190;"	f
+explodeShell	src/Dodge/Projectile/Update.hs	200;"	f
 explosionS	src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs	410;"	f
 explosiveBarrel	src/Dodge/Creature/Inanimate.hs	29;"	f
 extTrigLitPos	src/Dodge/Placement/Instance/Button.hs	84;"	f
@@ -5136,7 +5135,7 @@ pipe	src/Dodge/Item/Craftable.hs	32;"	f
 pistol	src/Dodge/Item/Held/Stick.hs	42;"	f
 pistolCrit	src/Dodge/Creature/PistolCrit.hs	12;"	f
 pistolerRoom	src/Dodge/Room/Room.hs	321;"	f
-pjRemoteSetDirection	src/Dodge/Projectile/Update.hs	147;"	f
+pjRemoteSetDirection	src/Dodge/Projectile/Update.hs	159;"	f
 plBlock	src/Dodge/Placement/PlaceSpot/Block.hs	18;"	f
 plDoor	src/Dodge/Placement/PlaceSpot/TriggerDoor.hs	22;"	f
 plLineBlock	src/Dodge/Placement/PlaceSpot/Block.hs	50;"	f
@@ -5385,7 +5384,7 @@ rectXY	src/Geometry/Polygon.hs	35;"	f
 rectanglePairs	src/Dodge/LevelGen/DoorPane.hs	7;"	f
 red	src/Color.hs	14;"	f
 reduceLocLDT	src/Dodge/DoubleTree.hs	256;"	f
-reduceSpinBy	src/Dodge/Projectile/Update.hs	174;"	f
+reduceSpinBy	src/Dodge/Projectile/Update.hs	184;"	f
 reflDirWall	src/Dodge/Base/Wall.hs	16;"	f
 reflVelWall	src/Dodge/Base/Wall.hs	24;"	f
 reflVelWallDamp	src/Dodge/Base/Wall.hs	20;"	f
@@ -5657,7 +5656,7 @@ shardShape	src/Dodge/Block/Debris.hs	181;"	f
 shatterGun	src/Dodge/Item/Held/Weapons.hs	8;"	f
 shatterGunSPic	src/Dodge/Item/Draw/SPic.hs	284;"	f
 shatterWall	src/Dodge/Item/Weapon/Shatter.hs	26;"	f
-shellCollisionCheck	src/Dodge/Projectile/Update.hs	76;"	f
+shellCollisionCheck	src/Dodge/Projectile/Update.hs	84;"	f
 shellMag	src/Dodge/Item/Ammo.hs	61;"	f
 shellModule	src/Dodge/Item/Scope.hs	45;"	f
 shellShape	src/Dodge/Projectile/Draw.hs	27;"	f
@@ -6046,7 +6045,7 @@ tryPutFloorItemIDInInv	src/Dodge/Inventory/Add.hs	26;"	f
 tryPutItemInInv	src/Dodge/Inventory/Add.hs	42;"	f
 tryPutItemInInvAt	src/Dodge/Inventory/Add.hs	32;"	f
 trySeedFromClipboard	src/Dodge/Menu.hs	88;"	f
-trySpinByCID	src/Dodge/Projectile/Update.hs	129;"	f
+trySpinByCID	src/Dodge/Projectile/Update.hs	141;"	f
 trySynthBullet	src/Dodge/Creature/State.hs	204;"	f
 tryUseParent	src/Dodge/Creature/State.hs	197;"	f
 turnTo	src/Dodge/Movement/Turn.hs	4;"	f