Refactor creature draw, pass World to function

2021-05-25 21:44:25 +02:00
parent 28386ec8b9
commit d4a15a2416
10 changed files with 48 additions and 37 deletions
@@ -4,6 +4,7 @@ Inanimate objects such as lamps, barrels, etc
 module Dodge.Creature.Inanimate
  where
 import Dodge.Data
+import Dodge.Creature.Picture
 --import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data
 import Dodge.Picture.Layer
@@ -25,7 +26,7 @@ lamp :: Creature
 lamp = defaultInanimate
    { _crUpdate = initialiseLamp
    , _crHP = 100
-    , _crPict = \ _ -> onLayer CrLayer $ color white $ circleSolid 3
+    , _crPict = picAtCrPos $ onLayer CrLayer $ color white $ circleSolid 3
    , _crRad = 3
    , _crMass = 3
    }
@@ -53,7 +54,7 @@ barrel :: Creature
 barrel = defaultInanimate
    { _crUpdate = updateBarrel
    , _crHP = 500
-    , _crPict = \ _ -> onLayer CrLayer $ pictures 
+    , _crPict = picAtCrPos $ onLayer CrLayer $ pictures 
        [ color orange $ circleSolid 10
        , color (greyN 0.5) $ circleSolid 8
        ]
@@ -67,7 +68,7 @@ explosiveBarrel :: Creature
 explosiveBarrel = defaultInanimate
    { _crUpdate = updateExpBarrel
    , _crHP = 400
-    , _crPict = \ _ -> onLayer CrLayer $ pictures 
+    , _crPict = picAtCrPos $ onLayer CrLayer $ pictures 
        [ color red $ circleSolid 8
        , color orange $ circleSolid 10
        ]
@@ -4,6 +4,7 @@ Takes into account damage etc. -}
 module Dodge.Creature.Picture
    ( basicCrPict
    , circLine
+    , picAtCrPos
    ) where
 import Dodge.Data
 --import Dodge.Creature.Stance.Data
@@ -19,8 +20,9 @@ import qualified Data.IntMap.Strict as IM
 basicCrPict 
    :: Color    -- ^ Creature color
    -> Creature 
+    -> World
    -> Picture
-basicCrPict col cr = pictures 
+basicCrPict col cr _ = uncurry translate (_crPos cr) $ rotate (_crDir cr) $ pictures 
    [ onLayer CrLayer . piercingMod $ bluntScale naked 
 --    , drawAwakeLevel cr
    , drawEquipment cr
@@ -72,3 +74,6 @@ drawEquipment cr = pictures $ map f $ IM.toList (_crInv cr)

 circLine :: Float -> Picture
 circLine x = line [(0,0),(x,0)]
+
+picAtCrPos :: Picture -> Creature -> World -> Picture
+picAtCrPos thePic cr _ = uncurry translate (_crPos cr) $ rotate (_crDir cr) thePic
@@ -136,7 +136,7 @@ data Creature = Creature
    , _crVel            :: Point2
    , _crDir            :: Float
    , _crID             :: Int
-    , _crPict           :: Creature -> Picture
+    , _crPict           :: Creature -> World -> Picture
    , _crUpdate     
        :: World 
        -> (World -> World,StdGen) 
@@ -219,6 +219,8 @@ data Item
        , _itEffect :: ItEffect
        , _itInvDisplay :: Item -> String
        , _itInvColor :: Color
+        , _itTargeting :: Maybe (World -> Maybe Point2, Item -> Int -> Creature -> World -> Picture)
+        , _itWorldTrigger :: Maybe (Int -> World -> Bool)
        }
    | Consumable
        { _itName :: String
@@ -80,7 +80,7 @@ defaultCreature = Creature
    , _crVel    = (0,0)
    , _crDir    = 0
    , _crID     = 1
-    , _crPict   = const $ onLayer CrLayer $ circleSolid 10
+    , _crPict   = \_ _ -> onLayer CrLayer $ circleSolid 10
    , _crUpdate = \ _ f cr -> (f , Just cr)
    , _crRad    = 10
    , _crMass   = 10
@@ -34,4 +34,6 @@ defaultGun = Weapon
    , _itEffect = wpRecock
    , _itInvDisplay = basicWeaponDisplay
    , _itInvColor = white
+    , _itTargeting = Nothing
+    , _itWorldTrigger = Nothing
    }
@@ -53,8 +53,8 @@ handlePressedKeyInGame scode w
    | scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ startReloadingWeapon (you w) w
    | scode == testEventKey (_keyConfig w) = Just $ testEvent w
    | scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w
--    | scode == rotateCameraPlusKey (_keyConfig w)  = Just $ w & cameraRot +~ 0.01
--    | scode == rotateCameraMinusKey (_keyConfig w) = Just $ w & cameraRot -~ 0.01
+    | scode == rotateCameraPlusKey (_keyConfig w)  = Just $ w & cameraRot +~ 0.01
+    | scode == rotateCameraMinusKey (_keyConfig w) = Just $ w & cameraRot -~ 0.01
    | scode == ScancodeF5 = Just $ dropLight w 
    | scode == ScancodeF6 = Just $ dropLight' w 
 handlePressedKeyInGame _ w = Just w
@@ -80,6 +80,8 @@ pistol = Weapon
    , _itEffect = wpRecock
    , _itInvDisplay = basicWeaponDisplay
    , _itInvColor = white
+    , _itTargeting = Nothing
+    , _itWorldTrigger = Nothing
    }
 defaultAutoGun :: Item
 defaultAutoGun = autoGun 
@@ -260,13 +262,13 @@ tractorGun = defaultAutoGun
    , _itEquipPict = pictureWeaponOnAim $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
    }
 useTargetPos 
