Commit before improving item targeting

src/Dodge/Creature.hs

@@ -183,7 +183,6 @@ testInventory = IM.fromList $ zip [0..]
 stackedInventory :: IM.IntMap Item
 stackedInventory = IM.fromList $ zip [0..] 
     [sonicGun
-    ,teleGun
     ,spreadGun
     , pipe
     ,rewindGun

src/Dodge/Creature/Lamp.hs

@@ -41,7 +41,7 @@ lampCrPic h = pictures
     , concatMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1)
     ]
   where
-    f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] 0 polyNum
+    f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] (LayNum 0) polyNum
 
 initialiseLamp :: Float -> Creature -> World -> World
 initialiseLamp = initialiseColorLamp 0.75

src/Dodge/Data.hs

@@ -377,6 +377,13 @@ data Item = Item
     , _itModules    :: M.Map ModuleSlot ItemModule
     , _itScope      :: Scope
     }
+data Targeting
+    = NoTargeting
+    | Targeting
+        { _tgPos    :: Maybe Point2
+        , _tgUpdate :: Item -> Creature -> World -> Maybe Point2
+        , _tgDraw   :: Item -> Creature -> World -> Picture
+        }
 data ModuleSlot
     = ModBullet
     | ModRifleMag
@@ -620,6 +627,15 @@ data Prop
         , _prDraw :: Prop -> SPic
         , _prToggle :: Bool
         }
+    | RemoteShell    
+        { _pjPos :: Point2
+        , _pjStartPos :: Point2
+        , _pjVel :: Point2
+        , _prDraw :: Prop -> SPic
+        , _pjID :: Int
+        , _pjUpdate :: Prop -> World -> World
+        , _pjPayload :: Point2 -> World -> World
+        }
     | Shell 
         { _pjPos :: Point2
         , _pjStartPos :: Point2
@@ -933,3 +949,4 @@ makeLenses ''Magnet
 makeLenses ''Gust
 makeLenses ''GunBarrels
 makeLenses ''ItemModule
+makeLenses ''Targeting

src/Dodge/Item/Weapon/Bezier.hs

@@ -1,6 +1,5 @@
 module Dodge.Item.Weapon.Bezier
     ( bezierGun
-    , teleGun
     ) where
 import Dodge.Data
 import Dodge.Base
@@ -47,7 +46,6 @@ bezierGun = defaultGun
         { _ammoBaseMax = 15
         }
     }
-
 shootBezier :: Point2 -> Creature -> World -> World
 shootBezier targetp cr w = w & particles .:~ aCurveBulAt 
     (Just cid) 
@@ -66,6 +64,3 @@ shootBezier targetp cr w = w & particles .:~ aCurveBulAt
         a <- randInCirc 10
         b <- randInCirc 20
         return (a,b)
-
-teleGun :: Item
-teleGun = bezierGun

src/Dodge/Item/Weapon/Grenade.hs

@@ -291,19 +291,4 @@ remoteBombUnarmedPic :: Picture
 remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5
 
 retireRemoteBomb :: Int -> Int -> Int -> World -> World
-retireRemoteBomb itid 0 pjid w = w
+retireRemoteBomb = retireRemoteProj $ const throwRemoteBomb
-    & pointToItem (_itemPositions w IM.! itid) %~ 
-        ( (itScope . scopePos .~ V2 0 0)
---        . (itZoom .~ defaultItZoom)
-        . (itUse . rUse .~ const throwRemoteBomb)
-        )
-    & props %~ IM.delete pjid
-retireRemoteBomb itid t pjid w = setScope w 
-    & props . ix pjid . pjUpdate .~ (\_ -> retireRemoteBomb itid (t-1) pjid)
-  where
-    setScope w' = case _itemPositions w' IM.! itid of
-        InInv cid invid -> w' 
-            & creatures . ix cid . crInv . ix invid . itScope 
-                    . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
-        _   -> w'
-    pos = fromMaybe (V2 0 0) $ w ^? props . ix pjid . pjPos

src/Dodge/Item/Weapon/Launcher.hs

@@ -408,19 +408,7 @@ remoteShellPic t
     col | t > (-99) = green
         | otherwise  = red
 retireRemoteRocket :: Int -> Int -> Int -> World -> World
