diff --git a/src/Dodge/CreatureAction.hs b/src/Dodge/CreatureAction.hs index 97d01aaaa..b468dba15 100644 --- a/src/Dodge/CreatureAction.hs +++ b/src/Dodge/CreatureAction.hs @@ -1,7 +1,7 @@ {-# LANGUAGE BangPatterns #-} module Dodge.CreatureAction ( module Dodge.CreatureAction - , useItemContinuous + , useItem , tryUseItem ) where diff --git a/src/Dodge/CreatureAction/UseItem.hs b/src/Dodge/CreatureAction/UseItem.hs index aa4cc550d..8a2c0fa83 100644 --- a/src/Dodge/CreatureAction/UseItem.hs +++ b/src/Dodge/CreatureAction/UseItem.hs @@ -9,10 +9,10 @@ import qualified Data.IntMap as IM import Control.Lens import Data.Maybe (fromMaybe) -useItemContinuous :: Int -> World -> World -useItemContinuous n w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of - Just HammerUp -> useItem1 n $ setHammerDown w - Just NoHammer -> useItem1 n w +useItem :: Int -> World -> World +useItem n w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of + Just HammerUp -> equippedItemEffect n $ setHammerDown w + Just NoHammer -> equippedItemEffect n w _ -> setHammerDown w where cr = _creatures w IM.! n @@ -20,16 +20,16 @@ useItemContinuous n w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of tryUseItem :: Int -> World -> World tryUseItem cid w = case w ^? creatures . ix cid of - Just cr -> useItem2 cid (_crInv cr IM.! _crInvSel cr) w + Just cr -> itemEffect cid (_crInv cr IM.! _crInvSel cr) w Nothing -> w -useItem1 :: Int -> World -> World -useItem1 n w = useItem2 n it w +equippedItemEffect :: Int -> World -> World +equippedItemEffect n w = itemEffect n it w where c = (_creatures w IM.! n) it = _crInv c IM.! _crInvSel c -useItem2 :: Int -> Item -> World -> World -useItem2 n (Consumable {_cnEffect=eff }) w = fromMaybe w $ fmap (rmInvItem n) $ eff n w -useItem2 n (Weapon {_wpFire=eff}) w = eff n w -useItem2 n (Throwable {_twFire = eff}) w = eff n w -useItem2 _ _ w = w +itemEffect :: Int -> Item -> World -> World +itemEffect n (Consumable {_cnEffect=eff }) w = fromMaybe w $ fmap (rmInvItem n) $ eff n w +itemEffect n (Weapon {_wpFire=eff}) w = eff n w +itemEffect n (Throwable {_twFire = eff}) w = eff n w +itemEffect _ _ w = w diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 8b5f050f6..b2f414a0b 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -19,6 +19,7 @@ import Dodge.Item.Draw import Dodge.Item.Weapon.Bullet import Dodge.Item.Weapon.InventoryDisplay import Dodge.Item.Weapon.TriggerType +import Dodge.Item.Weapon.Recock import Geometry import Picture @@ -329,12 +330,46 @@ launcher = defaultGun } bezierGun = defaultAutoGun { _itName = "B-GUN" - , _wpFire = bezierShoot + , _wpFire = maybeSetTarget shootBezier , _itAttachment = Nothing , _itScrollUp = removeItAttachment 0 , _itScrollDown = removeItAttachment 0 + , _itHammer = HammerUp + , _itEffect = bezierRecock + , _itZoom = basicItZoom + , _itAimingRange = 0 } +maybeSetTarget :: (Point2 -> Int -> World -> World) -> Int -> World -> World +maybeSetTarget f cid w = case join $ w ^? creatures . ix cid . crInv . ix itRef . itAttachment of + Just (ItTargetPos targetp) -> f targetp cid w + _ -> w & creatures . ix cid . crInv . ix itRef . itAttachment .~ Just (ItTargetPos mp) + where + mp = mouseWorldPos w + cr = _creatures w IM.! cid + itRef = _crInvSel cr + +shootBezier :: Point2 -> Int -> World -> World +shootBezier targetp cid w = (shootWithSound 0 . withMuzFlare . withRecoil 40 . torqueBefore 0.05 + . withRandomDir 0.5) + bezBul cid w + where + bezBul = mkBezierBul startp controlp targetp + controlp = mouseWorldPos w + cr = _creatures w IM.! cid + dir = _crDir cr + startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) + +mkBezierBul :: Point2 -> Point2 -> Point2 -> Int -> World -> World +mkBezierBul startp controlp targetp cid w = over particles' (bbul :) w + where + bbul = aCurveBulAt (Just cid) white startp (controlp +.+ randPos) (targetp +.+ randPos') + (threeEff' bulHitCr' bulHitWall' bulHitFF') 5 + (randPos,randPos') = flip evalState (_randGen w) + $ do a <- randInCirc 10 + b <- randInCirc 10 + return (a,b) + removeItAttachment :: Int -> Int -> World -> World removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ Nothing where cr = _creatures w IM.! i @@ -1338,7 +1373,6 @@ remoteBomb = defaultThrowable throwGrenade :: Int -> Int -> World -> World ---throwGrenade n w = rmInvItem n $ over particles addG $ set randGen g w throwGrenade fuseTime n w = setWp $ removePict $ over particles addG $ set randGen g w where addG = IM.insert i $ Particle { _ptPos = p @@ -1364,14 +1398,6 @@ throwGrenade fuseTime n w = setWp $ removePict $ over particles addG $ set randG dir = argV v setWp :: World -> World setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20 - --maybewpid = w ^? creatures . ix n . crInv . ix j . itID . _Just - --setWpLocation :: World -> World - --setWpLocation w' = case maybewpid of - -- Nothing -> w' & creatures . ix n . crInv . ix j . itID .~ Just newitid - -- & itemPositions %~ IM.insert newitid (InInv n j) - -- _ -> w' - --newitid = newKey $ _itemPositions w - --wpid = fromMaybe newitid maybewpid throwArmReset :: Int -> ItEffect throwArmReset x = @@ -1396,43 +1422,6 @@ grenadePic x = pictures [ color (dark $ dark green) $ circleSolid 5 $ scale 0.05 0.05 $ color green $ text $ show $ 1 + quot x 20 ] -bezTest cid w = mkBezierBul (0,11) (0,20) (0,20) cid w - -bezierTarget :: Int -> World -> World -bezierTarget cid w = setTarget w - where - j = _crInvSel $ _creatures w IM.! cid - setTarget = set (creatures . ix cid . crInv . ix j . wpFire) $ bezierControl p - p = mouseWorldPos w - -bezierControl :: Point2 -> Int -> World -> World -bezierControl targetp cid w = resetGun $ shootWithSound 0 (mkBezierBul startp controlp targetp) cid w - where - j = _crInvSel $ _creatures w IM.! cid - controlp = mouseWorldPos w - cr = _creatures w IM.! cid - dir = _crDir cr - startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) - resetGun = set (creatures . ix cid . crInv . ix j . wpFire) $ bezierTarget - -bezierShoot :: Int -> World -> World -bezierShoot cid w = case w ^? creatures . ix cid . crInv . ix itRef . itAttachment of - Just (Just (ItTargetPos targetp)) -> shootWithSound 0 (mkBezierBul startp controlp targetp) cid w - _ -> w & creatures . ix cid . crInv . ix itRef . itAttachment .~ Just (ItTargetPos controlp) - where - j = _crInvSel $ _creatures w IM.! cid - controlp = mouseWorldPos w - cr = _creatures w IM.! cid - dir = _crDir cr - startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) - itRef = _crInvSel cr - -mkBezierBul :: Point2 -> Point2 -> Point2 -> Int -> World -> World -mkBezierBul startp controlp targetp cid w = over particles' (bbul :) w - where - bbul = aCurveBulAt (Just cid) white startp controlp targetp - (threeEff' bulHitCr' bulHitWall' bulHitFF') 5 - fireRemoteLauncher :: Int -> World -> World fireRemoteLauncher cid w = setLocation $ resetFire $ resetName $ soundOnce (fromIntegral launcherSound) diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index f6804c074..6299314c7 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -32,7 +32,6 @@ withWarmUp t f cid w | t > 0 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) $ set (pointerToItem . wpFireState) 2 w - -- | otherwise = set (pointerToItem . wpFire) (withWarmUp 0 f) | otherwise = set (pointerToItem . wpFire) (withWarmUp 1 f) $ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) $ set (pointerToItem . wpFireState) 2 @@ -97,6 +96,22 @@ shoot f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> am && _wpLoadedAmmo item > 0 reloadCondition = _wpLoadedAmmo item == 0 +withMuzFlare :: (Int -> World -> World) -> Int -> World -> World +withMuzFlare f cid w = over tempLightSources (tLightAt 4 pos :) + . lowLightAt pos2 $ f cid w + where cr = _creatures w IM.! cid + dir = _crDir cr + pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) + pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr) + +withRandomDir :: Float -> (Int -> World -> World) -> Int -> World -> World +withRandomDir acc f cid w = over (creatures . ix cid . crDir) (\d -> d - a) + . f cid + . over (creatures . ix cid . crDir) (+ a) + $ set randGen g + w + where (a, g) = randomR (-acc,acc) $ _randGen w + withAccVelWthHiteff' :: Float -> Point2 -> Float -> HitEffect' -> Int -> World -> World withAccVelWthHiteff' acc vel width hiteff cid w = over particles' ((:) newbul) diff --git a/src/Dodge/KeyEvents.hs b/src/Dodge/KeyEvents.hs index cbead2409..e85ab9a87 100644 --- a/src/Dodge/KeyEvents.hs +++ b/src/Dodge/KeyEvents.hs @@ -13,16 +13,13 @@ import Control.Lens import Data.Maybe import Data.Char import Data.List -import Data.Function +import Data.Function (on) import qualified Data.Set as S import qualified Data.IntMap.Strict as IM import SDL ---import Graphics.Gloss ---import Graphics.Gloss.Interface.IO.Game - -- }}} pauseGame :: World -> World @@ -52,7 +49,6 @@ handlePressedKeyEvent w True _ = Just w handlePressedKeyEvent w _ keycode = case keycode of KeycodeEscape -> Nothing --- KeycodeEscape -> Just $ pauseGame $ escapeMap w KeycodeC -> Just $ pauseGame $ escapeMap w KeycodeF -> Just $ dropItem w KeycodeM -> Just $ toggleMap w @@ -149,14 +145,11 @@ mouseActionsCr keys cr = set ( crState . stance . posture) AtEase cr where lbPressed = ButtonLeft `S.member` keys rbPressed = ButtonRight `S.member` keys --- wUp = MouseButton WheelUp `S.member` keys --- -- wUp = Char 'q' `S.member` keys --- wDown = MouseButton WheelDown `S.member` keys mouseActionsWorld :: S.Set MouseButton -> World -> World mouseActionsWorld keys w | lbPressed && rbPressed - = useItemContinuous (_yourID w) w + = useItem (_yourID w) w | mbPressed = set lbClickMousePos (_mousePos w) $ over cameraRot (\r-> r - rotation) w | otherwise diff --git a/src/Dodge/Prototypes.hs b/src/Dodge/Prototypes.hs index f4daf37a9..0ecaff646 100644 --- a/src/Dodge/Prototypes.hs +++ b/src/Dodge/Prototypes.hs @@ -1,6 +1,8 @@ {-# LANGUAGE BangPatterns #-} module Dodge.Prototypes where +import Dodge.Item.Weapon.Recock + import Dodge.Data import Dodge.SoundLogic import Dodge.Base @@ -18,9 +20,6 @@ import qualified Data.Set as S import Data.Graph.Inductive.Graph hiding ((&)) import Data.List ---import Graphics.Gloss ---import Graphics.Gloss.Data.Vector - -- defalt datatypes / prototypes {{{ basicWall = Wall { _wlLine = [(0,0),(50,0)] , _wlID = 0 @@ -233,18 +232,4 @@ youLight = } -wpRecock :: ItEffect ---wpRecock = NoItEffect -wpRecock = ItInvEffect {_itInvEffect = f - ,_itEffectCounter = 0 - } - where f cr i = creatures . ix (_crID cr) . crInv - -- . ix i . itHammer %~ ($!) (fmap $! (moveHammerUp `seq` moveHammerUp)) - -- . ix i . itHammer %~ ($!) (fmap $! moveHammerUp) - -- . ix i . itHammer . _Just %~ ($!) moveHammerUp - %~ IM.adjust fOnIt i - moveHammerUp !HammerDown = HammerReleased - moveHammerUp !HammerReleased = HammerUp - moveHammerUp !HammerUp = HammerUp - fOnIt it = it & itHammer %~ moveHammerUp