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

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

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 INCENDIARYMODULE
-    , makeModule STATICMODULE
+--    , makeModule STATICMODULE
-    , bounceModule
+--    , bounceModule
     , medkit 50 & itConsumption . itAmount .~ 3
     , teleportModule
-    , makeTypeCraftNum 1 LIGHTER
+--    , makeTypeCraftNum 1 LIGHTER
---    , makeTypeCraftNum 15 TUBE
+    , makeTypeCraftNum 15 TUBE
-    , makeTypeCraftNum 9 TRANSFORMER
+--    , makeTypeCraftNum 9 TRANSFORMER
---    , makeTypeCraftNum 5 CREATURESENSOR
+    , makeTypeCraftNum 5 CREATURESENSOR
-    , makeTypeCraftNum 9 PRISM
+--    , 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

@@ -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

@@ -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

@@ -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 :: Int -> Item -> Item
-heldItemUpdate = invItemUpdate
+heldItemUpdate invid = (itIsHeld .~ True) . invItemUpdate invid
 --    . (itUse %~ useupdate)
 --  where
 --    useupdate = id
 
-invItemUpdate :: Item -> Item
+invItemUpdate :: Int -> Item -> Item
-invItemUpdate = itUse %~ useupdate
+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
+            | i == _crInvSel cr =  doHeldItemTargeting cr      . (itpointer %~ heldItemUpdate i) 
-            | otherwise         = itpointer %~ invItemUpdate
+            | 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

@@ -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)
+        , _tgHeldUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting)
-        , _tgDraw   :: Int -> Item -> Creature -> World -> Picture
+        , _tgNotHeldUpdate :: Item -> Creature -> World -> Targeting -> (World, Targeting)
+        , _tgDraw   :: Int -> Item -> Creature -> Configuration -> World -> Picture
         , _tgID     :: Maybe Int
         , _tgActive :: Bool
         }

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

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

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 :: Int -> Item -> Creature -> Configuration -> World -> Picture
-targetSimpleDraw _ it _ w = fromMaybe mempty $ do
+targetSimpleDraw _ it _ cfig w = fromMaybe mempty $ do
-    mwp <- it ^? itTargeting . tgPos . _Just
+    p <- it ^? itTargeting . tgPos . _Just
-    return $ setLayer DebugLayer $ color red $ setDepth 50 $ uncurryV translate mwp 
+    return $ winScale cfig $ setLayer FixedCoordLayer $ color white 
-        $ rotate (_cameraRot w)
+        $ uncurryV translate (worldPosToScreen w p)
-        $ pictures
+--        $ rotate (_cameraRot w)
-            [line [V2   x  x, V2 (-x) (-x)]
+        $ activeTargetCursorPic
-            ,line [V2 (-x) x, V2   x  (-x)]
-            ]
-  where
-    x = 5 / _cameraZoom w
 
-targetRBCreatureDraw :: Int -> Item -> Creature -> World -> Picture
+targetRBCreatureDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture
-targetRBCreatureDraw _ it _ w = fromMaybe mempty $ do
+targetRBCreatureDraw _ it _ cfig w = fromMaybe mempty $ do
-    mwp <- it ^? itTargeting . tgPos . _Just
+    p <- it ^? itTargeting . tgPos . _Just
-    return $ setLayer DebugLayer $ color thecolor $ setDepth 50 $ uncurryV translate mwp 
+    return $ winScale cfig $ setLayer FixedCoordLayer $ color white 
-        $ rotate (_cameraRot w)
+        $ uncurryV translate (worldPosToScreen w p)
-        $ pictures
+--        $ rotate (_cameraRot w)
-            [line [V2   x  x, V2 (-x) (-x)]
+        $ thepic
-            ,line [V2 (-x) x, V2   x  (-x)]
-            ]
   where
-    x = 5 / _cameraZoom w
+    thepic | _tgActive $ _itTargeting it = activeTargetCursorPic
-    thecolor | _tgActive $ _itTargeting it = red
+        | otherwise = targetCursorPic
-        | otherwise = blue
+
+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

@@ -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

@@ -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

@@ -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

@@ -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 ^? crGoal
-        ,fmap show $ ap ^? crStrategy
+--        ,fmap show $ ap ^? crStrategy
+        [fmap show $ cr ^? crPos
+        ,fmap show $ cr ^? crOldPos
         ,fmap show $ ap ^? crAction
         ,fmap show $ ap ^? crImpulse
         ]

src/Dodge/Update.hs

@@ -70,8 +70,8 @@ functionalUpdate cfig w = checkEndGame
     . zoneClouds
     . updateMIM magnets _mgUpdate
     . updateIMl _machines _mcUpdate
-    . updateIMl _creatures _crUpdate
+    . updateIMl _creatures _crUpdate 
-   -- . updateCreatures 
+        -- creatures should be updated early so that crOldPos is set before any position change
     . updateCreatureGroups
     . updateBlocks
     . updateSeenWalls