Refactor projectiles, fix shell drawing

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

@@ -17,16 +17,9 @@ import Data.Aeson.TH
 import Dodge.Data.Bullet
 import Dodge.Data.Payload
 
-data ProjectileHoming 
-    = NoHoming 
-    | HomeUsingRemoteScreen {_phRemoteID :: NewInt ItmInt}
-    | HomeUsingTargeting {_phTargetingID :: NewInt ItmInt}
-    deriving (Show, Eq, Ord, Read) --Generic, Flat)
-
 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}
     | ReduceSpinPU {_pjuReduceSpin :: Float}
     | DestroyPU {_pjuScreenID :: Maybe (NewInt ItmInt)
@@ -61,9 +54,7 @@ data GasCreate = CreatePoisonGas | CreateFlame
 
 makeLenses ''ProjectileUpdate
 makeLenses ''AmmoType
-makeLenses ''ProjectileHoming
 deriveJSON defaultOptions ''GasFuel
-deriveJSON defaultOptions ''ProjectileHoming
 deriveJSON defaultOptions ''ProjectileUpdate
 deriveJSON defaultOptions ''GasCreate
 deriveJSON defaultOptions ''ForceFieldType

src/Dodge/Data/Projectile.hs

@@ -5,6 +5,8 @@
 
 module Dodge.Data.Projectile where
 
+import Dodge.Data.Item.Location
+import NewInt
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -13,7 +15,7 @@ import Geometry.Data
 
 data ProjectileType
     = Grenade
-    | Rocket {_rocketHoming :: ProjectileHoming}
+    | Rocket {_rkHoming :: RocketHoming}
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data Projectile
@@ -32,7 +34,16 @@ data Projectile
         }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
+data RocketHoming 
+    = NoHoming 
+    | HomeUsingRemoteScreen {_phRemoteID :: NewInt ItmInt}
+    | HomeUsingTargeting {_phTargetingID :: NewInt ItmInt}
+    deriving (Show, Eq, Ord, Read) --Generic, Flat)
+
+
 makeLenses ''Projectile
 makeLenses ''ProjectileType
+makeLenses ''RocketHoming
+deriveJSON defaultOptions ''RocketHoming
 deriveJSON defaultOptions ''ProjectileType
 deriveJSON defaultOptions ''Projectile

src/Dodge/HeldUse.hs

@@ -593,7 +593,7 @@ shootTeslaArc itm cr mz w =
 determineProjectileTracking ::
     LabelDoubleTree ComposeLinkType Item ->
     LabelDoubleTree ComposeLinkType Item ->
-    ProjectileHoming
+    RocketHoming
 determineProjectileTracking magtree itmtree = fromMaybe NoHoming $
     finddronecontrols <|> findexternaltracking
   where

src/Dodge/Projectile/Create.hs

@@ -13,7 +13,7 @@ import qualified IntMapHelp as IM
 import LensHelp
 
 -- assumes the mscreen is in your inventory
-createShell :: ProjectileHoming 
+createShell :: RocketHoming 
     -> Maybe (NewInt ItmInt) 
     -> Maybe (NewInt ItmInt) 
     -> Bool

src/Dodge/Projectile/Draw.hs

@@ -1,7 +1,8 @@
-module Dodge.Projectile.Draw 
-    ( drawProjectile
-    ) where
+module Dodge.Projectile.Draw (
+    drawProjectile,
+) where
 
+import Control.Lens
 import Data.Strict.Tuple
 import Dodge.Data.Item.Use.Consumption.Ammo
 import Dodge.Data.Projectile
@@ -9,40 +10,37 @@ import Geometry
 import Picture
 import Shape
 import ShapePicture
-import Control.Lens
 
 drawProjectile :: Projectile -> SPic
-drawProjectile pj 
-    | Just (DestroyPU {}) <- pj ^? prjUpdates . ix 0 = mempty
-    | Just NoHoming <- pj ^? prjType . rocketHoming =
+drawProjectile pj
+    | Just (DestroyPU{}) <- pj ^? prjUpdates . ix 0 = mempty
+    | Just NoHoming <- pj ^? prjType . rkHoming =
         drawShell Nothing pj