-retireRemoteRocket itid 0 pjid w = 
+retireRemoteRocket = retireRemoteProj $ const fireRemoteLauncher
-    set (pointToItem (_itemPositions w IM.! itid) . itScope . scopePos) (V2 0 0)
-    $ set (pointToItem (_itemPositions w IM.! itid) . itUse . rUse) (const fireRemoteLauncher)
-    (w & props %~ IM.delete pjid)
-retireRemoteRocket itid t pjid w = setScope w 
-    & props . ix pjid . pjUpdate .~ (\_ -> retireRemoteRocket itid (t-1) pjid)
-  where
-    setScope w' = case _itemPositions w' IM.! itid of
-        InInv cid invid -> w' 
-            & creatures . ix cid . crInv . ix invid . itScope 
-                    . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
-        _   -> w'
-    pos = fromMaybe (V2 0 0) $ w ^? props . ix pjid . pjPos
 
 setRemoteScope :: Int -> Prop -> World -> World
 setRemoteScope itid pj w' = case w' ^? itemPositions . ix itid of

src/Dodge/Item/Weapon/Remote.hs

@@ -1,11 +1,33 @@
 module Dodge.Item.Weapon.Remote
     ( pointToItem
+    , retireRemoteProj
     ) where
 import Dodge.Data
+import Geometry
 
+import qualified Data.IntMap.Strict as IM
 import Control.Lens
+import Data.Maybe
 
 pointToItem :: Applicative f =>
                      ItemPos -> (Item -> f Item) -> World -> f World
 pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid
 pointToItem (OnFloor flid) = floorItems . ix flid . flIt
+
+retireRemoteProj :: (Item -> Creature -> World -> World) 
+    -> Int -> Int -> Int -> World -> World
+retireRemoteProj resetFire itid 0 pjid w = w
+    & pointToItem (_itemPositions w IM.! itid) %~ 
+        ( (itScope . scopePos .~ V2 0 0)
+        . (itUse . rUse .~ resetFire)
+        )
+    & props %~ IM.delete pjid
+retireRemoteProj resetFire itid t pjid w = setScope w 
+    & props . ix pjid . pjUpdate .~ (\_ -> retireRemoteProj resetFire itid (t-1) pjid)
+  where
+    setScope w' = case _itemPositions w' IM.! itid of
+        InInv cid invid -> w' 
+            & creatures . ix cid . crInv . ix invid . itScope 
+                    . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
+        _   -> w'
+    pos = fromMaybe (V2 0 0) $ w ^? props . ix pjid . pjPos

src/Dodge/Particle/Bullet/Spawn.hs

@@ -2,14 +2,15 @@ module Dodge.Particle.Bullet.Spawn
     ( aGenBulAt
     , aDelayedBulAt
     , aCurveBulAt
+    , accelBulAt
     ) where
 import Dodge.Data
 import Dodge.Particle.Bullet.Draw
 import Dodge.Particle.Bullet.Update
 import Geometry
 import Picture
+import LensHelp
 
-import Control.Lens
 import Data.Bifunctor
 
 aGenBulAt
@@ -80,3 +81,27 @@ aCurveBulAt maycid col pos control targ hiteff width = BulletPt
   where 
     setVel pt = pt & ptVel .~ bf (fromIntegral $ _ptTimer pt - 1) -.- bf (fromIntegral $ _ptTimer pt)
     bf t = bQuadToF (pos,control,targ) $ (100 - t) * 0.05
+
+accelBulAt 
+    :: Maybe Int -- ^ Pass-through creature id
+    -> Color 
+    -> Point2   -- ^ Start position
+    -> Point2  -- ^ Velocity
+    -> Point2   -- ^ Acceleration
+    -> HitEffect 
+    -> Float    -- ^ Bullet width
+    -> Particle
+accelBulAt maycid col pos vel acc hiteff width = BulletPt
+    { _ptDraw = drawBul
+    , _ptUpdate = \w -> mvBullet w . setVel
+    , _ptVel  = vel
+    , _btDrag = 1
+    , _ptColor = col
+    , _ptTrail = [pos]
+    , _ptCrIgnore = maycid
+    , _ptWidth = width
+    , _ptTimer = 100
+    , _ptHitEff = hiteff
+    }
+  where 
+    setVel pt = pt & ptVel .+.+~ acc

src/Picture.hs

