Make examine inventory controlled by item, perhaps still buggy
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -61,6 +61,7 @@ data ItemStructuralFunction
|
||||
| MakeAutoSF
|
||||
| ProjectileStabiliserSF
|
||||
| GrenadeHitEffectSF
|
||||
| ToggleSF
|
||||
deriving (Eq, Ord, Show, Read)
|
||||
|
||||
type ComposedItem = (Item, ItemStructuralFunction, LinkTest)
|
||||
|
||||
@@ -25,12 +25,6 @@ data HUDElement
|
||||
}
|
||||
| DisplayCarte
|
||||
|
||||
--data MouseInventorySelection
|
||||
-- = MouseInvSelect
|
||||
-- {_misSelStart :: (Int, Int), _misMaybeEnd :: Maybe (Int, Int)}
|
||||
-- | MouseInvDrag
|
||||
-- | MouseInvNothing
|
||||
|
||||
data SubInventory
|
||||
= NoSubInventory
|
||||
| ExamineInventory
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
@@ -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 =
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 =
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 =
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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,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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 -> \_ _ -> []
|
||||
|
||||
Reference in New Issue
Block a user