-    :: (Point2 -> Creature -> World -> World)
+    :: (Maybe Point2 -> Creature -> World -> World)
    -> Creature
    -> World
    -> World
-useTargetPos f cr w = case cr ^? crInv . ix (_crInvSel cr) . itAttachment . _Just . itTargetPos of
+useTargetPos f cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting . _Just of
    Nothing -> w
-    Just p -> f p cr w
+    Just (g,_) -> f (g w) cr w

 bezierGun :: Item
 bezierGun = defaultAutoGun
@@ -276,7 +278,7 @@ bezierGun = defaultAutoGun
        . withMuzFlare 
        . withRecoil 40
        . torqueBefore 0.05 -- I believe that this doesn't affect
-        $ shootBezier p    -- <- the start point
+        $ shootBezier $ fromJust p    -- <- the start point
    , _itAttachment = Nothing
    , _itScrollUp   = removeItAttachment 0
    , _itScrollDown = removeItAttachment 0
@@ -8,7 +8,7 @@ import Dodge.Data
 import Dodge.Base
 import Dodge.Item.Weapon.Decoration
 import Dodge.Item.Weapon.UseEffect
-import Dodge.Item.Attachment.Data
+--import Dodge.Item.Attachment.Data
 import Dodge.WorldEvent.Flash
 import Dodge.WorldEvent.ThingsHit
 import Picture
@@ -109,7 +109,15 @@ rbSetTarget = ItInvEffect
    setTarg _ cr invid w
        | _crInvSel cr /= invid = w
        | SDL.ButtonRight `S.member` _mouseButtons w = w 
-            & creatures . ix (_crID cr) . crInv . ix invid . itAttachment 
-                %~ maybe (Just $ ItTargetPos $ mouseWorldPos w) Just
-        | otherwise = w & creatures . ix (_crID cr) . crInv . ix invid . itAttachment .~ Nothing
+            & creatures . ix (_crID cr) . crInv . ix invid . itTargeting 
+                %~ maybe (Just $ targetCurrentMousePos w) Just
+        | otherwise = w & creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ Nothing

+targetCurrentMousePos 
+    :: World 
+    -> (World -> Maybe Point2, Item -> Int -> Creature -> World -> Picture)
+targetCurrentMousePos w = (f, \_ _ _ _ -> cursorPic)
+  where
+    f _ = Just mwp
+    mwp = mouseWorldPos w
+    cursorPic = line [mwp +.+ (5,5), mwp -.- (5,5)]
@@ -33,7 +33,7 @@ launcher = defaultGun
    , _wpReloadState = 0
    , _itUseRate = 20
    , _itUseTime = 0
-    , _itUse = \_ -> shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeExplosionAt
+    , _itUse = \it -> shootWithSound (fromIntegral launcherSound) $ aRocketWithItemParams it
    , _wpSpread = 0.02
    , _wpRange = 20
    , _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
@@ -48,30 +48,20 @@ launcher = defaultGun
        }
    }
 flameLauncher :: Item
-flameLauncher = launcher
-    { _itName = "FLROCKO"
-    , _itUse = \_ -> shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeFlameExplosionAt
-    }
-
+flameLauncher = launcher & wpAmmo . amPayload .~ makeFlameExplosionAt
 poisonLauncher :: Item
-poisonLauncher = launcher 
-    { _itName = "POISROCK"
-    , _itUse = \_ -> shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makePoisonExplosionAt
-    }
-
+poisonLauncher = launcher & wpAmmo . amPayload .~ makePoisonExplosionAt
 teslaLauncher :: Item
-teslaLauncher = launcher 
-    { _itName = "TESLROCK"
-    , _itUse = \_ -> shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeTeslaExplosionAt
-    }
+teslaLauncher = launcher & wpAmmo . amPayload .~ makeTeslaExplosionAt

-aRocketWithPayload
-    :: (Point2 -> World -> World)   -- ^ Payload
+aRocketWithItemParams
+    :: Item   -- ^ Firing item
    -> Creature
    -> World
    -> World
-aRocketWithPayload pl cr w = over projectiles (IM.insert i theShell) w
+aRocketWithItemParams it cr w = over projectiles (IM.insert i theShell) w
  where 
+    pl = _amPayload $ _wpAmmo it
    cid = _crID cr
    i = IM.newKey $ _projectiles w
    pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
@@ -18,7 +18,7 @@ worldPictures w = pictures $ concat
    [ IM.elems $ _decorations w 
    , map (dbArg _pjDraw)  . IM.elems $ _projectiles w
    , map drawItem . IM.elems $ _floorItems w
-    , map crDraw   . IM.elems $ _creatures w
+    , map (crDraw w) . IM.elems $ _creatures w
    , map clDraw   . reverse . IM.elems $ _clouds w
    , map ppDraw   . IM.elems $ _pressPlates w
    , map btDraw (IM.elems (_buttons w))
@@ -51,8 +51,8 @@ testPic w =
        . IM.filter ( (== 3) . _crRad ) $ _creatures w
    ]

-crDraw :: Creature -> Picture
-crDraw c = uncurry translate (_crPos c) $ rotate (_crDir c) (_crPict c c)
+crDraw :: World -> Creature -> Picture
+crDraw w c = (_crPict c c w)
 ppDraw :: PressPlate -> Picture
 ppDraw c = uncurry translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
 btDraw :: Button -> Picture
@@ -217,3 +217,4 @@ lightsForGloom' :: World -> [Point4]
 lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
    where getLS ls  = ( fst $ _lsPos ls, snd $ _lsPos ls,  _lsRad ls , _lsIntensity ls)
          getTLS ls = ( fst $ _tlsPos ls,snd $ _tlsPos ls, _tlsRad ls, _tlsIntensity ls)
+