justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Mapper, ARHUD, radar sweeps update. Add dropper items

Browse Source
This commit is contained in:
justin
2025-01-03 10:43:06 +00:00
parent e9f5a39ed7
commit 386d6f47b0
27 changed files with 802 additions and 700 deletions
Download Patch File Download Diff File Expand all files Collapse all files
data/dodge.config.json
+1 -1
View File
@@ -9,7 +9,7 @@
"_graphics_cloud_shadows": true,
"_graphics_distortion_resolution": "FullRes",
"_graphics_distortions": true,
"_graphics_downsize_resolution": "EighthRes",
"_graphics_downsize_resolution": "SixteenthRes",
"_graphics_num_shadow_casters": "NumShadowCasters20",
"_graphics_shadow_rendering": "GeoObjShads",
"_graphics_shadow_size": "Typical",
src/Dodge/Base/You.hs
-23
View File
@@ -1,19 +1,13 @@
module Dodge.Base.You
(you
-- , yourScopeInvID
, yourInv
-- , yourScrollAttachment
, yourSelectedItem
, yourRootItem
)where
import Dodge.Data.World
--import Dodge.HeldScroll
import qualified IntMapHelp as IM
--import qualified Data.Map.Strict as M
import Control.Lens
--import Control.Monad
--import Data.Maybe
you :: World -> Creature
you w = w ^?! cWorld . lWorld . creatures . ix 0
@@ -28,23 +22,6 @@ yourRootItem w = do
i <- you w ^? crManipulation . manObject . imRootSelectedItem
_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 = _crInv . you
--yourInvSel :: World -> Int
--yourInvSel = crSel . you
src/Dodge/Creature.hs
+3 -3
View File
@@ -245,7 +245,7 @@ inventoryX c = case c of
, gimbal
, battery
, laser
, augmentedHUD
, arHUD
, rLauncher
, megaShellMag
, homingModule
@@ -269,7 +269,7 @@ inventoryX c = case c of
<>
[ battery
, zoomScope
, augmentedHUD
, arHUD
, makeTypeCraft SPRING
, makeTypeCraft HARDWARE
, autoRifle
@@ -307,7 +307,7 @@ stackedInventory =
, magShield
, bangCone
, megaTinMag 100
, augmentedHUD
, arHUD
, smallBattery
, makeTypeCraft TRANSFORMER
, remoteScreen
src/Dodge/Creature/Impulse/UseItem.hs
+3 -1
View File
@@ -36,7 +36,7 @@ useItemLoc cr loc pt w
, cr ^. crStance . posture == Aiming =
return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
| GadgetPlatformSF <- sf =
return $ heldEffect pt (bimap _iatType (^. _1) ldt) cr w
return $ gadgetEffect pt loc cr w
| UnderBarrelPlatformSF <- sf
, fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
, cr ^. crStance . posture == Aiming =
@@ -79,6 +79,8 @@ structureUseAtLoc :: ItemStructuralFunction -> Bool
structureUseAtLoc = \case
HeldPlatformSF -> True
UnderBarrelPlatformSF -> True
GadgetPlatformSF -> True
MapperSF -> True
_ -> False
activateDetonator ::
src/Dodge/Creature/State.hs
+6 -4
View File
@@ -3,6 +3,7 @@ module Dodge.Creature.State (
doDamage,
) where
import Control.Applicative
import Dodge.HeldUse
import Control.Monad
import qualified Data.Map.Strict as M
@@ -291,16 +292,17 @@ updateItemWithOrientation cr m loc@(LocLDT _ itmtree) =
(HELD TORCH, _) -> shineTorch cr itmtree m
(HELD LASER, WeaponTargetingSF) -> shineTargetLaser cr itmtree m
(TARGETING tt, _) -> updateItemTargeting tt cr itm
(ATTACH AUGMENTEDHUD, _) -> drawAugmentedHUD loc
(ARHUD, _) -> drawARHUD loc
_ -> id
where
ci = itmtree ^. ldtValue
itm = ci ^. _1
drawAugmentedHUD :: LocationLDT ItemLink ComposedItem -> World -> World
drawAugmentedHUD (LocLDT con _) w = fromMaybe w $ do
drawARHUD :: LocationLDT ItemLink ComposedItem -> World -> World
drawARHUD (LocLDT con _) w = fromMaybe w $ do
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 ::
Creature ->
src/Dodge/Data/ComposedItem.hs
+2 -2
View File
@@ -26,7 +26,7 @@ data ComposeLinkType
| RemoteScreenLink
| RemoteDetonatorLink
| SmokeReducerLink
| AugmentedHUDLink
-- | AugmentedHUDLink
| FunctionChangeLink
| MakeAutoLink
| ProjectileStabiliserLink
@@ -47,7 +47,7 @@ data ItemStructuralFunction
| WeaponTargetingSF
| IntroScanSF
| TriggerSF
| AugmentedHUDSF
| ARHUDSF
| AmmoMagSF AmmoType
| RemoteScreenSF
| JoystickSF
src/Dodge/Data/Item/Combine.hs
+9 -1
View File
@@ -23,8 +23,16 @@ data ItemType
| STICKYMOD
| ITEMSCAN
| MAPPER
| DROPPER InventoryPathing
| INTROSCAN {_ibtIntroScanType :: IntroScanType}
| DETECTOR {_ibtDetector :: Detector}
| ARHUD
deriving (Eq, Ord, Show, Read)
data InventoryPathing
= ABSOLUTE
| RELCURS
| RELITEM
deriving (Eq, Ord, Show, Read)
data IntroScanType
@@ -85,7 +93,6 @@ data AttachType
| REMOTEDETONATOR
| SMOKEREDUCER
| HOMINGMODULE
| AUGMENTEDHUD
| SHELLPAYLOAD {_shellPayload :: Payload}
deriving (Eq, Ord, Show, Read)
@@ -175,6 +182,7 @@ data Detector
makeLenses ''ItemType
makeLenses ''HeldItemType
makeLenses ''AttachType
deriveJSON defaultOptions ''InventoryPathing
deriveJSON defaultOptions ''IntroScanType
deriveJSON defaultOptions ''CraftType
deriveJSON defaultOptions ''ConsumableItemType
src/Dodge/Data/Item/Use.hs
+1 -2
View File
@@ -41,6 +41,7 @@ data ItemUse
}
| UseEquip {_uequipEffect :: EquipEffect}
| UseAttach {_uaParams :: AttachParams}
| UseInt {_uInt :: Int}
| UseNothing
| UseScope {_uScope :: Scope}
| UseBulletMod {_ubMod :: BulletMod}
@@ -223,8 +224,6 @@ deriveJSON defaultOptions ''HeldParams
deriveJSON defaultOptions ''AmmoPerShot
deriveJSON defaultOptions ''Muzzle
deriveJSON defaultOptions ''AimStance
--deriveJSON defaultOptions ''ScrollAttachParams
deriveJSON defaultOptions ''AttachParams
deriveJSON defaultOptions ''ItZoom
deriveJSON defaultOptions ''AimParams
src/Dodge/Data/RadarSweep.hs
+2
View File
@@ -22,6 +22,8 @@ data RadarSweep = RadarSweep
, _rsObject :: ObjectType
, _rsTimer :: Int
, _rsMapper :: Maybe (NewInt ItmInt)
, _rsAR :: Maybe (NewInt ItmInt)
, _rsSource :: NewInt ItmInt
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
src/Dodge/HeldUse.hs
+47 -13
View File
@@ -3,17 +3,18 @@
module Dodge.HeldUse (
heldEffect,
gadgetEffect,
heldEffectNoHammerCheck,
mcUseHeld,
) where
import qualified Data.IntMap.Strict as IM
import Dodge.Creature.Action
import Color
import Control.Applicative
import Control.Monad
import Data.Maybe
import Dodge.Base.Collide
--import Dodge.Base.Coordinate
import Dodge.Creature.Action.Blink
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Dodge.Data.MuzzleEffect
@@ -35,6 +36,20 @@ import Picture.Base
import RandomHelp
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 ::
PressType ->
LabelDoubleTree ComposeLinkType Item ->
@@ -329,7 +344,8 @@ useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cme
w
MuzzleNozzle{} -> useGasParams mid mz itm cr $ walkNozzle mzid mz 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
MuzzleUnsafeBlink -> blinkActionMousePos cr 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
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)
getAttachedMapper =
(^? ldtRight . folding (lookup (SFLink MapperSF)) . ldtValue . itID)
itemDetectorEffect :: Item -> Maybe (NewInt ItmInt) -> Creature -> World -> World
itemDetectorEffect itm itid cr w = fromMaybe w $ do
itemDetectorEffect :: Item -> Maybe (NewInt ItmInt)
-> Maybe (NewInt ItmInt) -> Creature -> World -> World
itemDetectorEffect itm mitid armitid cr w = fromMaybe w $ do
DETECTOR dt <- itm ^? itType
return $ case dt of
ITEMDETECTOR -> aRadarPulse itid ObItem cr w
CREATUREDETECTOR -> aRadarPulse itid ObCreature cr w
WALLDETECTOR -> aRadarPulse itid ObWall cr w
return $ aRadarPulse (itm ^. itID) mitid armitid (f dt) cr w
where
f ITEMDETECTOR = ObItem
f CREATUREDETECTOR = ObCreature
f WALLDETECTOR = ObWall
walkNozzle :: Int -> Muzzle -> Item -> Creature -> World -> World
walkNozzle mzid mz itm cr w = fromMaybe w $ do
@@ -759,6 +777,22 @@ useRewindGun 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
-- [w'] -> w & cwTime . maybeWorld .~ Just' w'
-- (w' : ws) -> w
src/Dodge/Item.hs
+2 -1
View File
@@ -29,6 +29,8 @@ itemFromBase = \case
INTROSCAN t -> introScan t
MAPPER -> mapper
DETECTOR d -> detector d
ARHUD -> arHUD
DROPPER x -> dropper x
itemFromAmmoMag :: AmmoMagType -> Item
itemFromAmmoMag at = case at of
@@ -52,7 +54,6 @@ itemFromAttachType at = case at of
SMOKEREDUCER -> smokeReducer
-- ROCKETHOMER -> rocketHomer
HOMINGMODULE -> homingModule
AUGMENTEDHUD -> augmentedHUD
SHELLPAYLOAD p -> shellModule p
itemFromEquipType :: EquipItemType -> Item
src/Dodge/Item/Display.hs
+9 -1
View File
@@ -70,6 +70,14 @@ itemBaseName = \case
INTROSCAN t -> show t
MAPPER -> "MAPPER"
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 t = case t of
@@ -81,7 +89,6 @@ showAttachItem t = case t of
REMOTEDETONATOR -> "REM.DETONATR"
SMOKEREDUCER -> "SMOKE.REDUCR"
HOMINGMODULE -> "HOMING MOD"
AUGMENTEDHUD -> "AUGMENTED HUD"
SHELLPAYLOAD x -> show x
GIMBAL -> "GIMBAL"
GYROSCOPE -> "GYROSCOPE"
@@ -96,6 +103,7 @@ showEquipItem eit = case eit of
-- that is to say, it should not change based on functional positioning
itemNumberDisplay :: World -> Creature -> ComposedItem -> [String]
itemNumberDisplay w cr ci
| Just x <- ci ^? _1 . itUse . uInt = [show x]
| Just x <- ci ^? _1 . itUse . useToggle = [show x]
| ITEMSCAN <- ci ^. _1 . itType
, Just ExamineInventory <- w ^? hud . hudElement . subInventory
src/Dodge/Item/Draw/SPic.hs
+2
View File
@@ -43,8 +43,10 @@ itemSPic it = case it ^. itType of
STICKYMOD -> defSPic
ITEMSCAN -> defSPic
MAPPER -> defSPic
ARHUD -> defSPic
INTROSCAN {} -> defSPic
DETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPolySU 3 $ rectWH 2 2)
DROPPER{} -> defSPic
craftItemSPic :: CraftType -> Shape
craftItemSPic = \case
src/Dodge/Item/Grammar.hs
+8 -3
View File
@@ -72,7 +72,11 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
)
(DETECTOR {}, _) ->
( getAmmoLinks itm
, [(TriggerSF, TriggerLink),(MapperSF,SFLink MapperSF)]
, [(ARHUDSF,SFLink ARHUDSF),(TriggerSF, TriggerLink),(MapperSF,SFLink MapperSF)]
)
(MAPPER, _) ->
( []
, [(ARHUDSF,SFLink ARHUDSF)]
)
(_, GadgetPlatformSF) ->
( getAmmoLinks itm
@@ -100,7 +104,7 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
( [(JoystickSF, JoystickLink)]
, []
)
(_, WeaponTargetingSF) -> (getAmmoLinks itm ++ [(AugmentedHUDSF, AugmentedHUDLink)], [])
(_, WeaponTargetingSF) -> (getAmmoLinks itm ++ [(ARHUDSF, SFLink ARHUDSF)], [])
(ATTACH BULLETSYNTH, _) ->
([(AmmoMagSF ElectricalAmmo, AmmoInLink 0 ElectricalAmmo)], [])
_ -> ([], [])
@@ -154,7 +158,7 @@ itemToFunction itm = case itm ^. itType of
ATTACH BULLETSYNTH -> AmmoModifierSF BulletAmmo
ATTACH ZOOMSCOPE -> WeaponScopeSF
ATTACH HOMINGMODULE -> AmmoTargetingSF LauncherAmmo
ATTACH AUGMENTEDHUD -> AugmentedHUDSF
ARHUD -> ARHUDSF
ATTACH UNDERBARRELSLOT -> UnderBarrelSlotSF
BULLETMOD BulletModPayload{} -> AmmoPayloadSF BulletAmmo
BULLETMOD BulletModEffect{} -> AmmoEffectSF BulletAmmo
@@ -162,6 +166,7 @@ itemToFunction itm = case itm ^. itType of
EQUIP WRIST_ECG -> TriggerSF
EQUIP{} -> EquipmentPlatformSF
ATTACH SHELLPAYLOAD{} -> AmmoPayloadSF LauncherAmmo
DROPPER{} -> GadgetPlatformSF
_ -> NoSF
structureToPotentialFunction ::
src/Dodge/Item/Info.hs
+18
View File
@@ -28,8 +28,26 @@ itmBaseInfo itm = case itm ^. itType of
CRAFT fit -> craftInfo fit
DETECTOR d -> "A device that detects " ++ detectorInfo d ++ " in an expanding radius."
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"
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 = \case
ZOOMSCOPE -> "An optical zoom. "
src/Dodge/Item/InventoryColor.hs
+1 -1
View File
@@ -20,7 +20,7 @@ itemInvColor ci = case ci ^. _2 of
TriggerSF -> yellow
WeaponScopeSF -> chartreuse
WeaponTargetingSF -> green
AugmentedHUDSF -> rose
ARHUDSF -> rose
AmmoMagSF{} -> red
RemoteScreenSF -> azure
JoystickSF -> azure
src/Dodge/Item/Scope.hs
+12 -4
View File
@@ -10,14 +10,14 @@ module Dodge.Item.Scope (
joystick,
remoteDetonator,
homingModule,
-- bulletTargetingModule,
augmentedHUD,
arHUD,
bulletModule,
bulletPayloadModule,
smokeReducer,
itemScan,
introScan,
mapper,
dropper,
) where
import Dodge.Item.Attach
@@ -68,6 +68,12 @@ mapper =
& itType .~ MAPPER
& itUse .~ UseMapper mempty mempty
dropper :: InventoryPathing -> Item
dropper x =
defaultHeldItem
& itType .~ DROPPER x
& itUse .~ UseInt 0
bulletModule :: BulletMod -> Item
bulletModule bm =
defaultHeldItem
@@ -85,8 +91,10 @@ shellModule p = defaultHeldItem
bulletPayloadModule :: BulletPayload -> Item
bulletPayloadModule = bulletModule . BulletModPayload
augmentedHUD :: Item
augmentedHUD = makeAttach AUGMENTEDHUD
arHUD :: Item
arHUD = defaultHeldItem
& itType .~ ARHUD
& itUse .~ UseNothing
remoteScreen :: Item
remoteScreen = makeAttach REMOTESCREEN
src/Dodge/RadarBlip.hs
+4 -1
View File
@@ -1,4 +1,7 @@
module Dodge.RadarBlip where
module Dodge.RadarBlip (
updateRadarBlip,
drawBlip,
) where
import Dodge.Data.RadarBlip
import Geometry.Data
src/Dodge/RadarSweep.hs
+28 -15
View File
@@ -1,29 +1,39 @@
{-# LANGUAGE TupleSections #-}
module Dodge.RadarSweep (
aRadarPulse,
updateRadarSweep,
) where
import Data.Maybe
import Dodge.Item.Location
import qualified Data.Set as S
import Color
import Data.Maybe
import qualified Data.Set as S
import Dodge.Data.World
import Dodge.Item.Location
import Dodge.Zoning.Wall
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import NewInt
aRadarPulse :: Maybe (NewInt ItmInt) -> ObjectType -> Creature -> World -> World
aRadarPulse itid ob cr =
aRadarPulse ::
NewInt ItmInt ->
Maybe (NewInt ItmInt) ->
Maybe (NewInt ItmInt) ->
ObjectType ->
Creature ->
World ->
World
aRadarPulse itid mitid armitid ob cr =
cWorld . lWorld . radarSweeps
.:~ RadarSweep
{ _rsTimer = 50
, _rsRad = 0
, _rsPos = _crPos cr
, _rsObject = ob
, _rsMapper = itid
, _rsMapper = mitid
, _rsAR = armitid
, _rsSource = itid
}
updateRadarSweep :: World -> RadarSweep -> (World, Maybe RadarSweep)
@@ -40,13 +50,16 @@ updateRadarSweep w pt
p = _rsPos pt
ob = _rsObject pt
x = _rsTimer pt
putBlips = cWorld . lWorld . radarBlips .++~ map
(makeBlip ob)
blips
(blips,wps) = findBlips ob p r w
putBlips
| isJust (pt ^. rsAR) = cWorld . lWorld . radarBlips
.++~ map
(makeBlip ob)
blips
| otherwise = id
(blips, wps) = findBlips ob p r w
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
ObCreature -> crBlips
ObItem -> itemBlips
@@ -71,20 +84,20 @@ blipAt r col i 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
where
f q = dist p q <= r && dist p q > r - 100
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
where
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
where
f wl = case uncurry (intersectCircSeg p r) $ _wlLine wl of
[] -> mempty
xs -> (xs,S.singleton (wl ^. wlLine))
xs -> (xs, S.singleton (wl ^. wlLine))
src/Dodge/RadarSweep/Draw.hs
+17 -6
View File
@@ -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 Geometry
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 pt = setLayer DebugLayer $ fold
[ colHelper 0.1 $ uncurryV translate p $ thickCircle r 15
, colHelper 0.06 $ uncurryV translate p $ thickCircle (r -5) 5
, colHelper 0.03 $ uncurryV translate p $ thickCircle (r -10) 5
]
drawRadarSweep pt
| isJust (pt ^. rsAR) =
setLayer DebugLayer $
fold
[ colHelper 0.1 $ uncurryV translate p $ thickCircle r 15
, colHelper 0.06 $ uncurryV translate p $ thickCircle (r -5) 5
, colHelper 0.03 $ uncurryV translate p $ thickCircle (r -10) 5
]
| otherwise = mempty
where
col = rsObjectColor $ _rsObject pt
p = _rsPos pt
src/Dodge/Render/HUD.hs
+4 -4
View File
@@ -164,13 +164,13 @@ drawSubInventory subinv cfig w = case subinv of
ExamineInventory -> drawExamineInventory cfig w
DisplayTerminal tid -> drawTerminalDisplay tid cfig (w ^. cWorld . lWorld)
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 p z itid _ w = fold $ do
drawMapperInventory :: NewInt ItmInt -> World -> Picture
drawMapperInventory itid w = fold $ do
itm <- w ^? pointerToItemID itid
ls <- itm ^? itUse . useMapperLines
let r = w ^. wCam . camRot
let _ = w ^. wCam . camRot
return . color red
$ foldMap (\(x,y) -> line [f x,f y]) ls
where
src/Dodge/ScrollValue.hs
+4 -3
View File
@@ -1,11 +1,12 @@
module Dodge.ScrollValue where
module Dodge.ScrollValue (updateScrollTestValue) where
import Dodge.Data.Input
import LensHelp
updateScrollTestValue :: Input -> Input
updateScrollTestValue theinput = theinput & scrollTestFloat +~ theamount
& scrollTestInt +~ i
updateScrollTestValue theinput =
theinput & scrollTestFloat +~ theamount
& scrollTestInt +~ i
where
i = theinput ^. scrollAmount
theamount = fromIntegral i / 100
src/Dodge/SmoothScroll.hs
+7 -3
View File
@@ -1,4 +1,8 @@
module Dodge.SmoothScroll where
module Dodge.SmoothScroll (
getSmoothScrollValue,
calcSmoothScroll,
advanceSmoothScroll,
) where
import Control.Lens
import Dodge.Data.Input
@@ -33,5 +37,5 @@ advanceSmoothScroll y
| y > 0 = y - 1
| y == 0 = 0
| y > (-10) = y + 1
| y > (-20) = y+2
| otherwise = y+3
| y > (-20) = y + 2
| otherwise = y + 3
src/Dodge/Targeting/Draw.hs
+12 -5
View File
@@ -1,17 +1,24 @@
module Dodge.Targeting.Draw (
drawTargeting,
drawTargetingAR,
drawMapperAR,
) where
import Control.Lens
import Data.Maybe
import Dodge.Base.Coordinate
import Dodge.Data.Universe
import Geometry.Data
import Picture
-- it would be nice to get rid of some redundant checks here
drawTargeting :: Item -> World -> Picture
drawTargeting itm w = fromMaybe mempty $ do
drawMapperAR :: Item -> World -> Maybe Picture
drawMapperAR itm w = 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
let thepic = case itm ^? itTargeting . itTgActive of
Just True -> activeTargetCursorPic
src/Dodge/TestString.hs
-26
View File
@@ -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 tfs = case tfs of
DeathTime i -> "DeathTime"++show i
src/Dodge/Update/Scroll.hs
+33 -29
View File
@@ -18,7 +18,7 @@ updateWheelEvent :: Int -> World -> World
updateWheelEvent yi w = case w ^. hud . hudElement . subInventory of
NoSubInventory -> updateBaseWheelEvent yi w
ExamineInventory -> updateBaseWheelEvent yi w
MapperInventory {} -> updateBaseWheelEvent yi w
MapperInventory{} -> updateBaseWheelEvent yi w
CombineInventory{} -> moveCombineSel yi w
DisplayTerminal tmid -> terminalWheelEvent yi tmid w
@@ -27,7 +27,7 @@ updateBaseWheelEvent yi w
| Just True <- w ^? cWorld . lWorld . creatures . ix 0 . crInvLock = w
| bdown ButtonRight = case _rbOptions w of
EquipOptions{} -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax
NoRightButtonOptions -> selectedItemScroll yi w
NoRightButtonOptions -> fromMaybe w (selectedItemScroll yi w)
| bdown ButtonLeft = w & wCam . camZoom +~ fromIntegral yi
| ScancodeCapsLock `M.member` _pressedKeys (_input w) = changeSwapSel yi w
| otherwise = scrollAugInvSel yi w
@@ -38,37 +38,41 @@ updateBaseWheelEvent yi w
esite <- you w ^? crInv . ix invid . itUse . uequipEffect . eeType
return . length $ eqSiteToPositions esite
selectedItemScroll :: Int -> World -> World
selectedItemScroll scrollamount w = fromMaybe w $ do
selectedItemScroll :: Int -> World -> Maybe World
selectedItemScroll yi w = do
i <- you w ^? crManipulation . manObject . imSelectedItem
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 yi invid itm w = case itm ^. itType of
ATTACH ZOOMSCOPE -> updateScopeZoom w
HELD ALTERIFLE
| yi /= 0 ->
w
& cWorld . lWorld . creatures . ix 0 . crInv . ix invid
. itUse
. heldAim
. aimMuzzles
. ix 0
. mzAmmoSlot
%~ ((`mod` 2) . (+ 1))
_ -> w
itemScroll yi invid itm w
| isJust $ itm ^? itUse . uInt =
w
& 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
& cWorld . lWorld . creatures . ix 0 . crInv . ix invid
. itUse
. heldAim
. aimMuzzles
. ix 0
. mzAmmoSlot
%~ ((`mod` 2) . (+ 1))
| otherwise = w
-- note that your _crInvLock does not apply to this TODO check that this is what
-- is wanted
updateScopeZoom :: World -> World
updateScopeZoom w = fromMaybe w $ do
i <- you w ^? crManipulation . manObject . imSelectedItem
return $ updateScopeZoom' i w
updateScopeZoom' :: Int -> World -> World
updateScopeZoom' i w
| SDL.ButtonRight `M.member` _mouseButtons (_input w) =
updateScopeZoom :: Int -> World -> World
updateScopeZoom i w
| Just 0 <- w ^. input . mouseButtons . at SDL.ButtonRight =
w
& wppointer %~ resetscope
| Just _ <- w ^. input . mouseButtons . at SDL.ButtonRight =
w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) (w ^. input . mousePos)
| otherwise = w & wppointer %~ resetscope
where
@@ -118,10 +122,10 @@ moveCombineSel yi =
terminalWheelEvent :: Int -> Int -> World -> World
terminalWheelEvent yi tmid w
| w & has (input . mouseButtons . ix ButtonRight)
, Just TerminalReady <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus =
w & cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel
, Just TerminalReady <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus =
w & cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel
| Just TerminalReady <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus =
w & cWorld . lWorld . terminals . ix tmid %~ updatetermsel
w & cWorld . lWorld . terminals . ix tmid %~ updatetermsel
| otherwise = w
where
updatetermsel tm = case tm ^? tmInput . tiSel of
tags
+567 -548
View File
File diff suppressed because it is too large Load Diff