Add support for left click actions

2021-05-25 14:23:04 +02:00
parent 62c4baaec8
commit f737897b18
9 changed files with 141 additions and 34 deletions
@@ -5,7 +5,7 @@ import Dodge.Inventory

 import qualified Data.IntMap as IM
 import Control.Lens
--import Data.Maybe (maybe)
+import Data.Maybe

 useItem :: Int -> World -> World
 useItem n w = itemEffect c it w
@@ -35,3 +35,15 @@ itemEffect cr Consumable{_cnEffect=eff } w = maybe w (rmSelectedInvItem (_crID c
 itemEffect cr Weapon{_itUse=eff} w = eff cr w
 itemEffect cr Throwable{_itUse = eff} w = eff cr w
 itemEffect _ _ w = w
+
+useLeftItem
+    :: Int
+    -> World
+    -> World
+useLeftItem cid w = case luse of
+    Nothing -> w
+    Just (invid, f) -> f cr invid w
+  where
+    cr = _creatures w IM.! cid
+    luses = IM.mapMaybe (^? itLeftClickUse . _Just) (_crInv cr)
+    luse = listToMaybe $ IM.toList luses
@@ -197,7 +197,8 @@ data Item
        , _wpReloadState :: Int
        , _itUseRate :: Int
        , _itUseTime :: Int
-        , _itUse    :: Creature -> World -> World
+        , _itUse     :: Creature -> World -> World
+        , _itLeftClickUse :: Maybe (Creature -> Int -> World -> World)
        , _wpSpread :: Float
        , _wpRange :: Float
        , _itHammer :: HammerPosition
@@ -393,6 +394,8 @@ data Projectile
        { _pjPos :: Point2
        , _pjStartPos :: Point2
        , _pjVel :: Point2
+        , _pjDir :: Float
+        , _pjSpin :: Float
        , _pjDraw :: Projectile -> Picture
        , _pjID :: Int
        , _pjUpdate :: Projectile -> World -> World
@@ -0,0 +1,17 @@
+module Dodge.Default.Shell
+    where
+import Dodge.Data
+import Picture
+
+defaultShell :: Projectile
+defaultShell = Shell
+    { _pjPos = (0,0)
+    , _pjStartPos = (0,0)
+    , _pjVel = (0,0)
+    , _pjDir = 0
+    , _pjSpin = 0
+    , _pjDraw = \_ -> blank
+    , _pjID = 0
+    , _pjUpdate = \_ -> id
+    , _pjPayload = \_ -> id
+    }
@@ -10,6 +10,7 @@ import Dodge.Creature.Action
 import Dodge.RandomHelp
 import Dodge.WorldEvent
 import Dodge.Default
+import Dodge.Default.Shell
 import Dodge.Item.Draw
 import Dodge.Particle.Bullet.HitEffect
 import Dodge.Particle.Bullet.Spawn
@@ -59,6 +60,7 @@ pistol = Weapon
        . withMuzFlare
        . withVelWthHiteff (30,0) 2 
        $ destroyOnImpact bulHitCr bulHitWall' bulHitFF'
+    , _itLeftClickUse = Nothing
    , _wpSpread = 0.02
    , _wpRange = 20
    , _itHammer = HammerUp
@@ -317,7 +319,7 @@ bezierGun = defaultAutoGun
    , _itScrollUp   = removeItAttachment 0
    , _itScrollDown = removeItAttachment 0
    , _itHammer = HammerUp
-    , _itEffect = bezierTargetEffect
+    , _itEffect = rbSetTarget
    , _itZoom = defaultItZoom
    , _itAimingRange = 0
    }
@@ -572,6 +574,7 @@ blinkGun = defaultGun
    , _itUseRate = 0
    , _itUseTime = 0
    , _itUse = hammerCheck $ shoot aSelf
+    , _itLeftClickUse = Just $ hammerCheckL $ shootL aSelfL
    , _wpSpread = 0.05
    , _wpRange = 20
    , _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
@@ -589,6 +592,7 @@ boosterGun = defaultGun
    , _itUseRate = 0
    , _itUseTime = 0
    , _itUse = boostSelf 10
+    , _itLeftClickUse = Just $ boostSelfL 10
    , _wpSpread = 0.05
    , _wpRange = 20
    , _itFloorPict = onLayer FlItLayer $ polygon [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
@@ -635,7 +639,7 @@ makeShellAt
    -> Point2   -- ^ Start position
    -> Float    -- ^ Direction
    -> Projectile
-makeShellAt pl i cid pos dir = Shell
+makeShellAt pl i cid pos dir = defaultShell
    { _pjPos = pos
    , _pjStartPos = pos
    , _pjVel = rotateV dir (1,0)
@@ -747,6 +751,9 @@ aFlame cr w = w & particles %~ (aFlameParticle t pos vel (Just cid) :)
 aSelf :: Creature -> World -> World
 aSelf = blinkAction

+aSelfL :: Creature -> Int -> World -> World
+aSelfL cr _ = blinkAction cr
+
 reflect :: Float -> Float -> Float
 reflect a b = a + 2*(a-b)

@@ -772,11 +779,13 @@ retireRemoteRocket itid t pjid w = setScope w
    pos = fromMaybe (0,0) $ w ^? projectiles . ix pjid . pjPos

 retireRemoteBomb :: Int -> Int -> Int -> World -> World
-retireRemoteBomb itid 0 pjid w = 
-    set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0)
-    $ set (pointToItem (_itemPositions w IM.! itid) . itZoom) defaultItZoom
-    $ set (pointToItem (_itemPositions w IM.! itid) . itUse) (hammerCheck throwRemoteBomb)
-    (w & projectiles %~ IM.delete pjid)
+retireRemoteBomb itid 0 pjid w = w
+    & pointToItem (_itemPositions w IM.! itid) %~ 
+        ( (itAttachment . _Just . scopePos .~ (0,0))
+        . (itZoom .~ defaultItZoom)
+        . (itUse .~ hammerCheck throwRemoteBomb)
+        )
+    & projectiles %~ IM.delete pjid
 retireRemoteBomb itid t pjid w = setScope w 
    & projectiles . ix pjid . pjUpdate .~ (\_ -> retireRemoteBomb itid (t-1) pjid)
  where
@@ -25,6 +25,39 @@ boostPoint x cr w = case mayp2 of
    p1 = cpos +.+ x *.* safeNormalizeV (mouseWorldPos w -.- cpos)
    mayp2 = reflectPointWalls cpos p1 $ wallsAlongLine cpos p1 w

+boostSelfL
+    :: Float    -- ^ boost amount
+    -> Creature
+    -> Int      -- ^ item inventory id
+    -> World
+    -> World
+boostSelfL x cr invid w = case boostPoint x cr w of
+    Left p -> wWithShock p
+        & creatures . ix cid %~ 
+            ( (crPos .~ p) 
+            . (crInv . ix invid %~ 
+                (wpLoadedAmmo .~ 0)
+                . (itEffect . itEffectCounter .~ 1)
+                . (itAttachment .~ Just (ItInt pid))
+                )
+            )
+    Right p -> wWithShock p & creatures . ix cid . crPos .~ p
+        & creatures . ix cid %~ 
+            ( (crPos .~ p) 
+            . (crInv . ix invid %~ 
+                (wpLoadedAmmo -~ 1)
+                . (itEffect . itEffectCounter .~ 1)
+                . (itAttachment .~ Just (ItInt pid))
+                )
+            )
+  where
+    cid = _crID cr
+    --cpos = _crPos cr
+    r = _crRad cr
+    pid = fromMaybe (IM.newKey $ _projectiles w) 
+        (cr ^? crInv . ix invid . itAttachment . _Just . itInt)
+    wWithShock p' = addBoostShockwave pid p' (r *.* unitVectorAtAngle (_crDir cr)) w
+
 boostSelf
    :: Float    -- ^ boost amount
    -> Creature
@@ -51,7 +84,6 @@ boostSelf x cr w = case boostPoint x cr w of
            )
  where
    cid = _crID cr
-    --cpos = _crPos cr
    r = _crRad cr
    pid = fromMaybe (IM.newKey $ _projectiles w) 
        (cr ^? crInv . ix (_crInvSel cr) . itAttachment . _Just . itInt)
@@ -78,8 +78,7 @@ itemLaserScopeEffect
            | _wpLoadedAmmo it == 0 = 1
            | otherwise = fromIntegral (_wpReloadState it) / fromIntegral (_wpReloadTime it)
        col = mixColors reloadFrac (1-reloadFrac) red green
-{- |
-Automatically send out radar pulses that detect walls.  -}
+{- | Automatically send out radar pulses that detect walls.  -}
 autoRadarEffect :: ItEffect
 autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
  where 
@@ -90,28 +89,27 @@ autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
    f t _ cr i w = w 
        & creatures . ix (_crID cr) . crInv . ix i 
                                     . itEffect . itInvEffect .~ f (t-1)
-{- |
-Automatically send out sonar pulses that detect creatures.  -}
+{- | Automatically send out sonar pulses that detect creatures.  -}
 autoSonarEffect :: ItEffect
 autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 }
  where 
    f :: Int -> ItEffect -> Creature -> Int -> World -> World
-    f 0 _ cr i w = aSonarPulse cr
-                 w & creatures . ix (_crID cr) . crInv . ix i 
-                               . itEffect . itInvEffect     .~ f 140
-    f t _ cr i w = w & creatures . ix (_crID cr) . crInv . ix i 
-                               . itEffect . itInvEffect     .~ f (t-1)
+    f 0 _ cr i w = aSonarPulse cr w 
+        & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f 140
+    f t _ cr i w = w 
+        & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f (t-1)

-bezierTargetEffect :: ItEffect
-bezierTargetEffect = ItInvEffect
-    {_itInvEffect  = setBezierTarget
+rbSetTarget :: ItEffect
+rbSetTarget = ItInvEffect
+    {_itInvEffect  = setTarg
    ,_itEffectCounter = 0
    }
-setBezierTarget :: ItEffect -> Creature -> Int -> World -> World
-setBezierTarget _ cr invid w
-    | _crInvSel cr /= invid = w
-    | SDL.ButtonRight `S.member` _mouseButtons w = w 
-        & creatures . ix (_crID cr) . crInv . ix invid . itAttachment 
-            %~ maybe (Just $ ItTargetPos $ mouseWorldPos w) Just
-    | otherwise = w & creatures . ix (_crID cr) . crInv . ix invid . itAttachment .~ Nothing
+  where
+    setTarg :: ItEffect -> Creature -> Int -> World -> World
+    setTarg _ cr invid w
+        | _crInvSel cr /= invid = w
+        | SDL.ButtonRight `S.member` _mouseButtons w = w 
+            & creatures . ix (_crID cr) . crInv . ix invid . itAttachment 
+                %~ maybe (Just $ ItTargetPos $ mouseWorldPos w) Just
+        | otherwise = w & creatures . ix (_crID cr) . crInv . ix invid . itAttachment .~ Nothing

@@ -6,6 +6,7 @@ import Dodge.Picture.Layer
 import Dodge.SoundLogic
 import Dodge.Item.Attachment.Data
 import Dodge.Item.Draw
+import Dodge.Default.Shell
 --import Dodge.Default
 import Picture
 import Geometry
@@ -63,7 +64,7 @@ throwGrenade
 throwGrenade explosion cr w = setWp $ removePict $ over projectiles addG w
  where 
    n = _crID cr
-    addG = IM.insert i $ Shell 
+    addG = IM.insert i $ defaultShell 
        { _pjPos = p
        , _pjStartPos = p
        , _pjVel = v
@@ -193,8 +193,7 @@ useTimeCheck f cr w = case theItem ^? itUseTime of
    setUseTime = creatures . ix cid . crInv . ix (_crInvSel cr) . itUseTime +~ useRate
    theItem = _crInv cr IM.! _crInvSel cr
    useRate = fromMaybe 0 $ theItem ^? itUseRate
-{- | 
-Applies a world effect after a hammer position check. -}
+{- | Applies a world effect after a hammer position check. -}
 hammerCheck
    :: (Creature -> World -> World)  -- ^ Underlying effect
    -> Creature 
@@ -206,8 +205,7 @@ hammerCheck f cr w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of
  where 
    cid = _crID cr
    setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown
-{- | 
-Applies a world effect after an ammo check. -}
+{- | Applies a world effect after an ammo check. -}
 shoot 
    :: (Creature -> World -> World) 
            -- ^ Underlying effect
@@ -228,6 +226,42 @@ shoot f cr w
        && _itUseTime item == 0
        && _wpLoadedAmmo item > 0
    reloadCondition = _wpLoadedAmmo item == 0
+{- | Applies a world effect after a hammer position check.
+Arbitrary inventory position. -}
+hammerCheckL
+    :: (Creature -> Int -> World -> World)  -- ^ Underlying effect
+    -> Creature 
+    -> Int
+    -> World
+    -> World
+hammerCheckL f cr invid w = case (_crInv cr IM.! invid) ^? itHammer of
+    Just HammerUp -> f cr invid $ setHammerDown w
+    _             -> setHammerDown w
+  where 
+    cid = _crID cr
+    setHammerDown = creatures . ix cid . crInv . ix invid . itHammer .~ HammerDown
+{- | Applies a world effect after an ammo check. 
+Arbitrary inventory position. -}
+shootL 
+    :: (Creature -> Int -> World -> World) 
+            -- ^ Underlying effect
+    -> Creature
+    -> Int -- ^ Inventory position
+    -> World
+    -> World
+shootL f cr invid w 
+    | fireCondition = f cr invid w & pointerToItem %~
+        ( (wpLoadedAmmo -~ 1) . (itUseTime .~ _itUseRate item) )
+    | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
+    | otherwise = w
+  where 
+    cid = _crID cr
+    item = _crInv cr IM.! invid
+    pointerToItem = creatures . ix cid . crInv . ix invid
+    fireCondition = _wpReloadState item == 0
+        && _itUseTime item == 0
+        && _wpLoadedAmmo item > 0
+    reloadCondition = _wpLoadedAmmo item == 0

 withMuzFlare 
    :: (Creature -> World -> World)  -- ^ Underlying effect
@@ -21,6 +21,7 @@ updatePressedButtons :: S.Set MouseButton -> World -> World
 updatePressedButtons pkeys w 
    | lbPressed && rbPressed 
                = useItem (_yourID w) w
+    | lbPressed = useLeftItem (_yourID w) w
    | mbPressed = w & clickMousePos .~ _mousePos w 
                    & cameraRot     -~ rotation
    | otherwise = w