From e9cc7e64c95a3ad6ddf0d326d4ac7f017d856f3d Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 21 May 2022 19:30:51 +0100 Subject: [PATCH] Improve frontArmour equipment --- src/Dodge/Creature.hs | 2 +- src/Dodge/Creature/ArmourChase.hs | 4 +++- src/Dodge/Creature/Impulse/UseItem.hs | 25 +------------------------ src/Dodge/Creature/Property.hs | 10 +++++++++- src/Dodge/Creature/State.hs | 2 +- src/Dodge/Data.hs | 2 +- src/Dodge/Inventory.hs | 14 +++++++------- src/Dodge/Item/Equipment.hs | 13 +++++++------ src/Dodge/Render/HUD.hs | 14 +++++++------- 9 files changed, 37 insertions(+), 49 deletions(-) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 5fc231be6..0f0272f68 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -176,7 +176,7 @@ testInventory = IM.fromList $ zip [0..] [ makeTypeCraftNum 9 PIPE , autoSonar , autoRadar - , autoRadar + , magShield , frontArmour , flameShield , powerLegs diff --git a/src/Dodge/Creature/ArmourChase.hs b/src/Dodge/Creature/ArmourChase.hs index 344b57f07..c2e9172bc 100644 --- a/src/Dodge/Creature/ArmourChase.hs +++ b/src/Dodge/Creature/ArmourChase.hs @@ -60,6 +60,8 @@ armourChaseCrit = chaseCrit ,(1,medkit 200) ] , _crMvType = defaultChaseMvType {_mvTurnRad = f} - } + } + & crEquipment . at OnChest .~ Just 0 + & crInvEquipped . at 0 .~ Just OnChest where f _ = 0.05 diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 4d5aa716d..c8aa45e54 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -6,7 +6,7 @@ import Dodge.Data import Dodge.Inventory import qualified Data.IntMap.Strict as IM -import qualified Data.IntSet as IS +--import qualified Data.IntSet as IS import Control.Lens import Data.Maybe @@ -68,29 +68,6 @@ eqSiteToPos cr es = case es of Nothing -> OnLeftWrist _ -> OnRightWrist -removeEquipmentUsingSite :: EquipSite -> Creature -> Creature -removeEquipmentUsingSite esite cr = case esite of - GoesOnSpecial -> cr - _ -> case cr ^? crEquipment . esiteToPoint of - Just invid -> cr & crInvEquipped . at invid .~ Nothing - _ -> cr - where - esiteToPoint = case esite of - GoesOnHead -> ix OnHead - GoesOnChest -> ix OnChest - GoesOnBack -> ix OnBack - GoesOnWrist -> ix OnLeftWrist - GoesOnLegs -> ix OnLegs - -setEquipmentSite :: EquipSite -> Maybe Int -> Creature -> Creature -setEquipmentSite esite = case esite of - GoesOnHead -> set (crEquipment . at OnHead) - GoesOnChest -> set (crEquipment . at OnChest) - GoesOnBack -> set (crEquipment . at OnBack) - GoesOnWrist -> set (crEquipment . at OnLeftWrist) - GoesOnLegs -> set (crEquipment . at OnLegs) - GoesOnSpecial -> const id - useLeftItem :: Int -> World -> World useLeftItem cid w | _crInvLock cr = w diff --git a/src/Dodge/Creature/Property.hs b/src/Dodge/Creature/Property.hs index 48b580ed9..a697cb276 100644 --- a/src/Dodge/Creature/Property.hs +++ b/src/Dodge/Creature/Property.hs @@ -6,6 +6,7 @@ module Dodge.Creature.Property import Dodge.Data import Geometry +import Data.Maybe import Control.Lens -- the use of crOldPos is because the damage position is calculated on the @@ -14,10 +15,17 @@ import Control.Lens crIsArmouredFrom :: Point2 -> Creature -> Bool crIsArmouredFrom p cr = p /= _crOldPos cr - && any (\it -> it ^? itType == Just FRONTARMOUR) (_crInv cr) + -- && any (\it -> it ^? itType == Just FRONTARMOUR) (_crInv cr) + && hasFrontArmour cr && angleVV (unitVectorAtAngle $ _crDir cr) (p -.- _crOldPos cr) < pi/2 -- even though angleVV can generate NaN, the comparison seems to deal with it +hasFrontArmour :: Creature -> Bool +hasFrontArmour cr = fromMaybe False $ do + invid <- cr ^? crEquipment . ix OnChest + ittype <- cr ^? crInv . ix invid . itType + return $ FRONTARMOUR == ittype + --crOnSeg :: Point2 -> Point2 -> Creature -> Bool --crOnSeg p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 16a55779c..b2a2b7212 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -22,7 +22,7 @@ import Picture import qualified IntMapHelp as IM --import StrictHelp -import qualified Data.IntSet as IS +--import qualified Data.IntSet as IS --import Data.Maybe import Data.Function import Control.Lens diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 6218b8f8d..a6f327d86 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -420,7 +420,7 @@ data Item = Item { _itName :: String , _itConsumption :: ItemConsumption , _itUse :: ItemUse - , _itEquipPict :: Creature -> Int -> SPic + , _itEquipPict :: Creature -> Int -> SPic , _itScroll :: Float -> Creature -> Item -> Item , _itType :: CombineType , _itAttachment :: ItAttachment diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index abd5dd719..8041f097c 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -37,7 +37,7 @@ import qualified IntMapHelp as IM import ListHelp import LensHelp -import qualified Data.IntSet as IS +--import qualified Data.IntSet as IS import Data.Maybe --import Data.List --import System.Random @@ -197,12 +197,12 @@ changeSwapInvSel k w n = length $ _crInv $ _creatures w IM.! _yourID w numCO = length $ _closeObjects w -swapIntSetKeys :: Int -> Int -> IS.IntSet -> IS.IntSet -swapIntSetKeys i j is - | i `IS.member` is && j `IS.member` is = is - | i `IS.member` is = j `IS.insert` (i `IS.delete` is) - | j `IS.member` is = i `IS.insert` (j `IS.delete` is) - | otherwise = is +--swapIntSetKeys :: Int -> Int -> IS.IntSet -> IS.IntSet +--swapIntSetKeys i j is +-- | i `IS.member` is && j `IS.member` is = is +-- | i `IS.member` is = j `IS.insert` (i `IS.delete` is) +-- | j `IS.member` is = i `IS.insert` (j `IS.delete` is) +-- | otherwise = is changeAugInvSel :: Int -> World -> World changeAugInvSel i w diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 11e75df2f..0a2ff15db 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -58,17 +58,18 @@ frontArmour = defaultEquipment {_eqUse = \_ _ -> id ,_eqSite = GoesOnChest } --- , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ translate 0 (-5) $ pictures --- [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5 --- ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5 --- ] - , _itEquipPict = \_ _ -> (,) emptySH $ setDepth 20 $ pictures + , _itEquipPict = pictureOnEquip (emptySH , setDepth 20 $ pictures [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5 ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5 - ] + ]) , _itEffect = NoItEffect , _itID = Nothing } +pictureOnEquip :: SPic -> Creature -> Int -> SPic +pictureOnEquip sp cr i + | isJust (cr ^? crInvEquipped . ix i) = sp + | otherwise = mempty + flatShield :: Item flatShield = defaultEquipment { _itEquipPict = pictureWeaponAim flatShieldEquipSPic diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index b0ccd2b6f..53e943af5 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -19,7 +19,7 @@ import ListHelp import Data.Maybe import qualified Data.IntMap.Strict as IM import qualified Data.Set as S -import qualified Data.IntSet as IS +--import qualified Data.IntSet as IS import Control.Lens import SDL (MouseButton (..)) --import Data.List @@ -134,12 +134,12 @@ subInventoryDisplay subinv cfig w = case subinv of eqPosText :: EquipPosition -> String eqPosText ep = case ep of - OnHead -> "ON HEAD" - OnChest -> "ON CHEST" - OnBack -> "ON BACK" - OnLeftWrist -> "ON LEFT WRIST" - OnRightWrist -> "ON RIGHT WRIST" - OnLegs -> "ON LEGS" + OnHead -> "HEAD" + OnChest -> "CHEST" + OnBack -> "BACK" + OnLeftWrist -> "L.WRIST" + OnRightWrist -> "R.WRIST" + OnLegs -> "LEGS" OnSpecial -> "EQUIPPED" topInvW :: Int