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