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

Move towards implementing wrist shields

Browse Source
This commit is contained in:
justin
2022-05-25 10:27:05 +01:00
parent 546c279fae
commit dccbca5cfc
8 changed files with 131 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/HandPos.hs
+36 -1
View File
@@ -23,8 +23,30 @@ aimingMuzzlePos :: Creature -> Item -> Float
aimingMuzzlePos cr it = aimingWeaponZeroPos cr it
+ fromMaybe 0 (it ^? itDimension . dimPortage . muzPos)
translatePointToRightHand :: Creature -> Point3 -> Point3
translatePointToRightHand cr = translatePointToRightHand' cr . mirrorV3xz
mirrorV3xz :: Point3 -> Point3
mirrorV3xz (V3 x y z) = V3 x (-y) z
translatePointToRightHand' :: Creature -> Point3 -> Point3
translatePointToRightHand' cr
| oneH cr = (+.+.+ V3 11 (-3) 20) . rotate3 (-0.5)-- . scaleSH (V3 1 1.5 1)
| twists cr = (+.+.+ V3 0 5 20) . rotate3 (-1) . (+.+.+ V3 4 (-10) 0)
| twoFlat cr = (+.+.+ V3 4 (-8) 10)
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> (+.+.+ V3 (-f sa) (-off) 10)
_ -> (+.+.+ V3 0 (-off) 10)
where
off = 8
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
translateToRightHand :: Creature -> SPic -> SPic
translateToRightHand cr
translateToRightHand cr = translateToRightHand' cr . mirrorSPxz
translateToRightHand' :: Creature -> SPic -> SPic
translateToRightHand' cr
| oneH cr = shoulderSP . translateSPf 11 (-3) . rotateSP (-0.5)-- . scaleSH (V3 1 1.5 1)
| twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 4 (-10)
| twoFlat cr = waistSP . translateSPf 4 (-8)
@@ -36,6 +58,19 @@ translateToRightHand cr
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
translatePointToLeftHand :: Creature -> Point3 -> Point3
translatePointToLeftHand cr
| oneH cr = (+.+.+ V3 0 0 10) . rotate3 0.4 . (+.+.+ V3 0 off 0)
| twists cr = (+.+.+ V3 0 5 20) . rotate3 (-1) . (+.+.+ V3 12 4 0)
| twoFlat cr = (+.+.+ V3 4 8 10)
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa RightForward) -> (+.+.+ V3 (-f sa) off 10)
_ -> (+.+.+ V3 0 off 10)
where
off = 8
sLen = _strideLength $ _crStance cr
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
translateToLeftHand :: Creature -> SPic -> SPic
translateToLeftHand cr
| oneH cr = waistSP . rotateSP 0.4 . translateSPf 0 off
src/Dodge/Creature/Impulse/UseItem.hs
+31 -24
View File
@@ -32,42 +32,49 @@ itemEffect cr it w = case it ^? itUse of
hammerTest f = case _crHammerPosition cr of
HammerUp -> f w
_ -> w & setuhamdown
lhammer f' = w & case _crHammerPosition cr of
HammerUp -> creatures . ix (_crID cr) %~ f'
_ -> id
setuhamdown = creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
doequipmentchange = setuhamdown $ lhammer (toggleEquipmentAt (_rbOptions w) (_crInvSel cr)
. activateEquipmentAt (_rbOptions w))
doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions w) (_crInvSel cr) cr
. activateEquipmentAt (_rbOptions w) cr)
activateEquipmentAt :: RightButtonOptions -> Creature -> Creature
activateEquipmentAt rbo = case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World
activateEquipmentAt rbo cr = creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
(Just i,_) -> crLeftInvSel ?~ i
(_,Just _) -> crLeftInvSel .~ Nothing
_ -> id
toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> Creature
toggleEquipmentAt rbops invid cr = case rbops ^? opAllocateEquipment of
Just DoNotMoveEquipment -> cr
toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> World -> World
toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
Just DoNotMoveEquipment -> w
Just PutOnEquipment {_allocNewPos = newp}
-> cr & crEquipment . at newp ?~ invid
& crInvEquipped . at invid ?~ newp
-> w & crpoint . crEquipment . at newp ?~ invid
& crpoint . crInvEquipped . at invid ?~ newp
& onequip itm cr
Just MoveEquipment {_allocNewPos=newp,_allocOldPos = oldp }
-> cr & crEquipment . at newp ?~ invid
& crEquipment . at oldp .~ Nothing
& crInvEquipped . at invid ?~ newp
-> w & crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInvEquipped . at invid ?~ newp
Just SwapEquipment {_allocNewPos=newp, _allocOldPos = oldp, _allocSwapID = sid }
-> cr & crEquipment . at newp ?~ invid
& crEquipment . at oldp ?~ sid
& crInvEquipped . at invid ?~ newp
& crInvEquipped . at sid ?~ oldp
-> w & crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp ?~ sid
& crpoint . crInvEquipped . at invid ?~ newp
& crpoint . crInvEquipped . at sid ?~ oldp
Just ReplaceEquipment {_allocNewPos = newp, _allocRemoveID = rid }
-> cr & crEquipment . at newp ?~ invid
& crInvEquipped . at invid ?~ newp
& crInvEquipped . at rid .~ Nothing
-> w & crpoint . crEquipment . at newp ?~ invid
& crpoint . crInvEquipped . at invid ?~ newp
& crpoint . crInvEquipped . at rid .~ Nothing
& onremove (itmat rid) cr
& onequip itm cr
Just RemoveEquipment {_allocOldPos = oldp }
-> cr & crEquipment . at oldp .~ Nothing
& crInvEquipped . at invid .~ Nothing
-> w & crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInvEquipped . at invid .~ Nothing
& onremove itm cr
Nothing -> error "tried to toggle equipment whilst not prepared"
where
crpoint = creatures . ix (_crID cr)
itmat i = _crInv cr IM.! i
itm = itmat (_crInvSel cr)
onequip itm' = (_eqOnEquip . _itUse) itm' itm'
onremove itm' = (_eqOnRemove . _itUse) itm' itm'
useLeftItem :: Int -> World -> World
useLeftItem cid w
src/Dodge/Creature/State.hs
+3 -1
View File
@@ -145,7 +145,9 @@ useUpdate = (useHammer . hammerPosition %~ moveHammerUp)
. (useDelay . rateTime %~ decreaseToZero)
useEquipment :: Creature -> Int -> World -> World
useEquipment cr i = _eqUse (_itUse $ _crInv cr IM.! i) cr i
useEquipment cr i = _eqUse (_itUse itm) itm cr
where
itm = _crInv cr IM.! i
-- a map updating all inventory items
upInv :: Creature -> World -> World
upInv cr = creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr)
src/Dodge/Data.hs
+12 -4
View File
@@ -418,16 +418,20 @@ data ItemUse
, _useDelay :: UseDelay
, _useHammer :: HammerType
, _eqSite :: EquipSite
, _eqUse :: Creature -> Int -> World -> World
, _eqUse :: Item -> Creature -> World -> World
, _eqOnEquip :: Item -> Creature -> World -> World
, _eqOnRemove :: Item -> Creature -> World -> World
, _eqParams :: EquipParams
}
| ConsumeUse
{ _cUse :: Item -> Creature -> World -> World
}
| EquipUse
{ _eqUse :: Creature -> Int -> World -> World
, _eqOnEquip :: Creature -> Int -> World -> World
, _eqOnRemove :: Creature -> Int -> World -> World
{ _eqUse :: Item -> Creature -> World -> World
, _eqOnEquip :: Item -> Creature -> World -> World
, _eqOnRemove :: Item -> Creature -> World -> World
, _eqSite :: EquipSite
, _eqParams :: EquipParams
}
| NoUse
data EquipSite
@@ -725,6 +729,9 @@ data GunBarrels
, _brlInaccuracy :: Float
}
| SingleBarrel {_brlInaccuracy :: Float}
data EquipParams
= NoEquipParams
| EquipID {_eparamID :: Int}
data ItemParams
= NoParams
| ShellLauncher
@@ -1360,3 +1367,4 @@ makeLenses ''CreatureStatistics
makeLenses ''RightButtonOptions
makeLenses ''AllocateEquipment
makeLenses ''ActivateEquipment
makeLenses ''EquipParams
src/Dodge/Default.hs
+1
View File
@@ -163,6 +163,7 @@ defaultEquipment = Item
,_eqOnEquip = \_ _ -> id
,_eqOnRemove = \_ _ -> id
,_eqSite = GoesOnSpecial
,_eqParams = NoEquipParams
}
, _itAttachment = NoItAttachment
, _itParams = NoParams
src/Dodge/Default/Weapon.hs
+4 -3
View File
@@ -70,15 +70,16 @@ defaultlUse = LeftUse
, _useHammer = NoHammer
, _eqSite = GoesOnSpecial
, _eqUse = \_ _ -> id
, _eqOnEquip = \_ _ -> id
, _eqOnRemove = \_ _ -> id
, _eqParams = NoEquipParams
}
luseInstantNoH :: (Item -> Creature -> World -> World) -> ItemUse
luseInstantNoH f = LeftUse
luseInstantNoH f = defaultlUse
{ _lUse = f
, _useDelay = NoDelay
, _useHammer = NoHammer
, _eqSite = GoesOnSpecial
, _eqUse = \_ _ -> id
}
defaultAimParams :: AimParams
defaultAimParams = AimParams
src/Dodge/Item/Equipment.hs
+37 -11
View File
@@ -27,8 +27,8 @@ magShield = defaultEquipment
}
& itUse . eqUse .~ useMagShield
& itUse . eqSite .~ GoesOnWrist
useMagShield :: Creature -> Int -> World -> World
useMagShield cr invid w = w & magnets . at mgid ?~ themagnet
useMagShield :: Item -> Creature -> World -> World
useMagShield it cr w = w & magnets . at mgid ?~ themagnet
where
themagnet = Magnet
{_mgID = mgid
@@ -39,7 +39,7 @@ useMagShield cr invid w = w & magnets . at mgid ?~ themagnet
mgid = case it ^? itAttachment . itMInt . _Just of
Just mgid' -> mgid'
Nothing -> IM.newKey $ _magnets w
it = _crInv cr IM.! invid
-- it = _crInv cr IM.! invid
flameShield :: Item
flameShield = defaultEquipment
@@ -68,16 +68,42 @@ wristArmour :: Item
wristArmour = defaultEquipment
{ _itType = WRISTARMOUR
, _itName = "WRISTARMOUR"
, _itEquipPict = spicForWrist (emptySH , setDepth 20 $ pictures
[color thecol $ thickArc 0 (pi/2) 10 5
,color thecol $ thickArc (3*pi/2) (2*pi) 10 5
])
, _itEquipPict = spicForWrist mempty
, _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqSite .~ GoesOnWrist
& itUse . eqOnEquip .~ onEquipWristShield
& itUse . eqUse .~ setWristShieldPos
& itUse . eqOnRemove .~ onRemoveWristShield
onEquipWristShield :: Item -> Creature -> World -> World
onEquipWristShield itm cr w = w
& creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itUse . eqParams .~ EquipID i
& walls . at i ?~ (shieldWall (_crID cr)) {_wlDraw = True}
& setWristShieldPos (itm & itUse . eqParams .~ EquipID i) cr
where
thecol = yellow -- (greyN 0.1)
i = IM.newKey $ _walls w
onRemoveWristShield :: Item -> Creature -> World -> World
onRemoveWristShield itm cr w = w
& creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itUse . eqParams .~ NoEquipParams
-- & walls . at i .~ Nothing
where
i = _eparamID $ _eqParams $ _itUse itm
setWristShieldPos :: Item -> Creature -> World -> World
setWristShieldPos itm cr w = w
& moveWallIDUnsafe i wlline
-- & tempLightSources .:~ tlsTimeRadColPos 1 200 0.7 (fst wlline `v2z` 40)
where
i = _eparamID $ _eqParams $ _itUse itm
wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
invid = fromJust (_itInvPos itm)
--wlline = (V2 10 0, V2 (-10) 100)
handtrans = case cr ^? crInvEquipped . ix invid of
Just OnLeftWrist -> translatePointToLeftHand
_ -> translatePointToRightHand
f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
spicForWrist :: SPic -> Creature -> Item -> SPic
spicForWrist = pictureOnEquip . translateSP (V3 0 4 (-4))
@@ -89,7 +115,7 @@ pictureOnEquip sp cr itm = fromMaybe mempty $ do
equipPosition :: EquipPosition -> Creature -> SPic -> SPic
equipPosition epos cr sh = case epos of
OnLeftWrist -> translateToLeftHand cr sh
OnRightWrist -> translateToRightHand cr $ mirrorSPxz sh
OnRightWrist -> translateToRightHand cr sh
OnLegs -> translateToLeftLeg cr sh <>
translateToRightLeg cr (mirrorSPxz sh)
OnHead -> translateToHead cr sh
@@ -253,8 +279,8 @@ headLampShape = colorSH yellow $
<> translateSH (V3 5 (-2) 4) (upperPrismPoly 4 $ rectWH 4 1)
<> translateSH (V3 5 (-2) 0) (upperPrismPoly 4 $ rectWH 4 1)
createHeadLamp :: Creature -> Int -> World -> World
createHeadLamp cr _ = tempLightSources .:~ tlsTimeRadColPos 1 200 0.7
createHeadLamp :: Item -> Creature -> World -> World
createHeadLamp _ cr = tempLightSources .:~ tlsTimeRadColPos 1 200 0.7
((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
powerLegs :: Item
src/Dodge/Wall/Move.hs
+7
View File
@@ -1,6 +1,7 @@
{-# LANGUAGE BangPatterns #-}
module Dodge.Wall.Move
( moveWallID
, moveWallIDUnsafe
, moveWall
, moveWallIDToward
, mvPs
@@ -12,6 +13,12 @@ import Dodge.Wall.Zone
import Control.Lens
import qualified Data.IntMap.Strict as IM
moveWallIDUnsafe :: Int -> (Point2,Point2) -> World -> World
moveWallIDUnsafe wlid wlline w = case w ^? walls . ix wlid of
Nothing -> error "tried moving nonexistant wall"
Just wl -> moveWall wlid wl wlline w
moveWallID :: Int -> (Point2,Point2) -> World -> World
moveWallID wlid wlline w = case w ^? walls . ix wlid of
Nothing -> w