This commit is contained in:
2025-06-05 16:21:30 +01:00
parent 4b326433ab
commit 16f5c05f19
24 changed files with 488 additions and 599 deletions
+1 -1
View File
File diff suppressed because one or more lines are too long
@@ -1,7 +1,8 @@
module Dodge.Hotkey (
module Dodge.AssignHotkey (
assignHotkey,
) where
import Dodge.Data.Equipment.Misc
import Control.Lens
import Data.Maybe
import Dodge.Data.World
+1
View File
@@ -3,6 +3,7 @@ module Dodge.Creature.ArmourChase (
flockArmourChaseCrit,
) where
import Dodge.Data.Equipment.Misc
import Control.Lens
import Dodge.Creature.ChaseCrit
import Dodge.Data.Creature
+1
View File
@@ -4,6 +4,7 @@ module Dodge.Creature.ChaseCrit (
chaseCrit,
) where
import Dodge.Data.Equipment.Misc
import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
+2 -2
View File
@@ -53,7 +53,7 @@ useItemLoc cr loc pt w
| Just b <- itm ^? itUse . useToggle
, pt == InitialPress =
return $ w & pointerToItem itm . itUse . useToggle .~ not b
| isJust $ itm ^? itUse . uequipEffect
| isJust $ itm ^? itType . ibtEquip
, pt == InitialPress
, Just invid' <- itm ^? itLocation . ilInvID =
return $ toggleEquipmentAt invid' cr w
@@ -67,7 +67,7 @@ useLocation ::
LocationLDT ItemLink ComposedItem ->
LocationLDT ItemLink ComposedItem
useLocation loc
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uequipEffect = loc
| isJust $ loc ^? locLDT . ldtValue . _1 . itType . ibtEquip = loc
| isJust $ loc ^? locLDT . ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0 =
loc
| sf <- loc ^. locLDT . ldtValue . _2
+1
View File
@@ -24,6 +24,7 @@ module Dodge.Creature.Test (
crSafeDistFromTarg,
) where
import Dodge.Data.Equipment.Misc
import Dodge.Data.AimStance
import Dodge.Item.AimStance
import Control.Lens
+2 -1
View File
@@ -4,6 +4,7 @@ module Dodge.Creature.YourControl (
yourControl,
) where
import Dodge.Data.Equipment.Misc
import Control.Monad
import qualified Data.Map.Strict as M
import Data.Maybe
@@ -11,7 +12,7 @@ import Dodge.Creature.Impulse.Movement
import Dodge.Creature.Impulse.UseItem
import Dodge.Data.AimStance
import Dodge.Data.World
import Dodge.Hotkey
import Dodge.AssignHotkey
import Dodge.InputFocus
import Dodge.Inventory
import Dodge.Item.AimStance
+1
View File
@@ -16,6 +16,7 @@ module Dodge.Data.Creature (
module Dodge.Data.Material,
) where
import Dodge.Data.Equipment.Misc
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
+3 -1
View File
@@ -1,7 +1,9 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Data.EquipType (equipType) where
module Dodge.Data.EquipType (equipType
,module Dodge.Data.Equipment.Misc) where
import Dodge.Data.Equipment.Misc
import Control.Lens
import Dodge.Data.Item
+1 -4
View File
@@ -5,9 +5,7 @@
module Dodge.Data.Item.Use (
module Dodge.Data.Item.Use,
module Dodge.Data.Item.Use.Equipment,
module Dodge.Data.Item.HeldUse,
-- module Dodge.Data.Item.HeldDelay,
module Dodge.Data.Item.Use.Consumption,
module Dodge.Data.Item.Targeting,
module Dodge.Data.GenFloat,
@@ -26,12 +24,11 @@ import Dodge.Data.Item.HeldUse
import Dodge.Data.Item.Scope
import Dodge.Data.Item.Targeting
import Dodge.Data.Item.Use.Consumption
import Dodge.Data.Item.Use.Equipment
import Geometry.Data
data ItemUse
= UseHeld
| UseEquip {_uequipEffect :: EquipEffect}
| UseEquip
| UseAttach {_uaParams :: AttachParams}
| UseInt {_uInt :: Int}
| UseNothing
-43
View File
@@ -1,43 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Item.Use.Equipment (
module Dodge.Data.Equipment.Misc,
module Dodge.Data.Item.Use.Equipment,
) where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Equipment.Misc
data EquipEffect = EquipEffect
-- { _eeUse :: Euse --Item -> Creature -> World -> World
---- , _eeOnEquip :: ItmCrWdWd --Item -> Creature -> World -> World
---- , _eeOnRemove :: ItmCrWdWd --Item -> Creature -> World -> World
---- , _eeParams :: EquipParams
---- , _eeViewDist :: Maybe Float
---- , _eeAttachPos :: Point3
-- }
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data ItmCrWdWd
= ItmCrWdWdDoNothing
-- | ECamouflage {_euseCamouflageStatus :: CamouflageStatus}
| EonWristShield
| EoffWristShield
deriving (Eq, Ord, Show, Read) --Generic, Flat)
--data EquipParams
-- = NoEquipParams
---- | EquipID {_eparamID :: Int}
---- | EquipCounter {_eparamInt :: Int}
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''EquipEffect
--makeLenses ''EquipParams
makeLenses ''ItmCrWdWd
deriveJSON defaultOptions ''ItmCrWdWd
--deriveJSON defaultOptions ''EquipParams
deriveJSON defaultOptions ''EquipEffect
+1
View File
@@ -46,6 +46,7 @@ module Dodge.Data.LWorld (
module Dodge.Data.WorldEffect,
) where
import Dodge.Data.Equipment.Misc
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
+1 -5
View File
@@ -23,8 +23,7 @@ import Geometry
import Picture
defaultEquipment :: Item
defaultEquipment = defaultHeldItem & itUse .~ defaultEquipUse
-- & itUseFocus .~ UseFromLocation
defaultEquipment = defaultHeldItem & itUse .~ UseEquip
defaultFlIt :: FloorItem
defaultFlIt = FlIt{_flItRot = 0, _flIt = defaultHeldItem, _flItPos = V2 0 0, _flItID = 0}
@@ -73,9 +72,6 @@ defaultPP =
, _ppText = "Pressure plate"
}
--upHammer :: HammerType
--upHammer = HasHammer HammerUp
defaultProximitySensor :: Sensor
defaultProximitySensor =
ProximitySensor
+1 -6
View File
@@ -1,16 +1,11 @@
module Dodge.Default.Item.Use (
module Dodge.Default.Item.Use,
module Dodge.Default.Item.Use.Equipment,
) where
import Dodge.Data.Item.Use
import Dodge.Default.Item.Use.Equipment
defaultEquipUse :: ItemUse
defaultEquipUse =
UseEquip
{ _uequipEffect = defaultEquip
}
defaultEquipUse = UseEquip
--defaultHeldUse :: ItemUse
--defaultHeldUse =
-15
View File
@@ -1,15 +0,0 @@
module Dodge.Default.Item.Use.Equipment where
import Dodge.Data.Item.Use.Equipment
defaultEquip :: EquipEffect
defaultEquip =
EquipEffect
{ --_eeType = GoesOnHead
-- _eeUse = EDoNothing
-- , _eeOnEquip = ItmCrWdWdDoNothing
-- , _eeOnRemove = ItmCrWdWdDoNothing
-- , _eeParams = NoEquipParams
-- , _eeViewDist = Nothing
-- , _eeAttachPos = 0
}
+1
View File
@@ -3,6 +3,7 @@ module Dodge.Equipment (
effectOnEquip,
) where
import Dodge.Data.Equipment.Misc
import Control.Lens
import Data.Maybe
import Dodge.Creature.HandPos
+6 -56
View File
@@ -1,90 +1,48 @@
module Dodge.Euse (
createShieldWall,
removeShieldWall,
doItmCrWdWd,
useE,
) where
import Color
--import Control.Monad
import Data.Maybe
import Dodge.Creature.HandPos
import Dodge.Creature.Test
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Dodge.Data.Equipment.Misc
import Dodge.Data.World
import Dodge.Default.Wall
import Dodge.Item.HeldOffset
import Dodge.Item.Location
import Dodge.Wall.Create
import Dodge.Wall.Delete
import Dodge.Wall.ForceField
import Dodge.Wall.Move
import Geometry
import qualified IntMapHelp as IM
import LensHelp
doItmCrWdWd :: ItmCrWdWd -> Item -> Creature -> World -> World
doItmCrWdWd x itm cr = case x of
-- (ECamouflage vis) -> overCID (crCamouflage .~ vis) itm cr
EonWristShield -> onEquipWristShield itm cr
EoffWristShield -> onRemoveWristShield itm cr
_ -> id
useE :: LocationLDT ItemLink ComposedItem -> Creature -> World -> World
useE loc cr = case eo of
-- Nothing -> id
-- Just EDoNothing -> id
--Just (EMagShield mt)
EQUIP (MAGSHIELD mt) -> useMagShield mt itm cr
--Just EWristShield
EQUIP WRISTARMOUR -> setWristShieldPos itm cr
--Just EHeadLamp
EQUIP HEADLAMP -> createHeadLamp itm cr
_ -> id
where
itm = loc ^. locLDT . ldtValue . _1
eo = itm ^. itType
--eo = itm ^? itUse . uequipEffect . eeUse
-- this should probably drain energy
useMagShield :: MagnetBuBu -> Item -> Creature -> World -> World
useMagShield mt _ cr w = w & cWorld . lWorld . magnets .:~ themagnet
where
themagnet =
Magnet
useMagShield mt _ cr w =
w & cWorld . lWorld . magnets
.:~ Magnet
{ _mgPos = _crPos cr
--, _mgField = MagnetBuBuCurveAroundField 50 200
, _mgField = mt
, --, _mgField = MagnetBuBuCurveAroundField 50 200
_mgField = mt
}
onEquipWristShield :: Item -> Creature -> World -> World
onEquipWristShield itm cr w =
w
-- & pointerToItem itm . itUse . uequipEffect . eeParams .~ EquipID i
& pointerToItem itm . itParams .~ ItemParamID {_itParamID = i}
& cWorld . lWorld . walls . at i ?~ forceField{_wlID = i}
& setWristShieldPos (itm
-- & itUse . uequipEffect . eeParams .~ EquipID i
& itParams .~ ItemParamID {_itParamID = i}
) cr
where
i = IM.newKey (w ^. cWorld . lWorld . walls)
onRemoveWristShield :: Item -> Creature -> World -> World
onRemoveWristShield itm _ =
--(pointerToItem itm . itUse . uequipEffect . eeParams .~ NoEquipParams) . mremovewall
(pointerToItem itm . itParams .~ NoParams) . mremovewall
where
mremovewall = fromMaybe id $ do
--i <- itm ^? itUse . uequipEffect . eeParams . eparamID
i <- itm ^? itParams . itParamID
return $ deleteWallID i
setWristShieldPos :: Item -> Creature -> World -> World
setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
where
--i = _eparamID $ _eeParams $ _uequipEffect $ _itUse itm
i = _itParamID $ _itParams itm
wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
invid = _ilInvID (_itLocation itm)
@@ -148,11 +106,3 @@ createHeadLamp _ cr =
((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
200
0.7
-- cWorld . lWorld . tempLightSources
-- .:~ tlsTimeRadColPos
-- 1
-- 200
-- 0.7
-- ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
+1
View File
@@ -4,6 +4,7 @@ module Dodge.Inventory.RBList (
eqSiteToPositions,
) where
import Dodge.Data.Equipment.Misc
import Dodge.Data.EquipType
import Control.Applicative
import Control.Lens
+2 -1
View File
@@ -8,6 +8,7 @@ module Dodge.Inventory.SelectionList (
getItemValue,
) where
import Dodge.Data.Equipment.Misc
import Numeric
import Dodge.Inventory.Path
import Control.Applicative
@@ -61,7 +62,7 @@ itemDisplay w cr ci = -- f
anyhotkey = fmap hotkeyToString
(w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid)
anyequippos = do
_ <- ci ^? _1 . itUse . uequipEffect
_ <- ci ^? _1 . itType . ibtEquip
epText <$> ci ^? _1 . itLocation . ilEquipSite
anyscroll = fmap absurround $ itemScrollDisplay =<< (ci ^? _1)
absurround str = " <" ++ str ++ ">"
+1
View File
@@ -7,6 +7,7 @@ module Dodge.Item (
itemFromBase,
) where
import Dodge.Data.Equipment.Misc
import Dodge.Data.Item
import Dodge.Item.Ammo
import Dodge.Item.Craftable
+1
View File
@@ -4,6 +4,7 @@ module Dodge.Item.Draw (
itemEquipPict,
) where
import Dodge.Data.Equipment.Misc
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Geometry.Data
+3 -9
View File
@@ -17,6 +17,7 @@ module Dodge.Item.Equipment (
pulseChecker,
) where
import Dodge.Data.Equipment.Misc
import Dodge.Data.Magnet
import Dodge.Item.Weapon.Bullet
import Dodge.Data.Item
@@ -40,17 +41,10 @@ frontArmour =
& itType .~ EQUIP FRONTARMOUR
wristArmour :: Item
wristArmour =
defaultEquipment
-- & itUse . uequipEffect . eeOnEquip .~ EonWristShield
-- & itUse . uequipEffect . eeUse .~ EWristShield
-- & itUse . uequipEffect . eeOnRemove .~ EoffWristShield
& itType .~ EQUIP WRISTARMOUR
wristArmour = defaultEquipment & itType .~ EQUIP WRISTARMOUR
batteryPack :: Item
batteryPack =
defaultEquipment
-- & itUse . uequipEffect . eeUse .~ EDoNothing
batteryPack = defaultEquipment
& itConsumables
.~ AmmoMag
{ _magParams = NoAmmoParams
+1
View File
@@ -4,6 +4,7 @@ module Dodge.Item.Info (
itemInfo,
) where
import Dodge.Data.Equipment.Misc
import Dodge.Data.EquipType
import Dodge.Data.AimStance
import Data.Char
+454 -454
View File
File diff suppressed because it is too large Load Diff