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

Add Read/Show instance for Creature

Browse Source
This commit is contained in:
justin
2022-07-22 10:44:54 +01:00
parent 4c5218c633
commit 6b69fc1684
35 changed files with 345 additions and 225 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Corpse/Draw.hs
+7
View File
@@ -0,0 +1,7 @@
module Dodge.Corpse.Draw where
import Dodge.Data.Corpse
import ShapePicture
-- not currently used, too simple
drawCorpse :: Corpse -> SPic
drawCorpse cp = _cpSPic cp
src/Dodge/Corpse/Make.hs
+36
View File
@@ -0,0 +1,36 @@
module Dodge.Corpse.Make where
import Dodge.Creature.Picture
import Dodge.Data.Creature
import Dodge.Data.Corpse
import Control.Lens
import ShapePicture
import Shape
import Geometry
makeCorpse :: CreatureCorpse -> Creature -> Corpse
makeCorpse cc = case cc of
MakeDefaultCorpse -> makeDefaultCorpse
makeDefaultCorpse :: Creature -> Corpse
makeDefaultCorpse cr = defaultCorpse
& cpPos .~ _crPos cr
& cpDir .~ _crDir cr
& cpSPic .~ noPic (scaleSH (V3 crsize crsize crsize) $ mconcat
[ colorSH (_skinHead cskin) $ deadScalp cr
, colorSH (_skinUpper cskin) $ deadUpperBody cr
, rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
]
)
where
cskin = _crType cr -- this should be fixed
crsize = 0.1 * _crRad cr
rotmdir = rotateSH (_crMvDir cr - _crDir cr)
defaultCorpse :: Corpse
defaultCorpse = Corpse
{ _cpID = 0
, _cpPos = 0
, _cpDir = 0
, _cpSPic = mempty
, _cpRes = NoResurrection
}
src/Dodge/Creature.hs
+1 -4
View File
@@ -27,9 +27,6 @@ import Dodge.Item.Weapon
import Dodge.Item.Equipment
import Dodge.Item.Consumable
import Dodge.Creature.Inanimate
import Dodge.Creature.Picture
--import Dodge.Creature.ChooseTarget
--import Dodge.Item
import Picture
import Geometry.Data
import qualified IntMapHelp as IM
@@ -102,7 +99,7 @@ startCr = defaultCreature
, _crHP = 1000
, _crMaxHP = 1500
, _crInv = startInventory
, _crCorpse = basicCrCorpse
, _crCorpse = MakeDefaultCorpse
, _crFaction = PlayerFaction
, _crMvType = MvWalking yourDefaultSpeed
}
src/Dodge/Creature/Action.hs
+2 -1
View File
@@ -20,6 +20,7 @@ module Dodge.Creature.Action
, pickUpItemID
)
where
import Dodge.FloatFunction
import Dodge.Inventory.Add
import Dodge.CreatureEffect
--import Dodge.ShortShow
@@ -63,7 +64,7 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos)
cpos = _crPos cr
canSee' = canSee (_crID cr) tcid w
aimSp = case cr ^? crMvType . mvAimSpeed of
Just f -> f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
Nothing -> error "creature without aiming type"
tpos | canSee' = _crPos (_creatures w IM.! tcid)
| otherwise = p
src/Dodge/Creature/ArmourChase.hs
+2 -2
View File
@@ -3,6 +3,7 @@ module Dodge.Creature.ArmourChase
, flockArmourChaseCrit
) where
import Dodge.Data
import Dodge.Data.FloatFunction
import Dodge.Default
import Dodge.Creature.ChaseCrit
import Dodge.Item.Equipment
@@ -38,9 +39,8 @@ armourChaseCrit = chaseCrit
[(0,frontArmour)
,(1,medkit 200)
]
, _crMvType = defaultChaseMvType {_mvTurnRad = f}
, _crMvType = defaultChaseMvType {_mvTurnRad = FloatConst 0.05}
}
& crEquipment . at OnChest ?~ 0
& crInvEquipped . at 0 ?~ OnChest
where
f _ = 0.05
src/Dodge/Creature/ChaseCrit.hs
+1 -2
View File
@@ -5,7 +5,6 @@ module Dodge.Creature.ChaseCrit
) where
import Dodge.Data
import Dodge.Default
import Dodge.Creature.Picture
import Dodge.Item.Consumable
import Dodge.Item.Equipment
import Dodge.SoundLogic
@@ -20,7 +19,7 @@ smallChaseCrit = chaseCrit
{ _crHP = 1
, _crRad = 4
, _crInv = IM.fromList [(0,medkit 200)]
, _crCorpse = basicCrCorpse
, _crCorpse = MakeDefaultCorpse
}
invisibleChaseCrit :: Creature
invisibleChaseCrit = chaseCrit
src/Dodge/Creature/Impulse.hs
+4 -2
View File
@@ -4,6 +4,8 @@ module Dodge.Creature.Impulse
, followThenClearImpulses
) where
import Dodge.Data
import Dodge.FloatFunction
import Dodge.RandImpulse
import Dodge.CreatureEffect
import Dodge.Creature.Vocalization
import Dodge.Creature.Impulse.Movement
@@ -53,7 +55,7 @@ followImpulse :: Creature -> World -> Impulse -> (World -> World , Creature)
followImpulse cr w imp = case imp of
ImpulseNothing -> (id,cr)
RandomImpulse rimp ->
let (newimp,newgen) = runState rimp (_randGen w)
let (newimp,newgen) = runState (doRandImpulse rimp) (_randGen w)
in first ((randGen .~ newgen) .) $ followImpulse cr w newimp
Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown cr)
Move p -> crup $ crMvBy p cr
@@ -88,7 +90,7 @@ followImpulse cr w imp = case imp of
crup = (id,)
mvType = _crMvType cr
speed = _mvSpeed mvType
turnRad = _mvTurnRad mvType
turnRad = doFloatFloat $ _mvTurnRad mvType
cpos = _crPos cr
cdir = _crDir cr
cid = _crID cr
src/Dodge/Creature/Memory/Data.hs
+1
View File
@@ -10,5 +10,6 @@ data Memory = Memory
{ _soundsToInvestigate :: [Point2]
, _nodesSearched :: [Int]
}
deriving (Eq,Ord,Show,Read)
makeLenses ''Memory
src/Dodge/Creature/Perception.hs
+11 -8
View File
@@ -5,6 +5,7 @@ module Dodge.Creature.Perception
-- , newSounds
) where
import Dodge.Data
import Dodge.FloatFunction
import Dodge.Creature.Vocalization
import Dodge.Base.Collide
import RandomHelp
@@ -45,9 +46,10 @@ basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of
oldAwareness = _cpAwareness $ _crPerception cr
newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness
becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
thejitter = do
p <- randInCirc 1
return $ Move p
thejitter = RandImpulseCircMove 1
--do
--p <- randInCirc 1
--return $ Move p
maybeBark
| becomesCognizant = case vocalizationTest cr of
Just sid -> crActionPlan . apAction .~
@@ -77,9 +79,10 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness
becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness
--randBool = takeOne [False,True] & evalState $ _randGen w
thejitter = do
p <- randInCirc 2
return $ Move p
thejitter = RandImpulseCircMove 2
-- do
-- p <- randInCirc 2
-- return $ Move p
maybeBark
| becomesCognizant -- && randBool
&& cr ^? crVocalization . vcCoolDown == Just 0
@@ -133,7 +136,7 @@ newExtraAwareness
-> Maybe Awareness
newExtraAwareness cr w cid
| not $ canSeeIndirect (_crID cr) cid w = Nothing
| otherwise = Just . Suspicious $ _viFOV vi ang * _viDist vi d * awakeLevelPerception cr
| otherwise = Just . Suspicious $ doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d * awakeLevelPerception cr
where
vi = _cpVision $ _crPerception cr
tpos = _crPos $ _creatures w IM.! cid
@@ -168,7 +171,7 @@ rememberSounds w cr = cr
-- TODO work out correct form for sounds passing through walls
soundIsClose :: World -> Creature -> (Point2,Float) -> Bool
soundIsClose w cr (pos,vol) = dist cpos pos < 2000
&& vol > (_auDist . _cpAudition $ _crPerception cr) (dist pos cpos)
&& vol > doFloatFloat (_auDist . _cpAudition $ _crPerception cr) (dist pos cpos)
&& hasLOS cpos pos w
where
cpos = _crPos cr
src/Dodge/Creature/Perception/Data.hs
+11 -5
View File
@@ -21,6 +21,7 @@ module Dodge.Creature.Perception.Data
)
where
import Control.Lens
import Dodge.Data.FloatFunction
import qualified IntMapHelp as IM
data Perception = Perception
@@ -30,14 +31,18 @@ data Perception = Perception
, _cpVision :: Vision
, _cpAudition :: Audition
}
deriving (Eq,Ord,Show,Read)
data Vision = Eyes
{ _viFOV :: Float -> Float
, _viDist :: Float -> Float
{ _viFOV :: FloatFloat
, _viDist :: FloatFloat
}
deriving (Eq,Ord,Show,Read)
newtype Audition = Ears
{ _auDist :: Float -> Float
{ _auDist :: FloatFloat
}
deriving (Eq,Ord,Show,Read)
data Vigilance
= Comatose
@@ -45,16 +50,17 @@ data Vigilance
| Lethargic
| Vigilant
| Overstrung
deriving (Eq,Ord,Show)
deriving (Eq,Ord,Show,Read)
data Attention
= AttentiveTo {_getAttentiveTo :: IM.IntMap Awareness }
| Fixated {_getFixated :: Int }
deriving (Eq,Ord,Show,Read)
data Awareness
= Suspicious Float
| Cognizant Float
deriving (Eq,Ord)
deriving (Eq,Ord,Show,Read)
makeLenses ''Attention
makeLenses ''Perception
src/Dodge/Creature/Picture.hs
+4 -13
View File
@@ -9,7 +9,10 @@ module Dodge.Creature.Picture
, picAtCrPos
, shapeAtCrPos
, picAtCrPosNoRot
, basicCrCorpse
-- , basicCrCorpse
, deadScalp
, deadUpperBody
, deadFeet
) where
import Dodge.Data
import Dodge.Creature.HandPos (translateToRightHand,translateToLeftHand)
@@ -230,15 +233,3 @@ picAtCrPosNoRot :: Picture -> Creature -> SPic
--{-# INLINE picAtCrPos #-}
picAtCrPosNoRot thePic cr = (,) emptySH $ uncurryV translate (_crPos cr) thePic
basicCrCorpse :: Creature -> Corpse -> SPic
basicCrCorpse cr cp = noPic . tr . scaleSH (V3 crsize crsize crsize) $ mconcat
[ rotdir . colorSH (_skinHead cskin) $ deadScalp cr
, rotdir $ colorSH (_skinUpper cskin) $ deadUpperBody cr
, rotdir . rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
]
where
cskin = _crType cr -- this should be fixed
crsize = 0.1 * _crRad cr
tr = uncurryV translateSHf (_cpPos cp)
rotdir = rotateSH (_cpDir cp)
rotmdir = rotateSH (_crMvDir cr - _crDir cr)
src/Dodge/Creature/Stance/Data.hs
+7 -6
View File
@@ -10,7 +10,8 @@ data Stance = Stance
,_posture :: Posture
,_strideLength :: Int
}
deriving (Eq,Show)
deriving (Eq,Ord,Show,Read)
data Carriage
= Walking
{ _strideAmount :: Int
@@ -20,18 +21,18 @@ data Carriage
| Floating
| Flying
| Boosting Point2
deriving (Eq,Show)
deriving (Eq,Ord,Show,Read)
data FootForward
= LeftForward
| RightForward
| WasLeftForward
| WasRightForward
deriving
(Eq,Ord,Show)
deriving (Eq,Ord,Show,Read)
data Posture = Aiming
| AtEase
deriving
(Eq,Ord,Show)
deriving (Eq,Ord,Show,Read)
makeLenses ''Stance
makeLenses ''Carriage
src/Dodge/Creature/State.hs
+4 -9
View File
@@ -2,6 +2,7 @@ module Dodge.Creature.State
( stateUpdate
, doDamage
) where
import Dodge.Corpse.Make
import Dodge.Data
import Dodge.Targeting
import Dodge.ItEffect
@@ -71,9 +72,9 @@ checkDeath cr w
| otherwise = creatures . at (_crID cr) .~ Nothing
corpseOrGib :: Creature -> World -> World
corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
Just (FLAMING,_) -> w & plNew corpses cpID (thecorpse & cpPict %~ fmap scorchSPic)
Just (FLAMING,_) -> w & plNew corpses cpID (thecorpse & cpSPic %~ scorchSPic)
Just (ELECTRICAL,_) -> w & plNew corpses cpID thecorpse
Just (POISONDAM,_) -> w & plNew corpses cpID (thecorpse & cpPict %~ fmap poisonSPic)
Just (POISONDAM,_) -> w & plNew corpses cpID (thecorpse & cpSPic %~ poisonSPic)
_ | _crPastDamage cr > 200 -> w & addCrGibs cr
& bloodPuddleAt cpos
& bloodPuddleAt cpos
@@ -84,13 +85,7 @@ corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
& plNew corpses cpID thecorpse
where
cpos = _crPos cr
thecorpse = Corpse
{ _cpID = 0
, _cpPos = _crPos cr
, _cpDir = _crDir cr
, _cpPict = _crCorpse cr cr
, _cpRes = Nothing
}
thecorpse = makeDefaultCorpse cr
scorchSPic :: SPic -> SPic
scorchSPic = over _1 $
src/Dodge/Creature/State/Data.hs
+4 -3
View File
@@ -12,10 +12,11 @@ data CreatureDropType
= DropAll
| DropAmount Int
| DropSpecific [Int]
deriving (Eq,Ord,Show,Read)
data CrSpState
= Barrel { _piercedPoints :: [Point2]}
| GenCr
deriving (Eq,Show,Ord)
deriving (Eq,Ord,Show,Read)
data Faction
= GenericFaction Int
| ZombieFaction
@@ -25,7 +26,7 @@ data Faction
| NoFaction
| ColorFaction Color
| PlayerFaction
deriving (Eq,Show)
deriving (Eq,Ord,Show,Read)
data CrGroup
= LoneWolf
| Swarm
@@ -34,5 +35,5 @@ data CrGroup
}
| CrGroupID { _crGroupID :: Int }
| ShieldGroup
deriving (Eq, Show)
deriving (Eq,Ord,Show,Read)
makeLenses ''CrSpState
src/Dodge/Creature/SwarmCrit.hs
+1 -2
View File
@@ -3,7 +3,6 @@ module Dodge.Creature.SwarmCrit
) where
import Dodge.Data
import Dodge.Default
import Dodge.Creature.Picture
import Picture
import Control.Lens
@@ -13,7 +12,7 @@ swarmCrit = defaultCreature
{ _crHP = 1
, _crRad = 2
, _crMass = 2
, _crCorpse = basicCrCorpse
, _crCorpse = MakeDefaultCorpse
, _crFaction = ColorFaction yellow
, _crMeleeCooldown = 0
}
src/Dodge/Creature/Test.hs
+3 -2
View File
@@ -27,7 +27,7 @@ module Dodge.Creature.Test
import Dodge.Data
import Dodge.Base.Collide
import Geometry
import SameConstr
--import SameConstr
import Data.List (find)
import Data.Maybe
@@ -64,7 +64,8 @@ crSafeDistFromTarg d cr = case cr ^? crIntention . targetCr . _Just of
Nothing -> True
crStratConMatches :: Strategy -> Creature -> Bool
crStratConMatches strat cr = eqConstr strat (_apStrategy $ _crActionPlan cr)
crStratConMatches strat cr = strat == (_apStrategy $ _crActionPlan cr)
-- this equality check might be slow...
crAwayFromPost :: Creature -> Bool
crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
src/Dodge/Data.hs
+2
View File
@@ -10,6 +10,7 @@ circular imports are probably not a good idea.
{-# LANGUAGE DerivingStrategies #-}
module Dodge.Data
( module Dodge.Data
, module Dodge.Data.Corpse
, module Dodge.Data.ActionPlan
, module Dodge.Data.CreatureEffect
, module Dodge.Data.WorldEffect
@@ -72,6 +73,7 @@ module Dodge.Data
, module Dodge.Data.RadarBlip
, module Dodge.Data.PathGraph
) where
import Dodge.Data.Corpse
import Dodge.Data.ActionPlan
import Dodge.Data.CreatureEffect
import Dodge.Data.WorldEffect
src/Dodge/Data/ActionPlan.hs
+131 -127
View File
@@ -19,13 +19,17 @@ data ActionPlan
,_apStrategy :: Strategy
,_apGoal :: [Goal]
}
newtype RandImpulse = RandImpulseList [Impulse]
deriving (Eq,Ord,Show,Read)
data RandImpulse
= RandImpulseList [Impulse]
| RandImpulseCircMove Float
deriving (Eq,Ord,Show,Read)
data Impulse
= Move Point2
| MoveForward Float
| Turn Float
| RandomTurn Float
| RandomImpulse (State StdGen Impulse)
| RandomImpulse RandImpulse -- (State StdGen Impulse)
| TurnToward Point2 Float
| MvTurnToward Point2
| MvForward
@@ -52,34 +56,34 @@ data Impulse
{_impulseUseAheadPos :: P2Imp
}
| ImpulseNothing
instance Show Impulse where
show imp = case imp of
Move p -> "Move "++shortPoint2 p
MoveForward f -> "MoveForward "++ show f
Turn f -> "Turn "++show f
RandomTurn f -> "RandomTurn "++show f
TurnToward p f -> "TurnToward "++shortPoint2 p++show f
MvTurnToward p -> "MvTurnToward "++shortPoint2 p
MvForward -> "MvForward"
TurnTo p -> "TurnTo "++shortPoint2 p
UseItem -> "UseItem"
SwitchToItem i -> "SwitchToItem "++show i
DropItem -> "DropItem"
Bark sid -> "Bark "++show sid
Melee i -> "Melee "++show i
ChangePosture post -> "ChangePosture " ++ show post
MakeSound sid -> "MakeSound " ++ show sid
ChangeStrategy s -> "ChangeStrategy " ++ show s
AddGoal g -> "AddGoal " ++ show g
ArbitraryImpulseFunction {} -> "ArbitraryImpulseFunction"
ArbitraryImpulse {} -> "ArbitraryImpulse"
ArbitraryImpulseEffect {} -> "ArbitraryImpulseEffect"
ImpulseUseTargetCID {} -> "ImpulseUseTargetCID"
ImpulseUseTarget {} -> "ImpulseUseTarget"
ImpulseUseAheadPos {} -> "ImpulseUseAheadPos"
RandomImpulse {} -> "RandomImpulse"
ImpulseNothing -> "ImpulseNothing"
-- deriving (Eq,Ord,Show)
deriving (Eq,Ord,Show,Read)
--instance Show Impulse where
-- show imp = case imp of
-- Move p -> "Move "++shortPoint2 p
-- MoveForward f -> "MoveForward "++ show f
-- Turn f -> "Turn "++show f
-- RandomTurn f -> "RandomTurn "++show f
-- TurnToward p f -> "TurnToward "++shortPoint2 p++show f
-- MvTurnToward p -> "MvTurnToward "++shortPoint2 p
-- MvForward -> "MvForward"
-- TurnTo p -> "TurnTo "++shortPoint2 p
-- UseItem -> "UseItem"
-- SwitchToItem i -> "SwitchToItem "++show i
-- DropItem -> "DropItem"
-- Bark sid -> "Bark "++show sid
-- Melee i -> "Melee "++show i
-- ChangePosture post -> "ChangePosture " ++ show post
-- MakeSound sid -> "MakeSound " ++ show sid
-- ChangeStrategy s -> "ChangeStrategy " ++ show s
-- AddGoal g -> "AddGoal " ++ show g
-- ArbitraryImpulseFunction {} -> "ArbitraryImpulseFunction"
-- ArbitraryImpulse {} -> "ArbitraryImpulse"
-- ArbitraryImpulseEffect {} -> "ArbitraryImpulseEffect"
-- ImpulseUseTargetCID {} -> "ImpulseUseTargetCID"
-- ImpulseUseTarget {} -> "ImpulseUseTarget"
-- ImpulseUseAheadPos {} -> "ImpulseUseAheadPos"
-- RandomImpulse {} -> "RandomImpulse"
-- ImpulseNothing -> "ImpulseNothing"
infixr 9 `WaitThen`
infixr 9 `DoActionThen`
infixr 9 `DoActionWhile`
@@ -180,101 +184,101 @@ data Action
{_sideImpulses :: [Impulse]
,_mainAction :: Action
}
deriving (Generic)
instance Show Action where
show act = case act of
ActionNothing -> "ActionNothing"
LabelAction
{_actLabel = str
,_actAction = subAct
} -> str++":"++show subAct
AimAt
{_targetID = tid
,_targetSeenAt = p
} -> "AimAt tid:"++show tid++" seenAt:"++shortPoint2 p
PathTo
{_pathToPoint = p
} -> "PathTo:"++shortPoint2 p
TurnToPoint
{_turnToPoint = p
} -> "TurnToPoint:"++shortPoint2 p
---- | PickupItem
---- {_pickupItemID :: Int
---- }
ImpulsesList
{_impulsesListList = iss
} -> "ImpulsesList:"++show iss
DoImpulses
{_doImpulsesList = is
} -> "DoImpulses:"++show is
WaitThen
{_waitThenTimer = i
,_waitThenAction = a
} -> "WaitThen timer:"++show i++" act:"++show a
DoActionWhile
{_doActionWhileCondition = _
,_doActionWhileAction = a
} -> "DoActionWhile (function) act:"++show a
DoActionWhilePartial
{_doActionWhilePartial = partact
,_doActionWhileCondition = _
,_doActionWhileAction = a
} -> "DoActionWhilePartial partAct:"++show partact++" resetAct:"++show a
DoActionIf
{_doActionIfCondition = _
,_doActionIfAction = a
} -> "DoActionIf act:"++show a
DoActionIfElse
{_doActionIfElseIfAction = ifa
,_doActionIfElseCondition = _
,_doActionIfElseElseAction = elsea
} -> "DoActionIfElse ifa:"++show ifa++" elsea:"++show elsea
DoActionWhileInterrupt
{_doActionWhileThenDo = whilea
,_doActionWhileThenCondition = _
,_doActionWhileThenThen = thena
} -> "DoActionWhileInterrupt whilea:" ++show whilea++" interrupta:"++show thena
DoActions
{_doActionsList = as
} -> "DoActions " ++ foldMap show as
DoActionThen
{_doActionThenFirst = a1
,_doActionThenSecond = a2
} -> "DoActionThen " ++ show a1 ++ " then:" ++ show a2
---- | DoGuardActions
---- {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)]
---- }
DoReplicate
{_doReplicateTimes = i
,_doReplicateAction = a
} -> "DoReplicate times:" ++ show i ++ " act:"++ show a
DoReplicatePartial
{_partialAction = pa
,_doReplicateTimes = i
,_doReplicateAction = ra
} -> "DoReplicatePartial pa:" ++ show pa ++ " times:" ++ show i ++ " reset:"++ show ra
LeadTarget
{_leadTargetBy = p
} -> "LeadTarget by:"++ show p
NoAction -> "NoAction"
StartSentinelPost -> "StartSentinelPost"
UseTarget
{_useTarget = _
} -> "UseTarget func"
UseSelf
{_useSelf = _
} -> "UseSelf func"
UseAheadPos
{_useAheadPos = _
} -> "UseAheadPos func"
UseMvTargetPos
{_useMvTargetPos = _
} -> "UseMvTargetPos func"
ArbitraryAction {} -> "ArbitraryAction func"
DoImpulsesAlongside
{_sideImpulses = is
,_mainAction = a
} -> "DoImpulsesAlongside sideImpulses:"++show is ++ " mainA:"++show a
deriving (Eq,Ord,Show,Read)
--instance Show Action where
-- show act = case act of
-- ActionNothing -> "ActionNothing"
-- LabelAction
-- {_actLabel = str
-- ,_actAction = subAct
-- } -> str++":"++show subAct
-- AimAt
-- {_targetID = tid
-- ,_targetSeenAt = p
-- } -> "AimAt tid:"++show tid++" seenAt:"++shortPoint2 p
-- PathTo
-- {_pathToPoint = p
-- } -> "PathTo:"++shortPoint2 p
-- TurnToPoint
-- {_turnToPoint = p
-- } -> "TurnToPoint:"++shortPoint2 p
------ | PickupItem
------ {_pickupItemID :: Int
------ }
-- ImpulsesList
-- {_impulsesListList = iss
-- } -> "ImpulsesList:"++show iss
-- DoImpulses
-- {_doImpulsesList = is
-- } -> "DoImpulses:"++show is
-- WaitThen
-- {_waitThenTimer = i
-- ,_waitThenAction = a
-- } -> "WaitThen timer:"++show i++" act:"++show a
-- DoActionWhile
-- {_doActionWhileCondition = _
-- ,_doActionWhileAction = a
-- } -> "DoActionWhile (function) act:"++show a
-- DoActionWhilePartial
-- {_doActionWhilePartial = partact
-- ,_doActionWhileCondition = _
-- ,_doActionWhileAction = a
-- } -> "DoActionWhilePartial partAct:"++show partact++" resetAct:"++show a
-- DoActionIf
-- {_doActionIfCondition = _
-- ,_doActionIfAction = a
-- } -> "DoActionIf act:"++show a
-- DoActionIfElse
-- {_doActionIfElseIfAction = ifa
-- ,_doActionIfElseCondition = _
-- ,_doActionIfElseElseAction = elsea
-- } -> "DoActionIfElse ifa:"++show ifa++" elsea:"++show elsea
-- DoActionWhileInterrupt
-- {_doActionWhileThenDo = whilea
-- ,_doActionWhileThenCondition = _
-- ,_doActionWhileThenThen = thena
-- } -> "DoActionWhileInterrupt whilea:" ++show whilea++" interrupta:"++show thena
-- DoActions
-- {_doActionsList = as
-- } -> "DoActions " ++ foldMap show as
-- DoActionThen
-- {_doActionThenFirst = a1
-- ,_doActionThenSecond = a2
-- } -> "DoActionThen " ++ show a1 ++ " then:" ++ show a2
------ | DoGuardActions
------ {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)]
------ }
-- DoReplicate
-- {_doReplicateTimes = i
-- ,_doReplicateAction = a
-- } -> "DoReplicate times:" ++ show i ++ " act:"++ show a
-- DoReplicatePartial
-- {_partialAction = pa
-- ,_doReplicateTimes = i
-- ,_doReplicateAction = ra
-- } -> "DoReplicatePartial pa:" ++ show pa ++ " times:" ++ show i ++ " reset:"++ show ra
-- LeadTarget
-- {_leadTargetBy = p
-- } -> "LeadTarget by:"++ show p
-- NoAction -> "NoAction"
-- StartSentinelPost -> "StartSentinelPost"
-- UseTarget
-- {_useTarget = _
-- } -> "UseTarget func"
-- UseSelf
-- {_useSelf = _
-- } -> "UseSelf func"
-- UseAheadPos
-- {_useAheadPos = _
-- } -> "UseAheadPos func"
-- UseMvTargetPos
-- {_useMvTargetPos = _
-- } -> "UseMvTargetPos func"
-- ArbitraryAction {} -> "ArbitraryAction func"
-- DoImpulsesAlongside
-- {_sideImpulses = is
-- ,_mainAction = a
-- } -> "DoImpulsesAlongside sideImpulses:"++show is ++ " mainA:"++show a
-- deriving (Eq,Ord,Show)
data Strategy
@@ -293,13 +297,13 @@ data Strategy
| Reload
| Flee
| MeleeStrike
deriving (Generic,Show)
deriving (Eq,Ord,Show,Read)
-- deriving (Eq,Ord,Show)
data Goal
= LiveLongAndProsper
| Kill Int
| SentinelAt Point2 Float
deriving (Show)
deriving (Eq,Ord,Show,Read)
makeLenses ''ActionPlan
makeLenses ''Impulse
makeLenses ''Action
src/Dodge/Data/Ammo.hs
+1 -1
View File
@@ -41,6 +41,6 @@ data AmmoType
{ _amForceFieldType :: Wall
}
| GenericAmmo
deriving (Show,Read)
deriving (Eq,Ord,Show,Read)
makeLenses ''ProjectileUpdate
makeLenses ''AmmoType
src/Dodge/Data/Corpse.hs
+18
View File
@@ -0,0 +1,18 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Data.Corpse where
import ShapePicture.Data
import Geometry.Data
import Control.Lens
data CorpseResurrection = NoResurrection
data Corpse = Corpse
{ _cpID :: Int
, _cpPos :: Point2
, _cpDir :: Float
, _cpSPic :: SPic
, _cpRes :: CorpseResurrection
}
makeLenses ''Corpse
src/Dodge/Data/Creature.hs
+5 -9
View File
@@ -45,7 +45,7 @@ data Creature = Creature
, _crEquipment :: M.Map EquipPosition Int
, _crLeftInvSel :: Maybe Int
, _crState :: CreatureState
, _crCorpse :: Creature -> Corpse -> SPic
, _crCorpse :: CreatureCorpse --Creature -> Corpse -> SPic
, _crMaterial :: Material
, _crPastDamage :: Int
, _crStance :: Stance
@@ -63,18 +63,14 @@ data Creature = Creature
, _crStatistics :: CreatureStatistics
, _crCamouflage :: CamouflageStatus
}
data Corpse = Corpse
{ _cpID :: Int
, _cpPos :: Point2
, _cpDir :: Float
, _cpPict :: Corpse -> SPic
, _cpRes :: Maybe Creature
}
deriving (Eq,Ord,Show,Read)
data CreatureCorpse = MakeDefaultCorpse
deriving (Eq,Ord,Show,Read)
data Intention = Intention
{ _targetCr :: Maybe Creature
, _mvToPoint :: Maybe Point2
, _viewPoint :: Maybe Point2
}
deriving (Eq,Ord,Show,Read)
makeLenses ''Creature
makeLenses ''Intention
makeLenses ''Corpse
src/Dodge/Data/Creature/Misc.hs
+16 -4
View File
@@ -4,17 +4,20 @@ module Dodge.Data.Creature.Misc
( module Dodge.Data.Creature.Misc
, module Dodge.Data.CamouflageStatus
) where
import Dodge.Data.FloatFunction
import Dodge.Data.CamouflageStatus
import Sound.Data
import Geometry.Data
import Color
import Control.Lens
data CreatureStatistics = CreatureStatistics
{ _strength :: Int
, _dexterity :: Int
, _intelligence :: Int
}
deriving (Eq,Ord,Show)
deriving (Eq,Ord,Show,Read)
data Vocalization
= Mute
| Vocalization
@@ -23,19 +26,24 @@ data Vocalization
,_vcMaxCoolDown :: Int
,_vcCoolDown :: Int
}
deriving (Eq,Ord,Show)
deriving (Eq,Ord,Show,Read)
data CrMvType
= NoMvType
| MvWalking { _mvSpeed :: Float }
| CrMvType
{ _mvSpeed :: Float
, _mvTurnRad :: Float -> Float
, _mvTurnRad :: FloatFloat
, _mvTurnJit :: Float
, _mvAimSpeed :: Float -> Float
, _mvAimSpeed :: FloatFloat
}
deriving (Eq,Ord,Show,Read)
data HumanoidAI = YourAI | ChaseAI | InanimateAI | SpreadGunAI | PistolAI
| LtAutoAI | LauncherAI | SwarmAI | AutoAI | FlockArmourChaseAI | MiniGunAI
| LongAI | MultGunAI
deriving (Eq,Ord,Show,Read)
data CreatureType
= Humanoid
{ _skinHead :: Color
@@ -47,7 +55,11 @@ data CreatureType
| Lampoid {_lampHeight :: Float, _lampColor :: Point3, _lampLSID :: Maybe Int}
| Turretoid
| NonDrawnCreature
deriving (Eq,Ord,Show,Read)
data BarrelType = PlainBarrel | ExplosiveBarrel
deriving (Eq,Ord,Show,Read)
makeLenses ''CreatureStatistics
makeLenses ''Vocalization
makeLenses ''CrMvType
src/Dodge/Data/Creature/State.hs
+1
View File
@@ -10,4 +10,5 @@ data CreatureState = CrSt
, _csSpState :: CrSpState
, _csDropsOnDeath :: CreatureDropType
}
deriving (Eq,Ord,Show,Read)
makeLenses ''CreatureState
src/Dodge/Data/CreatureEffect.hs
+13
View File
@@ -1,37 +1,50 @@
module Dodge.Data.CreatureEffect where
data WdCrCr = NoCreatureEffect
deriving (Eq,Ord,Show,Read)
data CrWdImp = NoCrWdImp
deriving (Eq,Ord,Show,Read)
data CrWdWd = CrWdWdId
deriving (Eq,Ord,Show,Read)
data IntImp = NoIntImp
deriving (Eq,Ord,Show,Read)
data CrImp = NoCrImp
| TurnTowardCr Float -- turn amount
deriving (Eq,Ord,Show,Read)
data P2Imp = P2ImpNo
deriving (Eq,Ord,Show,Read)
data WdCrBl = WdCrTrue
| WdCrBlfromCrBl CrBl
| WdCrNegate WdCrBl
| WdCrLOSTarget
| WdCrSafeDistFromTarget Float
deriving (Eq,Ord,Show,Read)
data CrBl = CrCanShoot
| CrIsReloading
| CrIsAiming
deriving (Eq,Ord,Show,Read)
data MCrAc = MCrNoAction
deriving (Eq,Ord,Show,Read)
data CrAc = CrTurnAround
| CrFleeFromTarget
deriving (Eq,Ord,Show,Read)
data P2Ac = P2NoAction
deriving (Eq,Ord,Show,Read)
data MP2Ac = MP2NoAction
deriving (Eq,Ord,Show,Read)
data CrWdAc = CrWdBFSThenReturn Int
| ChooseMovementSpreadGun
| ChooseMovementLtAuto
deriving (Eq,Ord,Show,Read)
src/Dodge/Data/FloatFunction.hs
+8
View File
@@ -0,0 +1,8 @@
module Dodge.Data.FloatFunction where
data FloatFloat = FloatID
| FloatFOV Float
| FloatLessCheck Float
| FloatAbsCheckGreaterLess Float Float Float
| FloatConst Float
deriving (Eq,Ord,Show,Read)
src/Dodge/Data/Item.hs
+1 -1
View File
@@ -40,7 +40,7 @@ data Item = Item
, _itValue :: ItemValue
, _itParams :: ItemParams
}
deriving (Show,Read)
deriving (Eq,Ord,Show,Read)
data ItemTweaks
= NoTweaks
| Tweakable
src/Dodge/Data/Item/Consumption.hs
+1 -1
View File
@@ -28,5 +28,5 @@ data ItemConsumption
{ _icAmount :: IcAmount
}
| NoConsumption
deriving (Show,Read)
deriving (Eq,Ord,Show,Read)
makeLenses ''ItemConsumption
src/Dodge/Data/LoadAction.hs
+1
View File
@@ -11,6 +11,7 @@ data LoadAction
| LoadPrime {_actionTime :: Int, _actionSound :: SoundID}
deriving (Eq,Ord,Show,Read)
data InvSel = InvSel {_iselPos :: Int, _iselAction :: InvSelAction }
deriving (Eq,Ord,Show,Read)
data InvSelAction
= NoInvSelAction
| ReloadAction { _actionProgress :: Int, _reloadAction :: LoadAction, _actionHammer :: HammerType}
src/Dodge/Default/Creature.hs
+9 -17
View File
@@ -1,6 +1,6 @@
module Dodge.Default.Creature where
import Dodge.Data
import Dodge.Creature.Picture
import Dodge.Data.FloatFunction
import Geometry.Data
import Picture
@@ -30,7 +30,7 @@ defaultCreature = Creature
, _crInvEquipped = mempty
, _crLeftInvSel = Nothing
, _crState = defaultState
, _crCorpse = basicCrCorpse
, _crCorpse = MakeDefaultCorpse
, _crMaterial = Flesh
, _crPastDamage = 0
, _crEquipment = M.empty
@@ -78,17 +78,12 @@ defaultPerceptionState = Perception
}
defaultVision :: Vision
defaultVision = Eyes
{ _viFOV = f
, _viDist = g
{ _viFOV = FloatFOV 0.5
, _viDist = FloatLessCheck 500
}
where
f x | abs x < 0.5 * pi = 1
| otherwise = 0
g x | x > 500 = 0
| otherwise = 1
defaultAudition :: Audition
defaultAudition = Ears
{ _auDist = id
{ _auDist = FloatID
}
defaultIntention :: Intention
defaultIntention = Intention
@@ -99,9 +94,9 @@ defaultIntention = Intention
defaultChaseMvType :: CrMvType
defaultChaseMvType = CrMvType
{ _mvSpeed = 2
, _mvTurnRad = f
, _mvTurnRad = FloatAbsCheckGreaterLess (pi/4) 0.2 0.05--f
, _mvTurnJit = 0.2
, _mvAimSpeed = g
, _mvAimSpeed = FloatAbsCheckGreaterLess (pi/8) 0.2 0.01
}
where
g x | x > pi/8 = 0.2
@@ -111,13 +106,10 @@ defaultChaseMvType = CrMvType
defaultAimMvType :: CrMvType
defaultAimMvType = CrMvType
{ _mvSpeed = 3
, _mvTurnRad = const 0.2
, _mvTurnRad = FloatConst 0.2
, _mvTurnJit = 0.05
, _mvAimSpeed = f
, _mvAimSpeed = FloatAbsCheckGreaterLess (pi/8) 0.2 0.01
}
where
f x | x > pi/8 = 0.2
| otherwise = 0.01
defaultAimingCrit :: Creature
defaultAimingCrit = defaultCreature { _crMvType = defaultAimMvType }
src/Dodge/Equipment/Data.hs
+1 -1
View File
@@ -15,4 +15,4 @@ data EquipPosition
| OnRightWrist
| OnLegs
| OnSpecial
deriving (Eq,Ord,Show)
deriving (Eq,Ord,Show,Read)
src/Dodge/FloatFunction.hs
+16
View File
@@ -0,0 +1,16 @@
module Dodge.FloatFunction where
import Dodge.Data.FloatFunction
doFloatFloat :: FloatFloat -> Float -> Float
doFloatFloat ff x = case ff of
FloatID -> x
FloatConst y -> y
FloatFOV a
| abs x < 0.5 * a -> 1
| otherwise -> 0
FloatLessCheck y
| x > y -> 0
| otherwise -> 1
FloatAbsCheckGreaterLess a y1 y2
| abs x > a -> y1
| otherwise -> y2
src/Dodge/RandImpulse.hs
+9
View File
@@ -0,0 +1,9 @@
module Dodge.RandImpulse where
import Dodge.Data.ActionPlan
import Control.Monad.State
import RandomHelp
doRandImpulse :: RandImpulse -> State StdGen Impulse
doRandImpulse ri = case ri of
RandImpulseList xs -> takeOne xs
RandImpulseCircMove r -> Move <$> randInCirc r
src/Dodge/Render/ShapePicture.hs
+6 -1
View File
@@ -61,7 +61,7 @@ worldSPic cfig w
<> foldup drawProjectile (filtOn _prjPos _projectiles)
<> foldup (shiftDraw _blPos _blDir _blDraw) (filtOn _blPos _blocks)
<> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes)
<> foldup (dbArg _cpPict) (filtOn _cpPos _corpses)
<> foldup (shiftDraw' _cpPos _cpDir _cpSPic) (filtOn _cpPos _corpses)
<> foldup drawCreature (filtOn _crPos _creatures)
<> foldup floorItemSPic (filtOn _flItPos _floorItems)
<> foldup btSPic (filtOn _btPos _buttons)
@@ -112,6 +112,11 @@ shiftDraw fpos fdir fdraw x = uncurryV translateSPf (fpos x)
. rotateSP (fdir x)
$ fdraw x x
shiftDraw' :: (a -> Point2) -> (a -> Float) -> (a -> SPic) -> a -> SPic
shiftDraw' fpos fdir fdraw x = uncurryV translateSPf (fpos x)
. rotateSP (fdir x)
$ fdraw x
cullPoint :: Configuration -> World -> Point2 -> Bool
cullPoint cfig w p
| debugOn Close_shape_culling cfig = pointInPolygon p (_boundBox w)
src/ShapePicture.hs
+3 -4
View File
@@ -1,11 +1,10 @@
{-# LANGUAGE TupleSections #-}
module ShapePicture
( --emptyBlank
translateSP
( module ShapePicture.Data
, translateSP
, translateSPf
, translateSPz
, rotateSP
, SPic
, noPic
, noShape
-- , _spShape
@@ -14,6 +13,7 @@ module ShapePicture
, mirrorSPxz
, overPosSP
) where
import ShapePicture.Data
import Shape
import Picture
import Geometry
@@ -22,7 +22,6 @@ import Data.Bifunctor
import Control.Lens
--import qualified Streaming.Prelude as S
type SPic = (Shape, Picture)
shMap :: (ShapeObj -> ShapeObj) -> Shape -> Shape
shMap = map
src/ShapePicture/Data.hs
+4
View File
@@ -0,0 +1,4 @@
module ShapePicture.Data where
import Picture.Data
import Shape.Data
type SPic = (Shape, Picture)