Mapper, ARHUD, radar sweeps update. Add dropper items
This commit is contained in:
@@ -9,7 +9,7 @@
|
|||||||
"_graphics_cloud_shadows": true,
|
"_graphics_cloud_shadows": true,
|
||||||
"_graphics_distortion_resolution": "FullRes",
|
"_graphics_distortion_resolution": "FullRes",
|
||||||
"_graphics_distortions": true,
|
"_graphics_distortions": true,
|
||||||
"_graphics_downsize_resolution": "EighthRes",
|
"_graphics_downsize_resolution": "SixteenthRes",
|
||||||
"_graphics_num_shadow_casters": "NumShadowCasters20",
|
"_graphics_num_shadow_casters": "NumShadowCasters20",
|
||||||
"_graphics_shadow_rendering": "GeoObjShads",
|
"_graphics_shadow_rendering": "GeoObjShads",
|
||||||
"_graphics_shadow_size": "Typical",
|
"_graphics_shadow_size": "Typical",
|
||||||
|
|||||||
@@ -1,19 +1,13 @@
|
|||||||
module Dodge.Base.You
|
module Dodge.Base.You
|
||||||
(you
|
(you
|
||||||
-- , yourScopeInvID
|
|
||||||
, yourInv
|
, yourInv
|
||||||
-- , yourScrollAttachment
|
|
||||||
, yourSelectedItem
|
, yourSelectedItem
|
||||||
, yourRootItem
|
, yourRootItem
|
||||||
)where
|
)where
|
||||||
|
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
--import Dodge.HeldScroll
|
|
||||||
import qualified IntMapHelp as IM
|
import qualified IntMapHelp as IM
|
||||||
--import qualified Data.Map.Strict as M
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
--import Control.Monad
|
|
||||||
--import Data.Maybe
|
|
||||||
|
|
||||||
you :: World -> Creature
|
you :: World -> Creature
|
||||||
you w = w ^?! cWorld . lWorld . creatures . ix 0
|
you w = w ^?! cWorld . lWorld . creatures . ix 0
|
||||||
@@ -28,23 +22,6 @@ yourRootItem w = do
|
|||||||
i <- you w ^? crManipulation . manObject . imRootSelectedItem
|
i <- you w ^? crManipulation . manObject . imRootSelectedItem
|
||||||
_crInv (you w) IM.!? i
|
_crInv (you w) IM.!? i
|
||||||
|
|
||||||
--yourScrollAttachment :: World -> Maybe (Int,ScrollAttachParams)
|
|
||||||
--yourScrollAttachment w = do
|
|
||||||
-- i <- you w ^? crManipulation . manObject . inInventory . ispItem
|
|
||||||
-- itm <- _crInv (you w) IM.!? i
|
|
||||||
-- atparams <- you w ^? crInv . ix (i - 1) . itUse . attachParams . scrollAttachParams
|
|
||||||
-- guard (canHeldScrollAttach itm atparams)
|
|
||||||
-- return (i - 1, atparams)
|
|
||||||
|
|
||||||
--yourScopeInvID :: World -> Maybe Int
|
|
||||||
--yourScopeInvID w = do
|
|
||||||
-- (i, params) <- yourScrollAttachment w
|
|
||||||
-- _ <- params ^? opticPos
|
|
||||||
-- return i
|
|
||||||
|
|
||||||
yourInv :: World -> IM.IntMap Item
|
yourInv :: World -> IM.IntMap Item
|
||||||
yourInv = _crInv . you
|
yourInv = _crInv . you
|
||||||
|
|
||||||
|
|
||||||
--yourInvSel :: World -> Int
|
|
||||||
--yourInvSel = crSel . you
|
|
||||||
|
|||||||
@@ -245,7 +245,7 @@ inventoryX c = case c of
|
|||||||
, gimbal
|
, gimbal
|
||||||
, battery
|
, battery
|
||||||
, laser
|
, laser
|
||||||
, augmentedHUD
|
, arHUD
|
||||||
, rLauncher
|
, rLauncher
|
||||||
, megaShellMag
|
, megaShellMag
|
||||||
, homingModule
|
, homingModule
|
||||||
@@ -269,7 +269,7 @@ inventoryX c = case c of
|
|||||||
<>
|
<>
|
||||||
[ battery
|
[ battery
|
||||||
, zoomScope
|
, zoomScope
|
||||||
, augmentedHUD
|
, arHUD
|
||||||
, makeTypeCraft SPRING
|
, makeTypeCraft SPRING
|
||||||
, makeTypeCraft HARDWARE
|
, makeTypeCraft HARDWARE
|
||||||
, autoRifle
|
, autoRifle
|
||||||
@@ -307,7 +307,7 @@ stackedInventory =
|
|||||||
, magShield
|
, magShield
|
||||||
, bangCone
|
, bangCone
|
||||||
, megaTinMag 100
|
, megaTinMag 100
|
||||||
, augmentedHUD
|
, arHUD
|
||||||
, smallBattery
|
, smallBattery
|
||||||
, makeTypeCraft TRANSFORMER
|
, makeTypeCraft TRANSFORMER
|
||||||
, remoteScreen
|
, remoteScreen
|
||||||
|
|||||||
@@ -36,7 +36,7 @@ useItemLoc cr loc pt w
|
|||||||
, 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 <- sf =
|
| GadgetPlatformSF <- sf =
|
||||||
return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
|
return $ gadgetEffect pt loc cr w
|
||||||
| UnderBarrelPlatformSF <- sf
|
| UnderBarrelPlatformSF <- sf
|
||||||
, fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
|
, fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
|
||||||
, cr ^. crStance . posture == Aiming =
|
, cr ^. crStance . posture == Aiming =
|
||||||
@@ -79,6 +79,8 @@ structureUseAtLoc :: ItemStructuralFunction -> Bool
|
|||||||
structureUseAtLoc = \case
|
structureUseAtLoc = \case
|
||||||
HeldPlatformSF -> True
|
HeldPlatformSF -> True
|
||||||
UnderBarrelPlatformSF -> True
|
UnderBarrelPlatformSF -> True
|
||||||
|
GadgetPlatformSF -> True
|
||||||
|
MapperSF -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
activateDetonator ::
|
activateDetonator ::
|
||||||
|
|||||||
@@ -3,6 +3,7 @@ module Dodge.Creature.State (
|
|||||||
doDamage,
|
doDamage,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Applicative
|
||||||
import Dodge.HeldUse
|
import Dodge.HeldUse
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
@@ -291,16 +292,17 @@ updateItemWithOrientation cr m loc@(LocLDT _ itmtree) =
|
|||||||
(HELD TORCH, _) -> shineTorch cr itmtree m
|
(HELD TORCH, _) -> shineTorch cr itmtree m
|
||||||
(HELD LASER, WeaponTargetingSF) -> shineTargetLaser cr itmtree m
|
(HELD LASER, WeaponTargetingSF) -> shineTargetLaser cr itmtree m
|
||||||
(TARGETING tt, _) -> updateItemTargeting tt cr itm
|
(TARGETING tt, _) -> updateItemTargeting tt cr itm
|
||||||
(ATTACH AUGMENTEDHUD, _) -> drawAugmentedHUD loc
|
(ARHUD, _) -> drawARHUD loc
|
||||||
_ -> id
|
_ -> id
|
||||||
where
|
where
|
||||||
ci = itmtree ^. ldtValue
|
ci = itmtree ^. ldtValue
|
||||||
itm = ci ^. _1
|
itm = ci ^. _1
|
||||||
|
|
||||||
drawAugmentedHUD :: LocationLDT ItemLink ComposedItem -> World -> World
|
drawARHUD :: LocationLDT ItemLink ComposedItem -> World -> World
|
||||||
drawAugmentedHUD (LocLDT con _) w = fromMaybe w $ do
|
drawARHUD (LocLDT con _) w = fromMaybe w $ do
|
||||||
itm <- con ^? cldtParent . _1
|
itm <- con ^? cldtParent . _1
|
||||||
return $ w & cWorld . lWorld . flares <>~ drawTargeting itm w
|
return $ w & cWorld . lWorld . flares <>~ fold
|
||||||
|
(drawTargetingAR itm w <|> drawMapperAR itm w)
|
||||||
|
|
||||||
shineTargetLaser ::
|
shineTargetLaser ::
|
||||||
Creature ->
|
Creature ->
|
||||||
|
|||||||
@@ -26,7 +26,7 @@ data ComposeLinkType
|
|||||||
| RemoteScreenLink
|
| RemoteScreenLink
|
||||||
| RemoteDetonatorLink
|
| RemoteDetonatorLink
|
||||||
| SmokeReducerLink
|
| SmokeReducerLink
|
||||||
| AugmentedHUDLink
|
-- | AugmentedHUDLink
|
||||||
| FunctionChangeLink
|
| FunctionChangeLink
|
||||||
| MakeAutoLink
|
| MakeAutoLink
|
||||||
| ProjectileStabiliserLink
|
| ProjectileStabiliserLink
|
||||||
@@ -47,7 +47,7 @@ data ItemStructuralFunction
|
|||||||
| WeaponTargetingSF
|
| WeaponTargetingSF
|
||||||
| IntroScanSF
|
| IntroScanSF
|
||||||
| TriggerSF
|
| TriggerSF
|
||||||
| AugmentedHUDSF
|
| ARHUDSF
|
||||||
| AmmoMagSF AmmoType
|
| AmmoMagSF AmmoType
|
||||||
| RemoteScreenSF
|
| RemoteScreenSF
|
||||||
| JoystickSF
|
| JoystickSF
|
||||||
|
|||||||
@@ -23,8 +23,16 @@ data ItemType
|
|||||||
| STICKYMOD
|
| STICKYMOD
|
||||||
| ITEMSCAN
|
| ITEMSCAN
|
||||||
| MAPPER
|
| MAPPER
|
||||||
|
| DROPPER InventoryPathing
|
||||||
| INTROSCAN {_ibtIntroScanType :: IntroScanType}
|
| INTROSCAN {_ibtIntroScanType :: IntroScanType}
|
||||||
| DETECTOR {_ibtDetector :: Detector}
|
| DETECTOR {_ibtDetector :: Detector}
|
||||||
|
| ARHUD
|
||||||
|
deriving (Eq, Ord, Show, Read)
|
||||||
|
|
||||||
|
data InventoryPathing
|
||||||
|
= ABSOLUTE
|
||||||
|
| RELCURS
|
||||||
|
| RELITEM
|
||||||
deriving (Eq, Ord, Show, Read)
|
deriving (Eq, Ord, Show, Read)
|
||||||
|
|
||||||
data IntroScanType
|
data IntroScanType
|
||||||
@@ -85,7 +93,6 @@ data AttachType
|
|||||||
| REMOTEDETONATOR
|
| REMOTEDETONATOR
|
||||||
| SMOKEREDUCER
|
| SMOKEREDUCER
|
||||||
| HOMINGMODULE
|
| HOMINGMODULE
|
||||||
| AUGMENTEDHUD
|
|
||||||
| SHELLPAYLOAD {_shellPayload :: Payload}
|
| SHELLPAYLOAD {_shellPayload :: Payload}
|
||||||
deriving (Eq, Ord, Show, Read)
|
deriving (Eq, Ord, Show, Read)
|
||||||
|
|
||||||
@@ -175,6 +182,7 @@ data Detector
|
|||||||
makeLenses ''ItemType
|
makeLenses ''ItemType
|
||||||
makeLenses ''HeldItemType
|
makeLenses ''HeldItemType
|
||||||
makeLenses ''AttachType
|
makeLenses ''AttachType
|
||||||
|
deriveJSON defaultOptions ''InventoryPathing
|
||||||
deriveJSON defaultOptions ''IntroScanType
|
deriveJSON defaultOptions ''IntroScanType
|
||||||
deriveJSON defaultOptions ''CraftType
|
deriveJSON defaultOptions ''CraftType
|
||||||
deriveJSON defaultOptions ''ConsumableItemType
|
deriveJSON defaultOptions ''ConsumableItemType
|
||||||
|
|||||||
@@ -41,6 +41,7 @@ data ItemUse
|
|||||||
}
|
}
|
||||||
| UseEquip {_uequipEffect :: EquipEffect}
|
| UseEquip {_uequipEffect :: EquipEffect}
|
||||||
| UseAttach {_uaParams :: AttachParams}
|
| UseAttach {_uaParams :: AttachParams}
|
||||||
|
| UseInt {_uInt :: Int}
|
||||||
| UseNothing
|
| UseNothing
|
||||||
| UseScope {_uScope :: Scope}
|
| UseScope {_uScope :: Scope}
|
||||||
| UseBulletMod {_ubMod :: BulletMod}
|
| UseBulletMod {_ubMod :: BulletMod}
|
||||||
@@ -223,8 +224,6 @@ deriveJSON defaultOptions ''HeldParams
|
|||||||
deriveJSON defaultOptions ''AmmoPerShot
|
deriveJSON defaultOptions ''AmmoPerShot
|
||||||
deriveJSON defaultOptions ''Muzzle
|
deriveJSON defaultOptions ''Muzzle
|
||||||
deriveJSON defaultOptions ''AimStance
|
deriveJSON defaultOptions ''AimStance
|
||||||
|
|
||||||
--deriveJSON defaultOptions ''ScrollAttachParams
|
|
||||||
deriveJSON defaultOptions ''AttachParams
|
deriveJSON defaultOptions ''AttachParams
|
||||||
deriveJSON defaultOptions ''ItZoom
|
deriveJSON defaultOptions ''ItZoom
|
||||||
deriveJSON defaultOptions ''AimParams
|
deriveJSON defaultOptions ''AimParams
|
||||||
|
|||||||
@@ -22,6 +22,8 @@ data RadarSweep = RadarSweep
|
|||||||
, _rsObject :: ObjectType
|
, _rsObject :: ObjectType
|
||||||
, _rsTimer :: Int
|
, _rsTimer :: Int
|
||||||
, _rsMapper :: Maybe (NewInt ItmInt)
|
, _rsMapper :: Maybe (NewInt ItmInt)
|
||||||
|
, _rsAR :: Maybe (NewInt ItmInt)
|
||||||
|
, _rsSource :: NewInt ItmInt
|
||||||
}
|
}
|
||||||
deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
||||||
|
|
||||||
|
|||||||
+47
-13
@@ -3,17 +3,18 @@
|
|||||||
|
|
||||||
module Dodge.HeldUse (
|
module Dodge.HeldUse (
|
||||||
heldEffect,
|
heldEffect,
|
||||||
|
gadgetEffect,
|
||||||
heldEffectNoHammerCheck,
|
heldEffectNoHammerCheck,
|
||||||
mcUseHeld,
|
mcUseHeld,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import qualified Data.IntMap.Strict as IM
|
||||||
|
import Dodge.Creature.Action
|
||||||
import Color
|
import Color
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Dodge.Base.Collide
|
import Dodge.Base.Collide
|
||||||
--import Dodge.Base.Coordinate
|
|
||||||
import Dodge.Creature.Action.Blink
|
|
||||||
import Dodge.Data.ComposedItem
|
import Dodge.Data.ComposedItem
|
||||||
import Dodge.Data.DoubleTree
|
import Dodge.Data.DoubleTree
|
||||||
import Dodge.Data.MuzzleEffect
|
import Dodge.Data.MuzzleEffect
|
||||||
@@ -35,6 +36,20 @@ import Picture.Base
|
|||||||
import RandomHelp
|
import RandomHelp
|
||||||
import qualified SDL
|
import qualified SDL
|
||||||
|
|
||||||
|
gadgetEffect ::
|
||||||
|
PressType ->
|
||||||
|
LocationLDT ItemLink ComposedItem ->
|
||||||
|
Creature ->
|
||||||
|
World ->
|
||||||
|
World
|
||||||
|
gadgetEffect pt loc
|
||||||
|
| UseHeld {} <- loc ^. locLDT . ldtValue . _1 . itUse = heldEffect pt
|
||||||
|
(bimap _iatType (^. _1) (loc ^. locLDT))
|
||||||
|
| DROPPER x <- loc ^. locLDT . ldtValue . _1 . itType
|
||||||
|
, Just i <- loc ^? locLDT . ldtValue . _1 . itUse . uInt
|
||||||
|
, pt == InitialPress = dropInventoryPath i x loc
|
||||||
|
| otherwise = const id
|
||||||
|
|
||||||
heldEffect ::
|
heldEffect ::
|
||||||
PressType ->
|
PressType ->
|
||||||
LabelDoubleTree ComposeLinkType Item ->
|
LabelDoubleTree ComposeLinkType Item ->
|
||||||
@@ -329,7 +344,8 @@ useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cme
|
|||||||
w
|
w
|
||||||
MuzzleNozzle{} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w
|
MuzzleNozzle{} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w
|
||||||
MuzzleShatter -> shootShatter itm cr w
|
MuzzleShatter -> shootShatter itm cr w
|
||||||
MuzzleDetector -> itemDetectorEffect itm (getAttachedMapper itmtree) cr w
|
MuzzleDetector -> itemDetectorEffect itm (getAttachedSFLink MapperSF itmtree)
|
||||||
|
(getAttachedSFLink ARHUDSF itmtree) cr w
|
||||||
MuzzleBlink -> unsafeBlinkAction cr w
|
MuzzleBlink -> unsafeBlinkAction cr w
|
||||||
MuzzleUnsafeBlink -> blinkActionMousePos cr w
|
MuzzleUnsafeBlink -> blinkActionMousePos cr w
|
||||||
MuzzleRewind -> useRewindGun (itm ^. itID) w
|
MuzzleRewind -> useRewindGun (itm ^. itID) w
|
||||||
@@ -339,18 +355,20 @@ useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cme
|
|||||||
mid = magtree ^? ldtValue . itLocation . ilInvID
|
mid = magtree ^? ldtValue . itLocation . ilInvID
|
||||||
itm = itmtree ^. ldtValue
|
itm = itmtree ^. ldtValue
|
||||||
|
|
||||||
|
getAttachedSFLink :: ItemStructuralFunction
|
||||||
|
-> LabelDoubleTree ComposeLinkType Item -> Maybe (NewInt ItmInt)
|
||||||
|
getAttachedSFLink sf = (^? ldtRight . folding (lookup (SFLink sf)) . ldtValue . itID)
|
||||||
|
|
||||||
getAttachedMapper :: LabelDoubleTree ComposeLinkType Item -> Maybe (NewInt ItmInt)
|
itemDetectorEffect :: Item -> Maybe (NewInt ItmInt)
|
||||||
getAttachedMapper =
|
-> Maybe (NewInt ItmInt) -> Creature -> World -> World
|
||||||
(^? ldtRight . folding (lookup (SFLink MapperSF)) . ldtValue . itID)
|
itemDetectorEffect itm mitid armitid cr w = fromMaybe w $ do
|
||||||
|
|
||||||
itemDetectorEffect :: Item -> Maybe (NewInt ItmInt) -> Creature -> World -> World
|
|
||||||
itemDetectorEffect itm itid cr w = fromMaybe w $ do
|
|
||||||
DETECTOR dt <- itm ^? itType
|
DETECTOR dt <- itm ^? itType
|
||||||
return $ case dt of
|
return $ aRadarPulse (itm ^. itID) mitid armitid (f dt) cr w
|
||||||
ITEMDETECTOR -> aRadarPulse itid ObItem cr w
|
where
|
||||||
CREATUREDETECTOR -> aRadarPulse itid ObCreature cr w
|
f ITEMDETECTOR = ObItem
|
||||||
WALLDETECTOR -> aRadarPulse itid ObWall cr w
|
f CREATUREDETECTOR = ObCreature
|
||||||
|
f WALLDETECTOR = ObWall
|
||||||
|
|
||||||
|
|
||||||
walkNozzle :: Int -> Muzzle -> Item -> Creature -> World -> World
|
walkNozzle :: Int -> Muzzle -> Item -> Creature -> World -> World
|
||||||
walkNozzle mzid mz itm cr w = fromMaybe w $ do
|
walkNozzle mzid mz itm cr w = fromMaybe w $ do
|
||||||
@@ -759,6 +777,22 @@ useRewindGun i =
|
|||||||
, _scrollItemID = i
|
, _scrollItemID = i
|
||||||
}
|
}
|
||||||
|
|
||||||
|
dropInventoryPath :: Int -> InventoryPathing -> LocationLDT ItemLink ComposedItem
|
||||||
|
-> Creature
|
||||||
|
-> World -> World
|
||||||
|
dropInventoryPath i ip loc cr w = case ip of
|
||||||
|
ABSOLUTE -> fromMaybe w $ do
|
||||||
|
guard $ i `IM.member` (cr ^. crInv)
|
||||||
|
return $ dropItem cr i w
|
||||||
|
RELCURS -> fromMaybe w $ do
|
||||||
|
j <- cr ^? crManipulation . manObject . imSelectedItem
|
||||||
|
guard $ (i + j) `IM.member` (cr ^. crInv)
|
||||||
|
return $ dropItem cr (i + j) w
|
||||||
|
RELITEM -> fromMaybe w $ do
|
||||||
|
j <- loc ^? locLDT . ldtValue . _1 . itLocation . ilInvID
|
||||||
|
guard $ (i + j) `IM.member` (cr ^. crInv)
|
||||||
|
return $ dropItem cr (i + j) w
|
||||||
|
|
||||||
--useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
|
--useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
|
||||||
-- [w'] -> w & cwTime . maybeWorld .~ Just' w'
|
-- [w'] -> w & cwTime . maybeWorld .~ Just' w'
|
||||||
-- (w' : ws) -> w
|
-- (w' : ws) -> w
|
||||||
|
|||||||
+2
-1
@@ -29,6 +29,8 @@ itemFromBase = \case
|
|||||||
INTROSCAN t -> introScan t
|
INTROSCAN t -> introScan t
|
||||||
MAPPER -> mapper
|
MAPPER -> mapper
|
||||||
DETECTOR d -> detector d
|
DETECTOR d -> detector d
|
||||||
|
ARHUD -> arHUD
|
||||||
|
DROPPER x -> dropper x
|
||||||
|
|
||||||
itemFromAmmoMag :: AmmoMagType -> Item
|
itemFromAmmoMag :: AmmoMagType -> Item
|
||||||
itemFromAmmoMag at = case at of
|
itemFromAmmoMag at = case at of
|
||||||
@@ -52,7 +54,6 @@ itemFromAttachType at = case at of
|
|||||||
SMOKEREDUCER -> smokeReducer
|
SMOKEREDUCER -> smokeReducer
|
||||||
-- ROCKETHOMER -> rocketHomer
|
-- ROCKETHOMER -> rocketHomer
|
||||||
HOMINGMODULE -> homingModule
|
HOMINGMODULE -> homingModule
|
||||||
AUGMENTEDHUD -> augmentedHUD
|
|
||||||
SHELLPAYLOAD p -> shellModule p
|
SHELLPAYLOAD p -> shellModule p
|
||||||
|
|
||||||
itemFromEquipType :: EquipItemType -> Item
|
itemFromEquipType :: EquipItemType -> Item
|
||||||
|
|||||||
@@ -70,6 +70,14 @@ itemBaseName = \case
|
|||||||
INTROSCAN t -> show t
|
INTROSCAN t -> show t
|
||||||
MAPPER -> "MAPPER"
|
MAPPER -> "MAPPER"
|
||||||
DETECTOR t -> show t
|
DETECTOR t -> show t
|
||||||
|
ARHUD -> "AR-HUD"
|
||||||
|
DROPPER x -> "DROPPER-" ++ showInventoryPathing x
|
||||||
|
|
||||||
|
showInventoryPathing :: InventoryPathing -> String
|
||||||
|
showInventoryPathing = \case
|
||||||
|
ABSOLUTE -> "ABS"
|
||||||
|
RELCURS -> "CURS"
|
||||||
|
RELITEM -> "HERE"
|
||||||
|
|
||||||
showAttachItem :: AttachType -> String
|
showAttachItem :: AttachType -> String
|
||||||
showAttachItem t = case t of
|
showAttachItem t = case t of
|
||||||
@@ -81,7 +89,6 @@ showAttachItem t = case t of
|
|||||||
REMOTEDETONATOR -> "REM.DETONATR"
|
REMOTEDETONATOR -> "REM.DETONATR"
|
||||||
SMOKEREDUCER -> "SMOKE.REDUCR"
|
SMOKEREDUCER -> "SMOKE.REDUCR"
|
||||||
HOMINGMODULE -> "HOMING MOD"
|
HOMINGMODULE -> "HOMING MOD"
|
||||||
AUGMENTEDHUD -> "AUGMENTED HUD"
|
|
||||||
SHELLPAYLOAD x -> show x
|
SHELLPAYLOAD x -> show x
|
||||||
GIMBAL -> "GIMBAL"
|
GIMBAL -> "GIMBAL"
|
||||||
GYROSCOPE -> "GYROSCOPE"
|
GYROSCOPE -> "GYROSCOPE"
|
||||||
@@ -96,6 +103,7 @@ showEquipItem eit = case eit of
|
|||||||
-- 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 :: World -> Creature -> ComposedItem -> [String]
|
itemNumberDisplay :: World -> Creature -> ComposedItem -> [String]
|
||||||
itemNumberDisplay w cr ci
|
itemNumberDisplay w cr ci
|
||||||
|
| Just x <- ci ^? _1 . itUse . uInt = [show x]
|
||||||
| Just x <- ci ^? _1 . itUse . useToggle = [show x]
|
| Just x <- ci ^? _1 . itUse . useToggle = [show x]
|
||||||
| ITEMSCAN <- ci ^. _1 . itType
|
| ITEMSCAN <- ci ^. _1 . itType
|
||||||
, Just ExamineInventory <- w ^? hud . hudElement . subInventory
|
, Just ExamineInventory <- w ^? hud . hudElement . subInventory
|
||||||
|
|||||||
@@ -43,8 +43,10 @@ itemSPic it = case it ^. itType of
|
|||||||
STICKYMOD -> defSPic
|
STICKYMOD -> defSPic
|
||||||
ITEMSCAN -> defSPic
|
ITEMSCAN -> defSPic
|
||||||
MAPPER -> defSPic
|
MAPPER -> defSPic
|
||||||
|
ARHUD -> defSPic
|
||||||
INTROSCAN {} -> defSPic
|
INTROSCAN {} -> defSPic
|
||||||
DETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPolySU 3 $ rectWH 2 2)
|
DETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPolySU 3 $ rectWH 2 2)
|
||||||
|
DROPPER{} -> defSPic
|
||||||
|
|
||||||
craftItemSPic :: CraftType -> Shape
|
craftItemSPic :: CraftType -> Shape
|
||||||
craftItemSPic = \case
|
craftItemSPic = \case
|
||||||
|
|||||||
@@ -72,7 +72,11 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
|
|||||||
)
|
)
|
||||||
(DETECTOR {}, _) ->
|
(DETECTOR {}, _) ->
|
||||||
( getAmmoLinks itm
|
( getAmmoLinks itm
|
||||||
, [(TriggerSF, TriggerLink),(MapperSF,SFLink MapperSF)]
|
, [(ARHUDSF,SFLink ARHUDSF),(TriggerSF, TriggerLink),(MapperSF,SFLink MapperSF)]
|
||||||
|
)
|
||||||
|
(MAPPER, _) ->
|
||||||
|
( []
|
||||||
|
, [(ARHUDSF,SFLink ARHUDSF)]
|
||||||
)
|
)
|
||||||
(_, GadgetPlatformSF) ->
|
(_, GadgetPlatformSF) ->
|
||||||
( getAmmoLinks itm
|
( getAmmoLinks itm
|
||||||
@@ -100,7 +104,7 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
|
|||||||
( [(JoystickSF, JoystickLink)]
|
( [(JoystickSF, JoystickLink)]
|
||||||
, []
|
, []
|
||||||
)
|
)
|
||||||
(_, WeaponTargetingSF) -> (getAmmoLinks itm ++ [(AugmentedHUDSF, AugmentedHUDLink)], [])
|
(_, WeaponTargetingSF) -> (getAmmoLinks itm ++ [(ARHUDSF, SFLink ARHUDSF)], [])
|
||||||
(ATTACH BULLETSYNTH, _) ->
|
(ATTACH BULLETSYNTH, _) ->
|
||||||
([(AmmoMagSF ElectricalAmmo, AmmoInLink 0 ElectricalAmmo)], [])
|
([(AmmoMagSF ElectricalAmmo, AmmoInLink 0 ElectricalAmmo)], [])
|
||||||
_ -> ([], [])
|
_ -> ([], [])
|
||||||
@@ -154,7 +158,7 @@ itemToFunction itm = case itm ^. itType of
|
|||||||
ATTACH BULLETSYNTH -> AmmoModifierSF BulletAmmo
|
ATTACH BULLETSYNTH -> AmmoModifierSF BulletAmmo
|
||||||
ATTACH ZOOMSCOPE -> WeaponScopeSF
|
ATTACH ZOOMSCOPE -> WeaponScopeSF
|
||||||
ATTACH HOMINGMODULE -> AmmoTargetingSF LauncherAmmo
|
ATTACH HOMINGMODULE -> AmmoTargetingSF LauncherAmmo
|
||||||
ATTACH AUGMENTEDHUD -> AugmentedHUDSF
|
ARHUD -> ARHUDSF
|
||||||
ATTACH UNDERBARRELSLOT -> UnderBarrelSlotSF
|
ATTACH UNDERBARRELSLOT -> UnderBarrelSlotSF
|
||||||
BULLETMOD BulletModPayload{} -> AmmoPayloadSF BulletAmmo
|
BULLETMOD BulletModPayload{} -> AmmoPayloadSF BulletAmmo
|
||||||
BULLETMOD BulletModEffect{} -> AmmoEffectSF BulletAmmo
|
BULLETMOD BulletModEffect{} -> AmmoEffectSF BulletAmmo
|
||||||
@@ -162,6 +166,7 @@ itemToFunction itm = case itm ^. itType of
|
|||||||
EQUIP WRIST_ECG -> TriggerSF
|
EQUIP WRIST_ECG -> TriggerSF
|
||||||
EQUIP{} -> EquipmentPlatformSF
|
EQUIP{} -> EquipmentPlatformSF
|
||||||
ATTACH SHELLPAYLOAD{} -> AmmoPayloadSF LauncherAmmo
|
ATTACH SHELLPAYLOAD{} -> AmmoPayloadSF LauncherAmmo
|
||||||
|
DROPPER{} -> GadgetPlatformSF
|
||||||
_ -> NoSF
|
_ -> NoSF
|
||||||
|
|
||||||
structureToPotentialFunction ::
|
structureToPotentialFunction ::
|
||||||
|
|||||||
@@ -28,8 +28,26 @@ itmBaseInfo itm = case itm ^. itType of
|
|||||||
CRAFT fit -> craftInfo fit
|
CRAFT fit -> craftInfo fit
|
||||||
DETECTOR d -> "A device that detects " ++ detectorInfo d ++ " in an expanding radius."
|
DETECTOR d -> "A device that detects " ++ detectorInfo d ++ " in an expanding radius."
|
||||||
ATTACH t -> attachInfo t
|
ATTACH t -> attachInfo t
|
||||||
|
AMMOMAG t -> ammoMagInfo t
|
||||||
|
-- TARGETING {_ibtTargeting :: TargetingType}
|
||||||
|
-- BULLETMOD {_ibtBulletMod :: BulletMod}
|
||||||
|
-- STICKYMOD
|
||||||
|
-- ITEMSCAN
|
||||||
|
-- MAPPER
|
||||||
|
-- INTROSCAN {_ibtIntroScanType :: IntroScanType}
|
||||||
|
-- DETECTOR {_ibtDetector :: Detector}
|
||||||
|
-- ARHUD
|
||||||
_ -> "THIS SHOULD NOT BE DISPLAYED"
|
_ -> "THIS SHOULD NOT BE DISPLAYED"
|
||||||
|
|
||||||
|
ammoMagInfo :: AmmoMagType -> String
|
||||||
|
ammoMagInfo = \case
|
||||||
|
TINMAG -> "A small tin magazine for containing bullets. "
|
||||||
|
DRUMMAG -> "A mid-sized magazine for containing bullets. "
|
||||||
|
BELTMAG -> "A belt with attachable bullets. "
|
||||||
|
SHELLMAG -> "A container for a projectile. "
|
||||||
|
BATTERY -> "A store of electrical potential energy. "
|
||||||
|
CHEMFUELPOUCH -> "A small tank for containing flammable liquids. "
|
||||||
|
|
||||||
attachInfo :: AttachType -> String
|
attachInfo :: AttachType -> String
|
||||||
attachInfo = \case
|
attachInfo = \case
|
||||||
ZOOMSCOPE -> "An optical zoom. "
|
ZOOMSCOPE -> "An optical zoom. "
|
||||||
|
|||||||
@@ -20,7 +20,7 @@ itemInvColor ci = case ci ^. _2 of
|
|||||||
TriggerSF -> yellow
|
TriggerSF -> yellow
|
||||||
WeaponScopeSF -> chartreuse
|
WeaponScopeSF -> chartreuse
|
||||||
WeaponTargetingSF -> green
|
WeaponTargetingSF -> green
|
||||||
AugmentedHUDSF -> rose
|
ARHUDSF -> rose
|
||||||
AmmoMagSF{} -> red
|
AmmoMagSF{} -> red
|
||||||
RemoteScreenSF -> azure
|
RemoteScreenSF -> azure
|
||||||
JoystickSF -> azure
|
JoystickSF -> azure
|
||||||
|
|||||||
+12
-4
@@ -10,14 +10,14 @@ module Dodge.Item.Scope (
|
|||||||
joystick,
|
joystick,
|
||||||
remoteDetonator,
|
remoteDetonator,
|
||||||
homingModule,
|
homingModule,
|
||||||
-- bulletTargetingModule,
|
arHUD,
|
||||||
augmentedHUD,
|
|
||||||
bulletModule,
|
bulletModule,
|
||||||
bulletPayloadModule,
|
bulletPayloadModule,
|
||||||
smokeReducer,
|
smokeReducer,
|
||||||
itemScan,
|
itemScan,
|
||||||
introScan,
|
introScan,
|
||||||
mapper,
|
mapper,
|
||||||
|
dropper,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Dodge.Item.Attach
|
import Dodge.Item.Attach
|
||||||
@@ -68,6 +68,12 @@ mapper =
|
|||||||
& itType .~ MAPPER
|
& itType .~ MAPPER
|
||||||
& itUse .~ UseMapper mempty mempty
|
& itUse .~ UseMapper mempty mempty
|
||||||
|
|
||||||
|
dropper :: InventoryPathing -> Item
|
||||||
|
dropper x =
|
||||||
|
defaultHeldItem
|
||||||
|
& itType .~ DROPPER x
|
||||||
|
& itUse .~ UseInt 0
|
||||||
|
|
||||||
bulletModule :: BulletMod -> Item
|
bulletModule :: BulletMod -> Item
|
||||||
bulletModule bm =
|
bulletModule bm =
|
||||||
defaultHeldItem
|
defaultHeldItem
|
||||||
@@ -85,8 +91,10 @@ shellModule p = defaultHeldItem
|
|||||||
bulletPayloadModule :: BulletPayload -> Item
|
bulletPayloadModule :: BulletPayload -> Item
|
||||||
bulletPayloadModule = bulletModule . BulletModPayload
|
bulletPayloadModule = bulletModule . BulletModPayload
|
||||||
|
|
||||||
augmentedHUD :: Item
|
arHUD :: Item
|
||||||
augmentedHUD = makeAttach AUGMENTEDHUD
|
arHUD = defaultHeldItem
|
||||||
|
& itType .~ ARHUD
|
||||||
|
& itUse .~ UseNothing
|
||||||
|
|
||||||
remoteScreen :: Item
|
remoteScreen :: Item
|
||||||
remoteScreen = makeAttach REMOTESCREEN
|
remoteScreen = makeAttach REMOTESCREEN
|
||||||
|
|||||||
@@ -1,4 +1,7 @@
|
|||||||
module Dodge.RadarBlip where
|
module Dodge.RadarBlip (
|
||||||
|
updateRadarBlip,
|
||||||
|
drawBlip,
|
||||||
|
) where
|
||||||
|
|
||||||
import Dodge.Data.RadarBlip
|
import Dodge.Data.RadarBlip
|
||||||
import Geometry.Data
|
import Geometry.Data
|
||||||
|
|||||||
+26
-13
@@ -1,29 +1,39 @@
|
|||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
|
|
||||||
module Dodge.RadarSweep (
|
module Dodge.RadarSweep (
|
||||||
aRadarPulse,
|
aRadarPulse,
|
||||||
updateRadarSweep,
|
updateRadarSweep,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Maybe
|
|
||||||
import Dodge.Item.Location
|
|
||||||
import qualified Data.Set as S
|
|
||||||
import Color
|
import Color
|
||||||
|
import Data.Maybe
|
||||||
|
import qualified Data.Set as S
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
|
import Dodge.Item.Location
|
||||||
import Dodge.Zoning.Wall
|
import Dodge.Zoning.Wall
|
||||||
import Geometry
|
import Geometry
|
||||||
import qualified IntMapHelp as IM
|
import qualified IntMapHelp as IM
|
||||||
import LensHelp
|
import LensHelp
|
||||||
import NewInt
|
import NewInt
|
||||||
|
|
||||||
aRadarPulse :: Maybe (NewInt ItmInt) -> ObjectType -> Creature -> World -> World
|
aRadarPulse ::
|
||||||
aRadarPulse itid ob cr =
|
NewInt ItmInt ->
|
||||||
|
Maybe (NewInt ItmInt) ->
|
||||||
|
Maybe (NewInt ItmInt) ->
|
||||||
|
ObjectType ->
|
||||||
|
Creature ->
|
||||||
|
World ->
|
||||||
|
World
|
||||||
|
aRadarPulse itid mitid armitid ob cr =
|
||||||
cWorld . lWorld . radarSweeps
|
cWorld . lWorld . radarSweeps
|
||||||
.:~ RadarSweep
|
.:~ RadarSweep
|
||||||
{ _rsTimer = 50
|
{ _rsTimer = 50
|
||||||
, _rsRad = 0
|
, _rsRad = 0
|
||||||
, _rsPos = _crPos cr
|
, _rsPos = _crPos cr
|
||||||
, _rsObject = ob
|
, _rsObject = ob
|
||||||
, _rsMapper = itid
|
, _rsMapper = mitid
|
||||||
|
, _rsAR = armitid
|
||||||
|
, _rsSource = itid
|
||||||
}
|
}
|
||||||
|
|
||||||
updateRadarSweep :: World -> RadarSweep -> (World, Maybe RadarSweep)
|
updateRadarSweep :: World -> RadarSweep -> (World, Maybe RadarSweep)
|
||||||
@@ -40,13 +50,16 @@ updateRadarSweep w pt
|
|||||||
p = _rsPos pt
|
p = _rsPos pt
|
||||||
ob = _rsObject pt
|
ob = _rsObject pt
|
||||||
x = _rsTimer pt
|
x = _rsTimer pt
|
||||||
putBlips = cWorld . lWorld . radarBlips .++~ map
|
putBlips
|
||||||
|
| isJust (pt ^. rsAR) = cWorld . lWorld . radarBlips
|
||||||
|
.++~ map
|
||||||
(makeBlip ob)
|
(makeBlip ob)
|
||||||
blips
|
blips
|
||||||
(blips,wps) = findBlips ob p r w
|
| otherwise = id
|
||||||
|
(blips, wps) = findBlips ob p r w
|
||||||
r = fromIntegral (400 - x * 8)
|
r = fromIntegral (400 - x * 8)
|
||||||
|
|
||||||
findBlips :: ObjectType -> Point2 -> Float -> World -> ([Point2],S.Set (Point2,Point2))
|
findBlips :: ObjectType -> Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
|
||||||
findBlips ob = case ob of
|
findBlips ob = case ob of
|
||||||
ObCreature -> crBlips
|
ObCreature -> crBlips
|
||||||
ObItem -> itemBlips
|
ObItem -> itemBlips
|
||||||
@@ -71,20 +84,20 @@ blipAt r col i p =
|
|||||||
, _rbPos = p
|
, _rbPos = p
|
||||||
}
|
}
|
||||||
|
|
||||||
crBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2,Point2))
|
crBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
|
||||||
crBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures . _lWorld . _cWorld
|
crBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures . _lWorld . _cWorld
|
||||||
where
|
where
|
||||||
f q = dist p q <= r && dist p q > r - 100
|
f q = dist p q <= r && dist p q > r - 100
|
||||||
g cr = _crID cr /= 0
|
g cr = _crID cr /= 0
|
||||||
|
|
||||||
itemBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2,Point2))
|
itemBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
|
||||||
itemBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _flItPos . _unNIntMap . _floorItems . _lWorld . _cWorld
|
itemBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _flItPos . _unNIntMap . _floorItems . _lWorld . _cWorld
|
||||||
where
|
where
|
||||||
f q = dist p q <= r && dist p q > r - 4
|
f q = dist p q <= r && dist p q > r - 4
|
||||||
|
|
||||||
wallBlips :: Point2 -> Float -> World -> ([Point2],S.Set (Point2,Point2))
|
wallBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
|
||||||
wallBlips p r = foldMap f . wlsNearCirc p r
|
wallBlips p r = foldMap f . wlsNearCirc p r
|
||||||
where
|
where
|
||||||
f wl = case uncurry (intersectCircSeg p r) $ _wlLine wl of
|
f wl = case uncurry (intersectCircSeg p r) $ _wlLine wl of
|
||||||
[] -> mempty
|
[] -> mempty
|
||||||
xs -> (xs,S.singleton (wl ^. wlLine))
|
xs -> (xs, S.singleton (wl ^. wlLine))
|
||||||
|
|||||||
@@ -1,15 +1,26 @@
|
|||||||
module Dodge.RadarSweep.Draw where
|
module Dodge.RadarSweep.Draw (
|
||||||
|
drawRadarSweep,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Lens
|
||||||
|
import Data.Maybe
|
||||||
import Dodge.Data.RadarSweep
|
import Dodge.Data.RadarSweep
|
||||||
import Geometry
|
import Geometry
|
||||||
import Picture
|
import Picture
|
||||||
|
|
||||||
|
-- I have taken shortcuts in determining whether this is drawn or not wrt to the
|
||||||
|
-- linked ARHUD: it needs to have existed at the sweeps original creation, then
|
||||||
|
-- the sweep is drawn
|
||||||
drawRadarSweep :: RadarSweep -> Picture
|
drawRadarSweep :: RadarSweep -> Picture
|
||||||
drawRadarSweep pt = setLayer DebugLayer $ fold
|
drawRadarSweep pt
|
||||||
|
| isJust (pt ^. rsAR) =
|
||||||
|
setLayer DebugLayer $
|
||||||
|
fold
|
||||||
[ colHelper 0.1 $ uncurryV translate p $ thickCircle r 15
|
[ colHelper 0.1 $ uncurryV translate p $ thickCircle r 15
|
||||||
, colHelper 0.06 $ uncurryV translate p $ thickCircle (r -5) 5
|
, colHelper 0.06 $ uncurryV translate p $ thickCircle (r -5) 5
|
||||||
, colHelper 0.03 $ uncurryV translate p $ thickCircle (r -10) 5
|
, colHelper 0.03 $ uncurryV translate p $ thickCircle (r -10) 5
|
||||||
]
|
]
|
||||||
|
| otherwise = mempty
|
||||||
where
|
where
|
||||||
col = rsObjectColor $ _rsObject pt
|
col = rsObjectColor $ _rsObject pt
|
||||||
p = _rsPos pt
|
p = _rsPos pt
|
||||||
|
|||||||
@@ -164,13 +164,13 @@ drawSubInventory subinv cfig w = case subinv of
|
|||||||
ExamineInventory -> drawExamineInventory cfig w
|
ExamineInventory -> drawExamineInventory cfig w
|
||||||
DisplayTerminal tid -> drawTerminalDisplay tid cfig (w ^. cWorld . lWorld)
|
DisplayTerminal tid -> drawTerminalDisplay tid cfig (w ^. cWorld . lWorld)
|
||||||
CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
|
CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
|
||||||
MapperInventory p z itid -> drawMapperInventory p z itid cfig w
|
MapperInventory _ _ itid -> drawMapperInventory itid w
|
||||||
|
|
||||||
drawMapperInventory :: Point2 -> Float -> NewInt ItmInt -> Configuration -> World -> Picture
|
drawMapperInventory :: NewInt ItmInt -> World -> Picture
|
||||||
drawMapperInventory p z itid _ w = fold $ do
|
drawMapperInventory itid w = fold $ do
|
||||||
itm <- w ^? pointerToItemID itid
|
itm <- w ^? pointerToItemID itid
|
||||||
ls <- itm ^? itUse . useMapperLines
|
ls <- itm ^? itUse . useMapperLines
|
||||||
let r = w ^. wCam . camRot
|
let _ = w ^. wCam . camRot
|
||||||
return . color red
|
return . color red
|
||||||
$ foldMap (\(x,y) -> line [f x,f y]) ls
|
$ foldMap (\(x,y) -> line [f x,f y]) ls
|
||||||
where
|
where
|
||||||
|
|||||||
@@ -1,10 +1,11 @@
|
|||||||
module Dodge.ScrollValue where
|
module Dodge.ScrollValue (updateScrollTestValue) where
|
||||||
|
|
||||||
import Dodge.Data.Input
|
import Dodge.Data.Input
|
||||||
import LensHelp
|
import LensHelp
|
||||||
|
|
||||||
updateScrollTestValue :: Input -> Input
|
updateScrollTestValue :: Input -> Input
|
||||||
updateScrollTestValue theinput = theinput & scrollTestFloat +~ theamount
|
updateScrollTestValue theinput =
|
||||||
|
theinput & scrollTestFloat +~ theamount
|
||||||
& scrollTestInt +~ i
|
& scrollTestInt +~ i
|
||||||
where
|
where
|
||||||
i = theinput ^. scrollAmount
|
i = theinput ^. scrollAmount
|
||||||
|
|||||||
@@ -1,4 +1,8 @@
|
|||||||
module Dodge.SmoothScroll where
|
module Dodge.SmoothScroll (
|
||||||
|
getSmoothScrollValue,
|
||||||
|
calcSmoothScroll,
|
||||||
|
advanceSmoothScroll,
|
||||||
|
) where
|
||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Dodge.Data.Input
|
import Dodge.Data.Input
|
||||||
@@ -33,5 +37,5 @@ advanceSmoothScroll y
|
|||||||
| y > 0 = y - 1
|
| y > 0 = y - 1
|
||||||
| y == 0 = 0
|
| y == 0 = 0
|
||||||
| y > (-10) = y + 1
|
| y > (-10) = y + 1
|
||||||
| y > (-20) = y+2
|
| y > (-20) = y + 2
|
||||||
| otherwise = y+3
|
| otherwise = y + 3
|
||||||
|
|||||||
@@ -1,17 +1,24 @@
|
|||||||
module Dodge.Targeting.Draw (
|
module Dodge.Targeting.Draw (
|
||||||
drawTargeting,
|
drawTargetingAR,
|
||||||
|
drawMapperAR,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Data.Maybe
|
|
||||||
import Dodge.Base.Coordinate
|
import Dodge.Base.Coordinate
|
||||||
import Dodge.Data.Universe
|
import Dodge.Data.Universe
|
||||||
import Geometry.Data
|
import Geometry.Data
|
||||||
import Picture
|
import Picture
|
||||||
|
|
||||||
-- it would be nice to get rid of some redundant checks here
|
drawMapperAR :: Item -> World -> Maybe Picture
|
||||||
drawTargeting :: Item -> World -> Picture
|
drawMapperAR itm w = do
|
||||||
drawTargeting itm w = fromMaybe mempty $ do
|
ls <- itm ^? itUse . useMapperLines
|
||||||
|
let _ = w ^. wCam . camRot
|
||||||
|
return . setLayer FixedCoordLayer . color red $ foldMap (\(x,y) -> line [f x,f y]) ls
|
||||||
|
where
|
||||||
|
f = worldPosToScreen (w ^. wCam)
|
||||||
|
|
||||||
|
drawTargetingAR :: Item -> World -> Maybe Picture
|
||||||
|
drawTargetingAR itm w = do
|
||||||
p <- itm ^? itTargeting . itTgPos . _Just
|
p <- itm ^? itTargeting . itTgPos . _Just
|
||||||
let thepic = case itm ^? itTargeting . itTgActive of
|
let thepic = case itm ^? itTargeting . itTgActive of
|
||||||
Just True -> activeTargetCursorPic
|
Just True -> activeTargetCursorPic
|
||||||
|
|||||||
@@ -96,32 +96,6 @@ showManObj (SelCloseButton x) = "CloseButton " ++ show x
|
|||||||
-- ]
|
-- ]
|
||||||
|
|
||||||
|
|
||||||
-- getPrettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crHotkeys)
|
|
||||||
-- <> ["---"]
|
|
||||||
-- <> getPrettyShort ( u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInvHotkeys)
|
|
||||||
|
|
||||||
-- [show $ u ^. uvWorld . input . smoothScrollAmount
|
|
||||||
-- , show $ getSmoothScrollValue (u ^. uvWorld . input)
|
|
||||||
-- , show (u ^. uvConfig . windowX) ++ " " ++ show (u ^. uvConfig . windowY)
|
|
||||||
-- ]
|
|
||||||
-- [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . wCam)
|
|
||||||
-- (u ^. uvWorld . cWorld . lWorld)
|
|
||||||
-- , show a
|
|
||||||
-- , show $ u ^. uvWorld . input . mousePos
|
|
||||||
-- , show $ u ^. uvConfig . windowX
|
|
||||||
-- , show $ u ^. uvConfig . windowY
|
|
||||||
-- , show $ u ^. uvWorld . input . scrollTestInt
|
|
||||||
-- ]
|
|
||||||
-- where
|
|
||||||
-- w = u ^. uvWorld
|
|
||||||
-- a = fromMaybe 0 $ do
|
|
||||||
-- cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
|
|
||||||
-- return . toClosestMultiple (pi/ 8) $ argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- cpos)
|
|
||||||
-- - w ^. wCam . camRot
|
|
||||||
|
|
||||||
--[show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra . sssSelPos . _Just]
|
|
||||||
-- [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . subInventory . ciSections . sssSections]
|
|
||||||
|
|
||||||
showTimeFlow :: TimeFlowStatus -> String
|
showTimeFlow :: TimeFlowStatus -> String
|
||||||
showTimeFlow tfs = case tfs of
|
showTimeFlow tfs = case tfs of
|
||||||
DeathTime i -> "DeathTime"++show i
|
DeathTime i -> "DeathTime"++show i
|
||||||
|
|||||||
+22
-18
@@ -18,7 +18,7 @@ updateWheelEvent :: Int -> World -> World
|
|||||||
updateWheelEvent yi w = case w ^. hud . hudElement . subInventory of
|
updateWheelEvent yi w = case w ^. hud . hudElement . subInventory of
|
||||||
NoSubInventory -> updateBaseWheelEvent yi w
|
NoSubInventory -> updateBaseWheelEvent yi w
|
||||||
ExamineInventory -> updateBaseWheelEvent yi w
|
ExamineInventory -> updateBaseWheelEvent yi w
|
||||||
MapperInventory {} -> updateBaseWheelEvent yi w
|
MapperInventory{} -> updateBaseWheelEvent yi w
|
||||||
CombineInventory{} -> moveCombineSel yi w
|
CombineInventory{} -> moveCombineSel yi w
|
||||||
DisplayTerminal tmid -> terminalWheelEvent yi tmid w
|
DisplayTerminal tmid -> terminalWheelEvent yi tmid w
|
||||||
|
|
||||||
@@ -27,7 +27,7 @@ updateBaseWheelEvent yi w
|
|||||||
| Just True <- w ^? cWorld . lWorld . creatures . ix 0 . crInvLock = w
|
| Just True <- w ^? cWorld . lWorld . creatures . ix 0 . crInvLock = 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 -> fromMaybe w (selectedItemScroll yi w)
|
||||||
| bdown ButtonLeft = w & wCam . camZoom +~ fromIntegral yi
|
| bdown ButtonLeft = w & wCam . camZoom +~ fromIntegral yi
|
||||||
| ScancodeCapsLock `M.member` _pressedKeys (_input w) = changeSwapSel yi w
|
| ScancodeCapsLock `M.member` _pressedKeys (_input w) = changeSwapSel yi w
|
||||||
| otherwise = scrollAugInvSel yi w
|
| otherwise = scrollAugInvSel yi w
|
||||||
@@ -38,17 +38,23 @@ updateBaseWheelEvent yi w
|
|||||||
esite <- you w ^? crInv . ix invid . itUse . uequipEffect . eeType
|
esite <- you w ^? crInv . ix invid . itUse . uequipEffect . eeType
|
||||||
return . length $ eqSiteToPositions esite
|
return . length $ eqSiteToPositions esite
|
||||||
|
|
||||||
selectedItemScroll :: Int -> World -> World
|
selectedItemScroll :: Int -> World -> Maybe World
|
||||||
selectedItemScroll scrollamount w = fromMaybe w $ do
|
selectedItemScroll yi w = do
|
||||||
i <- you w ^? crManipulation . manObject . imSelectedItem
|
i <- you w ^? crManipulation . manObject . imSelectedItem
|
||||||
itm <- you w ^? crInv . ix i
|
itm <- you w ^? crInv . ix i
|
||||||
return $ itemScroll scrollamount i itm w
|
return $ itemScroll yi i itm w
|
||||||
|
|
||||||
itemScroll :: Int -> Int -> Item -> World -> World
|
itemScroll :: Int -> Int -> Item -> World -> World
|
||||||
itemScroll yi invid itm w = case itm ^. itType of
|
itemScroll yi invid itm w
|
||||||
ATTACH ZOOMSCOPE -> updateScopeZoom w
|
| isJust $ itm ^? itUse . uInt =
|
||||||
HELD ALTERIFLE
|
w
|
||||||
| yi /= 0 ->
|
& cWorld . lWorld . creatures . ix 0 . crInv . ix invid
|
||||||
|
. itUse
|
||||||
|
. uInt
|
||||||
|
+~ yi
|
||||||
|
| ATTACH ZOOMSCOPE <- itm ^. itType = updateScopeZoom invid w
|
||||||
|
| HELD ALTERIFLE <- itm ^. itType
|
||||||
|
, yi /= 0 =
|
||||||
w
|
w
|
||||||
& cWorld . lWorld . creatures . ix 0 . crInv . ix invid
|
& cWorld . lWorld . creatures . ix 0 . crInv . ix invid
|
||||||
. itUse
|
. itUse
|
||||||
@@ -57,18 +63,16 @@ itemScroll yi invid itm w = case itm ^. itType of
|
|||||||
. ix 0
|
. ix 0
|
||||||
. mzAmmoSlot
|
. mzAmmoSlot
|
||||||
%~ ((`mod` 2) . (+ 1))
|
%~ ((`mod` 2) . (+ 1))
|
||||||
_ -> w
|
| otherwise = w
|
||||||
|
|
||||||
-- note that your _crInvLock does not apply to this TODO check that this is what
|
-- note that your _crInvLock does not apply to this TODO check that this is what
|
||||||
-- is wanted
|
-- is wanted
|
||||||
updateScopeZoom :: World -> World
|
updateScopeZoom :: Int -> World -> World
|
||||||
updateScopeZoom w = fromMaybe w $ do
|
updateScopeZoom i w
|
||||||
i <- you w ^? crManipulation . manObject . imSelectedItem
|
| Just 0 <- w ^. input . mouseButtons . at SDL.ButtonRight =
|
||||||
return $ updateScopeZoom' i w
|
w
|
||||||
|
& wppointer %~ resetscope
|
||||||
updateScopeZoom' :: Int -> World -> World
|
| Just _ <- w ^. input . mouseButtons . at SDL.ButtonRight =
|
||||||
updateScopeZoom' i w
|
|
||||||
| SDL.ButtonRight `M.member` _mouseButtons (_input w) =
|
|
||||||
w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) (w ^. input . mousePos)
|
w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) (w ^. input . mousePos)
|
||||||
| otherwise = w & wppointer %~ resetscope
|
| otherwise = w & wppointer %~ resetscope
|
||||||
where
|
where
|
||||||
|
|||||||
Reference in New Issue
Block a user