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-28 12:35:19 +01:00
parent 160560af5f
commit 8aeabf3f6c
16 changed files with 123 additions and 365 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/Instance/Analyser.hs
+2 -2
View File
@@ -27,9 +27,9 @@ analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp ->
themachine =
defaultMachine & mcColor .~ aquamarine
-- & mcUpdate .~ mcProximitySensorUpdate
& mcDraw .~ MachineDrawTerminal
& mcType .~ McTerminal
& mcHP .~ 100
& mcSensor .~ defaultProximitySensor{_proxRequirement = proxreq}
& mcType . _McSensor .~ defaultProximitySensor{_proxRequirement = proxreq}
--this can probably be deleted
--mcProximitySensorUpdate :: Machine -> World -> World
src/Dodge/Placement/Instance/Sensor.hs
+1 -13
View File
@@ -1,7 +1,6 @@
module Dodge.Placement.Instance.Sensor (
lightSensor,
damageSensor,
sensorSPic, -- this should be moved
) where
import Color
@@ -11,10 +10,7 @@ import Dodge.Data.GenWorld
import Dodge.Default
import Dodge.LevelGen.Data
import Dodge.LightSource
import Dodge.Placement.TopDecoration
import Geometry
import Shape
import ShapePicture
damageSensor ::
DamageType ->
@@ -34,8 +30,7 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
& mcColor .~ yellow
& mcMounts . at ObTrigger .~ mtrid
& mcMounts . at ObLightSource ?~ lsid
& mcDraw .~ MachineDrawDamageSensor wdth (_sensorCoding (_genParams (_cWorld gw)) M.! dt)
& mcSensor .~ DamageSensor False 0 dt
& mcType . _McSensor .~ DamageSensor False 0 dt (_sensorCoding (_genParams (_cWorld gw)) M.! dt)
)
defaultSensorWall
@@ -46,10 +41,3 @@ lightSensor ::
Placement
lightSensor = damageSensor LASERING
sensorSPic :: Float -> (PaletteColor, DecorationShape) -> Machine -> SPic
sensorSPic wdth (pc, ds) mc =
noPic $
colorSH (_mcColor mc) (upperPrismPoly 25 (square wdth))
<> decorationToShape ds wdth wdth 25 col col
where
col = paletteToColor pc
src/Dodge/Placement/Instance/Terminal.hs
+1 -1
View File
@@ -45,7 +45,7 @@ putMessageTerminal col =
putTerminal $
defaultMachine
& mcColor .~ col
& mcDraw .~ MachineDrawTerminal --terminalSPic
& mcType .~ McTerminal
& mcHP .~ 100
termButton :: Button
src/Dodge/Placement/Instance/Turret.hs
+4 -100
View File
@@ -2,126 +2,30 @@ module Dodge.Placement.Instance.Turret where
import Dodge.Item.Held.BatteryGuns
import Color
import Data.List
import Data.Maybe
import Dodge.Base
import Dodge.Data.GenWorld
import Dodge.Default
import Dodge.FloorItem
import Dodge.LevelGen.Data
import Dodge.Movement.Turn
import Dodge.Wall.Delete
import Dodge.WorldEvent.Explosion
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Shape
import ShapePicture
putLasTurret :: Float -> Placement
putLasTurret rotSpeed =
sps0 $
PutMachine
(reverse $ square wdth)
(reverse $ square 10)
( defaultMachine
& mcColor .~ blue
& mcDraw .~ MachineDrawTurret
& mcType .~ (lasTurret & tuTurnSpeed .~ rotSpeed)
& mcType .~ (lasTurret & _McTurret . tuTurnSpeed .~ rotSpeed)
& mcHP .~ 50000
)
defaultMachineWall
lasTurret :: MachineType
lasTurret =
lasTurret = McTurret $
Turret
{ _tuWeapon = lasGun
, -- { _tuWeapon = autoRifle
_tuTurnSpeed = 0.1
, _tuFireTime = 0
, _tuMCrID = Nothing
, _tuDir = 0
}
-- this needs a major cleanup
updateTurret :: Float -> Machine -> World -> World
updateTurret rotSpeed mc w
| _mcHP mc < 1 =
w & cWorld . machines %~ IM.delete mcid
& deleteWallIDs (_mcWallIDs mc)
& makeExplosionAt mcpos
& copyItemToFloor mcpos lasGun
& deleteHomonculus
| otherwise =
w
& initHomonculus
& dodamage
& maybeFire
& elecDamBranch
where
deleteHomonculus = case _tuMCrID (_mcType mc) of
Nothing -> id
Just cid -> cWorld . creatures . at cid .~ Nothing
initHomonculus w' = case w' ^? cWorld . machines . ix mcid . mcType . tuMCrID . _Just of
Nothing ->
w' & cWorld . machines . ix mcid . mcType . tuMCrID ?~ cid
& cWorld . creatures . at cid ?~ thecreature
where
cid = IM.newKey (_creatures (_cWorld w'))
thecreature =
defaultCreature
& crID .~ cid
& crInv . at 0
?~ ( _tuWeapon (_mcType mc) & itUse . heldAim . aimHandlePos -~ 10
& itUse . heldConsumption . laLoaded .~ 1
)
& crPos .~ mcpos
& crOldPos .~ mcpos
& crRad .~ 1
& crDir .~ mcdir
& crStance . posture .~ Aiming
& crMaterial .~ Crystal
Just cid ->
w'
& cWorld . creatures . ix cid . crPos .~ mcpos
& cWorld . creatures . ix cid . crDir .~ mcdir
dodamage =
cWorld . machines . ix mcid
%~ ( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect])
. (mcHP -~ dam)
)
elecDamBranch
| elecDam < 10 = updateFiringStatus . doTurn
| otherwise = id
maybeFire
| _tuFireTime (_mcType mc) > 0 =
fromMaybe id $ do
cid <- _tuMCrID (_mcType mc)
return $ cWorld . creatures . ix cid . crActionPlan . apImpulse .~ [UseItem]
| otherwise = id
mcid = _mcID mc
ypos = _crPos $ you w
mcpos = _mcPos mc
mcdir = _mcDir mc
seesYou = hasLOSIndirect mcpos ypos w
(elecDams, dams) = partition isElectrical $ _mcDamage mc
dam = sum $ map _dmAmount dams
elecDam = sum $ map _dmAmount elecDams
doTurn
| seesYou = cWorld . machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos
| otherwise = id
closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1
updateFiringStatus
| closeFireAngle = cWorld . machines . ix mcid . mcType . tuFireTime .~ 20
| otherwise = cWorld . machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1)
drawTurret :: Machine -> SPic
drawTurret mc =
( rotateSH (- _mcDir mc) . colorSH (_mcColor mc) $ upperPrismPoly 20 (square wdth)
, mempty -- setLayer 5 $ scale 0.5 0.5 $ text $ show $ _mcDir mc )
)
-- <> translateSPz 20 (itSPic it)
-- where
-- it = _tuWeapon $ _mcType mc
wdth :: Float
wdth = 10