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

Refactor creature draw, pass World to function

Browse Source
This commit is contained in:
justin
2021-05-25 21:44:25 +02:00
parent 28386ec8b9
commit d4a15a2416
10 changed files with 48 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Inanimate.hs
+4 -3
View File
@@ -4,6 +4,7 @@ Inanimate objects such as lamps, barrels, etc
module Dodge.Creature.Inanimate module Dodge.Creature.Inanimate
where where
import Dodge.Data import Dodge.Data
import Dodge.Creature.Picture
--import Dodge.Creature.Stance.Data --import Dodge.Creature.Stance.Data
import Dodge.Creature.State.Data import Dodge.Creature.State.Data
import Dodge.Picture.Layer import Dodge.Picture.Layer
@@ -25,7 +26,7 @@ lamp :: Creature
lamp = defaultInanimate lamp = defaultInanimate
{ _crUpdate = initialiseLamp { _crUpdate = initialiseLamp
, _crHP = 100 , _crHP = 100
, _crPict = \ _ -> onLayer CrLayer $ color white $ circleSolid 3 , _crPict = picAtCrPos $ onLayer CrLayer $ color white $ circleSolid 3
, _crRad = 3 , _crRad = 3
, _crMass = 3 , _crMass = 3
} }
@@ -53,7 +54,7 @@ barrel :: Creature
barrel = defaultInanimate barrel = defaultInanimate
{ _crUpdate = updateBarrel { _crUpdate = updateBarrel
, _crHP = 500 , _crHP = 500
, _crPict = \ _ -> onLayer CrLayer $ pictures , _crPict = picAtCrPos $ onLayer CrLayer $ pictures
[ color orange $ circleSolid 10 [ color orange $ circleSolid 10
, color (greyN 0.5) $ circleSolid 8 , color (greyN 0.5) $ circleSolid 8
] ]
@@ -67,7 +68,7 @@ explosiveBarrel :: Creature
explosiveBarrel = defaultInanimate explosiveBarrel = defaultInanimate
{ _crUpdate = updateExpBarrel { _crUpdate = updateExpBarrel
, _crHP = 400 , _crHP = 400
, _crPict = \ _ -> onLayer CrLayer $ pictures , _crPict = picAtCrPos $ onLayer CrLayer $ pictures
[ color red $ circleSolid 8 [ color red $ circleSolid 8
, color orange $ circleSolid 10 , color orange $ circleSolid 10
] ]
src/Dodge/Creature/Picture.hs
+6 -1
View File
@@ -4,6 +4,7 @@ Takes into account damage etc. -}
module Dodge.Creature.Picture module Dodge.Creature.Picture
( basicCrPict ( basicCrPict
, circLine , circLine
, picAtCrPos
) where ) where
import Dodge.Data import Dodge.Data
--import Dodge.Creature.Stance.Data --import Dodge.Creature.Stance.Data
@@ -19,8 +20,9 @@ import qualified Data.IntMap.Strict as IM
basicCrPict basicCrPict
:: Color -- ^ Creature color :: Color -- ^ Creature color
-> Creature -> Creature
-> World
-> Picture -> Picture
basicCrPict col cr = pictures basicCrPict col cr _ = uncurry translate (_crPos cr) $ rotate (_crDir cr) $ pictures
[ onLayer CrLayer . piercingMod $ bluntScale naked [ onLayer CrLayer . piercingMod $ bluntScale naked
-- , drawAwakeLevel cr -- , drawAwakeLevel cr
, drawEquipment cr , drawEquipment cr
@@ -72,3 +74,6 @@ drawEquipment cr = pictures $ map f $ IM.toList (_crInv cr)
circLine :: Float -> Picture circLine :: Float -> Picture
circLine x = line [(0,0),(x,0)] circLine x = line [(0,0),(x,0)]
picAtCrPos :: Picture -> Creature -> World -> Picture
picAtCrPos thePic cr _ = uncurry translate (_crPos cr) $ rotate (_crDir cr) thePic
src/Dodge/Data.hs
+3 -1
View File
@@ -136,7 +136,7 @@ data Creature = Creature
, _crVel :: Point2 , _crVel :: Point2
, _crDir :: Float , _crDir :: Float
, _crID :: Int , _crID :: Int
, _crPict :: Creature -> Picture , _crPict :: Creature -> World -> Picture
, _crUpdate , _crUpdate
:: World :: World
-> (World -> World,StdGen) -> (World -> World,StdGen)
@@ -219,6 +219,8 @@ data Item
, _itEffect :: ItEffect , _itEffect :: ItEffect
, _itInvDisplay :: Item -> String , _itInvDisplay :: Item -> String
, _itInvColor :: Color , _itInvColor :: Color
, _itTargeting :: Maybe (World -> Maybe Point2, Item -> Int -> Creature -> World -> Picture)
, _itWorldTrigger :: Maybe (Int -> World -> Bool)
} }
| Consumable | Consumable
{ _itName :: String { _itName :: String
src/Dodge/Default.hs
+1 -1
View File
@@ -80,7 +80,7 @@ defaultCreature = Creature
, _crVel = (0,0) , _crVel = (0,0)
, _crDir = 0 , _crDir = 0
, _crID = 1 , _crID = 1
, _crPict = const $ onLayer CrLayer $ circleSolid 10 , _crPict = \_ _ -> onLayer CrLayer $ circleSolid 10
, _crUpdate = \ _ f cr -> (f , Just cr) , _crUpdate = \ _ f cr -> (f , Just cr)
, _crRad = 10 , _crRad = 10
, _crMass = 10 , _crMass = 10
src/Dodge/Default/Weapon.hs
+2
View File
@@ -34,4 +34,6 @@ defaultGun = Weapon
, _itEffect = wpRecock , _itEffect = wpRecock
, _itInvDisplay = basicWeaponDisplay , _itInvDisplay = basicWeaponDisplay
, _itInvColor = white , _itInvColor = white
, _itTargeting = Nothing
, _itWorldTrigger = Nothing
} }
src/Dodge/Event/Keyboard.hs
+2 -2
View File
@@ -53,8 +53,8 @@ handlePressedKeyInGame scode w
| scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ startReloadingWeapon (you w) w | scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ startReloadingWeapon (you w) w
| scode == testEventKey (_keyConfig w) = Just $ testEvent w | scode == testEventKey (_keyConfig w) = Just $ testEvent w
| scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w | scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w
-- | scode == rotateCameraPlusKey (_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 == rotateCameraMinusKey (_keyConfig w) = Just $ w & cameraRot -~ 0.01
| scode == ScancodeF5 = Just $ dropLight w | scode == ScancodeF5 = Just $ dropLight w
| scode == ScancodeF6 = Just $ dropLight' w | scode == ScancodeF6 = Just $ dropLight' w
handlePressedKeyInGame _ w = Just w handlePressedKeyInGame _ w = Just w
src/Dodge/Item/Weapon.hs
+6 -4
View File
@@ -80,6 +80,8 @@ pistol = Weapon
, _itEffect = wpRecock , _itEffect = wpRecock
, _itInvDisplay = basicWeaponDisplay , _itInvDisplay = basicWeaponDisplay
, _itInvColor = white , _itInvColor = white
, _itTargeting = Nothing
, _itWorldTrigger = Nothing
} }
defaultAutoGun :: Item defaultAutoGun :: Item
defaultAutoGun = autoGun defaultAutoGun = autoGun
@@ -260,13 +262,13 @@ tractorGun = defaultAutoGun
, _itEquipPict = pictureWeaponOnAim $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ] , _itEquipPict = pictureWeaponOnAim $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
} }
useTargetPos useTargetPos
:: (Point2 -> Creature -> World -> World) :: (Maybe Point2 -> Creature -> World -> World)
-> Creature -> Creature
-> World -> World
-> 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 Nothing -> w
Just p -> f p cr w Just (g,_) -> f (g w) cr w
bezierGun :: Item bezierGun :: Item
bezierGun = defaultAutoGun bezierGun = defaultAutoGun
@@ -276,7 +278,7 @@ bezierGun = defaultAutoGun
. withMuzFlare . withMuzFlare
. withRecoil 40 . withRecoil 40
. torqueBefore 0.05 -- I believe that this doesn't affect . torqueBefore 0.05 -- I believe that this doesn't affect
$ shootBezier p -- <- the start point $ shootBezier $ fromJust p -- <- the start point
, _itAttachment = Nothing , _itAttachment = Nothing
, _itScrollUp = removeItAttachment 0 , _itScrollUp = removeItAttachment 0
, _itScrollDown = removeItAttachment 0 , _itScrollDown = removeItAttachment 0
src/Dodge/Item/Weapon/ExtraEffect.hs
+12 -4
View File
@@ -8,7 +8,7 @@ import Dodge.Data
import Dodge.Base import Dodge.Base
import Dodge.Item.Weapon.Decoration import Dodge.Item.Weapon.Decoration
import Dodge.Item.Weapon.UseEffect import Dodge.Item.Weapon.UseEffect
import Dodge.Item.Attachment.Data --import Dodge.Item.Attachment.Data
import Dodge.WorldEvent.Flash import Dodge.WorldEvent.Flash
import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.ThingsHit
import Picture import Picture
@@ -109,7 +109,15 @@ rbSetTarget = ItInvEffect
setTarg _ cr invid w setTarg _ cr invid w
| _crInvSel cr /= invid = w | _crInvSel cr /= invid = w
| SDL.ButtonRight `S.member` _mouseButtons w = w | SDL.ButtonRight `S.member` _mouseButtons w = w
& creatures . ix (_crID cr) . crInv . ix invid . itAttachment & creatures . ix (_crID cr) . crInv . ix invid . itTargeting
%~ maybe (Just $ ItTargetPos $ mouseWorldPos w) Just %~ maybe (Just $ targetCurrentMousePos w) Just
| otherwise = w & creatures . ix (_crID cr) . crInv . ix invid . itAttachment .~ Nothing | 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)]
src/Dodge/Item/Weapon/Launcher.hs
+8 -18
View File
@@ -33,7 +33,7 @@ launcher = defaultGun
, _wpReloadState = 0 , _wpReloadState = 0
, _itUseRate = 20 , _itUseRate = 20
, _itUseTime = 0 , _itUseTime = 0
, _itUse = \_ -> shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeExplosionAt , _itUse = \it -> shootWithSound (fromIntegral launcherSound) $ aRocketWithItemParams it
, _wpSpread = 0.02 , _wpSpread = 0.02
, _wpRange = 20 , _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5) , _itFloorPict = onLayer FlItLayer $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
@@ -48,30 +48,20 @@ launcher = defaultGun
} }
} }
flameLauncher :: Item flameLauncher :: Item
flameLauncher = launcher flameLauncher = launcher & wpAmmo . amPayload .~ makeFlameExplosionAt
{ _itName = "FLROCKO"
, _itUse = \_ -> shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeFlameExplosionAt
}
poisonLauncher :: Item poisonLauncher :: Item
poisonLauncher = launcher poisonLauncher = launcher & wpAmmo . amPayload .~ makePoisonExplosionAt
{ _itName = "POISROCK"
, _itUse = \_ -> shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makePoisonExplosionAt
}
teslaLauncher :: Item teslaLauncher :: Item
teslaLauncher = launcher teslaLauncher = launcher & wpAmmo . amPayload .~ makeTeslaExplosionAt
{ _itName = "TESLROCK"
, _itUse = \_ -> shootWithSound (fromIntegral launcherSound) $ aRocketWithPayload makeTeslaExplosionAt
}
aRocketWithPayload aRocketWithItemParams
:: (Point2 -> World -> World) -- ^ Payload :: Item -- ^ Firing item
-> Creature -> Creature
-> World -> World
-> 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 where
pl = _amPayload $ _wpAmmo it
cid = _crID cr cid = _crID cr
i = IM.newKey $ _projectiles w i = IM.newKey $ _projectiles w
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
src/Dodge/Render/Picture.hs
+4 -3
View File
@@ -18,7 +18,7 @@ worldPictures w = pictures $ concat
[ IM.elems $ _decorations w [ IM.elems $ _decorations w
, map (dbArg _pjDraw) . IM.elems $ _projectiles w , map (dbArg _pjDraw) . IM.elems $ _projectiles w
, map drawItem . IM.elems $ _floorItems 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 clDraw . reverse . IM.elems $ _clouds w
, map ppDraw . IM.elems $ _pressPlates w , map ppDraw . IM.elems $ _pressPlates w
, map btDraw (IM.elems (_buttons w)) , map btDraw (IM.elems (_buttons w))
@@ -51,8 +51,8 @@ testPic w =
. IM.filter ( (== 3) . _crRad ) $ _creatures w . IM.filter ( (== 3) . _crRad ) $ _creatures w
] ]
crDraw :: Creature -> Picture crDraw :: World -> Creature -> Picture
crDraw c = uncurry translate (_crPos c) $ rotate (_crDir c) (_crPict c c) crDraw w c = (_crPict c c w)
ppDraw :: PressPlate -> Picture ppDraw :: PressPlate -> Picture
ppDraw c = uncurry translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c) ppDraw c = uncurry translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
btDraw :: Button -> Picture btDraw :: Button -> Picture
@@ -217,3 +217,4 @@ lightsForGloom' :: World -> [Point4]
lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w) 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) 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) getTLS ls = ( fst $ _tlsPos ls,snd $ _tlsPos ls, _tlsRad ls, _tlsIntensity ls)