Make examine inventory controlled by item, perhaps still buggy

This commit is contained in:
2025-01-01 21:14:38 +00:00
parent 86aba6d115
commit 5b978d9f1c
25 changed files with 523 additions and 502 deletions
+7 -7
View File
@@ -3,9 +3,7 @@
-- | Actions performed by creatures within the world
module Dodge.Creature.Action (
performActions,
-- stripNoItems,
setMinInvSize,
-- dropUnselected,
dropExcept,
dropItem,
blinkActionMousePos,
@@ -13,12 +11,9 @@ module Dodge.Creature.Action (
unsafeBlinkAction,
sizeSelf,
youDropItem,
-- pickUpItem,
) where
import Control.Applicative
--import Data.List (findIndex)
import Control.Monad
import Data.Bifunctor
import Data.Maybe
@@ -31,6 +26,7 @@ import Dodge.Default
import Dodge.FloatFunction
import Dodge.FloorItem
import Dodge.Inventory
import Dodge.ItEffect
--import Dodge.Inventory.Add
import Dodge.Path
import Dodge.SoundLogic
@@ -176,11 +172,15 @@ dropExcept cr invid w =
-- why not a cid (Int)?
dropItem :: Creature -> Int -> World -> World
dropItem cr invid =
maybeshiftseldown
. rmInvItem (_crID cr) invid
doanyitemdropeffect
. maybeshiftseldown
. rmInvItem (_crID cr) invid
. copyItemToFloor (_crPos cr) itm -- . mayberemoveequip
. soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
where
doanyitemdropeffect = fromMaybe id $ do
rmf <- itm ^? itEffect . ieOnDrop
return $ doInvEffect rmf itm cr
itm = fromMaybe (error "dropItem cannot find item") $ cr ^? crInv . ix invid
maybeshiftseldown w = fromMaybe w $ do
3 <- w ^? hud . hudElement . diSelection . _Just . _1
+24 -17
View File
@@ -4,8 +4,8 @@ module Dodge.Creature.Impulse.UseItem (
useItem,
) where
import Dodge.ToggleExamine
import Control.Lens
import Control.Monad
import Data.Maybe
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
@@ -15,6 +15,7 @@ import Dodge.Euse
import Dodge.HeldUse
import Dodge.Inventory
import Dodge.Item.Grammar
import Dodge.Item.Location
import qualified IntMapHelp as IM
useItem :: Int -> PressType -> World -> Maybe World
@@ -30,27 +31,33 @@ useItemLoc ::
PressType ->
World ->
Maybe World
useItemLoc cr loc pt w = case loc ^. locLDT . ldtValue . _2 of
HeldPlatformSF -> do
guard $ fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsRoot
guard $ cr ^. crStance . posture == Aiming
useItemLoc cr loc pt w
| HeldPlatformSF <- sf
, fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsRoot
, cr ^. crStance . posture == Aiming =
return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
GadgetPlatformSF ->
return $
heldEffect pt (bimap _iatType (^. _1) ldt) cr w
UnderBarrelPlatformSF -> do
guard $ fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
guard $ cr ^. crStance . posture == Aiming
| GadgetPlatformSF <- sf =
return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
RemoteDetonatorSF -> do
guard $ pt == InitialPress
| UnderBarrelPlatformSF <- sf
, fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
, cr ^. crStance . posture == Aiming =
return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
| RemoteDetonatorSF <- sf
, pt == InitialPress =
return $ activateDetonator ldt w
_ | isJust $ itm ^? itUse . uequipEffect -> do
guard $ pt == InitialPress
invid' <- itm ^? itLocation . ilInvID
| ITEMSCANNER <- itm ^. itType
, pt == InitialPress =
return $ toggleExamineInv w
| Just b <- itm ^? itUse . useToggle
, pt == InitialPress =
return $ w & pointerToItem itm . itUse . useToggle .~ not b
| isJust $ itm ^? itUse . uequipEffect
, pt == InitialPress
, Just invid' <- itm ^? itLocation . ilInvID =
return $ toggleEquipmentAt invid' cr w
_ -> Nothing
| otherwise = Nothing
where
sf = loc ^. locLDT . ldtValue . _2
ldt = loc ^. locLDT
itm = ldt ^. ldtValue . _1
+5 -2
View File
@@ -23,8 +23,8 @@ import qualified SDL
yourControl :: Creature -> World -> World
yourControl _ w
| inTextInputFocus w = w
| Just NoSubInventory{} <- w ^? hud . hudElement . subInventory =
w
| Just x <- w ^? hud . hudElement . subInventory
, f x = w
& cWorld . lWorld . creatures . ix 0
%~ (wasdWithAiming w . setCrPosture pkeys)
& tryClickUse pkeys
@@ -32,6 +32,9 @@ yourControl _ w
| otherwise =
w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
where
f NoSubInventory = True
f ExamineInventory = True
f _ = False
pkeys = w ^. input . mouseButtons
handleHotkeys :: World -> World
+1
View File
@@ -61,6 +61,7 @@ data ItemStructuralFunction
| MakeAutoSF
| ProjectileStabiliserSF
| GrenadeHitEffectSF
| ToggleSF
deriving (Eq, Ord, Show, Read)
type ComposedItem = (Item, ItemStructuralFunction, LinkTest)
-6
View File
@@ -25,12 +25,6 @@ data HUDElement
}
| DisplayCarte
--data MouseInventorySelection
-- = MouseInvSelect
-- {_misSelStart :: (Int, Int), _misMaybeEnd :: Maybe (Int, Int)}
-- | MouseInvDrag
-- | MouseInvNothing
data SubInventory
= NoSubInventory
| ExamineInventory
+8 -2
View File
@@ -1,13 +1,17 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Effect where
module Dodge.Data.Item.Effect (
module Dodge.Data.Item.Effect,
module Dodge.Data.BlBl,
) where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.BlBl
data ItEffect = ItEffect
{ _ieInv :: ItInvEffect --Item -> Creature -> World -> World
@@ -23,6 +27,8 @@ data ItInvEffect
| RemoveShieldWall
| EffectWhileRoot ItInvEffect
| EffectWhileAttached ItInvEffect
| ItemUseToggle BlBl
| ItemCancelExamineInventory
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data ItDropEffect = NoDropEffect
+1
View File
@@ -43,6 +43,7 @@ data ItemUse
| UseNothing
| UseScope { _uScope :: Scope }
| UseBulletMod { _ubMod :: BulletMod }
| UseToggle {_useToggle :: Bool}
deriving (Eq, Show, Read)
data HeldUseEffect
@@ -19,7 +19,6 @@ data ProjectileUpdate
= ThrustPU {_pjuStart :: Int, _pjuEnd :: Int}
| StartSpinPU {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
| RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int}
-- | ApplyGravityPU
deriving (Show, Eq, Ord, Read) --Generic, Flat)
data AmmoType
+1 -6
View File
@@ -11,6 +11,7 @@ import Data.Aeson
import Data.Aeson.TH
import qualified Data.Map.Strict as M
import Dodge.Data.WorldEffect
import Dodge.Data.BlBl
data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady
deriving Eq
@@ -85,11 +86,6 @@ data TerminalToggle = TerminalToggle
}
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data BlBl
= BlNegate
| BlConst Bool
| BlId
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data EffectArguments
= NoArguments {_cmdEffect :: [TerminalLine]}
@@ -135,7 +131,6 @@ concat <$> mapM (deriveJSON defaultOptions)
, ''TmTm
, ''TerminalLine
, ''TerminalBootProgram
, ''BlBl
, ''TerminalToggle
, ''EffectArguments
, ''TerminalCommandEffect
+1 -1
View File
@@ -179,7 +179,7 @@ updateDisplaySections w cfig =
( \(indent, x) ->
invSelectionItem
indent
(w ^. cWorld . lWorld)
w
(x ^. locLDT . ldtValue)
)
(fmap (first removeindentiffiltering) . allInvLocs $ _crInv cr)
+13 -13
View File
@@ -1,6 +1,6 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Inventory (
rmInvItem,
rmInvItem,
destroyInvItem,
updateCloseObjects,
changeSwapSel,
@@ -14,9 +14,8 @@ module Dodge.Inventory (
swapItemWith,
) where
import qualified Data.IntSet as IS
import Dodge.Inventory.Swap
import Data.Function
import qualified Data.IntSet as IS
import Data.Maybe
import Dodge.Base
import Dodge.Data.SelectionList
@@ -25,7 +24,7 @@ import Dodge.Euse
import Dodge.Inventory.CheckSlots
import Dodge.Inventory.Location
import Dodge.Inventory.RBList
import Dodge.ItEffect
import Dodge.Inventory.Swap
import Dodge.SelectionSections
import Geometry
import qualified IntMapHelp as IM
@@ -43,8 +42,9 @@ destroyInvItem ::
Int ->
World ->
World
destroyInvItem cid invid w = rmInvItem cid invid w & removeitloc
& removeithotkey
destroyInvItem cid invid w =
rmInvItem cid invid w & removeitloc
& removeithotkey
where
removeitloc = fromMaybe id $ do
itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID . unNInt
@@ -54,7 +54,7 @@ destroyInvItem cid invid w = rmInvItem cid invid w & removeitloc
hk <- w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid
return $
(cWorld . lWorld . imHotkeys . unNIntMap . at itid .~ Nothing)
. ( cWorld . lWorld . hotkeys . at hk .~ Nothing)
. (cWorld . lWorld . hotkeys . at hk .~ Nothing)
-- | after this the item at the inventory position will no longer exist
rmInvItem ::
@@ -66,7 +66,6 @@ rmInvItem ::
World
rmInvItem cid invid w =
w
& doanyitemeffect
& dounequipfunction --the ordering of these is
& pointcid . crInv %~ f -- important
& removeAnySlotEquipment
@@ -90,12 +89,13 @@ rmInvItem cid invid w =
dounequipfunction = fromMaybe id $ do
rmf <- itm ^? itUse . uequipEffect . eeOnRemove
return $ doItmCrWdWd rmf itm cr
doanyitemeffect = fromMaybe id $ do
rmf <- itm ^? itEffect . ieOnDrop
return $ doInvEffect rmf itm cr
removeAnySlotEquipment = fromMaybe id $ do
epos <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
. itLocation . ilEquipSite . _Just
epos <-
w
^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
. itLocation
. ilEquipSite
. _Just
return $ pointcid . crEquipment . at epos .~ Nothing
maxk = fmap fst $ IM.lookupMax $ cr ^. crInv
f inv =
+4 -3
View File
@@ -19,8 +19,8 @@ import NewInt
import Padding
import Picture.Base
invSelectionItem :: Int -> LWorld -> ComposedItem -> SelectionItem ()
invSelectionItem indent lw ci =
invSelectionItem :: Int -> World -> ComposedItem -> SelectionItem ()
invSelectionItem indent w ci =
SelectionItem
{ _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
, _siHeight = itInvHeight $ ci ^. _1
@@ -31,13 +31,14 @@ invSelectionItem indent lw ci =
, _siPayload = ()
}
where
lw = w ^. cWorld . lWorld
cr = lw ^?! creatures . ix 0
itid = ci ^. _1 . itID . unNInt
anyhotkey = maybe [] ((' ' :) . hotkeyToString) (lw ^? imHotkeys . unNIntMap . ix itid)
anyequippos = maybe [] (rightPad 8 ' ' . (' ' :) . eqPosText)
(ci ^? _1 . itLocation . ilEquipSite . _Just)
col = itemInvColor ci
pics = itemDisplay cr ci
pics = itemDisplay w cr ci
hotkeyToString :: Hotkey -> String
hotkeyToString x = case x of
+11
View File
@@ -3,6 +3,8 @@ module Dodge.ItEffect (
doInvEffect,
) where
import Dodge.BlBl
import Dodge.Item.Location
import Control.Lens
import Dodge.Data.World
import Dodge.Euse
@@ -15,6 +17,15 @@ doInvEffect = \case
RemoveShieldWall -> removeShieldWall
EffectWhileRoot f -> rootNotrootEff f NoInvEffect
EffectWhileAttached f -> effectWhileAttached f
ItemUseToggle f -> \itm _
-> pointerToItemID (itm ^. itID) . itUse . useToggle %~ doBlBl f
ItemCancelExamineInventory -> \_ _ -> cancelExamineInventory
cancelExamineInventory :: World -> World
cancelExamineInventory = hud . hudElement . subInventory %~ f
where
f ExamineInventory = NoSubInventory
f x = x
rootNotrootEff :: ItInvEffect -> ItInvEffect -> Item -> Creature -> World -> World
rootNotrootEff f g it
+10 -6
View File
@@ -6,9 +6,9 @@ module Dodge.Item.Display (
basicItemDisplay,
) where
import Dodge.Data.World
import Data.Maybe
import Dodge.Data.ComposedItem
import Dodge.Data.Creature
import Dodge.Item.InvSize
import LensHelp
import Padding
@@ -18,14 +18,14 @@ import ShortShow
-- variety of factors but typically don't depend on functional quality,
-- colour gives an indication of an item's function within a structure
itemDisplay :: Creature -> ComposedItem -> [String]
itemDisplay cr ci =
itemDisplay :: World -> Creature -> ComposedItem -> [String]
itemDisplay w cr ci =
zipWithDefaults
id
(leftPad 15 ' ')
itemDisplayPad
(basicItemDisplay itm)
(itemNumberDisplay cr ci)
(itemNumberDisplay w cr ci)
where
itm = ci ^. _1
@@ -92,8 +92,12 @@ showEquipItem eit = case eit of
-- this can change, but probably won't when (say) dropped and then picked up
-- again
-- that is to say, it should not change based on functional positioning
itemNumberDisplay :: Creature -> ComposedItem -> [String]
itemNumberDisplay cr ci
itemNumberDisplay :: World -> Creature -> ComposedItem -> [String]
itemNumberDisplay w cr ci
| Just x <- ci ^? _1 . itUse . useToggle = [show x]
| ITEMSCANNER <- ci ^. _1 . itType
, Just ExamineInventory <- w ^? hud . hudElement . subInventory
= ["ACTIVE"]
| EQUIP WRIST_ECG <- ci ^. _1 . itType =
[displayPulse $ cr ^?! crType . avatarPulse . pulseProgress]
| HELD ALTERIFLE <- ci ^. _1 . itType =
+1
View File
@@ -131,6 +131,7 @@ getAmmoLinks itm =
itemToFunction :: Item -> ItemStructuralFunction
itemToFunction itm = case itm ^. itType of
ITEMSCANNER -> ToggleSF
INTROSCAN {} -> IntroScanSF
HELD LASER -> WeaponTargetingSF
HELD{} -> case itm ^? itUseCondition of
+1
View File
@@ -10,6 +10,7 @@ itemInvColor :: ComposedItem -> Color
itemInvColor ci = case ci ^. _2 of
GrenadeHitEffectSF -> yellow
IntroScanSF -> white
ToggleSF -> white
UnloadedWeaponSF -> mixColorsLinear 0.5 0.5 red white
HeldPlatformSF -> white
MakeAutoSF -> white
+2 -1
View File
@@ -19,6 +19,7 @@ module Dodge.Item.Scope (
introScan,
) where
--import Dodge.Data.BlBl
import Dodge.Item.Attach
import Control.Lens
import Dodge.Data.Item
@@ -59,7 +60,7 @@ itemScanner =
defaultHeldItem
& itType .~ ITEMSCANNER
& itUse .~ UseNothing
& itEffect . ieOnDrop .~ ItemCancelExamineInventory
bulletModule :: BulletMod -> Item
bulletModule bm =
+1 -1
View File
@@ -35,7 +35,7 @@ invDP =
invCursorParams :: World -> CursorDisplay
invCursorParams w = BoundaryCursor $ case w ^? hud . hudElement . subInventory of
Just ExamineInventory{} -> [North, South, East, West]
-- Just ExamineInventory{} -> [North, South, East, West]
Just CombineInventory{} -> []
_ | ButtonRight `M.member` _mouseButtons (_input w) -> [North, South, East, West]
_ -> [North, South, West]
+43 -36
View File
@@ -3,49 +3,56 @@ module Dodge.Projectile.Create (
PJStabiliser (..),
) where
import NewInt
--import Dodge.Data.ComposedItem
--import Dodge.Data.DoubleTree
import Dodge.Item.Location
import Data.Maybe
import Dodge.Data.World
import Dodge.Item.Location
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import NewInt
data PJStabiliser
= StabOrthReduce
| StabSpinIncrease
-- assumes the mscreen is in your inventory
createShell ::Maybe (NewInt ItmInt)
-> Maybe (NewInt ItmInt)
-> Maybe PJStabiliser
-> ProjectileType
-> Payload -> Muzzle -> Creature -> World -> World
createShell mdetonator mscreen stab pjtype payload muz cr w = w
& updatescreen
& updatedetonator
& cWorld . lWorld . projectiles . at i
?~ Shell
{ _pjPos = pos
, _pjZ = 20
, _pjZVel = 5
, _pjVel = rotateV dir (V2 speed 0) + crvelcomponent
, _pjID = i
, _pjDir = dir
, _pjSpin = 0
, _pjPayload = payload
, _pjTimer = lifespan
, _pjUpdates =
anyspin <>
[ RemoteDirectionPU (lifespan - thrustdelay) 0
] <> thrustorgrav
, _pjType = pjtype
, _pjDetonatorID = mdetonator
, _pjScreenID = mscreen
}
createShell ::
Maybe (NewInt ItmInt) ->
Maybe (NewInt ItmInt) ->
Maybe PJStabiliser ->
ProjectileType ->
Payload ->
Muzzle ->
Creature ->
World ->
World
createShell mdetonator mscreen stab pjtype payload muz cr w =
w
& updatescreen
& updatedetonator
& cWorld . lWorld . projectiles . at i
?~ Shell
{ _pjPos = pos
, _pjZ = 20
, _pjZVel = 5
, _pjVel = rotateV dir (V2 speed 0) + crvelcomponent
, _pjID = i
, _pjDir = dir
, _pjSpin = 0
, _pjPayload = payload
, _pjTimer = lifespan
, _pjUpdates =
anyspin
<> [ RemoteDirectionPU (lifespan - thrustdelay) 0
]
<> thrustorgrav
, _pjType = pjtype
, _pjDetonatorID = mdetonator
, _pjScreenID = mscreen
}
where
crvelcomponent = case stab of
Just StabOrthReduce -> projV (cr ^. crPos - cr ^. crOldPos) (unitVectorAtAngle dir)
@@ -55,27 +62,27 @@ createShell mdetonator mscreen stab pjtype payload muz cr w = w
Just StabSpinIncrease -> [StartSpinPU (lifespan - 15) (_crID cr) 4]
_ -> [StartSpinPU (lifespan - 15) (_crID cr) 2]
speed = case pjtype of
Grenade {} -> 4
Grenade{} -> 4
Rocket{} -> 1
RetiredProjectile -> 0
lifespan = 350
thrustorgrav = case pjtype of
Grenade {}-> []
Grenade{} -> []
Rocket{} -> [ThrustPU (lifespan - thrustdelay) 0]
RetiredProjectile -> []
thrustdelay = 20
updatedetonator = fromMaybe id $ do
screenid <- mdetonator
return $ pointerToItemID screenid . itUse . uaParams
return $
pointerToItemID screenid . itUse . uaParams
. apProjectiles
.:~ i
updatescreen = fromMaybe id $ do
screenid <- mscreen
return $ pointerToItemID screenid . itUse . uaParams
return $
pointerToItemID screenid . itUse . uaParams
. apProjectiles
.:~ i
-- . apLinkedProjectile
-- ?~ i
i = IM.newKey $ w ^. cWorld . lWorld . projectiles
dir = _crDir cr + _mzRot muz
pos = _crPos cr +.+ rotateV dir (_mzPos muz)
+29 -24
View File
@@ -42,14 +42,15 @@ upProjectile pj pu = case pu of
RemoteDirectionPU st et
| act st et -> pjRemoteSetDirection (pj ^? pjType . rkHoming) pj
| otherwise -> id
-- ApplyGravityPU -> applyGravityPU pj
where
-- ApplyGravityPU -> applyGravityPU pj
time = _pjTimer pj
act st et = time <= st && time >= et
doGravityPU :: Projectile -> World -> World
doGravityPU pj
| Grenade GBounce {} <- pj ^. pjType = applyGravityPU pj
| Grenade GBounce{} <- pj ^. pjType = applyGravityPU pj
| Grenade GStick <- pj ^. pjType = applyGravityPU pj
| otherwise = id
@@ -106,14 +107,16 @@ tryShellBounce :: (Point2, Either Creature Wall) -> Projectile -> World -> World
tryShellBounce (p, Right wl) pj w
| Just GStuckCreature{} <- pj ^? pjType . gnHitEffect = w
| Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
| Just GStick <- pj ^? pjType . gnHitEffect = w
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
.~ Grenade (GStuckWall (wl ^. wlStructure))
-- & cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates %~ delete ApplyGravityPU
& soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
| Just GStick <- pj ^? pjType . gnHitEffect =
w
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
.~ Grenade (GStuckWall (wl ^. wlStructure))
-- & cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates %~ delete ApplyGravityPU
& soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
| Just x <- pj ^? pjType . gnHitEffect . bounceTolerance =
if abs (dotV (pj ^. pjVel) (vNormal hitline)) < x
then w
then
w
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjVel
%~ reflectIn hitline
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos .~ p
@@ -124,16 +127,17 @@ tryShellBounce (p, Right wl) pj w
tryShellBounce (p, Left cr) pj w
| Just GStuckCreature{} <- pj ^? pjType . gnHitEffect = w
| Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
| Just GStick <- pj ^? pjType . gnHitEffect = w
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
.~ Grenade
(GStuckCreature
(cr ^. crID)
(rotateV (- cr ^. crDir) (p - cr ^. crPos))
(pj ^. pjDir - cr ^. crDir)
)
-- & cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates %~ delete ApplyGravityPU
& soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
| Just GStick <- pj ^? pjType . gnHitEffect =
w
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
.~ Grenade
( GStuckCreature
(cr ^. crID)
(rotateV (- cr ^. crDir) (p - cr ^. crPos))
(pj ^. pjDir - cr ^. crDir)
)
-- & cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates %~ delete ApplyGravityPU
& soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
tryShellBounce _ pj w = explodeShell pj w
destroyProjectile :: Maybe (NewInt ItmInt) -> Int -> World -> World
@@ -209,16 +213,17 @@ pjRemoteSetDirection ph pj w = case ph of
pjMovement :: Projectile -> World -> World
pjMovement pj w
| Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
| Just (GStuckCreature crid p d) <- pj ^? pjType . gnHitEffect = fromMaybe
(w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjType .~ Grenade GStick)
| Just (GStuckCreature crid p d) <- pj ^? pjType . gnHitEffect = fromMaybe
(w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjType .~ Grenade GStick)
$ do
cpos <- w ^? cWorld . lWorld . creatures . ix crid . crPos
cdir <- w ^? cWorld . lWorld . creatures . ix crid . crDir
return $
w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjPos
.~ cpos + rotateV cdir p
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir
.~ d + cdir
w
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjPos
.~ cpos + rotateV cdir p
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir
.~ d + cdir
| otherwise =
w
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjSpin *~ 0.99
-2
View File
@@ -2,8 +2,6 @@
module Dodge.Room.Warning where
import Color
--import qualified Data.Set as S
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Cleat
+1 -12
View File
@@ -440,7 +440,6 @@ updateInitialPressInGame uv sc = case sc of
ScancodeM -> toggleMap uv
-- ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crReloadToggle uv
ScancodeT -> over uvWorld testEvent uv
ScancodeX -> uv & uvWorld %~ toggleTweakInv
ScancodeC -> toggleCombineInv uv
-- the following should be put in a more sensible place
ScancodeSlash -> uv & uvWorld %~ updateEnterRegex
@@ -470,8 +469,7 @@ doRegexInput inp i sss msel filts
)
where
endregex a b =
--( sss & ix i . ssItems .~ mempty
( sss -- & ix i . ssItems .~ mempty
( sss
, msel & ssSetCursor (ssLookupDown a b) sss
, Nothing
)
@@ -596,15 +594,6 @@ toggleMap u = case u ^. uvWorld . hud . hudElement of
}
_ -> u & uvWorld . hud . hudElement .~ DisplayCarte
toggleTweakInv :: World -> World
toggleTweakInv w = case w ^? hud . hudElement . subInventory of
Just ExamineInventory{} ->
w
& thepointer .~ NoSubInventory --MouseInvNothing
_ -> w & thepointer .~ ExamineInventory -- mi
where
thepointer = hud . hudElement . subInventory
tryCombine :: (Int, Int) -> World -> World
tryCombine (i, j) w = fromMaybe w $ do
sss <- w ^? hud . hudElement . subInventory . ciSections
+3 -10
View File
@@ -27,10 +27,6 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
-- functions that modify the inventory should be centralised so that
-- this lock can be sensibly applied, perhaps
| w ^?! cWorld . lWorld . creatures . ix 0 . crInvLock -> w
-- | rbDown -> case (yourScrollAttachment w, _rbOptions w) of
-- (_,EquipOptions{}) -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax
-- (Nothing, _) -> w
-- (Just (invid,hs), _) -> doHeldScroll invid hs y w
| bdown ButtonRight -> case _rbOptions w of
EquipOptions{} -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax
NoRightButtonOptions -> selectedItemScroll yi w
@@ -38,12 +34,9 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
| invKeyDown -> changeSwapSel yi w
| otherwise -> scrollAugInvSel yi w
DisplayInventory{_subInventory = ExamineInventory}
| invKeyDown -> scrollAugInvSel yi w
| otherwise -> w
-- | invKeyDown && rbDown -> w & moveTweakSel yi
-- | invKeyDown -> scrollAugInvSel yi w
-- | rbDown -> w & changeTweakParam mi yi
-- | otherwise -> w & moveTweakSel yi
-- | invKeyDown
-> scrollAugInvSel yi w
-- | otherwise -> w
DisplayInventory{_subInventory = CombineInventory{}} -> w & moveCombineSel yi
DisplayInventory{_subInventory = DisplayTerminal tmid} -> terminalWheelEvent yi tmid w
_ -> w
+1 -6
View File
@@ -5,6 +5,7 @@ module Dodge.WorldEffect (
lineOutputTerminal,
) where
import Dodge.BlBl
import Dodge.Data.Input
import Dodge.HeldUse
import Dodge.Data.ComposedItem
@@ -88,12 +89,6 @@ doDeathTriggers tm = cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathTo
doDeathToggle :: TerminalToggle -> IM.IntMap Bool -> IM.IntMap Bool
doDeathToggle (TerminalToggle trid f) = ix trid %~ doBlBl f
doBlBl :: BlBl -> Bool -> Bool
doBlBl bb = case bb of
BlNegate -> not
BlConst bl -> const bl
BlId -> id
doTerminalBootProgram :: TerminalBootProgram -> Terminal -> World -> [TerminalLine]
doTerminalBootProgram tbp = case tbp of
TerminalBootMempty -> \_ _ -> []
+355 -346
View File
File diff suppressed because it is too large Load Diff