From c686d9e111a18e803b14b1d79962f5b491782a5e Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 11 Apr 2022 13:32:06 +0100 Subject: [PATCH] Add fields to determine an item's inventory position/whether it is held --- src/Dodge/Base/Coordinate.hs | 2 +- src/Dodge/Creature.hs | 20 ++++---- src/Dodge/Creature/Action.hs | 6 ++- src/Dodge/Creature/Picture.hs | 2 +- src/Dodge/Creature/State.hs | 40 +++++++++++----- src/Dodge/Data.hs | 7 ++- src/Dodge/Default.hs | 4 ++ src/Dodge/Default/Weapon.hs | 4 ++ src/Dodge/Item/Weapon/ExtraEffect.hs | 69 +++++++++++++++++----------- src/Dodge/Picture/Layer.hs | 34 -------------- src/Dodge/Picture/Layer/Data.hs | 19 -------- src/Dodge/Render/InfoBox.hs | 2 +- src/Dodge/Render/ShapePicture.hs | 7 ++- src/Dodge/Update.hs | 4 +- 14 files changed, 107 insertions(+), 113 deletions(-) delete mode 100644 src/Dodge/Picture/Layer.hs delete mode 100644 src/Dodge/Picture/Layer/Data.hs diff --git a/src/Dodge/Base/Coordinate.hs b/src/Dodge/Base/Coordinate.hs index 97c1df32a..40b236f4b 100644 --- a/src/Dodge/Base/Coordinate.hs +++ b/src/Dodge/Base/Coordinate.hs @@ -11,7 +11,7 @@ worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTransla doZoom p = _cameraZoom w *.* p doRotate p = rotateV (negate $ _cameraRot w) p {- | Transform world coordinates to scaled screen coordinates. - - These have to be according to the size of the window to get actual screen positions. + - These have to be scaled according to the size of the window to get actual screen positions. - This allows for line thicknesses etc to correspond to pixel sizes.-} worldPosToScreen :: World -> Point2 -> Point2 worldPosToScreen w = doRotate . doZoom . doTranslate diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index ae1a8e142..9349d8972 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -174,21 +174,21 @@ inventoryA = IM.fromList $ zip [0..] testInventory :: IM.IntMap Item testInventory = IM.fromList $ zip [0..] [ makeTypeCraftNum 9 PIPE - , makeModule INCENDIARYMODULE - , makeModule STATICMODULE - , bounceModule +-- , makeModule INCENDIARYMODULE +-- , makeModule STATICMODULE +-- , bounceModule , medkit 50 & itConsumption . itAmount .~ 3 , teleportModule - , makeTypeCraftNum 1 LIGHTER --- , makeTypeCraftNum 15 TUBE - , makeTypeCraftNum 9 TRANSFORMER --- , makeTypeCraftNum 5 CREATURESENSOR - , makeTypeCraftNum 9 PRISM +-- , makeTypeCraftNum 1 LIGHTER + , makeTypeCraftNum 15 TUBE +-- , makeTypeCraftNum 9 TRANSFORMER + , makeTypeCraftNum 5 CREATURESENSOR +-- , makeTypeCraftNum 9 PRISM -- , makeTypeCraftNum 3 DRUM -- , makeTypeCraftNum 3 PUMP - , makeTypeCraftNum 3 BATTERY +-- , makeTypeCraftNum 3 BATTERY -- , makeTypeCraftNum 1 MAGNET --- , makeTypeCraftNum 1 TRANSMITTER + , makeTypeCraftNum 1 TRANSMITTER , makeTypeCraftNum 10 HARDWARE , makeTypeCraftNum 3 SPRING , makeTypeCraftNum 10 CAN diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 4b505c2d3..b389f015c 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -217,7 +217,11 @@ youDropItem' w = case yourItem w ^? _Just . itCurseStatus of cr = you w {- | Copy an inventory item to the floor. -} copyInvItemToFloor :: Creature -> Int -> World -> World -copyInvItemToFloor cr i = copyItemToFloor (_crPos cr) (_crInv cr IM.! i) +copyInvItemToFloor cr i = copyItemToFloor (_crPos cr) + (_crInv cr IM.! i + & itInvPos .~ Nothing + & itIsHeld .~ False + ) sizeSelf :: Float -> Creature -> World -> Maybe World diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index b5a8db616..5808f6f28 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -45,7 +45,7 @@ basicCrPict col cr cfig w = ) where targetingPic = IM.elems $ IM.mapMaybeWithKey f $ _crInv cr - f invid it = fmap (\g -> g invid it cr w) (it ^? itTargeting . tgDraw) + f invid it = fmap (\g -> g invid it cr cfig w) (it ^? itTargeting . tgDraw) drawCrEquipment :: Creature -> SPic drawCrEquipment cr = uncurryV translateSPf (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index a52f70f55..7c4ff8c19 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -38,7 +38,12 @@ import System.Random foldCr :: [Creature -> World -> World] -> Creature -> World -> World -foldCr xs cr w = foldr ($ cr) w xs +--foldCr xs cr w = foldr ($ cr) w xs +foldCr xs cr w = foldr f w xs + where + f g w' = case w' ^? creatures . ix (_crID cr) of + Just cr' -> g cr' w' + Nothing -> w' -- | this seems to work, but I am not sure about the ordering: -- previously, the movement was updated before the ai in order to correctly set the oldpos. @@ -48,12 +53,14 @@ foldCr xs cr w = foldr ($ cr) w xs -- may effect whether the shield moves correctly stateUpdate :: (Creature -> World -> World) -> Creature -> World -> World stateUpdate f = foldCr - [ checkDeath - , doDamage + [ doDamage , invSideEff , movementSideEff - , internalUpdate , f + , internalUpdate -- note that updateMovement needs to be evaluated at the correct moment + -- wrt any changes in position made by the creature: the + -- oldPos needs to be correctly set + , checkDeath ] checkDeath :: Creature -> World -> World @@ -121,14 +128,14 @@ movementSideEff cr w (randDir,g) = randomR (-0.5,0.5) $ _randGen w (randAng,_) = randomR (0,2*pi) $ _randGen w -heldItemUpdate :: Item -> Item -heldItemUpdate = invItemUpdate +heldItemUpdate :: Int -> Item -> Item +heldItemUpdate invid = (itIsHeld .~ True) . invItemUpdate invid -- . (itUse %~ useupdate) -- where -- useupdate = id -invItemUpdate :: Item -> Item -invItemUpdate = itUse %~ useupdate +invItemUpdate :: Int -> Item -> Item +invItemUpdate invid = (itUse %~ useupdate) . (itIsHeld .~ False) . (itInvPos ?~ invid) where useupdate = (useHammer . hammerPosition %~ moveHammerUp) . (useDelay . warmTime %~ decreaseToZero) @@ -137,7 +144,7 @@ invItemUpdate = itUse %~ useupdate invSideEff :: Creature -> World -> World invSideEff cr w = weaponReloadSounds cr . flip (IS.foldr useeq) (_crInvEquipped cr) - . doHeldItemTargeting cr +-- . doHeldItemTargeting cr $ IM.foldrWithKey f w (_crInv cr) where useeq i = _eqUse (_itUse $ _crInv cr IM.! i) cr i @@ -146,16 +153,25 @@ invSideEff cr w = weaponReloadSounds cr Just g -> g (_itEffect it) cr i w' & doitemupdate where doitemupdate - | i == _crInvSel cr = itpointer %~ heldItemUpdate - | otherwise = itpointer %~ invItemUpdate + | i == _crInvSel cr = doHeldItemTargeting cr . (itpointer %~ heldItemUpdate i) + | otherwise = doNotHeldItemTargeting i cr . (itpointer %~ invItemUpdate i) itpointer = creatures . ix (_crID cr) . crInv . ix i doHeldItemTargeting :: Creature -> World -> World doHeldItemTargeting cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting of Nothing -> w Just NoTargeting -> w - Just t -> let (w',t') = _tgUpdate t (_crInv cr IM.! _crInvSel cr) cr w t + Just t -> let (w',t') = _tgHeldUpdate t (_crInv cr IM.! _crInvSel cr) cr w t in w' & creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itTargeting .~ t' +-- & testString .~ const ["Held"] + +doNotHeldItemTargeting :: Int -> Creature -> World -> World +doNotHeldItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of + Nothing -> w + Just NoTargeting -> w + Just t -> let (w',t') = _tgNotHeldUpdate t (_crInv cr IM.! invid) cr w t + in w' & creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t' +-- & testString .~ const ["Not"] weaponReloadSounds :: Creature -> World -> World weaponReloadSounds cr w = case cr ^? crInv . ix (_crInvSel cr) . itConsumption of diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index d5e0ba761..99a9629f0 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -406,6 +406,8 @@ data Item = Item , _itType :: CombineType , _itAttachment :: ItAttachment , _itID :: Maybe Int + , _itInvPos :: Maybe Int + , _itIsHeld :: Bool , _itEffect :: ItEffect , _itInvSize :: Float , _itInvDisplay :: Item -> [String] @@ -429,8 +431,9 @@ data Targeting = NoTargeting | TargetingOnHeld { _tgPos :: Maybe Point2 - , _tgUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting) - , _tgDraw :: Int -> Item -> Creature -> World -> Picture + , _tgHeldUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting) + , _tgNotHeldUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting) + , _tgDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture , _tgID :: Maybe Int , _tgActive :: Bool } diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 7e204602c..43bbbd539 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -144,9 +144,11 @@ defaultEquipment = Item , _itEquipPict = \_ _ -> (,) emptySH blank , _itEffect = NoItEffect , _itID = Nothing + , _itIsHeld = False , _itInvColor = yellow , _itInvDisplay = \it -> [_itName it] , _itInvSize = 1 + , _itInvPos = Nothing , _itDimension = defItDimCol yellow , _itConsumption = NoConsumption , _itUse = EquipUse {_eqUse = \_ _ -> id} @@ -171,6 +173,8 @@ defaultConsumable = Item , _itConsumption = ItemItselfConsumable {_itAmount = 1} , _itEquipPict = \_ _ -> mempty , _itID = Nothing + , _itInvPos = Nothing + , _itIsHeld = False , _itInvColor = blue , _itInvDisplay = \it -> [_itName it ++ " x" ++ show (_itAmount $ _itConsumption it)] , _itEffect = NoItEffect diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index bb932ea6d..70ff2de62 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -93,6 +93,8 @@ defaultGun = Item , _itScroll = \_ _ -> id , _itAttachment = NoItAttachment , _itID = Nothing + , _itInvPos = Nothing + , _itIsHeld = False , _itEffect = NoItEffect , _itInvDisplay = basicItemDisplay , _itInvColor = white @@ -122,6 +124,8 @@ defaultCraftable = Item , _itScroll = \_ _ -> id , _itAttachment = NoItAttachment , _itID = Nothing + , _itInvPos = Nothing + , _itIsHeld = False , _itEffect = NoItEffect , _itInvDisplay = basicItemDisplay , _itInvColor = green diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 5d8e98557..0dd24d65f 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -52,51 +52,64 @@ autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 } defaultTargeting :: Targeting defaultTargeting = TargetingOnHeld { _tgPos = Nothing - , _tgUpdate = \_ _ w t -> (w,t) + , _tgHeldUpdate = \_ _ w t -> (w,t) + , _tgNotHeldUpdate = \_ _ w t -> (w,t) , _tgDraw = \_ _ _ _ -> mempty , _tgID = Nothing , _tgActive = False } targetLaser :: Targeting targetLaser = defaultTargeting - & tgUpdate .~ targetLaserUpdate + & tgHeldUpdate .~ targetLaserUpdate targetRBPress :: Targeting targetRBPress = defaultTargeting - & tgUpdate .~ targetUpdateWith targetRBPressUpdate + & tgHeldUpdate .~ targetUpdateWith targetRBPressUpdate & tgDraw .~ targetSimpleDraw targetRBCreature :: Targeting targetRBCreature = defaultTargeting - & tgUpdate .~ targetUpdateWith targetRBCreatureUpdate + & tgHeldUpdate .~ targetUpdateWith targetRBCreatureUpdate + & tgNotHeldUpdate .~ targetUpdateWith + (const ((tgID .~ Nothing) . (tgPos .~ Nothing) . (tgActive .~ False))) +-- undefined & tgDraw .~ targetRBCreatureDraw targetCursor :: Targeting targetCursor = defaultTargeting - & tgUpdate .~ targetUpdateWith targetCursorUpdate + & tgHeldUpdate .~ targetUpdateWith targetCursorUpdate & tgDraw .~ targetSimpleDraw -targetSimpleDraw :: Int -> Item -> Creature -> World -> Picture -targetSimpleDraw _ it _ w = fromMaybe mempty $ do - mwp <- it ^? itTargeting . tgPos . _Just - return $ setLayer DebugLayer $ color red $ setDepth 50 $ uncurryV translate mwp - $ rotate (_cameraRot w) - $ pictures - [line [V2 x x, V2 (-x) (-x)] - ,line [V2 (-x) x, V2 x (-x)] - ] - where - x = 5 / _cameraZoom w +targetSimpleDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture +targetSimpleDraw _ it _ cfig w = fromMaybe mempty $ do + p <- it ^? itTargeting . tgPos . _Just + return $ winScale cfig $ setLayer FixedCoordLayer $ color white + $ uncurryV translate (worldPosToScreen w p) +-- $ rotate (_cameraRot w) + $ activeTargetCursorPic -targetRBCreatureDraw :: Int -> Item -> Creature -> World -> Picture -targetRBCreatureDraw _ it _ w = fromMaybe mempty $ do - mwp <- it ^? itTargeting . tgPos . _Just - return $ setLayer DebugLayer $ color thecolor $ setDepth 50 $ uncurryV translate mwp - $ rotate (_cameraRot w) - $ pictures - [line [V2 x x, V2 (-x) (-x)] - ,line [V2 (-x) x, V2 x (-x)] - ] +targetRBCreatureDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture +targetRBCreatureDraw _ it _ cfig w = fromMaybe mempty $ do + p <- it ^? itTargeting . tgPos . _Just + return $ winScale cfig $ setLayer FixedCoordLayer $ color white + $ uncurryV translate (worldPosToScreen w p) +-- $ rotate (_cameraRot w) + $ thepic where - x = 5 / _cameraZoom w - thecolor | _tgActive $ _itTargeting it = red - | otherwise = blue + thepic | _tgActive $ _itTargeting it = activeTargetCursorPic + | otherwise = targetCursorPic + +activeTargetCursorPic :: Picture +activeTargetCursorPic = pictures + [rotate a $ line [V2 15 0,V2 10 0] <> targCorner | a <- [0,0.5*pi,pi,1.5*pi]] + +targetCursorPic :: Picture +targetCursorPic = pictures + [rotate a targCorner | a <- [0,0.5*pi,pi,1.5*pi]] +targCorner :: Picture +targCorner = pictures + [line [V2 x x, V2 x (x-y)] + ,line [V2 x x, V2 (x-y) x] + ] + where + x = 10 + y = 5 targetUpdateWith :: (World -> Targeting -> Targeting) -> Item -> Creature -> World -> Targeting -> (World,Targeting) diff --git a/src/Dodge/Picture/Layer.hs b/src/Dodge/Picture/Layer.hs deleted file mode 100644 index c89d57837..000000000 --- a/src/Dodge/Picture/Layer.hs +++ /dev/null @@ -1,34 +0,0 @@ -{- | -Uniform management of layers and depths on which pictures are drawn. -} -module Dodge.Picture.Layer - ( --onLayer - onLayerL --- , levLayer --- , Layer (..) - ) where -import Picture -{- | Uses a layer to set the depth. -} ---onLayer :: Layer -> Picture -> Picture ---onLayer l = setDepth $ (1 - fromIntegral (levLayer l) / 100) / 1000 -{- | Set a depth according to a list of numbers. -Lists are lexicographically ordered if input values are always less than 100. -Higher numbers will get placed on top of lower numbers. -} -onLayerL :: [Int] -> Picture -> Picture -onLayerL is = setDepth $ (1 - sum (zipWith (/) (map fromIntegral is) $ map (100 **) [1..])) / 1000 -{- | For depth testing, set layer values. -} ---levLayer :: Layer -> Int ---levLayer BgLayer = 20 ---levLayer PressPlateLayer = 45 ---levLayer CorpseLayer = 50 ---levLayer FlItLayer = 55 ---levLayer CrLayer = 60 ---levLayer WlLayer = 74 ---levLayer GloomLayer = 67 ---levLayer UPtLayer = 70 ---levLayer PtLayer = 72 ---levLayer HPtLayer = 73 ---levLayer ShadowLayer = 75 ---levLayer LabelLayer = 80 ---levLayer InvLayer = 85 ---levLayer MenuDepth = 90 ---levLayer DebugLayer = 99 diff --git a/src/Dodge/Picture/Layer/Data.hs b/src/Dodge/Picture/Layer/Data.hs deleted file mode 100644 index 63710c823..000000000 --- a/src/Dodge/Picture/Layer/Data.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Dodge.Picture.Layer.Data - where - -data Layer'' - = PtLayer - | CrLayer - | WlLayer - | BgLayer - | ShadowLayer - | FlItLayer - | LabelLayer - | InvLayer - | MenuDepth - | PressPlateLayer - | CorpseLayer - | UPtLayer - | HPtLayer - | GloomLayer - | DebugLayer diff --git a/src/Dodge/Render/InfoBox.hs b/src/Dodge/Render/InfoBox.hs index 2a7079a42..bcb9dc033 100644 --- a/src/Dodge/Render/InfoBox.hs +++ b/src/Dodge/Render/InfoBox.hs @@ -14,7 +14,7 @@ import Geometry renderInfoListAt :: Float -> Float -> Configuration -> World -> (Point2,[String]) -> Picture renderInfoListAt x y cfig w (p,ss) = renderListAt x y cfig (zip ss (repeat yellow)) - <> winScale cfig (color yellow $ lConnect (V2 (x-hw) (hh-20-y)) (worldPosToScreen w p)) + <> winScale cfig (color yellow $ lConnect (V2 (x-hw) (hh-25-y)) (worldPosToScreen w p)) <> listCursorNSW x y cfig 0 yellow 19 (length ss) where hw = halfWidth cfig diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index d813ebd25..00e148daa 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -108,9 +108,12 @@ drawPathing cfig w crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2,[String]) crDisplayInfo cfig w cr + | _crID cr == 0 = Nothing | crOnScreen = Just (_crPos cr, catMaybes - [fmap show $ ap ^? crGoal - ,fmap show $ ap ^? crStrategy +-- [fmap show $ ap ^? crGoal +-- ,fmap show $ ap ^? crStrategy + [fmap show $ cr ^? crPos + ,fmap show $ cr ^? crOldPos ,fmap show $ ap ^? crAction ,fmap show $ ap ^? crImpulse ] diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 4b70d1ad9..7efadc4da 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -70,8 +70,8 @@ functionalUpdate cfig w = checkEndGame . zoneClouds . updateMIM magnets _mgUpdate . updateIMl _machines _mcUpdate - . updateIMl _creatures _crUpdate - -- . updateCreatures + . updateIMl _creatures _crUpdate + -- creatures should be updated early so that crOldPos is set before any position change . updateCreatureGroups . updateBlocks . updateSeenWalls