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

Start more sensibly separating avatar from ai creatures

Browse Source
This commit is contained in:
justin
2024-12-17 19:55:07 +00:00
parent 234b10df40
commit d0ef2628ce
23 changed files with 393 additions and 369 deletions
Download Patch File Download Diff File Expand all files Collapse all files
saveSlot/LevelStart0
+1 -1
View File
File diff suppressed because one or more lines are too long
src/Dodge/Annotation/Data.hs
+7 -6
View File
@@ -1,11 +1,12 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Annotation.Data where
import Dodge.Data.GenWorld
import Dodge.Tree.Compose.Data
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Annotation.Data where
import Control.Monad.State
import Control.Lens
import Control.Monad.State
import Dodge.Data.GenWorld
import Dodge.Data.MetaTree
import System.Random
type MTRS = MetaTree Room String
@@ -19,6 +20,6 @@ data Annotation
| PassthroughLockKeyLists
[(Int -> State StdGen (MetaTree Room String), State StdGen ItemType)]
[(ItemType, State StdGen (MetaTree Room String))]
Int
Int
makeLenses ''Annotation
src/Dodge/Bullet.hs
+1 -4
View File
@@ -21,10 +21,7 @@ import qualified ListHelp as List
import Data.Bifunctor
updateBullet :: World -> Bullet -> (World, Maybe Bullet)
updateBullet w bu = mvBullet w bu
mvBullet :: World -> Bullet -> (World, Maybe Bullet)
mvBullet w bu
updateBullet w bu
| magV (_buVel bu) < 1 || _buTimer bu <= 0 = (endspawn w, Nothing)
| otherwise =
second (fmap updateBulVel)
src/Dodge/Creature.hs
+4 -3
View File
@@ -103,7 +103,8 @@ startCr =
& crFaction .~ PlayerFaction
& crMvType .~ MvWalking yourDefaultSpeed
& crType . skinUpper .~ lightx4 black
& crType . humanoidAI .~ YourAI
& crType .~ Avatar
(greyN 0.9) (lightx4 green) (greyN 0.3)
-- | Items you start with.
startInvList :: [Item]
@@ -115,8 +116,8 @@ startInventory = IM.fromList $ zip [0 ..] startInvList
inventoryX :: Char -> [Item]
inventoryX c = case c of
'A' ->
[ clickDetector ITEMDETECTOR
] <> fold
[ clickDetector x | x <- [minBound .. maxBound]
] <> [pulseChecker] <> fold
[ makeTypeCraftNum 1 TRANSFORMER
, makeTypeCraftNum 2 CAN
, makeTypeCraftNum 2 PIPE
src/Dodge/Creature/Update.hs
+6 -3
View File
@@ -1,7 +1,9 @@
module Dodge.Creature.Update
( updateCreature
) where
module Dodge.Creature.Update (
updateCreature,
) where
import Dodge.Creature.YourControl
import Dodge.Creature.State
import Dodge.Barreloid
import Dodge.Data.World
import Dodge.Humanoid
@@ -9,6 +11,7 @@ import Dodge.Lampoid
updateCreature :: Creature -> World -> World
updateCreature cr = case _crType cr of
Avatar{} -> crUpdate yourControl cr
Lampoid{} -> updateLampoid cr
Humanoid{} -> updateHumanoid cr
Barreloid{} -> updateBarreloid cr
src/Dodge/Creature/YourControl.hs
+1 -2
View File
@@ -7,7 +7,6 @@ import Data.Foldable
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base.Coordinate
import Dodge.Base.You
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.Impulse.UseItem
import Dodge.Data.World
@@ -163,7 +162,7 @@ mouseActionsCr pkeys
pressedMBEffectsTopInventory :: M.Map SDL.MouseButton Int -> World -> World
pressedMBEffectsTopInventory pkeys w
| isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = youhammerdown $ useRootItem 0 w
| isDown SDL.ButtonLeft && inTopInv = youhammerdown $ useItemLeftClick (you w) w
-- | isDown SDL.ButtonLeft && inTopInv = youhammerdown $ useItemLeftClick (you w) w
| isDown SDL.ButtonMiddle = w & wCam . camRot -~ rotation
| otherwise = w
where
src/Dodge/Data/Creature/Misc.hs
+7 -3
View File
@@ -46,8 +46,7 @@ data CrMvType
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data HumanoidAI
= YourAI
| ChaseAI
= ChaseAI
| InanimateAI
| SpreadGunAI
| PistolAI
@@ -62,7 +61,12 @@ data HumanoidAI
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data CreatureType
= Humanoid
= Avatar
{ _skinHead :: Color
, _skinUpper :: Color
, _skinLower :: Color
}
| Humanoid
{ _skinHead :: Color
, _skinUpper :: Color
, _skinLower :: Color
src/Dodge/Data/Item/Combine.hs
+2 -1
View File
@@ -114,6 +114,7 @@ data EquipItemType
| BULLETBELTBRACER
| BATTERYPACK
| AUTODETECTOR Detector
| PULSECHECKER
deriving (Eq, Ord, Show, Read)
data LeftItemType
@@ -169,7 +170,7 @@ data Detector
= ITEMDETECTOR
| CREATUREDETECTOR
| WALLDETECTOR
deriving (Eq, Ord, Show, Read) --Generic, Flat)
deriving (Eq, Ord, Show, Read, Enum, Bounded) --Generic, Flat)
makeLenses ''ItemType
makeLenses ''HeldItemType
src/Dodge/Data/Item/Use/Consumption/Ammo.hs
+1 -1
View File
@@ -37,7 +37,7 @@ data ProjectileUpdate
deriving (Show, Eq, Ord, Read) --Generic, Flat)
data AmmoType
= ProjectileAmmo
= LauncherAmmo
| BulletAmmo
| BeltBulletAmmo
| ElectricalAmmo
src/Dodge/HeldUse.hs
+18 -12
View File
@@ -6,7 +6,6 @@ module Dodge.HeldUse (
mcUseHeld,
) where
import Dodge.Item.HeldOffset
import Color
import Control.Monad
import Data.Maybe
@@ -18,6 +17,7 @@ import Dodge.Data.MuzzleEffect
import Dodge.Data.World
import Dodge.Gas
import Dodge.Inventory.Lock
import Dodge.Item.HeldOffset
import Dodge.Item.Weapon.Radar
import Dodge.Item.Weapon.Shatter
import Dodge.Item.Weapon.TriggerType
@@ -152,18 +152,19 @@ makeMuzzleFlare mz itmtree cr = case mz ^. mzFlareType of
HeavySmokeFlare -> basicMuzFlare pos dir
LasGunFlare ->
flareCircleAt (getLaserColor itmtree) 0.8 (pos `v2z` 20)
-- . ( cWorld . lWorld . tempLightSources
-- .:~ tlsTimeRadColPos 1 100 (xyzV4 $ getLaserColor itmtree) (pos `v2z` 10)
-- . ( cWorld . lWorld . tempLightSources
-- .:~ tlsTimeRadColPos 1 100 (xyzV4 $ getLaserColor itmtree) (pos `v2z` 10)
. ( cWorld . lWorld . lights
.:~ LSParam (pos `v2z` 10) 100 (xyzV4 $ getLaserColor itmtree)
)
TeslaGunFlare ->
cWorld . lWorld . lights
.:~ LSParam (pos `v2z` 10) 100 (V3 0 0 1)
-- .:~ tlsTimeRadColPos 1 100 (V3 0 0 1) (pos `v2z` 10)
where
-- .:~ tlsTimeRadColPos 1 100 (V3 0 0 1) (pos `v2z` 10)
itm = itmtree ^. ldtValue
(moff,mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
(moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
pos = _crPos cr + rotateV (_crDir cr) moff
dir = _crDir cr + mrot
@@ -203,7 +204,7 @@ getLaserColor = const yellow
basicMuzFlare :: Point2 -> Float -> World -> World
basicMuzFlare pos dir =
-- makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) (pos `v2z` 20)
-- makeTlsTimeRadColPos 2 100 (V3 1 1 0.5) (pos `v2z` 20)
(cWorld . lWorld . lights .:~ LSParam (pos `v2z` 20) 100 (V3 1 1 0.5))
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
@@ -296,7 +297,7 @@ shootLaser itmtree cr mz w =
}
where
itm = itmtree ^. ldtValue
(moff,mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
(moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
pos = _crPos cr + rotateV (_crDir cr) moff
dir = _crDir cr + mrot + a
(a, g) = randomR (- inacc, inacc) $ _randGen w
@@ -365,7 +366,7 @@ getBulletTrajectory mz itm bt tp cr w = case bt of
BezierTrajectoryType -> BezierTrajectory bulpos tp (mouseWorldPos (w ^. input) (w ^. wCam))
MagnetTrajectoryType -> MagnetTrajectory tp
where
(moff,_) = heldItemOrient2D itm cr (_mzPos mz + V2 0 offset) (_mzRot mz)
(moff, _) = heldItemOrient2D itm cr (_mzPos mz + V2 0 offset) (_mzRot mz)
bulpos = _crPos cr + rotateV (_crDir cr) moff
offset = case itm ^? itUse . heldParams . randomOffset of
Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w
@@ -395,7 +396,7 @@ makeBullet thebullet itm cr mz w =
& buDrag *~ drag
)
where
(moff,mrot) = heldItemOrient2D itm cr (_mzPos mz + V2 0 offset) (_mzRot mz)
(moff, mrot) = heldItemOrient2D itm cr (_mzPos mz + V2 0 offset) (_mzRot mz)
bulpos = _crPos cr + rotateV (_crDir cr) moff
(a, g'') = randomR (- inacc, inacc) $ _randGen w
inacc = _mzInaccuracy mz
@@ -440,7 +441,7 @@ useGasParams mmagid mz itm cr w =
gc <- itm ^? itUse . heldParams . gasCreation
return $ gasCreate fueltype gc
--pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
(moff,mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
(moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
pos = _crPos cr + rotateV (_crDir cr) moff
(a, g') = randomR (- inacc, inacc) g
inacc = _mzInaccuracy mz
@@ -490,7 +491,7 @@ shootTeslaArc itm cr mz w =
-- use items item location instead
itRef = cr ^?! crManipulation . manObject . imRootSelectedItem -- unsafe!! TODO change
(w', ip) = makeTeslaArc (_itParams itm) pos dir w
(moff,mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
(moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
pos = _crPos cr + rotateV (_crDir cr) moff
dir = _crDir cr + mrot
@@ -522,7 +523,12 @@ createProjectile magtree muz itmtree cr = fromMaybe failsound $ do
. startthesound
where
-- the sound should be moved to the projectile firing
startthesound = soundMultiFrom [CrWeaponSound (_crID cr) j | j <- [0 .. 3]] (_crPos cr) tap4S Nothing
startthesound =
soundMultiFrom
[CrWeaponSound (_crID cr) j | j <- [0 .. 3]]
(_crPos cr)
tap4S
Nothing
failsound w' = case w' ^? input . mouseButtons . ix SDL.ButtonLeft of
Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
_ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
src/Dodge/Humanoid.hs
+1 -1
View File
@@ -9,6 +9,7 @@ import Geometry
import LensHelp
import RandomHelp
updateHumanoid :: Creature -> World -> World
updateHumanoid cr = case cr ^?! crType . humanoidAI of
ChaseAI ->
@@ -168,7 +169,6 @@ updateHumanoid cr = case cr ^?! crType . humanoidAI of
]
]
cr
YourAI -> crUpdate yourControl cr
InanimateAI -> id
where
drawwp = DoActionIfElse NoAction (WdCrBlfromCrBl CrIsAiming) (DoActionThen drawWeapon (WaitThen 50 NoAction))
src/Dodge/Item.hs
+1
View File
@@ -72,6 +72,7 @@ itemFromEquipType et = case et of
BULLETBELTPACK -> bulletBeltPack
BULLETBELTBRACER -> bulletBeltBracer
AUTODETECTOR d -> autoDetector d
PULSECHECKER -> pulseChecker
itemFromLeftType :: LeftItemType -> Item
itemFromLeftType lt = case lt of
src/Dodge/Item/Ammo.hs
+1 -1
View File
@@ -78,7 +78,7 @@ shellMag =
{ _iaMax = 1
, _iaLoaded = 1
}
, _amagType = ProjectileAmmo
, _amagType = LauncherAmmo
}
megaBattery :: Item
src/Dodge/Item/Draw/SPic.hs
+1
View File
@@ -65,6 +65,7 @@ fractionLoadedAmmo rs = fromIntegral (_iaLoaded rs) / fromIntegral (_iaMax rs)
equipItemSPic :: EquipItemType -> Item -> SPic
equipItemSPic et _ = case et of
PULSECHECKER -> defSPic
MAGSHIELD -> defSPic
FLAMESHIELD -> defSPic
FRONTARMOUR -> defSPic
src/Dodge/Item/Equipment.hs
+7
View File
@@ -15,6 +15,7 @@ module Dodge.Item.Equipment (
speedLegs,
jumpLegs,
flameShield,
pulseChecker,
) where
import Geometry.Data
@@ -123,3 +124,9 @@ wristInvisibility =
& itUse . uequipEffect . eeOnEquip .~ ECamouflage Invisible
& itUse . uequipEffect . eeOnRemove .~ ECamouflage FullyVisible
& itType .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
pulseChecker :: Item
pulseChecker =
defaultEquipment
& itUse . uequipEffect . eeSite .~ GoesOnWrist
& itType .~ EQUIP PULSECHECKER
src/Dodge/Item/Grammar.hs
+1 -1
View File
@@ -88,7 +88,7 @@ itemToFunction itm = case itm ^. itType of
ATTACH REMOTESCREEN -> RemoteScreenSF
ATTACH BULLETSYNTH -> AmmoModifierSF BulletAmmo
ATTACH ZOOMSCOPE -> WeaponScopeSF
ATTACH HOMINGMODULE -> AmmoTargetingSF ProjectileAmmo
ATTACH HOMINGMODULE -> AmmoTargetingSF LauncherAmmo
ATTACH AUGMENTEDHUD -> AugmentedHUDSF
BULLETMOD BulletModTrajectory{} -> AmmoTargetingSF BulletAmmo
BULLETMOD BulletModPayload{} -> AmmoPayloadSF BulletAmmo
src/Dodge/Item/Held/Launcher.hs
+2 -2
View File
@@ -18,7 +18,7 @@ launcher =
& itUse . heldAim . aimStance .~ TwoHandOver
& itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy .~ 0
& itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleLauncher
& itAmmoSlots .~ singleAmmo ProjectileAmmo
& itAmmoSlots .~ singleAmmo LauncherAmmo
& itType .~ HELD LAUNCHER
& itUse . heldParams . muzVel .~ ConstFloat 0
& itUse . heldParams . rifling .~ ConstFloat 0
@@ -36,6 +36,6 @@ launcherX i =
<*> pure DefaultFlareType
<*> pure MuzzleLauncher
)
& itAmmoSlots .~ IM.fromList [(j,ProjectileAmmo) | j <- [0..i-1]]
& itAmmoSlots .~ IM.fromList [(j,LauncherAmmo) | j <- [0..i-1]]
where
angles = take i [0,2*pi/ fromIntegral i ..]
src/Dodge/Item/Info.hs
+1
View File
@@ -119,6 +119,7 @@ equipInfo eit = case eit of
BULLETBELTBRACER -> "A container holding a long belt of bullets."
BATTERYPACK -> "A collection of batteries with a universal adapter."
AUTODETECTOR d -> "A device that detects " ++ detectorInfo d ++ " in an expanding radius. Pulses automatically. "
PULSECHECKER -> "A device that detects heartbeats."
--targetingInfo :: TargetingType -> String
--targetingInfo tt = case tt of
src/Dodge/Render/ShapePicture.hs
+1
View File
@@ -40,6 +40,7 @@ worldSPic cfig u =
drawCreature :: Creature -> SPic
drawCreature cr = case _crType cr of
Avatar {} -> basicCrPict cr
Humanoid{} -> basicCrPict cr
Barreloid{} ->
picAtCrPos1
src/Dodge/Tree.hs
+13 -12
View File
@@ -1,13 +1,14 @@
{-| Collects together tree modules. -}
module Dodge.Tree
( module Dodge.Tree.Shift
, module Dodge.Tree.GenerateStructure
, module TreeHelp
, module Dodge.Tree.Compose
, module Dodge.Tree.Compose.Data
) where
import Dodge.Tree.Shift
import Dodge.Tree.GenerateStructure
import TreeHelp
-- | Collects together tree modules.
module Dodge.Tree (
module Dodge.Tree.Shift,
module Dodge.Tree.GenerateStructure,
module TreeHelp,
module Dodge.Tree.Compose,
module Dodge.Data.MetaTree,
) where
import Dodge.Data.MetaTree
import Dodge.Tree.Compose
import Dodge.Tree.Compose.Data
import Dodge.Tree.GenerateStructure
import Dodge.Tree.Shift
import TreeHelp
src/Dodge/Tree/Compose.hs
+2 -2
View File
@@ -16,7 +16,7 @@ module Dodge.Tree.Compose (
attachOnward,
attachOnward',
showIntsString,
module Dodge.Tree.Compose.Data,
module Dodge.Data.MetaTree
) where
import Control.Monad.State
@@ -24,7 +24,7 @@ import Data.List (intersperse)
import Data.Maybe
import Data.Tuple
import Dodge.Data.GenWorld
import Dodge.Tree.Compose.Data
import Dodge.Data.MetaTree
import LensHelp
import TreeHelp
src/Dodge/Tree/Compose/Data.hs
-19
View File
@@ -1,19 +0,0 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Tree.Compose.Data where
import Data.Tree
import Control.Lens
data MetaTree a b = MTree {_mtLabel :: b , _mtTree :: MetaNode a b, _mtBranches :: [MetaBranch a b] }
data MetaNode a b = NodeTree {_nodeTree :: Tree a} | NodeMTree {_nodeMetaTree :: MetaTree a b}
data MetaBranch a b = MBranch {_mbAttach :: a -> Maybe a, _mbTree :: MetaTree a b}
newtype SelfTree a = ST {_unST :: Tree (a,Either (Tree a) (SelfTree a))}
makeLenses ''MetaTree
makeLenses ''MetaBranch
makeLenses ''MetaNode
instance Functor (MetaTree a) where
fmap f (MTree b mn bs) = MTree (f b) (mn & nodeMetaTree %~ fmap f) (map (mbTree %~ fmap f) bs)
tags
+314 -295
View File
File diff suppressed because it is too large Load Diff