Add terminal GODON command
This commit is contained in:
@@ -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)
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
@@ -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
@@ -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)
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|||||||
Reference in New Issue
Block a user