Start more sensibly separating avatar from ai creatures

src/Dodge/Annotation/Data.hs

@@ -1,11 +1,12 @@
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Annotation.Data where
-import Dodge.Data.GenWorld
-import Dodge.Tree.Compose.Data
 
-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

@@ -21,10 +21,7 @@ import qualified ListHelp as List
 import Data.Bifunctor
 
 updateBullet :: World -> Bullet -> (World, Maybe Bullet)
-updateBullet w bu = mvBullet w bu
+updateBullet w bu
-
-mvBullet :: World -> Bullet -> (World, Maybe Bullet)
-mvBullet w bu
     | magV (_buVel bu) < 1 || _buTimer bu <= 0 = (endspawn w, Nothing)
     | otherwise =
         second (fmap updateBulVel)

src/Dodge/Creature.hs

@@ -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
+        [ clickDetector x | x <- [minBound .. maxBound]
-        ] <> fold
+        ] <> [pulseChecker] <> fold
         [ makeTypeCraftNum 1 TRANSFORMER
         , makeTypeCraftNum 2 CAN
         , makeTypeCraftNum 2 PIPE

src/Dodge/Creature/Update.hs

@@ -1,7 +1,9 @@
-module Dodge.Creature.Update 
+module Dodge.Creature.Update (
-    ( updateCreature
+    updateCreature,
-    ) where
+) 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

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

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

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

@@ -37,7 +37,7 @@ data ProjectileUpdate
     deriving (Show, Eq, Ord, Read) --Generic, Flat)
 
 data AmmoType
-    = ProjectileAmmo
+    = LauncherAmmo
     | BulletAmmo
     | BeltBulletAmmo
     | ElectricalAmmo

src/Dodge/HeldUse.hs

@@ -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
+            --            . ( cWorld . lWorld . tempLightSources
---                    .:~ tlsTimeRadColPos 1 100 (xyzV4 $ getLaserColor itmtree) (pos `v2z` 10)
+            --                    .:~ 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

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

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

@@ -78,7 +78,7 @@ shellMag =
                         { _iaMax = 1
                         , _iaLoaded = 1
                         }
-                , _amagType = ProjectileAmmo
+                , _amagType = LauncherAmmo
                 }
 
 megaBattery :: Item

src/Dodge/Item/Draw/SPic.hs

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

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

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

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

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

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

@@ -1,13 +1,14 @@
-{-| Collects together tree modules. -}
+-- | Collects together tree modules.
-module Dodge.Tree 
+module Dodge.Tree (
-    ( module Dodge.Tree.Shift
+    module Dodge.Tree.Shift,
-    , module Dodge.Tree.GenerateStructure
+    module Dodge.Tree.GenerateStructure,
-    , module TreeHelp
+    module TreeHelp,
-    , module Dodge.Tree.Compose
+    module Dodge.Tree.Compose,
-    , module Dodge.Tree.Compose.Data
+    module Dodge.Data.MetaTree,
-    ) where
+) where
-import Dodge.Tree.Shift
+
-import Dodge.Tree.GenerateStructure
+import Dodge.Data.MetaTree
-import TreeHelp
 import Dodge.Tree.Compose
-import Dodge.Tree.Compose.Data
+import Dodge.Tree.GenerateStructure
+import Dodge.Tree.Shift
+import TreeHelp

src/Dodge/Tree/Compose.hs

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

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