diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 086226129..c5bc25df5 100644 --- a/src/Dodge/Creature.hs +++ b/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 diff --git a/src/Dodge/Creature/Lamp.hs b/src/Dodge/Creature/Lamp.hs index 9dad395aa..1b769d98a 100644 --- a/src/Dodge/Creature/Lamp.hs +++ b/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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 0fee2108d..019b24712 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -320,7 +320,7 @@ data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, data ItemPos = InInv { _itCrId :: Int , _itInvId :: Int } | OnFloor { _itFlID :: Int } -data ItemUse +data ItemUse = RightUse { _rUse :: Item -> Creature -> World -> World , _useDelay :: UseDelay @@ -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 diff --git a/src/Dodge/Item/Weapon/Bezier.hs b/src/Dodge/Item/Weapon/Bezier.hs index 0771ce3c9..0017dc506 100644 --- a/src/Dodge/Item/Weapon/Bezier.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon/Grenade.hs b/src/Dodge/Item/Weapon/Grenade.hs index 9038f758b..bee8ea53c 100644 --- a/src/Dodge/Item/Weapon/Grenade.hs +++ b/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 - & 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 +retireRemoteBomb = retireRemoteProj $ const throwRemoteBomb diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index 4666a3d05..552f83f9c 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/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 = - 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 +retireRemoteRocket = retireRemoteProj $ const fireRemoteLauncher setRemoteScope :: Int -> Prop -> World -> World setRemoteScope itid pj w' = case w' ^? itemPositions . ix itid of diff --git a/src/Dodge/Item/Weapon/Remote.hs b/src/Dodge/Item/Weapon/Remote.hs index 17fc29408..486f9f8c6 100644 --- a/src/Dodge/Item/Weapon/Remote.hs +++ b/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 diff --git a/src/Dodge/Particle/Bullet/Spawn.hs b/src/Dodge/Particle/Bullet/Spawn.hs index ab46af558..c5a0e4622 100644 --- a/src/Dodge/Particle/Bullet/Spawn.hs +++ b/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 diff --git a/src/Picture.hs b/src/Picture.hs index 5bb1de8e5..ed7e5864c 100644 --- a/src/Picture.hs +++ b/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 diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs index 75a74140c..0daea6505 100644 --- a/src/Picture/Data.hs +++ b/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 #-} diff --git a/src/Polyhedra.hs b/src/Polyhedra.hs index 00f911f23..65b74b613 100644 --- a/src/Polyhedra.hs +++ b/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 diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index c9bfc008f..e18675ec9 100644 --- a/src/Shader/Poke.hs +++ b/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