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

Major item refactor, still broken

Browse Source
This commit is contained in:
justin
2025-08-24 19:34:09 +01:00
parent 22b4be440a
commit 94f6d5c630
62 changed files with 820 additions and 805 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+5 -2
View File
@@ -170,18 +170,21 @@ dropExcept cr invid w =
-- why not a cid (Int)?
dropItem :: Creature -> Int -> World -> World
dropItem cr invid =
dropItem cr invid w' =
doanyitemdropeffect
. maybeshiftseldown
. rmInvItem (_crID cr) invid
. copyItemToFloor (_crPos cr) itm -- . mayberemoveequip
. soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
$ w'
where
--doanyitemdropeffect = fromMaybe id $ do
-- rmf <- itm ^? itEffect . ieOnDrop
-- return $ doInvEffect rmf itm cr
doanyitemdropeffect = itEffectOnDrop itm cr
itm = fromMaybe (error "dropItem cannot find item") $ cr ^? crInv . ix invid
itm = fromMaybe (error "dropItem cannot find item") $ do
itid <- cr ^? crInv . ix invid
w' ^? cWorld . lWorld . items . ix itid
maybeshiftseldown w = fromMaybe w $ do
3 <- w ^? hud . hudElement . diSelection . _Just . _1
return $ w & hud . hudElement . diSelection . _Just . _2 +~ 1
src/Dodge/Creature/ArmourChase.hs
+2 -2
View File
@@ -18,7 +18,7 @@ flockArmourChaseCrit =
, _crHP = 300
, _crInv =
IM.fromList
[ (0, frontArmour)
[ --(0, frontArmour)
]
, _crActionPlan =
ActionPlan
@@ -39,7 +39,7 @@ armourChaseCrit =
, --, _crUpdate = defaultImpulsive []
_crInv =
IM.fromList
[ (0, frontArmour)
[ --(0, frontArmour)
]
-- , _crMvType = defaultChaseMvType{_mvTurnRad = FloatConst 0.05}
}
src/Dodge/Creature/AutoCrit.hs
+2 -2
View File
@@ -12,8 +12,8 @@ import qualified IntMapHelp as IM
autoCrit :: Creature
autoCrit =
defaultCreature
{ _crInv = IM.fromList [(0, autoRifle)]
, _crHP = 300
{ --_crInv = IM.fromList [(0, autoRifle)]
_crHP = 300
-- , _crMvType = defaultAimMvType
}
-- & crType . skinUpper .~ lightx4 red
src/Dodge/Creature/ChaseCrit.hs
+2 -2
View File
@@ -21,8 +21,8 @@ smallChaseCrit =
invisibleChaseCrit :: Creature
invisibleChaseCrit =
chaseCrit
& crInv . at 0 ?~ wristInvisibility
& crEquipment . at OnLeftWrist ?~ 0
-- & crInv . at 0 ?~ wristInvisibility
-- & crEquipment . at OnLeftWrist ?~ 0
chaseCrit :: Creature
chaseCrit =
src/Dodge/Creature/Damage.hs
+4 -3
View File
@@ -20,9 +20,10 @@ applyIndividualDamage cr w dm = damMatSideEffect dm (crMaterial (_crType cr)) (L
_ -> w & damageHP cr (_dmAmount dm)
applyPiercingDamage :: Creature -> Damage -> World -> World
applyPiercingDamage cr dm
| crIsArmouredFrom p cr = f . makeSpark NormalSpark p1 (argV (p1 - p))
| otherwise = f . damageHP cr (_dmAmount dm)
applyPiercingDamage cr dm w
| crIsArmouredFrom (w ^. cWorld . lWorld . items) p cr
= f . makeSpark NormalSpark p1 (argV (p1 - p)) $ w
| otherwise = f . damageHP cr (_dmAmount dm) $ w
where
f = cWorld . lWorld . creatures . ix (_crID cr) . crPos +~ _dmVector dm
/ V2 x x
src/Dodge/Creature/HandPos.hs
+51 -40
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.HandPos (
translatePointToLeftHand,
translatePointToRightHand,
@@ -14,6 +15,8 @@ module Dodge.Creature.HandPos (
headPQ,
) where
import Dodge.Data.Equipment.Misc
import qualified Data.IntMap.Strict as IM
import qualified Quaternion as Q
import Control.Lens
import Dodge.Creature.Test
@@ -21,14 +24,22 @@ import Dodge.Data.Creature
import Geometry
import ShapePicture
translatePointToRightHand :: Creature -> Point3 -> Point3
translatePointToRightHand cr p = fst (rightHandPQ cr `Q.comp` (p,Q.qID))
translatePointToRightHand :: IM.IntMap Item -> Creature -> Point3 -> Point3
translatePointToRightHand m cr p = fst (rightHandPQ m cr `Q.comp` (p,Q.qID))
rightHandPQ :: Creature -> Point3Q
rightHandPQ cr
| oneH cr = (V3 11 (-3) 20, Q.qID)
| twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0,Q.qID)
| twoFlat cr = (V3 4 (-8) 10, Q.qID)
equipSitePQ :: EquipSite -> IM.IntMap Item -> Creature -> Point3Q
equipSitePQ = \case
OnRightWrist -> rightHandPQ
OnLeftWrist -> leftHandPQ
OnBack -> backPQ
OnChest -> chestPQ
_ -> undefined
rightHandPQ :: IM.IntMap Item -> Creature -> Point3Q
rightHandPQ m cr
| oneH m cr = (V3 11 (-3) 20, Q.qID)
| twists m cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0,Q.qID)
| twoFlat m cr = (V3 4 (-8) 10, Q.qID)
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> (V3 (- f sa) (- off) 10, Q.qID)
Just (Walking sa RightForward) -> (V3 (- g sa) (- off) 10, Q.qID)
@@ -39,18 +50,18 @@ rightHandPQ cr
f i = negate 2 + negate 6 * (sLen - i) / sLen
g i = negate 2 + negate 6 * i / sLen
translateToRightHand :: Creature -> SPic -> SPic
translateToRightHand = overPosSP . translatePointToRightHand
translateToRightHand :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToRightHand m = overPosSP . translatePointToRightHand m
translateToRightWrist :: Creature -> SPic -> SPic
translateToRightWrist cr = overPosSP
(\p -> fst $ rightHandPQ cr `Q.comp` (V3 0 (-4) (-4)+p, Q.qID))
translateToRightWrist :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToRightWrist m cr = overPosSP
(\p -> fst $ rightHandPQ m cr `Q.comp` (V3 0 (-4) (-4)+p, Q.qID))
leftHandPQ :: Creature -> Point3Q
leftHandPQ cr
| oneH cr = (V3 0 off 10, Q.qz 0.4)
| twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4)
| twoFlat cr = (V3 4 8 10, Q.qID)
leftHandPQ :: IM.IntMap Item -> Creature -> Point3Q
leftHandPQ m cr
| oneH m cr = (V3 0 off 10, Q.qz 0.4)
| twists m cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4)
| twoFlat m cr = (V3 4 8 10, Q.qID)
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa RightForward) -> (V3 (- f sa) off 10 , Q.qID)
Just (Walking sa LeftForward) -> (V3 (- g sa) off 10 , Q.qID)
@@ -61,15 +72,15 @@ leftHandPQ cr
f i = negate 2 + negate 6 * (sLen - i) / sLen
g i = negate 2 + negate 6 * i / sLen
translatePointToLeftHand :: Creature -> Point3 -> Point3
translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p,Q.qID))
translatePointToLeftHand :: IM.IntMap Item -> Creature -> Point3 -> Point3
translatePointToLeftHand m cr p = fst (leftHandPQ m cr `Q.comp` (p,Q.qID))
translateToLeftHand :: Creature -> SPic -> SPic
translateToLeftHand = overPosSP . translatePointToLeftHand
translateToLeftHand :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToLeftHand m = overPosSP . translatePointToLeftHand m
translateToLeftWrist :: Creature -> SPic -> SPic
translateToLeftWrist cr = overPosSP
(\p -> fst $ leftHandPQ cr `Q.comp` (V3 0 4 (-4)+p, Q.qID))
translateToLeftWrist :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToLeftWrist m cr = overPosSP
(\p -> fst $ leftHandPQ m cr `Q.comp` (V3 0 4 (-4)+p, Q.qID))
leftLegPQ :: Creature -> Point3Q
leftLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
@@ -102,26 +113,26 @@ rightLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
translateToRightLeg :: Creature -> SPic -> SPic
translateToRightLeg cr = overPosSP (\p -> fst (rightLegPQ cr `Q.comp` (p,Q.qID)))
translateToHead :: Creature -> SPic -> SPic
translateToHead cr = overPosSP (\p -> fst (headPQ cr `Q.comp` (p,Q.qID)))
translateToHead :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToHead m cr = overPosSP (\p -> fst (headPQ m cr `Q.comp` (p,Q.qID)))
headPQ :: Creature -> Point3Q
headPQ cr
| twists cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
| oneH cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
headPQ :: IM.IntMap Item -> Creature -> Point3Q
headPQ m cr
| twists m cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
| oneH m cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
| otherwise = (V3 2.5 0 20, Q.qID)
translatePointToHead :: Creature -> Point3 -> Point3
translatePointToHead cr p = fst (headPQ cr `Q.comp` (p,Q.qID))
translatePointToHead :: IM.IntMap Item -> Creature -> Point3 -> Point3
translatePointToHead m cr p = fst (headPQ m cr `Q.comp` (p,Q.qID))
chestPQ :: Creature -> Point3Q
chestPQ cr = backPQ cr `Q.comp` (0,Q.qz pi)
chestPQ :: IM.IntMap Item -> Creature -> Point3Q
chestPQ m cr = backPQ m cr `Q.comp` (0,Q.qz pi)
translateToChest :: Creature -> SPic -> SPic
translateToChest cr = overPosSP (\p -> fst $ chestPQ cr `Q.comp` (p,Q.qID))
translateToChest :: IM.IntMap Item -> Creature -> SPic -> SPic
translateToChest m cr = overPosSP (\p -> fst $ chestPQ m cr `Q.comp` (p,Q.qID))
backPQ :: Creature -> Point3Q
backPQ cr
| oneH cr = (V3 0 0 10, Q.qz 0.5)
| twists cr = (V3 0 3 10, Q.qz (-1.5))
backPQ :: IM.IntMap Item -> Creature -> Point3Q
backPQ m cr
| oneH m cr = (V3 0 0 10, Q.qz 0.5)
| twists m cr = (V3 0 3 10, Q.qz (-1.5))
| otherwise = (V3 0 0 10, Q.qz 0)
src/Dodge/Creature/Impulse.hs
+4 -4
View File
@@ -42,8 +42,8 @@ followImpulse cr w imp = case imp of
let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w)
in first ((randGen .~ newgen) .) $ followImpulse cr w newimp
Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown w cr)
Move p -> crup $ crMvBy p cr
MoveForward x -> crup $ crMvForward x cr
Move p -> crup $ crMvBy p (w ^. cWorld . lWorld) cr
MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld) cr
Turn a -> crup $ cr & crDir +~ a
TurnToward p a -> crup $ creatureTurnToward p a cr
TurnTo p -> crup $ creatureTurnTo p cr
@@ -54,7 +54,7 @@ followImpulse cr w imp = case imp of
SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem i i mempty
Melee cid' ->
( hitCr cid'
, crMvAbsolute (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20
, crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20
)
RandomTurn a -> (randGen .~ snd (rr a), cr & crDir +~ fst (rr a))
MakeSound sid -> (soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing, cr)
@@ -71,7 +71,7 @@ followImpulse cr w imp = case imp of
Just tcr -> followImpulse cr w (doCrImp f tcr)
_ -> crup cr
ImpulseUseAheadPos f -> followImpulse cr w (doP2Imp f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
MvForward -> crup $ crMvForward speed cr
MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld) cr
MvTurnToward p ->
crup $
creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr
src/Dodge/Creature/Impulse/Movement.hs
+6 -5
View File
@@ -20,17 +20,18 @@ For now, though, this cannot fail.
crMvBy ::
-- | Movement translation vector, will be made relative to creature direction
Point2 ->
LWorld ->
Creature ->
Creature
crMvBy p cr = crMvAbsolute (rotateV (_crDir cr) p) cr
crMvBy p lw cr = crMvAbsolute lw (rotateV (_crDir cr) p) cr
crMvAbsolute :: Point2 -> Creature -> Creature
crMvAbsolute p' cr =
crMvAbsolute :: LWorld -> Point2 -> Creature -> Creature
crMvAbsolute lw p' cr =
advanceStepCounter (magV p) cr
& crPos +~ p
& crMvDir .~ argV p
where
p = strengthFactor (getCrMoveSpeed cr) *.* p'
p = strengthFactor (getCrMoveSpeed lw cr) *.* p'
strengthFactor :: Int -> Float
strengthFactor i
@@ -38,7 +39,7 @@ strengthFactor i
| i < 1 = 0
| otherwise = 0.02 * fromIntegral i
crMvForward :: Float -> Creature -> Creature
crMvForward :: Float -> LWorld -> Creature -> Creature
crMvForward speed = crMvBy (V2 speed 0)
advanceStepCounter :: Float -> Creature -> Creature
src/Dodge/Creature/Impulse/UseItem.hs
+12 -9
View File
@@ -18,7 +18,7 @@ import qualified IntMapHelp as IM
useItem :: Int -> Int -> World -> Maybe World
useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
itmloc <- invIndents (_crInv cr) ^? ix invid . _2
itmloc <- invIndents (fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ _crInv cr) ^? ix invid . _2
useItemLoc cr itmloc pt w
useItemLoc :: Creature -> LocationDT OItem -> Int -> World -> Maybe World
@@ -68,34 +68,37 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation invid w of
PutOnEquipment{_allocNewPos = newp} ->
w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
& onequip itm cr
MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
SwapEquipment{_allocNewPos = newp, _allocOldPos = oldp, _allocSwapID = sid} ->
w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp ?~ sid
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
& crpoint . crInv . ix sid . itLocation . ilEquipSite ?~ oldp
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
& toitems . ix (invidtoitid sid) . itLocation . ilEquipSite ?~ oldp
ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
& crpoint . crInv . ix rid . itLocation . ilEquipSite .~ Nothing
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
& toitems . ix (invidtoitid rid) . itLocation . ilEquipSite .~ Nothing
& onremove (itmat rid) cr
& onequip itm cr
RemoveEquipment{_allocOldPos = oldp} ->
w
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInv . ix invid . itLocation . ilEquipSite .~ Nothing
& toitems . ix itid . itLocation . ilEquipSite .~ Nothing
& onremove itm cr
where
invidtoitid i = _crInv cr IM.! i
toitems = cWorld . lWorld . items
itid = _crInv cr IM.! invid
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
itmat i = _crInv cr IM.! i
itmat i = w ^?! cWorld . lWorld . items . ix (_crInv cr IM.! i)
itm = itmat invid
onequip itm' = effectOnEquip itm'
onremove itm' = effectOnRemove itm'
src/Dodge/Creature/LauncherCrit.hs
+2 -2
View File
@@ -12,8 +12,8 @@ import qualified IntMapHelp as IM
launcherCrit :: Creature
launcherCrit =
defaultCreature
{ _crInv = IM.fromList [(0, rLauncher)]
, _crHP = 300
{ -- _crInv = IM.fromList [(0, rLauncher)]
_crHP = 300
}
-- & crType . skinUpper .~ lightx4 red
-- & crType . humanoidAI .~ LauncherAI
src/Dodge/Creature/LtAutoCrit.hs
+4 -4
View File
@@ -5,15 +5,15 @@ module Dodge.Creature.LtAutoCrit (
--import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
import Dodge.Item.Held.Stick
import qualified IntMapHelp as IM
--import Dodge.Item.Held.Stick
--import qualified IntMapHelp as IM
--import Picture
ltAutoCrit :: Creature
ltAutoCrit =
defaultCreature
{ _crInv = IM.fromList [(0, autoPistol)]
, _crHP = 500
{ --_crInv = IM.fromList [(0, autoPistol)]
_crHP = 500
}
-- & crType .~ LtAutoCrit
-- & crType . humanoidAI .~ LtAutoAI
src/Dodge/Creature/Picture.hs
+23 -22
View File
@@ -10,6 +10,7 @@ module Dodge.Creature.Picture (
) where
import Dodge.Creature.HandPos
import qualified Data.IntMap.Strict as IM
import Control.Lens
import Dodge.Creature.Radius
import Dodge.Creature.Shape
@@ -25,20 +26,20 @@ import Shape
--import Shape
import ShapePicture
basicCrPict :: Creature -> SPic
basicCrPict cr = drawEquipment cr <> noPic (basicCrShape cr)
basicCrPict :: IM.IntMap Item -> Creature -> SPic
basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape m cr)
crCamouflage :: Creature -> CamouflageStatus
crCamouflage _ = FullyVisible
basicCrShape :: Creature -> Shape
basicCrShape cr
basicCrShape :: IM.IntMap Item -> Creature -> Shape
basicCrShape m cr
| crCamouflage cr == Invisible = mempty
| otherwise =
scaleSH (V3 crsize crsize crsize) $
mconcat
[ colorSH (_skinHead cskin) $ scalp cr
, colorSH (_skinUpper cskin) $ upperBody cr
[ colorSH (_skinHead cskin) $ scalp m cr
, colorSH (_skinUpper cskin) $ upperBody m cr
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
]
where
@@ -67,17 +68,17 @@ deadFeet :: Creature -> Shape
{-# INLINE deadFeet #-}
deadFeet = feet
arms :: Creature -> Shape
arms :: IM.IntMap Item -> Creature -> Shape
{-# INLINE arms #-}
arms cr =
arms m cr =
(^. _1) $
translateToRightHand cr aHand
<> translateToLeftHand cr aHand
translateToRightHand m cr aHand
<> translateToLeftHand m cr aHand
where
aHand = noPic $ translateSHz (-4) . upperPrismPolyHalfST 4 $ polyCirc 3 4
deadScalp :: Creature -> Shape
deadScalp cr = deadRot cr . translateSHz 10 . scalp $ cr
deadScalp :: IM.IntMap Item -> Creature -> Shape
deadScalp m cr = deadRot cr . translateSHz 10 . scalp m $ cr
deadRot :: Creature -> Shape -> Shape
deadRot cr = overPosSH (Q.rotateToZ d)
@@ -88,18 +89,18 @@ deadRot cr = overPosSH (Q.rotateToZ d)
(addZ 0 . unitVectorAtAngle . subtract (_crDir cr + pi))
(damageDirection $ _crDamage cr)
scalp :: Creature -> Shape
scalp :: IM.IntMap Item -> Creature -> Shape
{-# INLINE scalp #-}
scalp cr = overPosSH (\p -> fst (headPQ cr `Q.comp` (p,Q.qID))) fhead
scalp m cr = overPosSH (\p -> fst (headPQ m cr `Q.comp` (p,Q.qID))) fhead
-- | twists cr = translateSHxy 0 5 . rotateSH (-1) $ translateSHxy (negate 2.5) 0.25 fhead
-- | oneH cr = rotateSH 0.5 $ translateSHxy 2.5 0 fhead
-- | otherwise = translateSHxy 2.5 0 fhead
where
fhead = colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5
torso :: Creature -> Shape
torso :: IM.IntMap Item -> Creature -> Shape
{-# INLINE torso #-}
torso cr = overPosSH (\p -> fst (backPQ cr `Q.comp` (p,Q.qID))) tsh
torso m cr = overPosSH (\p -> fst (backPQ m cr `Q.comp` (p,Q.qID))) tsh
-- | oneH cr = rotateSH 0.5 tsh
-- | twists cr =
-- translateSHxy 0 3 . rotateSH (-1.3) $ tsh
@@ -116,20 +117,20 @@ torso cr = overPosSH (\p -> fst (backPQ cr `Q.comp` (p,Q.qID))) tsh
]
aShoulder = scaleSH (V3 10 10 1) baseShoulder
deadUpperBody :: Creature -> Shape
deadUpperBody cr = deadRot cr . translateSHz (negate 10) . upperBody $ cr
deadUpperBody :: IM.IntMap Item -> Creature -> Shape
deadUpperBody m cr = deadRot cr . translateSHz (negate 10) . upperBody m $ cr
baseShoulder :: Shape
{-# INLINE baseShoulder #-}
baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
upperBody :: Creature -> Shape
upperBody :: IM.IntMap Item -> Creature -> Shape
{-# INLINE upperBody #-}
upperBody cr = arms cr <> shoulderSH (torso cr)
upperBody m cr = arms m cr <> shoulderSH (torso m cr)
shoulderSH :: Shape -> Shape
shoulderSH = translateSHz 20
drawEquipment :: Creature -> SPic
drawEquipment :: IM.IntMap Item -> Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment cr = foldMap (itemEquipPict cr) (invDT $ _crInv cr)
drawEquipment m cr = foldMap (itemEquipPict m cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)
src/Dodge/Creature/PistolCrit.hs
-19
View File
@@ -1,19 +0,0 @@
module Dodge.Creature.PistolCrit (
pistolCrit,
) where
--import Control.Lens
import Dodge.Data.Creature
import Dodge.Default
import Dodge.Item.Held.Stick
import qualified IntMapHelp as IM
--import Picture
pistolCrit :: Creature
pistolCrit =
defaultCreature
{ _crInv = IM.fromList [(0, pistol)]
, _crHP = 500
}
-- & crType . humanoidAI .~ PistolAI
-- & crType . skinUpper .~ lightx4 red
src/Dodge/Creature/SpreadGunCrit.hs
+2 -2
View File
@@ -12,8 +12,8 @@ import qualified IntMapHelp as IM
spreadGunCrit :: Creature
spreadGunCrit =
defaultCreature
{ _crInv = IM.fromList [(0, bangStick 6)]
, _crHP = 500
{ --_crInv = IM.fromList [(0, bangStick 6)]
_crHP = 500
}
-- & crType . humanoidAI .~ SpreadGunAI
-- & crType . skinUpper .~ lightx4 red
src/Dodge/Creature/State.hs
+19 -21
View File
@@ -4,6 +4,7 @@ module Dodge.Creature.State (
invItemEffs,
) where
import NewInt
import Control.Applicative
import Control.Monad
import qualified Data.Map.Strict as M
@@ -53,7 +54,7 @@ applyPastDamages cr w
where
dojitter x y =
let (p, g) = runState (randInCirc x) (_randGen w)
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvBy p
in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvBy p (w ^. cWorld . lWorld)
& cWorld . lWorld . creatures . ix (_crID cr) . crPain -~ y
& randGen .~ g
@@ -64,7 +65,7 @@ invItemEffs cid w = fromMaybe w $ do
return . appEndo (
foldMap
(reduceLocDT (Endo . invItemLocUpdate cr) . LocDT TopDT)
(invDT' (_crInv cr))) $ w
(invDT' $ fmap (\k -> w ^?! cWorld . lWorld . items . ix k) (_crInv cr))) $ w
invItemLocUpdate :: Creature -> LocationDT OItem -> World -> World
invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
@@ -132,7 +133,7 @@ copierItemUpdate itm cr w = fromMaybe w $ do
invid <- itm ^? itLocation . ilInvID
ip <- itm ^? itType . ibtPathing
i <- getInventoryPath x ip invid cr
itm' <- cr ^? crInv . ix i
itm' <- cr ^? crInv . ix i >>= \k -> w ^? cWorld . lWorld . items . ix k
v <- getItemValue itm' w cr
return $ w & pointerToItem itm . itUse . uValue .~ v
@@ -149,22 +150,22 @@ tryUseParent loc w = fromMaybe w $ do
tryDrawToCapacitor :: LocationDT OItem -> World -> World
tryDrawToCapacitor loc w = fromMaybe w $ do
itm <- loc ^? locDT . dtValue . _1
i <- itm ^? itLocation . ilInvID
i <- itm ^? itID . unNInt
x <- loc ^? locDT . dtValue . _1 . itConsumables . _Just
guard $ x < 200
bat <- loc ^? locDT . dtLeft . ix 0 . dtValue . _1
j <- bat ^? itLocation . ilInvID
j <- bat ^? itID . unNInt
y <- bat ^? itConsumables . _Just
let z = min y 10
return $ w
& invpoint . ix i . itConsumables . _Just +~ z
& invpoint . ix j . itConsumables . _Just -~ z
where
invpoint = cWorld . lWorld . creatures . ix 0 . crInv
invpoint = cWorld . lWorld . items
trySynthBullet :: LocationDT OItem -> World -> World
trySynthBullet loc w = fromMaybe w $ do
i <- itm ^? itLocation . ilInvID
i <- itm ^? itID . unNInt
x <- itm ^? itUse . uaParams . apInt
if x < 100
then do
@@ -177,7 +178,7 @@ trySynthBullet loc w = fromMaybe w $ do
& invpoint . ix j . itConsumables . _Just -~ 1
else do
mag <- loc ^? locDtContext . cdtParent . _1
j <- mag ^? itLocation . ilInvID
j <- mag ^? itID . unNInt
y <- mag ^. itConsumables
ymax <- maxAmmo mag
guard $ y < ymax
@@ -186,7 +187,7 @@ trySynthBullet loc w = fromMaybe w $ do
& invpoint . ix j . itConsumables . _Just +~ 1
where
itm = loc ^. locDT . dtValue . _1
invpoint = cWorld . lWorld . creatures . ix 0 . crInv
invpoint = cWorld . lWorld . items
drawARHUD :: LocationDT OItem -> World -> World
drawARHUD (LocDT con _) w = fromMaybe w $ do
@@ -202,13 +203,12 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
mag <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft)
i <- mag ^. dtValue . _1 . itConsumables
guard $ i >= x
maginvid <- mag ^? dtValue . _1 . itLocation . ilInvID
magitid <- mag ^? dtValue . _1 . itID . unNInt
return $
w
& worldEventFlags . at InventoryChange ?~ ()
& cWorld . lWorld . creatures . ix (_crID cr)
. crInv
. ix maginvid
& cWorld . lWorld . items
. ix magitid
. itConsumables
. _Just
-~ x
@@ -230,9 +230,8 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
pos = _crPos cr + xyV3 (rotate3 cdir p)
cdir = _crDir cr
itm = itmtree ^. dtValue . _1
pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
cid = _crID cr
invid = _ilInvID $ _itLocation itm
pointittarg = cWorld . lWorld . items . ix itid . itTargeting
itid = itm ^. itID . unNInt
col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
shineTorch :: Creature -> LocationDT OItem -> World -> World
@@ -241,10 +240,10 @@ shineTorch cr loc = fromMaybe id $ do
i <- mag ^. dtValue . _1 . itConsumables
guard $ crIsAiming cr
guard $ i >= x
invid <- mag ^? dtValue . _1 . itLocation . ilInvID
itid <- mag ^? dtValue . _1 . itID . unNInt
return $
(cWorld . lWorld . lights .:~ LSParam pos 250 0.7)
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itConsumables . _Just -~ x)
. (cWorld . lWorld . items . ix itid . itConsumables . _Just -~ x)
where
itmtree = loc ^. locDT
(p, q) = locOrient loc cr
@@ -281,9 +280,8 @@ updateItemTargeting tt cr itm w = case tt of
Nothing
True
where
pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
cid = _crID cr
invid = _ilInvID $ _itLocation itm
pointittarg = cWorld . lWorld . items . ix itid . itTargeting
itid = itm ^. itID . unNInt
isattached = itm ^?! itLocation . ilIsAttached
rbpressed = SDL.ButtonRight `M.member` _mouseButtons (_input w)
src/Dodge/Creature/Statistics.hs
+12 -9
View File
@@ -6,6 +6,7 @@ module Dodge.Creature.Statistics (
crIntelligence,
) where
import Dodge.Data.LWorld
import Data.Maybe
import Dodge.Data.Creature
import qualified IntMapHelp as IM
@@ -42,11 +43,11 @@ crIntelligence cr = case cr ^. crType of
LampCrit {} -> 0
getCrMoveSpeed :: Creature -> Int
getCrMoveSpeed cr = strFromHeldItem cr + strFromEquipment cr + crStrength cr
getCrMoveSpeed :: LWorld -> Creature -> Int
getCrMoveSpeed lw cr = strFromHeldItem lw cr + strFromEquipment lw cr + crStrength cr
strFromEquipment :: Creature -> Int
strFromEquipment = sum . fmap equipmentStrValue . crCurrentEquipment
strFromEquipment :: LWorld -> Creature -> Int
strFromEquipment lw = sum . fmap equipmentStrValue . crCurrentEquipment lw
equipmentStrValue :: Item -> Int
equipmentStrValue itm = case _itType itm of
@@ -54,14 +55,16 @@ equipmentStrValue itm = case _itType itm of
EQUIP POWERLEGS -> 3
_ -> 0
crCurrentEquipment :: Creature -> IM.IntMap Item
crCurrentEquipment = IM.filter (isJust . (^? itLocation . ilEquipSite . _Just)) . _crInv
crCurrentEquipment :: LWorld -> Creature -> IM.IntMap Item
crCurrentEquipment lw = IM.filter (isJust . (^? itLocation . ilEquipSite . _Just)) . fmap f . _crInv
where
f i = lw ^?! items . ix i
strFromHeldItem :: Creature -> Int
strFromHeldItem cr = fromMaybe 0 $ do
strFromHeldItem :: LWorld -> Creature -> Int
strFromHeldItem lw cr = fromMaybe 0 $ do
Aiming <- cr ^? crStance . posture
i <- cr ^? crManipulation . manObject . imRootSelectedItem
fmap (negate . itemWeight) $ cr ^? crInv . ix i
fmap (negate . itemWeight) $ lw ^? items . ix i
itemWeight :: Item -> Int
itemWeight it = case it ^. itType of
src/Dodge/Creature/Test.hs
+15 -16
View File
@@ -24,6 +24,7 @@ module Dodge.Creature.Test (
crSafeDistFromTarg,
) where
import qualified Data.IntMap.Strict as IM
import Dodge.Item.Grammar
import Dodge.Creature.Radius
import Dodge.Data.Equipment.Misc
@@ -90,35 +91,33 @@ crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
--crCanShoot :: Creature -> Bool
--crCanShoot cr = crIsAiming cr && crWeaponReady cr
crInAimStance :: AimStance -> Creature -> Bool
crInAimStance as cr = crIsAiming cr && mitstance == Just as
crInAimStance :: AimStance -> IM.IntMap Item -> Creature -> Bool
crInAimStance as m cr = crIsAiming cr && mitstance == Just as
where
mitstance = do
i <- cr ^? crManipulation . manObject . imRootSelectedItem
--itm <- invRootTrees' (cr ^. crInv) ^? ix i
itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (cr ^. crInv) ^? ix i
itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (fmap (\i -> m ^?! ix i) (cr ^. crInv)) ^? ix i
return $ aimStance itm
--cr ^? crInv . ix i . itUse . heldAim . aimStance
oneH :: Creature -> Bool
oneH :: IM.IntMap Item -> Creature -> Bool
oneH = crInAimStance OneHand
twoFlat :: Creature -> Bool
twoFlat :: IM.IntMap Item -> Creature -> Bool
twoFlat = crInAimStance TwoHandFlat
twists :: Creature -> Bool
twists cr = crInAimStance TwoHandUnder cr || crInAimStance TwoHandOver cr
twists :: IM.IntMap Item -> Creature -> Bool
twists m cr = crInAimStance TwoHandUnder m cr || crInAimStance TwoHandOver m cr
-- the use of crOldPos is because the damage position is calculated on the
-- previous frame
-- Not sure if it is a good idea
crIsArmouredFrom :: Point2 -> Creature -> Bool
crIsArmouredFrom = hasFrontArmour
hasFrontArmour :: Point2 -> Creature -> Bool
hasFrontArmour p cr = fromMaybe False $ do
crIsArmouredFrom :: IM.IntMap Item -> Point2 -> Creature -> Bool
crIsArmouredFrom m p cr = fromMaybe False $ do
invid <- cr ^? crEquipment . ix OnChest
ittype <- cr ^? crInv . ix invid . itType
itid <- cr ^? crInv . ix invid
ittype <- m ^? ix itid . itType
return $
EQUIP FRONTARMOUR == ittype
&& p /= _crOldPos cr
@@ -127,9 +126,9 @@ hasFrontArmour p cr = fromMaybe False $ do
-- even though angleVV can generate NaN, the comparison seems to deal with it
frontarmdirection
| crInAimStance OneHand cr = 0.5
| crInAimStance TwoHandUnder cr = negate 1
| crInAimStance TwoHandOver cr = negate 1
| crInAimStance OneHand m cr = 0.5
| crInAimStance TwoHandUnder m cr = negate 1
| crInAimStance TwoHandOver m cr = negate 1
| otherwise = 0
--crOnSeg :: Point2 -> Point2 -> Creature -> Bool
src/Dodge/Creature/Update.hs
+2 -2
View File
@@ -99,14 +99,14 @@ destroyCreature cr
-- could look at the amount of damage here (given by maxDamage) too
corpseOrGib :: Creature -> World -> World
corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of
corpseOrGib cr w = w & case cr ^? crDamage . to maxDamageType . _Just . _1 of
Just CookingDamage -> addcorpse (thecorpse & cpSPic %~ scorchSPic)
Just PoisonDamage -> addcorpse (thecorpse & cpSPic %~ poisonSPic)
Just PhysicalDamage | _crPain cr > 200 -> addCrGibs cr
_ -> addcorpse thecorpse
where
addcorpse ctype = plNew (cWorld . lWorld . corpses) cpID ctype
thecorpse = makeCorpse cr
thecorpse = makeCorpse (w ^. cWorld . lWorld . items) cr
scorchSPic :: SPic -> SPic
scorchSPic = _1 %~ overColSH (mixColors 0.9 0.1 black . normalizeColor)
src/Dodge/Creature/YourControl.hs
+25 -21
View File
@@ -4,6 +4,7 @@ module Dodge.Creature.YourControl (
yourControl,
) where
import qualified Data.IntMap.Strict as IM
import Dodge.Creature.MoveType
import Dodge.Data.Equipment.Misc
import Control.Monad
@@ -48,14 +49,14 @@ handleHotkeys w
, Just hk <-
listToMaybe . mapMaybe scancodeToHotkey . M.keys $ w ^. input . pressedKeys
, Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
, Just itid <- lw ^? creatures . ix 0 . crInv . ix invid . itID =
w & cWorld . lWorld %~ assignHotkey itid hk
, Just itid <- lw ^? creatures . ix 0 . crInv . ix invid =
w & cWorld . lWorld %~ assignHotkey (NInt itid) hk
| ispressed SDL.ScancodeLCtrl || ispressed SDL.ScancodeRCtrl
, Just hk <-
listToMaybe . mapMaybe scancodeToHotkey . M.keys $
w ^. input . pressedKeys
, Just itid <- lw ^? hotkeys . ix hk . unNInt
, Just invid <- lw ^? itemLocations . ix itid . ilInvID =
, Just invid <- lw ^? items . ix itid . itLocation . ilInvID =
w & invSetSelectionPos 0 invid
| otherwise =
M.foldl'
@@ -69,7 +70,7 @@ handleHotkeys w
useHotkey :: World -> (NewInt ItmInt, Int) -> World
useHotkey w (NInt itid, pt) = fromMaybe w $ do
invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID
invid <- w ^? cWorld . lWorld . items . ix itid . itLocation . ilInvID
useItem invid pt w
hotkeyToScancode :: Hotkey -> SDL.Scancode
@@ -117,7 +118,7 @@ scancodeToHotkey x = case x of
within wasdMovement should probably be done first
-}
wasdWithAiming :: World -> Creature -> Creature
wasdWithAiming w cr = wasdAim inp w $ wasdMovement inp cam speed cr
wasdWithAiming w cr = wasdAim inp w $ wasdMovement (w ^. cWorld . lWorld) inp cam speed cr
where
speed = _mvSpeed $ crMvType cr
inp = w ^. input
@@ -127,31 +128,34 @@ wasdAim :: Input -> World -> Creature -> Creature
wasdAim inp w cr
| Just 0 <- inp ^? mouseButtons . ix SDL.ButtonRight
, Nothing <- inp ^? mouseButtons . ix SDL.ButtonLeft =
setAimPosture cr
| SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn mousedir cr
| Aiming <- cr ^. crStance . posture = removeAimPosture cr
setAimPosture (w ^. cWorld . lWorld . items) cr
| SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn (w ^. cWorld . lWorld)
mousedir cr
| Aiming <- cr ^. crStance . posture = removeAimPosture m cr
| otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
where
m = w ^. cWorld . lWorld . items
mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos)
setAimPosture :: Creature -> Creature
setAimPosture = (crStance . posture .~ Aiming) . doAimTwist (- twoHandTwistAmount)
setAimPosture :: IM.IntMap Item -> Creature -> Creature
setAimPosture m = (crStance . posture .~ Aiming) . doAimTwist m (- twoHandTwistAmount)
doAimTwist :: Float -> Creature -> Creature
doAimTwist x cr = fromMaybe cr $ do
doAimTwist :: IM.IntMap Item -> Float -> Creature -> Creature
doAimTwist m x cr = fromMaybe cr $ do
itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
astance <- fmap itemBaseStance $ cr ^? crInv . ix itRef
itid <- cr ^? crInv . ix itRef
astance <- fmap itemBaseStance $ m ^? ix itid
guard $ astance == TwoHandOver || astance == TwoHandUnder
return $ cr & crDir +~ x
removeAimPosture :: Creature -> Creature
removeAimPosture = (crStance . posture .~ AtEase) . doAimTwist twoHandTwistAmount
removeAimPosture :: IM.IntMap Item -> Creature -> Creature
removeAimPosture m = (crStance . posture .~ AtEase) . doAimTwist m twoHandTwistAmount
twoHandTwistAmount :: Float
twoHandTwistAmount = 1.6 * pi
wasdMovement :: Input -> Camera -> Float -> Creature -> Creature
wasdMovement inp cam speed = theMovement . setMvAim
wasdMovement :: LWorld -> Input -> Camera -> Float -> Creature -> Creature
wasdMovement lw inp cam speed = theMovement . setMvAim
where
setMvAim = fromMaybe id $ do
dir <- safeArgV movDir
@@ -160,14 +164,14 @@ wasdMovement inp cam speed = theMovement . setMvAim
movAbs = rotateV (cam ^. camRot) $ normalizeV movDir
theMovement
| movDir == V2 0 0 = id
| otherwise = crMvAbsolute (speed *.* movAbs)
| otherwise = crMvAbsolute lw (speed *.* movAbs)
aimTurn :: Float -> Creature -> Creature
aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
aimTurn :: LWorld -> Float -> Creature -> Creature
aimTurn lw a cr = creatureTurnTowardDir a (x * 0.2) cr
where
x = fromMaybe 1 $ do
itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
fmap itemBulkiness $ cr ^? crInv . ix itRef . itType
fmap itemBulkiness $ cr ^? crInv . ix itRef >>= \k -> lw ^? items . ix k . itType
itemBulkiness :: ItemType -> Float
itemBulkiness = \case