-    | Just _ <- pj ^? prjType . rocketHoming =
+    | Just _ <- pj ^? prjType . rkHoming =
         drawRemoteShell pj
     | otherwise = drawShell Nothing pj
 
 drawShell :: Maybe Color -> Projectile -> SPic
 drawShell mcol pj =
-    noPic
-        . translateSHz (_prjZ pj)
-        . uncurryV translateSHxy (_prjPos pj)
-        $ rotateSH (_prjDir pj) shellShape
+    translateSPz (_prjZ pj)
+        . uncurryV translateSPxy (_prjPos pj)
+        $ rotateSP (_prjDir pj) $
+            shellShape :!: thelight
+  where
+    thelight =
+        foldMap
+            (\col -> setLayer BloomNoZWrite . setDepth 4.5 . color col $ circleSolid 3)
+            mcol
 
 shellShape :: Shape
 shellShape = colorSH black $ upperPrismPoly Small Typical 4 $ map toV2 [(-6, 4), (-6, -4), (6, -4), (8, 0), (6, 4)]
 
 drawRemoteShell :: Projectile -> SPic
 drawRemoteShell pj
-    | rem (t + 200) 20 < 9 =
-        doposition $ noPic shellShape
-    | otherwise = doposition $ remoteShellShape col
+    | rem (t + 200) 20 < 9 = drawShell Nothing pj
+    | otherwise = drawShell (Just col) pj
   where
     col
         | t > (-99) = green
         | otherwise = red
     t = _prjTimer pj
-    doposition = translateSPz 18 . uncurryV translateSPxy (_prjPos pj) . rotateSP (_prjDir pj)
-
-remoteShellShape :: Color -> SPic
-remoteShellShape col =
-     shellShape
-    :!: ( setLayer BloomNoZWrite . setDepth 4.5 . color col $ circleSolid 3)

src/Dodge/Projectile/Update.hs

@@ -40,7 +40,7 @@ upProjectile pu pj = case pu of
         | time == t -> trySpinByCID cid spinamount pj
         | otherwise -> id
     RemoteDirectionPU st et
-        | act st et -> pjRemoteSetDirection (pj ^? prjType . rocketHoming) pj
+        | act st et -> pjRemoteSetDirection (pj ^? prjType . rkHoming) pj
         | otherwise -> id
     ReduceSpinPU x -> reduceSpinBy x (_prjID pj)
     DestroyPU mitid 0 -> destroyProjectile mitid (_prjID pj)
@@ -156,7 +156,7 @@ 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 :: Maybe ProjectileHoming -> Projectile -> World -> World
+pjRemoteSetDirection :: Maybe RocketHoming -> Projectile -> World -> World
 pjRemoteSetDirection ph pj w = case ph of
     Just (HomeUsingRemoteScreen screenid)
         | lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem

src/Dodge/SelectUse.hs

@@ -1,28 +0,0 @@
-module Dodge.SelectUse (selectUse) where
-
-import Control.Monad
-import qualified SDL
-import Control.Lens
-import Data.Maybe
-import Dodge.Data.World
-import Dodge.Payload
-
--- this could just set the timer to 0?
-selectUse :: Item -> Creature -> World -> World
-selectUse itm _ w = fromMaybe w $ do
-    lbtime <- w ^? input . mouseButtons . ix SDL.ButtonLeft 
-    guard $ lbtime == 0
-    itid <- itm ^? itID
-    pjid <- itm ^? itUse . uaParams . apLinkedProjectile . _Just
-    thepj <- w ^? cWorld . lWorld . projectiles . ix pjid
-    topupdate <- thepj ^? prjUpdates . ix 0
-    guard $ notdestroyed topupdate -- this assumes that "destroyed" projectiles always have the same type of update at the top
-    return $
-        w
-            & cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [DestroyPU (Just itid) 30] -- 69 is placeholder, should be removed
-            --        & itPoint . itUse . heldUse .~ HeldDoNothing
-            --        & itPoint . itUse . heldMods .~ DoNothingMod
-            & usePayload (_prjPayload thepj) (_prjPos thepj) (_prjVel thepj)
-  where
-    notdestroyed DestroyPU{} = False
-    notdestroyed _ = True