diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 1df721444..e6e751fe3 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -110,7 +110,8 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of useLeftItem :: Int -> World -> World useLeftItem cid w | _crInvLock cr = w - | itmShouldBeUsed = useItem cr w -- I believe this ONLY sets equipment options + | itmIsConsumable = useItem cr w -- I believe this ONLY sets equipment options + | itmIsEquipable = useItem cr w -- I believe this ONLY sets equipment options | otherwise = fromMaybe w $ do invid <- _crLeftInvSel cr itm <- cr ^? crInv . ix invid @@ -121,9 +122,10 @@ useLeftItem cid w $ w where cr = _creatures (_cWorld w) IM.! cid - itmShouldBeUsed = + itmIsConsumable = isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse) - || ( isJust (cr ^? crInv . ix (crSel cr) . itUse . equipEffect . eeUse) + itmIsEquipable = + ( isJust (cr ^? crInv . ix (crSel cr) . itUse . equipEffect . eeUse) && _crLeftInvSel cr /= Just (crSel cr) ) diff --git a/src/Dodge/Creature/Perception.hs b/src/Dodge/Creature/Perception.hs index 8232c2378..5278eaa31 100644 --- a/src/Dodge/Creature/Perception.hs +++ b/src/Dodge/Creature/Perception.hs @@ -147,6 +147,7 @@ newExtraAwareness :: Int -> Maybe Awareness newExtraAwareness cr w cid + | dist cpos tpos > 600 = Nothing | not $ canSeeIndirect (_crID cr) cid w = Nothing | otherwise = Just . Suspicious $ doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d * awakeLevelPerception cr where diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 135f94e4c..49ad98c2f 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -202,6 +202,8 @@ movementSideEff cr w useUpdate :: ItemUse -> ItemUse useUpdate = (heldHammer %~ moveHammerUp) + . (leftHammer %~ moveHammerUp) + . (leftDelay . rateTime %~ decreaseToZero) . (heldDelay . warmTime %~ decreaseToZero) . (heldDelay . rateTime %~ decreaseToZero) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index f0c7c5590..fe2b749e4 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -3,6 +3,7 @@ Rexports all Dodge.Data.x files. -} module Dodge.Data ( module Dodge.Data.World, + module Dodge.Data.Scenario, module Dodge.Data.WorldEffect, module Dodge.Data.ArcStep, module Dodge.Data.Config, @@ -22,6 +23,7 @@ module Dodge.Data ( ) where import Dodge.Data.Config +import Dodge.Data.Scenario import Dodge.Data.WorldEffect import Dodge.Data.ActionPlan import Dodge.Data.ArcStep diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index fde2a34e2..21224bbea 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -65,7 +65,7 @@ doDrawing pdata u = do windowPoints (_floorTiles (_cWorld w)) ) - ( pokeShape' + ( pokeShape (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata) (_eboPtr $ _shapeEBO pdata) (_eboPtr $ _silhouetteEBO pdata) diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index 9b23c8918..43a9f98bb 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -1,7 +1,16 @@ module Dodge.TestString where import Dodge.Data.Universe +import Control.Lens +import Data.Maybe testStringInit :: Universe -> [String] -testStringInit _ = [] +testStringInit u = [ + show $ u ^? uvWorld . hammers . ix DoubleMouseHam + , show $ u ^? uvWorld . cWorld . creatures . ix 0 . crLeftInvSel . _Just + , fromMaybe "" $ do + i <- u ^? uvWorld . cWorld . creatures . ix 0 . crLeftInvSel . _Just + h <- u ^? uvWorld . cWorld . creatures . ix 0 . crInv . ix i . itUse . leftHammer + return $ show h + ] diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 4a811db18..6587a3c8e 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -453,6 +453,7 @@ markWallSeen :: World -> Int -> World markWallSeen !w !i = w & cWorld . walls .~ IM.adjust markSeen i (_walls (_cWorld w)) markSeen :: Wall -> Wall +{-# INLINE markSeen #-} markSeen wl = wl{_wlSeen = True} checkEndGame :: Universe -> Universe diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index 22cd4d6d3..9f6b68002 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -20,16 +20,16 @@ import SDL updateUsingInput :: World -> World updateUsingInput w = case _hudElement $ _hud (_cWorld w) of DisplayInventory subinv -> - updatePressedButtons subinv (_mouseButtons w) w + pressedMBEffects subinv (_mouseButtons w) w DisplayCarte -> updatePressedButtonsCarte (_mouseButtons w) w -updatePressedButtons :: SubInventory -> M.Map MouseButton Bool -> World -> World -updatePressedButtons subinv pkeys w = case subinv of +pressedMBEffects :: SubInventory -> M.Map MouseButton Bool -> World -> World +pressedMBEffects subinv pkeys w = case subinv of NoSubInventory | ButtonLeft `M.member` pkeys && w ^?! hammers . ix SubInvHam /= HammerUp -> w & hammers . ix SubInvHam .~ HammerDown - | otherwise -> updatePressedButtons' pkeys w + | otherwise -> pressedMBEffectsNoInventory pkeys w CombineInventory mi | pkeys ^? ix ButtonLeft == Just False -> maybeexitcombine (maybe id doCombine mi w) & hammers . ix SubInvHam .~ HammerDown @@ -49,8 +49,8 @@ updatePressedButtons subinv pkeys w = case subinv of | ButtonRight `M.member` _mouseButtons w = id | otherwise = cWorld . hud . hudElement .~ DisplayInventory NoSubInventory -updatePressedButtons' :: M.Map MouseButton Bool -> World -> World -updatePressedButtons' pkeys w +pressedMBEffectsNoInventory :: M.Map MouseButton Bool -> World -> World +pressedMBEffectsNoInventory pkeys w | isDown ButtonLeft && isDown ButtonRight && inTopInv = useItem (you w) w & hammers . ix DoubleMouseHam .~ HammerDown | isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame) diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 5fab63a2a..ff5979d8c 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -1,11 +1,8 @@ module Shader.Poke ( pokeVerxs --- , pokeSPics , pokeLayVerxs , pokeArrayOff --- , pokePoint33s --- , pokeShape - , pokeShape' + , pokeShape , pokeWallsWindowsFloor ) where import Shader.Data @@ -54,11 +51,8 @@ pokeWallsWindowsFloor -> [ ( Point3 , Point3 ) ] -> IO (Int,Int,Int) pokeWallsWindowsFloor wlptr wiptr flptr wls wis fls = do - --wlcounts1 <- S.foldM_ (pokeW wlptr) (return 0) return (S.each wls) wlcounts1 <- VFSM.foldlM' (pokeW wlptr) 0 (VFSM.fromList wls) - --wlcounts2 <- S.foldM_ (pokeW wiptr) (return 0) return (S.each wis) wlcounts2 <- VFSM.foldlM' (pokeW wiptr) 0 (VFSM.fromList wis) - --flcounts <- S.foldM_ (pokeF flptr) (return 0) return (S.each fls) flcounts <- VFSM.foldlM' (pokeF flptr) 0 (VFSM.fromList fls) return (wlcounts1,wlcounts2,flcounts) @@ -86,33 +80,11 @@ pokeW ptr i' ((V2 a b,V2 c d),V4 e f g h) = do pokeElemOff ptr (i + 7) h return $ i' + 1 ---pokeSPics --- :: MV.MVector (PrimState IO) FullShader --- -> UMV.MVector (PrimState IO) Int --- -> Ptr Float -> Ptr GLushort -> Ptr GLushort --- -> Stream (Of SPic) IO () --- -> IO (Int,Int,Int) ---pokeSPics vbos counts ptr iptr ieptr = --- S.foldM_ (\is (sh,pic) -> pokeLayVerxs vbos counts pic >> pokeShape' ptr iptr ieptr is sh) --- (return (0,0,0)) return - - pokeShape :: Ptr Float -> Ptr GLushort -> Ptr GLushort - -> VFSM.Stream IO ShapeObj - -> IO (Int,Int,Int) -pokeShape ptr iptr ieptr = VFSM.foldlM' (pokeShapeObj ptr iptr ieptr) (0,0,0) - ---pokeShape' :: Ptr Float -> Ptr GLushort -> Ptr GLushort --- -> (Int,Int,Int) --- -> Stream (Of ShapeObj) IO () --- -> IO (Int,Int,Int) ---pokeShape' ptr iptr ieptr is = S.foldM_ (pokeShapeObj ptr iptr ieptr) (return is) return --- -pokeShape' :: Ptr Float -> Ptr GLushort -> Ptr GLushort -> (Int,Int,Int) -> [ShapeObj] -> IO (Int,Int,Int) -pokeShape' ptr iptr ieptr is = VFSM.foldlM' (pokeShapeObj ptr iptr ieptr) is . VFSM.fromList +pokeShape ptr iptr ieptr is = VFSM.foldlM' (pokeShapeObj ptr iptr ieptr) is . VFSM.fromList pokeShapeObj :: Ptr Float @@ -260,18 +232,3 @@ poke34 ptr (V3 a b c) (V4 d e f g) = do pokeArrayOff :: Ptr Float -> Int -> [Float] -> IO () {-# INLINE pokeArrayOff #-} pokeArrayOff ptr i = pokeArray (plusPtr ptr (floatSize * i)) - ---pokePoint33s :: Ptr Float -> [(Point3,Point3)] -> IO Int ---pokePoint33s ptr = S.foldM_ (pokePoint33 ptr) (return 0) return . S.each - ---pokePoint33 :: Ptr Float -> Int -> (Point3,Point3) -> IO Int ---pokePoint33 ptr n (V3 a b c,V3 d e f) = do --- pokeElemOff ptr (off 0) a --- pokeElemOff ptr (off 1) b --- pokeElemOff ptr (off 2) c --- pokeElemOff ptr (off 3) d --- pokeElemOff ptr (off 4) e --- pokeElemOff ptr (off 5) f --- return (n+1) --- where --- off i = n*6 + i