diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 3693db45a..4fddaf894 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -190,7 +190,7 @@ updateRBList w chooseEquipmentPosition :: Creature -> [EquipPosition] -> Int chooseEquipmentPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do ep <- cr ^? crInvEquipped . ix (_crInvSel cr) - findIndex (==ep) eps + elemIndex ep eps chooseFreeSite :: Creature -> [EquipPosition] -> Int chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment @@ -238,7 +238,7 @@ setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment Just i | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment {_activateEquipment = invsel,_deactivateEquipment = i} - Just i | Just i == rbos ^? allocSwapID || Just i == rbos ^? allocRemoveID + Just i | Just i == rbos ^? allocRemoveID -> w & rbOptions . opActivateEquipment .~ DeactivateEquipment i Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment Nothing | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateEquipment diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 8de12fc43..fd798b8f8 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -221,10 +221,10 @@ brainHat = defaultEquipment } & itUse . eqSite .~ GoesOnHead -headLamp :: Item -headLamp = defaultEquipment +headLamp1 :: Item +headLamp1 = defaultEquipment { _itType = HEADLAMP - , _itName = "HEADLAMP" + , _itName = "HEADLAMP1" , _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ translateSHf 5 2 (upperPrismPoly 8 $ rectWH 4 1) <> translateSHf 5 (-2) (upperPrismPoly 8 $ rectWH 4 1) @@ -235,6 +235,23 @@ headLamp = defaultEquipment } & itUse . eqUse .~ createHeadLamp & itUse . eqSite .~ GoesOnHead +headLamp :: Item +headLamp = defaultEquipment + { _itType = HEADLAMP + , _itName = "HEADLAMP" + , _itEquipPict = pictureOnEquip (noPic headLampShape) + , _itEffect = NoItEffect + , _itID = Nothing + } + & itUse . eqUse .~ createHeadLamp + & itUse . eqSite .~ GoesOnHead + +headLampShape :: Shape +headLampShape = colorSH yellow $ + translateSH (V3 5 2 4) (upperPrismPoly 4 $ rectWH 4 1) + <> translateSH (V3 5 2 0) (upperPrismPoly 4 $ rectWH 4 1) + <> 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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 1c21346a5..30018919e 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -132,10 +132,6 @@ subInventoryDisplay subinv cfig w = case subinv of _ -> mempty equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr) f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos --- | _crInvSel cr /= invid || not (ButtonRight `S.member` _mouseButtons w) --- = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos --- | otherwise = mempty - --rboptions = listTextPicturesAtOffset 200 0 cfig (selNumPos invid w) ["TEST","ME"] rboptions = if ButtonRight `S.member` _mouseButtons w then drawRBOptions cfig w (_rbOptions w) else mempty diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index df1876377..f8a5ca760 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -307,7 +307,8 @@ updateCloud w c newPos2 = stripZ newPos -- the following only tests for the first collision with a wall hitWl = collidePointAnyWallsReflect oldPos2 newPos2 $ wallsNearPoint newPos2 w - finalPos = addZ npz $ maybe newPos2 fst hitWl + finalPos = addZ (min 74 npz) $ maybe newPos2 fst hitWl + -- allowing clouds to height 75 causes graphical glitches 22.05.23 finalVel = addZ nvz $ maybe newVel2 snd hitWl --updateCloud :: World -> Cloud -> Maybe Cloud