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

Add fields to determine an item's inventory position/whether it is held

Browse Source
This commit is contained in:
justin
2022-04-11 13:32:06 +01:00
parent d46d315203
commit c686d9e111
14 changed files with 107 additions and 113 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Coordinate.hs
+1 -1
View File
@@ -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
src/Dodge/Creature.hs
+10 -10
View File
@@ -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
src/Dodge/Creature/Action.hs
+5 -1
View File
@@ -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
src/Dodge/Creature/Picture.hs
+1 -1
View File
@@ -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)
src/Dodge/Creature/State.hs
+28 -12
View File
@@ -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
src/Dodge/Data.hs
+5 -2
View File
@@ -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
}
src/Dodge/Default.hs
+4
View File
@@ -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
src/Dodge/Default/Weapon.hs
+4
View File
@@ -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
src/Dodge/Item/Weapon/ExtraEffect.hs
+41 -28
View File
@@ -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)
src/Dodge/Picture/Layer.hs
-34
View File
@@ -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
src/Dodge/Picture/Layer/Data.hs
-19
View File
@@ -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
src/Dodge/Render/InfoBox.hs
+1 -1
View File
@@ -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
src/Dodge/Render/ShapePicture.hs
+5 -2
View File
@@ -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
]
src/Dodge/Update.hs
+2 -2
View File
@@ -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