Add support for left click actions

src/Dodge/Creature/Action/UseItem.hs

@@ -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

src/Dodge/Data.hs

@@ -198,6 +198,7 @@ data Item
         , _itUseRate :: Int
         , _itUseTime :: Int
         , _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

src/Dodge/Default/Shell.hs

@@ -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
+    }

src/Dodge/Item/Weapon.hs

@@ -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 = 
+retireRemoteBomb itid 0 pjid w = w
-    set (pointToItem (_itemPositions w IM.! itid) . itAttachment . _Just . scopePos) (0,0)
+    & pointToItem (_itemPositions w IM.! itid) %~ 
-    $ set (pointToItem (_itemPositions w IM.! itid) . itZoom) defaultItZoom
+        ( (itAttachment . _Just . scopePos .~ (0,0))
-    $ set (pointToItem (_itemPositions w IM.! itid) . itUse) (hammerCheck throwRemoteBomb)
+        . (itZoom .~ defaultItZoom)
-    (w & projectiles %~ IM.delete pjid)
+        . (itUse .~ hammerCheck throwRemoteBomb)
+        )
+    & projectiles %~ IM.delete pjid
 retireRemoteBomb itid t pjid w = setScope w 
     & projectiles . ix pjid . pjUpdate .~ (\_ -> retireRemoteBomb itid (t-1) pjid)
   where

src/Dodge/Item/Weapon/Booster.hs

@@ -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)

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -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,25 +89,24 @@ 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
+    f 0 _ cr i w = aSonarPulse cr w 
-                 w & creatures . ix (_crID cr) . crInv . ix i 
+        & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f 140
-                               . itEffect . itInvEffect     .~ f 140
+    f t _ cr i w = w 
-    f t _ cr i w = w & creatures . ix (_crID cr) . crInv . ix i 
+        & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f (t-1)
-                               . itEffect . itInvEffect     .~ f (t-1)
 
-bezierTargetEffect :: ItEffect
+rbSetTarget :: ItEffect
-bezierTargetEffect = ItInvEffect
+rbSetTarget = ItInvEffect
-    {_itInvEffect  = setBezierTarget
+    {_itInvEffect  = setTarg
     ,_itEffectCounter = 0
     }
-setBezierTarget :: ItEffect -> Creature -> Int -> World -> World
+  where
-setBezierTarget _ cr invid w
+    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 

src/Dodge/Item/Weapon/Grenade.hs

@@ -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

src/Dodge/Item/Weapon/TriggerType.hs

@@ -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

src/Dodge/Update/UsingInput.hs

@@ -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