@@ -56,19 +56,19 @@ polygon :: [Point2] -> Picture
 {-# INLINE polygon #-}
 polygon = map f . polyToTris
   where
-    f (V2 x y) = Verx (V3 x y 0) black [] 0 polyNum
+    f (V2 x y) = Verx (V3 x y 0) black [] (LayNum 0) polyNum
 
 polygonZ :: [Point2] -> Float -> Picture
 {-# INLINE polygonZ #-}
 polygonZ ps z = map (f . zeroZ) $ polyToTris ps
   where
-    f pos = Verx pos black [z] 0 polyzNum
+    f pos = Verx pos black [z] (LayNum 0) polyzNum
 
 polygonCol :: [(Point2,RGBA)] -> Picture
 {-# INLINE polygonCol #-}
 polygonCol = polyToTris . map f
   where
-    f (V2 x y,col) = Verx (V3 x y 0) col [] 0 polyNum
+    f (V2 x y,col) = Verx (V3 x y 0) col [] (LayNum 0) polyNum
 
 poly3 :: [Point3] -> Picture
 {-# INLINE poly3 #-}
@@ -78,7 +78,7 @@ poly3Col :: [(Point3,RGBA)] -> Picture
 {-# INLINE poly3Col #-}
 poly3Col = map f . polyToTris
   where
-    f (pos,col) = Verx pos col [] 0 polyNum
+    f (pos,col) = Verx pos col [] (LayNum 0) polyNum
 
 -- note that much of work computing the width of the bezier curve is done here
 bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture
@@ -117,7 +117,7 @@ bezierQuad cola colc ra rc a b c
 bzhelp :: [(Point2, Point4, Point2, Point2)] -> Picture
 bzhelp = map f
   where
-    f (V2 x y,col,V2 a b,V2 c d) = Verx (V3 x y 0) col [a,b,c,d] 0 bezNum
+    f (V2 x y,col,V2 a b,V2 c d) = Verx (V3 x y 0) col [a,b,c,d] (LayNum 0) bezNum
 
 -- given a one and two zeros of a linear function over x and y,
 -- determine the function
@@ -169,7 +169,7 @@ setLayer :: Int -> Picture -> Picture
 {-# INLINE setLayer #-}
 setLayer i = map f
   where
-    f v = v {_vxLayer = i}
+    f v = v {_vxLayer = LayNum i}
 
 scale3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE scale3 #-}
@@ -214,7 +214,7 @@ circleSolidCol colC colE r = map f
     ,(V3   r  (-r) 0, black)
     ]
   where
-    f (pos,col) = Verx pos col [] 0 ellNum
+    f (pos,col) = Verx pos col [] (LayNum 0) ellNum
 
 circle :: Float -> Picture
 {-# INLINE circle #-}
@@ -228,7 +228,7 @@ text :: String -> Picture
 {-# INLINE text #-}
 text = map f . stringToList
   where
-    f (pos,col,V2 a b) = Verx pos col [a,b] 0 textNum
+    f (pos,col,V2 a b) = Verx pos col [a,b] (LayNum 0) textNum
 
 line :: [Point2] -> Picture
 {-# INLINE line #-}
@@ -321,7 +321,7 @@ thickArcHelp startA endA rad wdth = map f
     (V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * sqrt 2) 0)
     --(V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * 2) 0)
     (V2 xc yc) = rotateV endA (V2 rad 0)
-    f (pos,col,V3 a b c) = Verx pos col [a,b,c] 0 arcNum
+    f (pos,col,V3 a b c) = Verx pos col [a,b,c] (LayNum 0) arcNum
 
 
 -- Currently the lens version is much slower

src/Picture/Data.hs

@@ -10,9 +10,11 @@ data Verx = Verx
     { _vxPos    :: !Point3
     , _vxCol    :: !Point4
     , _vxExt    :: [Float]
-    , _vxLayer  :: !Int
+    , _vxLayer  :: !LayNum
     , _vxShadNum  :: !ShadNum
     }
+newtype LayNum  = LayNum  { _unLayNum :: Int }
+--TODO use synonyms for layer numbers
 newtype ShadNum = ShadNum { _unShadNum :: Int }
 polyNum, polyzNum, bezNum, textNum, arcNum, ellNum :: ShadNum
 {-# INLINE polyNum #-}

src/Polyhedra.hs

@@ -121,7 +121,7 @@ polyToPics = map helpPoly3D . _pyFaces
 helpPoly3D :: [(Point3, Point4)] -> Picture
 helpPoly3D = map f . polyToTris
   where
-    f (pos,col) = Verx pos col [] 0 polyNum
+    f (pos,col) = Verx pos col [] (LayNum 0) polyNum
 
 polysToPic :: [Polyhedra] -> Picture
 polysToPic = pictures . concatMap polyToPics

src/Shader/Poke.hs

@@ -197,7 +197,7 @@ pokeLayVerx vbos counts vx = do
   where
     sn = _unShadNum (_vxShadNum vx)
     vecPos = theLayer * 6 + sn
-    theLayer = _vxLayer vx
+    theLayer = _unLayNum $ _vxLayer vx
     thePos = _vxPos vx
     theCol = _vxCol vx
     layOff = theLayer * numSubElements