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

Cleanup

Browse Source
This commit is contained in:
justin
2022-07-14 21:32:19 +01:00
parent 893a3d5f17
commit 7d7ed6689d
10 changed files with 173 additions and 188 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Default.hs
+2 -133
View File
@@ -10,154 +10,23 @@ module Dodge.Default
, module Dodge.Default.LightSource
, module Dodge.Default.Weapon
, module Dodge.Default.Wall
, module Dodge.Default.Creature
) where
import Dodge.Default.Wall
import Dodge.Default.Creature
import Dodge.Default.Weapon
import Dodge.Default.LightSource
import Dodge.Default.Item
import Dodge.Data
import Dodge.SoundLogic
import Dodge.Creature.Damage
import Dodge.Creature.Picture
import Geometry
import Picture
import ShapePicture
import Shape
import Control.Lens
import qualified Data.IntMap.Strict as IM
import qualified Data.Text as T
import qualified Data.Map.Strict as M
--import qualified Data.Vector as V
--import Data.Monoid
defaultCreature :: Creature
defaultCreature = Creature
{ _crPos = V2 0 0
, _crOldPos = V2 0 0
, _crVel = V2 0 0
, _crDir = 0
, _crOldDir = 0
, _crMvDir = 0
, _crTwist = 0
, _crID = 1
-- , _crPict = basicCrPict
, _crType = defaultCreatureSkin
, _crUpdate = const id
, _crRad = 10
, _crMass = 10
, _crHP = 100
, _crMaxHP = 150
, _crInv = IM.empty
, _crInvSel = InvSel 0 NoInvSelAction
, _crInvCapacity = 25
, _crInvLock = False
, _crInvEquipped = mempty
, _crLeftInvSel = Nothing
, _crState = defaultState
, _crCorpse = basicCrCorpse
, _crApplyDamage = defaultApplyDamage
, _crPastDamage = 0
, _crEquipment = M.empty
, _crStance = Stance
{_carriage=Walking 0 WasLeftForward
,_posture=AtEase
,_strideLength = yourDefaultStrideLength
}
, _crVocalization = Mute
, _crActionPlan = ActionPlan [] [] (StrategyActions WatchAndWait [StartSentinelPost]) [LiveLongAndProsper]
, _crPerception = defaultPerceptionState
, _crMemory = defaultCreatureMemory
, _crMeleeCooldown = 0
, _crFaction = NoFaction
, _crIntention = defaultIntention
, _crGroup = LoneWolf
, _crMvType = defaultAimMvType
, _crHammerPosition = HammerUp
, _crName = "DEFAULTCRNAME"
, _crStatistics = CreatureStatistics 10 10 10
, _crCamouflage = FullyVisible
}
defaultCreatureSkin :: CreatureType
defaultCreatureSkin = Humanoid (greyN 0.9) (light4 green) (greyN 0.3)
defaultInanimate :: Creature
defaultInanimate = defaultCreature & crActionPlan .~ Inanimate
defaultCreatureMemory :: Memory
defaultCreatureMemory = Memory
{ _soundsToInvestigate = []
, _nodesSearched = []
}
defaultInvSize :: Int
defaultInvSize = 20
defaultPerceptionState :: Perception
defaultPerceptionState = Perception
{ _cpVigilance = Lethargic
, _cpAttention = AttentiveTo IM.empty
, _cpAwareness = IM.empty
, _cpVision = defaultVision
, _cpAudition = defaultAudition
}
defaultVision :: Vision
defaultVision = Eyes
{ _viFOV = f
, _viDist = g
}
where
f x | abs x < 0.5 * pi = 1
| otherwise = 0
g x | x > 500 = 0
| otherwise = 1
defaultAudition :: Audition
defaultAudition = Ears
{ _auDist = id
}
defaultIntention :: Intention
defaultIntention = Intention
{ _targetCr = Nothing
, _mvToPoint = Nothing
, _viewPoint = Nothing
}
defaultChaseMvType :: CrMvType
defaultChaseMvType = CrMvType
{ _mvSpeed = 2
, _mvTurnRad = f
, _mvTurnJit = 0.2
, _mvAimSpeed = g
}
where
g x | x > pi/8 = 0.2
| otherwise = 0.01
f x | x > pi / 4 = 0.2
| otherwise = 0.05
defaultAimMvType :: CrMvType
defaultAimMvType = CrMvType
{ _mvSpeed = 3
, _mvTurnRad = const 0.2
, _mvTurnJit = 0.05
, _mvAimSpeed = f
}
where
f x | x > pi/8 = 0.2
| otherwise = 0.01
defaultAimingCrit :: Creature
defaultAimingCrit = defaultCreature { _crMvType = defaultAimMvType }
yourDefaultSpeed :: Float
yourDefaultSpeed = 3
yourDefaultStrideLength :: Int
yourDefaultStrideLength = 40
defaultState :: CreatureState
defaultState = CrSt
{ _csDamage = []
-- , _crPastDamage = V.fromList $ replicate 20 []
, _csSpState = GenCr
, _csDropsOnDeath = DropAll
}
defaultEquipment :: Item
defaultEquipment = defaultItem
src/Dodge/Default/Creature.hs
+139
View File
@@ -0,0 +1,139 @@
module Dodge.Default.Creature where
import Dodge.Data
import Dodge.Creature.Picture
import Dodge.Creature.Damage
import Geometry.Data
import Picture
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
import Control.Lens
defaultCreature :: Creature
defaultCreature = Creature
{ _crPos = V2 0 0
, _crOldPos = V2 0 0
, _crVel = V2 0 0
, _crDir = 0
, _crOldDir = 0
, _crMvDir = 0
, _crTwist = 0
, _crID = 1
-- , _crPict = basicCrPict
, _crType = defaultCreatureSkin
, _crUpdate = const id
, _crRad = 10
, _crMass = 10
, _crHP = 100
, _crMaxHP = 150
, _crInv = IM.empty
, _crInvSel = InvSel 0 NoInvSelAction
, _crInvCapacity = 25
, _crInvLock = False
, _crInvEquipped = mempty
, _crLeftInvSel = Nothing
, _crState = defaultState
, _crCorpse = basicCrCorpse
, _crApplyDamage = defaultApplyDamage
, _crPastDamage = 0
, _crEquipment = M.empty
, _crStance = Stance
{_carriage=Walking 0 WasLeftForward
,_posture=AtEase
,_strideLength = yourDefaultStrideLength
}
, _crVocalization = Mute
, _crActionPlan = ActionPlan [] [] (StrategyActions WatchAndWait [StartSentinelPost]) [LiveLongAndProsper]
, _crPerception = defaultPerceptionState
, _crMemory = defaultCreatureMemory
, _crMeleeCooldown = 0
, _crFaction = NoFaction
, _crIntention = defaultIntention
, _crGroup = LoneWolf
, _crMvType = defaultAimMvType
, _crHammerPosition = HammerUp
, _crName = "DEFAULTCRNAME"
, _crStatistics = CreatureStatistics 10 10 10
, _crCamouflage = FullyVisible
}
defaultCreatureSkin :: CreatureType
defaultCreatureSkin = Humanoid (greyN 0.9) (light4 green) (greyN 0.3)
defaultInanimate :: Creature
defaultInanimate = defaultCreature & crActionPlan .~ Inanimate
defaultCreatureMemory :: Memory
defaultCreatureMemory = Memory
{ _soundsToInvestigate = []
, _nodesSearched = []
}
defaultInvSize :: Int
defaultInvSize = 20
defaultPerceptionState :: Perception
defaultPerceptionState = Perception
{ _cpVigilance = Lethargic
, _cpAttention = AttentiveTo IM.empty
, _cpAwareness = IM.empty
, _cpVision = defaultVision
, _cpAudition = defaultAudition
}
defaultVision :: Vision
defaultVision = Eyes
{ _viFOV = f
, _viDist = g
}
where
f x | abs x < 0.5 * pi = 1
| otherwise = 0
g x | x > 500 = 0
| otherwise = 1
defaultAudition :: Audition
defaultAudition = Ears
{ _auDist = id
}
defaultIntention :: Intention
defaultIntention = Intention
{ _targetCr = Nothing
, _mvToPoint = Nothing
, _viewPoint = Nothing
}
defaultChaseMvType :: CrMvType
defaultChaseMvType = CrMvType
{ _mvSpeed = 2
, _mvTurnRad = f
, _mvTurnJit = 0.2
, _mvAimSpeed = g
}
where
g x | x > pi/8 = 0.2
| otherwise = 0.01
f x | x > pi / 4 = 0.2
| otherwise = 0.05
defaultAimMvType :: CrMvType
defaultAimMvType = CrMvType
{ _mvSpeed = 3
, _mvTurnRad = const 0.2
, _mvTurnJit = 0.05
, _mvAimSpeed = f
}
where
f x | x > pi/8 = 0.2
| otherwise = 0.01
defaultAimingCrit :: Creature
defaultAimingCrit = defaultCreature { _crMvType = defaultAimMvType }
yourDefaultSpeed :: Float
yourDefaultSpeed = 3
yourDefaultStrideLength :: Int
yourDefaultStrideLength = 40
defaultState :: CreatureState
defaultState = CrSt
{ _csDamage = []
-- , _crPastDamage = V.fromList $ replicate 20 []
, _csSpState = GenCr
, _csDropsOnDeath = DropAll
}
src/Dodge/Floor.hs
+1 -1
View File
@@ -62,7 +62,7 @@ initialAnoTree = OnwardList
, IntAnno $ PassthroughLockKeyLists
[(sensorRoomRunPast ELECTRICAL, takeOne [CRAFT STATICMODULE,HELD SPARKGUN] )] itemRooms
, IntAnno $ PassthroughLockKeyLists keyCardRunPastRand itemRooms
, IntAnno $ AnTree . warningRooms
, IntAnno $ AnTree . warningRooms "INVISIBLE CREATURE AHEAD"
, AnTree $ rToOnward "chaseCrit+armourChaseCrit rectRoom"
$ return . cleatOnward $ roomRectAutoLinks 400 400 & rmPmnts .++~
[ spNoID anyUnusedSpot (PutCrit invisibleChaseCrit)
src/Dodge/Machine/Update.hs
+6 -5
View File
@@ -111,14 +111,15 @@ mcTriggerVal :: Machine -> Maybe Bool
mcTriggerVal mc = case mc ^. mcSensor of
NoSensor -> Nothing
s@ProximitySensor{} -> s ^? sensToggle
s@SensorToggleAmount{} -> Just $ (_sensAmount s) > 900
s@SensorToggleAmount{} -> Just $ _sensAmount s > 900
mcPlaySound :: Machine -> World -> World
mcPlaySound mc w = case _mcCloseSound mc of
Just sid | d < 200 -> soundContinueVol (1-0.01*max 0 (d-100)) (MachineSound mid) (_mcPos mc) sid (Just 2) w
_ -> w
Just sid | d < 100
-> soundContinueVol (1-0.01*d) (MachineSound mid) (_mcPos mc) sid (Just 2) w
_ -> w
where
d = dist (_crPos $ you w) (_mcPos mc)
d = max 0 (dist (_crPos $ you w) (_mcPos mc) - 100)
mid = _mcID mc
mcApplyDamage :: [Damage] -> Machine -> World -> World
@@ -130,7 +131,7 @@ mcApplyDamage ds mc = case _mcSensor mc of
mcSensorUpdate :: Machine -> World -> World
mcSensorUpdate mc w = case _mcSensor mc of
NoSensor -> w
SensorToggleAmount{} -> foldr (flip sensorUpdate mc) w (map _dmType $ _mcDamage mc)
SensorToggleAmount{} -> foldr (flip sensorUpdate mc . _dmType) w (_mcDamage mc)
ProximitySensor{} -> mcProximitySensorUpdate mc w
mcProximitySensorUpdate :: Machine -> World -> World
src/Dodge/Placement/Instance/Analyser.hs
+1 -1
View File
@@ -44,7 +44,7 @@ analyser
-> PlacementSpot
-> Placement
analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp ->
Just $ plSpot .~ psmc $ putTerminal''
Just $ plSpot .~ psmc $ putTerminal
(themachine & mcMounts . at ObTrigger .~ _plMID tp)
tparams -- (linksensortotrigger tp)
where
src/Dodge/Placement/Instance/Terminal.hs
+14 -35
View File
@@ -1,8 +1,7 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Placement.Instance.Terminal
( putTerminal
, putTerminal'
, putTerminal''
( putMessageTerminal
, putTerminal
, simpleTermMessage
, terminalColor
, terminalSPic
@@ -23,19 +22,15 @@ import Shape
import Data.Maybe
putTerminal''
:: Machine
-> Terminal
-- -> (Int -> Machine -> World -> World) -- | machine update, takes button id as input
-> Placement
putTerminal'' mc tm --mcf
putTerminal :: Machine -> Terminal -> Placement
putTerminal mc tm
= ps0PushPS (PutTerminal tm)
$ \tmpl -> Just $ ps0PushPS (PutButton termButton)
$ \btpl -> Just $ pt0 (PutMachine (reverse $ square 10)
(mc -- & mcUpdate %~ (\fmu mc' -> mcf (fromJust $ _plMID btpl) mc' . fmu mc') . machineAddSound fridgeHumS
& mcMounts . at ObButton ?~ fromJust (_plMID btpl)
& mcCloseSound ?~ fridgeHumS
) )
$ \btpl -> Just $ pt0
(PutMachine (reverse $ square 10)
(mc & mcMounts . at ObButton ?~ fromJust (_plMID btpl)
& mcCloseSound ?~ fridgeHumS)
)
$ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl)
where
setids tmpl btpl mcpl w = w
@@ -48,25 +43,11 @@ putTerminal'' mc tm --mcf
btid = fromJust (_plMID btpl)
mcid = fromJust (_plMID mcpl)
putTerminal'
:: Color
-> Terminal
-- -> (Int -> Machine -> World -> World) -- | machine update, takes button id as input
-> Placement
putTerminal' col = putTerminal'' (defaultMachine
& mcColor .~ col)
{ _mcDraw = noPic . terminalShape
, _mcHP = 100
, _mcSensor = defaultProximitySensor
}
putTerminal :: Color -> Terminal -> Placement
putTerminal col f = putTerminal'' (mc & mcColor .~ col) f -- (\_ -> basicMachineUpdate $ const id)
where
mc = defaultMachine
{ _mcDraw = terminalSPic
, _mcHP = 100
}
putMessageTerminal :: Color -> Terminal -> Placement
putMessageTerminal col = putTerminal $ defaultMachine
& mcColor .~ col
& mcDraw .~ terminalSPic
& mcHP .~ 100
termButton :: Button
termButton = Button
@@ -86,11 +67,9 @@ terminalColor :: Color
terminalColor = dark magenta
terminalSPic :: Machine -> SPic
--terminalShape _ = upperPrismPoly 15 $ square 10
terminalSPic = noPic . terminalShape
terminalShape :: Machine -> Shape
--terminalShape _ = upperPrismPoly 15 $ square 10
terminalShape mc = colorSH col (prismPoly
[V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10]
[V3 10 10 0, V3 (-10) 10 0, V3 (-10) (-10) 0, V3 10 (-10) 0]
src/Dodge/Room/LasTurret.hs
+2 -5
View File
@@ -40,10 +40,7 @@ lightSensInsideDoor outplid rm = rm
, psPt atFstLnkOut (PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100)))
, psPt atFstLnkOut (PutForeground $ verticalWire (V2 20 0) 0 80)
]
& rmOutPmnt .~ [OutPlacement (lasSensLightAboveDoor 10 (atFstLnkOutShiftInward 100)) outplid]
lasSensLightAboveDoor :: Float -> PlacementSpot -> Placement
lasSensLightAboveDoor = sensAboveDoor LASERING
& rmOutPmnt .~ [OutPlacement (sensAboveDoor LASERING 10 (atFstLnkOutShiftInward 100)) outplid]
lightSensByDoor :: Int -> Room -> Room
lightSensByDoor outplid rm = rm
@@ -52,7 +49,7 @@ lightSensByDoor outplid rm = rm
, heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape
, heightWallPS (atFstLnkOutShiftInward 100) 30 covershape
]
& rmOutPmnt .~ [OutPlacement (lasSensLightAboveDoor 20 (atFstLnkOutShiftBy sensorshift)) outplid]
& rmOutPmnt .~ [OutPlacement (sensAboveDoor LASERING 20 (atFstLnkOutShiftBy sensorshift)) outplid]
where
covershape = rectNSWE 10 (-10) (-20) 20
sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a)
src/Dodge/Room/LongDoor.hs
+1 -1
View File
@@ -98,7 +98,7 @@ addButtonSlowDoor x h rm = do
& rmPmnts .++~ [butDoor , theterminal]
& rmBound .:~ openDoorBound
where
theterminal = putTerminal terminalColor (simpleTermMessage themessage)
theterminal = putMessageTerminal terminalColor (simpleTermMessage themessage)
& plSpot .~ rprBoolShift (isUnusedLnkType InLink) (shiftByV2 (V2 0 (-10)))
themessage =
["WARNING:"
src/Dodge/Room/SensorDoor.hs
+1 -1
View File
@@ -67,7 +67,7 @@ sensInsideDoor senseType outplid rm = rm
[ psPt atFstLnkOut . PutForeground $ floorWire (V2 20 0) (V2 20 (-100))
, psPt atFstLnkOut . PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100))
, psPt atFstLnkOut . PutForeground $ verticalWire (V2 20 0) 0 80
, putTerminal terminalColor (basicTerminal & tmScrollCommands .:~ damageCodeCommand)
, putMessageTerminal terminalColor (basicTerminal & tmScrollCommands .:~ damageCodeCommand)
& plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
]
& rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid]
src/Dodge/Room/Warning.hs
+6 -6
View File
@@ -38,21 +38,21 @@ import qualified Data.Map.Strict as M
--import qualified Data.Text as T
warningRooms :: RandomGen g => Int -> State g (MetaTree Room String)
warningRooms n = do
warningRooms :: RandomGen g => String -> Int -> State g (MetaTree Room String)
warningRooms str n = do
rm <- do
tr <- tanksRoom [] []
takeOne [roomNgon 8 200, roomRectAutoLinks 200 200,tr]
cenroom <- shuffleLinks $ addWarningTerminal n rm
cenroom <- shuffleLinks $ addWarningTerminal str n rm
rToOnward "warningRooms" $ treePost [ door, cenroom, triggerDoorRoom n, cleatOnward door]
addWarningTerminal :: Int -> Room -> Room
addWarningTerminal outplid = (rmName .++~ "warningTerm-")
addWarningTerminal :: String -> Int -> Room -> Room
addWarningTerminal str outplid = (rmName .++~ "warningTerm-")
. (rmOutPmnt .~ [OutPlacement outplace outplid])
where
outplace = extTrigLitPos
(atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
(Just . set plSpot (rprShift moveToSideFirstOutLink) . putTerminal terminalColor . termMessages)
(Just . set plSpot (rprShift moveToSideFirstOutLink) . putMessageTerminal terminalColor . termMessages)
termMessages trpl = basicTerminal & tmScrollCommands .:~ toggleCommand
& tmToggles .~ M.fromList
[("DOOR",TerminalToggle (fromJust $ _plMID trpl) (const (const True)))]