Add terminal GODON command

This commit is contained in:
2021-12-09 17:12:32 +00:00
parent 4324d298d4
commit 1a053421ef
7 changed files with 34 additions and 18 deletions
+10 -6
View File
@@ -1,6 +1,8 @@
module Dodge.Creature.State module Dodge.Creature.State
( stateUpdate ( stateUpdate
, stateUpdateDamage
, doDamage , doDamage
, clearDamage
) where ) where
import Dodge.Data import Dodge.Data
import Dodge.Hammer import Dodge.Hammer
@@ -35,20 +37,19 @@ import Data.Monoid
import qualified Data.Vector as V import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV import qualified Data.Vector.Mutable as MV
--dummyUpdate :: CRUpdate
--dummyUpdate cr _ = (Endo id, Just cr)
-- | The movement is updated before the ai in order to correctly set the oldpos. -- | The movement is updated before the ai in order to correctly set the oldpos.
-- This should be made more sensible: should the movement side effects apply to -- This should be made more sensible: should the movement side effects apply to
-- the creature before or after it has moved? -- the creature before or after it has moved?
-- currently invSideEffects are applied after the creature moves, to correctly -- currently invSideEffects are applied after the creature moves, to correctly
-- update shield positions -- update shield positions
stateUpdate :: CRUpdate -> CRUpdate stateUpdate :: CRUpdate -> CRUpdate
stateUpdate u cr w = case u (updateMovement cr) w of stateUpdate = stateUpdateDamage doDamage
stateUpdateDamage :: (Creature -> Creature) -> CRUpdate -> CRUpdate
stateUpdateDamage damageupdate u cr w = case u (updateMovement cr) w of
(f, maybeCr) -> (f, maybeCr) ->
( Endo $ invSideEff (fromMaybe cr maybeCr) . movementSideEff cr . deathEff . appEndo f ( Endo $ invSideEff (fromMaybe cr maybeCr) . movementSideEff cr . deathEff . appEndo f
--, fmap (stepReloading . doDamage . crAutoReload) $ crOrCorpse =<< maybeCr , fmap (stepReloading . damageupdate) $ crOrCorpse =<< maybeCr
, fmap (stepReloading . doDamage) $ crOrCorpse =<< maybeCr
) )
where where
crOrCorpse cr' crOrCorpse cr'
@@ -81,6 +82,9 @@ setOldPos cr = cr
--meleeCooldown :: CRUpdate -> CRUpdate --meleeCooldown :: CRUpdate -> CRUpdate
--meleeCooldown u cr = u $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1)) --meleeCooldown u cr = u $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1))
clearDamage :: Creature -> Creature
clearDamage = crState . crDamage .~ []
doDamage :: Creature -> Creature doDamage :: Creature -> Creature
doDamage cr = set (crState . crDamage) [] doDamage cr = set (crState . crDamage) []
. over (crState . crPastDamage) (advancePastDamages dams) . over (crState . crPastDamage) (advancePastDamages dams)
+1
View File
@@ -680,6 +680,7 @@ data MachineType
{ _tuWeapon :: Item { _tuWeapon :: Item
, _tuTurnSpeed :: Float , _tuTurnSpeed :: Float
, _tuFireTime :: Int , _tuFireTime :: Int
, _tuMCrID :: Maybe Int
} }
data Door = Door data Door = Door
{ _drID :: Int { _drID :: Int
+7 -2
View File
@@ -2,6 +2,8 @@ module Dodge.Debug.Terminal
where where
import Dodge.Data import Dodge.Data
import Dodge.Creature import Dodge.Creature
import Dodge.Creature.YourControl
import Dodge.Creature.State
import Control.Lens import Control.Lens
@@ -9,9 +11,12 @@ applyTerminalString :: String -> Universe -> Universe
applyTerminalString "NOCLIP" w = w & config . debug_noclip %~ not applyTerminalString "NOCLIP" w = w & config . debug_noclip %~ not
applyTerminalString "LOADME" w = w & uvWorld . creatures . ix 0 . crInv .~ stackedInventory applyTerminalString "LOADME" w = w & uvWorld . creatures . ix 0 . crInv .~ stackedInventory
& uvWorld . creatures . ix 0 . crInvCapacity .~ 50 & uvWorld . creatures . ix 0 . crInvCapacity .~ 50
applyTerminalString "LM" w = applyTerminalString "LOADME" w applyTerminalString "GODON" u = u & uvWorld . creatures . ix 0 . crUpdate .~ stateUpdateDamage clearDamage yourControl
applyTerminalString "LT" w = w & uvWorld . creatures . ix 0 . crInv .~ testInventory applyTerminalString "GODOFF" u = u & uvWorld . creatures . ix 0 . crUpdate .~ stateUpdate yourControl
applyTerminalString "LOADTEST" w = w & uvWorld . creatures . ix 0 . crInv .~ testInventory
& uvWorld . creatures . ix 0 . crInvCapacity .~ 50 & uvWorld . creatures . ix 0 . crInvCapacity .~ 50
applyTerminalString "LM" w = applyTerminalString "LOADME" w
applyTerminalString "LT" w = applyTerminalString "LOADTEST" w
applyTerminalString _ w = w applyTerminalString _ w = w
loadme :: a loadme :: a
+2 -2
View File
@@ -1,6 +1,6 @@
module Dodge.Initialisation where module Dodge.Initialisation where
import Dodge.Default.World import Dodge.Default.World
import Dodge.Base --import Dodge.Base
--import Dodge.Save --import Dodge.Save
import Dodge.Data import Dodge.Data
import Dodge.Creature import Dodge.Creature
@@ -39,4 +39,4 @@ initialWorld = defaultWorld
} }
testStringInit :: World -> [String] testStringInit :: World -> [String]
testStringInit w = [show $ _crInvSel $ you w] testStringInit w = [show $ length $ _magnets w]
+2 -2
View File
@@ -16,7 +16,7 @@ curveLeftField mg pt = case pt of
curveAroundField :: Magnet -> Particle -> Particle curveAroundField :: Magnet -> Particle -> Particle
curveAroundField mg pt = case pt of curveAroundField mg pt = case pt of
BulletPt{} | thedist < 400 -> pt & btVel' %~ rotateToCircle BulletPt{} | thedist < 200 -> pt & btVel' %~ rotateToCircle
where where
thedist = dist btpos mgpos thedist = dist btpos mgpos
mgpos = _mgPos mg mgpos = _mgPos mg
@@ -27,5 +27,5 @@ curveAroundField mg pt = case pt of
= rotateV rot vel = rotateV rot vel
| otherwise = rotateV (negate rot) vel | otherwise = rotateV (negate rot) vel
rot | thedist < 100 = 0.5 rot | thedist < 100 = 0.5
| otherwise = 0.5 - ((thedist - 100) / 600) | otherwise = 0.5 - ((thedist - 100) / 200)
_ -> pt _ -> pt
+2 -4
View File
@@ -52,11 +52,9 @@ trySeedFromClipboard :: Universe -> IO (Maybe Universe)
trySeedFromClipboard u = do trySeedFromClipboard u = do
mcstr <- getClipboardString mcstr <- getClipboardString
case mcstr >>= readMaybe of case mcstr >>= readMaybe of
Nothing -> sayinputunusable Nothing -> pushScreen (seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")
Just i -> return . Just $ startSeedGame i u
where
sayinputunusable = pushScreen (seedStartMenu "INPUT UNUSABLE, EXPECTING INTEGER")
(u & menuLayers %~ tail) (u & menuLayers %~ tail)
Just i -> return . Just $ startSeedGame i u
slTitleOptions :: String -> [MenuOption] -> ScreenLayer slTitleOptions :: String -> [MenuOption] -> ScreenLayer
slTitleOptions title ops = slTitleOptionsEff title ops (popScreen . writeConfig) slTitleOptions title ops = slTitleOptionsEff title ops (popScreen . writeConfig)
+10 -2
View File
@@ -17,9 +17,9 @@ import Shape
import Dodge.Base import Dodge.Base
import Dodge.Base.Collide import Dodge.Base.Collide
import LensHelp import LensHelp
import qualified IntMapHelp as IM
import Data.List import Data.List
import qualified Data.IntMap.Strict as IM
putLasTurret :: Float -> Placement putLasTurret :: Float -> Placement
putLasTurret rotSpeed = sps0 $ PutMachine blue (reverse $ square wdth) defaultMachine putLasTurret rotSpeed = sps0 $ PutMachine blue (reverse $ square wdth) defaultMachine
@@ -34,6 +34,7 @@ lasTurret = Turret
{ _tuWeapon = autoRifle { _tuWeapon = autoRifle
, _tuTurnSpeed = 0.1 , _tuTurnSpeed = 0.1
, _tuFireTime = 0 , _tuFireTime = 0
, _tuMCrID = Nothing
} }
updateTurret :: Float -> Machine -> World -> World updateTurret :: Float -> Machine -> World -> World
@@ -42,8 +43,15 @@ updateTurret rotSpeed mc w
& deleteWallIDs (_mcWallIDs mc) & deleteWallIDs (_mcWallIDs mc)
& makeExplosionAt mcpos & makeExplosionAt mcpos
& copyItemToFloor mcpos lasGun & copyItemToFloor mcpos lasGun
| otherwise = w & doDamage & maybeFire & elecDamBranch | otherwise = w
& initHomonculus
& doDamage
& maybeFire
& elecDamBranch
where where
initHomonculus w' = case w' ^? machines . ix mcid . mcType . tuMCrID . _Just of
Nothing -> w' & machines . ix mcid . mcType . tuMCrID ?~ IM.newKey (_creatures w')
_ -> w'
doDamage = machines . ix mcid %~ doDamage = machines . ix mcid %~
( (mcDamage .~ [Electrical (min 2500 $ max 0 (elecDam - 10)) 0 0 0]) ( (mcDamage .~ [Electrical (min 2500 $ max 0 (elecDam - 10)) 0 0 0])
. (mcHP -~ dam) . (mcHP -~ dam)