diff --git a/src/Dodge/Creature/HandPos.hs b/src/Dodge/Creature/HandPos.hs index 4da5bfcbb..fe5fd49f1 100644 --- a/src/Dodge/Creature/HandPos.hs +++ b/src/Dodge/Creature/HandPos.hs @@ -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 diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index cb6b2e668..21322f337 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -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 diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 04b3bc210..23e12eae2 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -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) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index f9bbf0af5..db2103e1d 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 2edc48746..ec0ea00e4 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -163,6 +163,7 @@ defaultEquipment = Item ,_eqOnEquip = \_ _ -> id ,_eqOnRemove = \_ _ -> id ,_eqSite = GoesOnSpecial + ,_eqParams = NoEquipParams } , _itAttachment = NoItAttachment , _itParams = NoParams diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index 0add40c41..57997dc9c 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -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 diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index bd810aa01..455fddbd2 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -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 diff --git a/src/Dodge/Wall/Move.hs b/src/Dodge/Wall/Move.hs index a227b581d..6ffc4d9c8 100644 --- a/src/Dodge/Wall/Move.hs +++ b/src/Dodge/Wall/Move.hs @@ -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