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/Creature/Picture.hs
+3 -90
View File
@@ -1,16 +1,9 @@
--{-# LANGUAGE TupleSections #-}
{- |
Drawing of creatures.
Takes into account damage etc.
-}
module Dodge.Creature.Picture (
basicCrPict,
drawCrEquipment,
circLine,
picAtCrPos,
shapeAtCrPos,
picAtCrPosNoRot,
deadScalp,
deadUpperBody,
deadFeet,
@@ -29,16 +22,8 @@ import Shape
import ShapePicture
basicCrPict :: Creature -> SPic
basicCrPict cr = drawCrEquipment cr <> (basicCrShape cr, mempty)
drawCrEquipment :: Creature -> SPic
drawCrEquipment cr = uncurryV translateSPf (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr)
shapeAtCrPos :: Shape -> Creature -> SPic
shapeAtCrPos sh cr =
( uncurryV translateSHf (_crPos cr) $ rotateSH (_crDir cr) sh
, mempty
)
basicCrPict cr = uncurryV translateSPf (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr)
<> (basicCrShape cr, mempty)
basicCrShape ::
Creature ->
@@ -48,8 +33,7 @@ basicCrShape cr
| otherwise =
tr . scaleSH (V3 crsize crsize crsize) $
mconcat
[ --rotdir . _spShape $ drawEquipment cr
rotdir . colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr
[ rotdir . colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr
, rotdir $ colorSH (_skinUpper cskin) $ upperBody cr
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
]
@@ -60,25 +44,6 @@ basicCrShape cr
rotdir = rotateSH (_crDir cr)
rotmdir = rotateSH (_crMvDir cr)
--damageMod :: Creature -> Picture -> Picture
--damageMod cr pic = piercingMod $ bluntScale pic
-- where
-- cdir = _crDir cr
-- pastDams = _crPastDamage $ _crState cr
-- bluntDam :: Maybe Point2
-- bluntDam = find isBluntDam (concat pastDams) >>= (\dm -> (-.-) <$> dm ^? dmFrom <*> dm ^? dmTo)
-- bluntScale = case fmap argV bluntDam of
-- Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
-- _ -> id
-- isBluntDam Blunt{} = True
-- isBluntDam _ = False
-- piercingDam = find isPiercingDam (concat pastDams) >>= (\dm -> (-.-) <$> dm ^? dmFrom <*> dm ^? dmTo)
-- isPiercingDam Piercing{} = True
-- isPiercingDam _ = False
-- piercingMod = case fmap argV piercingDam of
-- Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
-- _ -> id
feet :: Creature -> Shape
{-# INLINE feet #-}
feet cr = case cr ^? crStance . carriage of
@@ -136,26 +101,8 @@ arms cr =
translateToRightHand cr aHand
<> translateToLeftHand cr aHand
where
--arms cr
-- | oneH cr = shoulderSH . translateSHf 11 (-3) . rotateSH (-0.5) $ scaleSH (V3 1 1.5 1) aHand
-- | twists cr = shoulderSH . translateSHf 0 5 . rotateSH (-1) $ mconcat
-- [ translateSHf 12 4 aHand
-- , translateSHf 4 (-10) aHand
-- ]
-- | twoFlat cr = waistSH $ translateSHf 4 8 aHand
-- <> translateSHf 4 (-8) aHand
-- | otherwise = case cr ^? crStance . carriage of
-- Just (Walking sa LeftForward) -> waistSH $ translateSHf (-f sa) (-off) aHand
-- Just (Walking sa RightForward) -> waistSH $ translateSHf (-f sa) off aHand
-- _ -> emptySH
aHand :: SPic
aHand = noPic $ translateSHz (-4) . upperPrismPolyHalf 4 $ polyCirc 3 4
-- off = 8
-- sLen = _strideLength $ _crStance cr
-- f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
deadScalp :: Creature -> Shape
deadScalp cr = deadRot cr . translateSHz 10 . scalp $ cr
@@ -177,11 +124,6 @@ scalp cr
where
fhead = colorSH (greyN 0.9) . upperPrismPolyHalf 5 $ polyCirc 4 5
--hasAmmo :: Creature -> Bool
--hasAmmo cr = case cr ^? crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded of
-- Just x -> x > 0
-- _ -> False
torso :: Creature -> Shape
{-# INLINE torso #-}
torso cr
@@ -203,7 +145,6 @@ torso cr
, translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
]
where
--aShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPoly 10 $ polyCirc 3 crad
aShoulder = scaleSH (V3 10 10 1) baseShoulder
deadUpperBody :: Creature -> Shape
@@ -215,7 +156,6 @@ baseShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalf 10
upperBody :: Creature -> Shape
{-# INLINE upperBody #-}
--upperBody col cr = colorSH (light4 col) $ mconcat
upperBody cr =
mconcat
[ arms cr
@@ -225,33 +165,6 @@ upperBody cr =
shoulderSH :: Shape -> Shape
shoulderSH = translateSHz 20
--waistSH :: Shape -> Shape
--waistSH = translateSHz 10
--drawAwakeLevel
-- :: Creature
-- -> Picture
--drawAwakeLevel cr = case cr ^? crAttentionDir of
-- Just (AttentiveTo [0]) -> setPos . color red $ circleSolid 5
-- _ -> setPos . color blue $ circleSolid 5
-- where
-- setPos = translate 0 (_crRad cr)
drawEquipment :: Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment cr = foldMap (itemEquipPict cr) (_crInv cr)
--drawEquipment cr = foldMap f (_crInv cr)
-- where
-- f itm = _itEquipPict itm cr itm
circLine :: Float -> Picture
circLine x = line [V2 0 0, V2 x 0]
picAtCrPos :: Picture -> Creature -> SPic
--{-# INLINE picAtCrPos #-}
picAtCrPos thePic cr = (,) emptySH $ tranRot (_crPos cr) (_crDir cr) thePic
picAtCrPosNoRot :: Picture -> Creature -> SPic
--{-# INLINE picAtCrPos #-}
picAtCrPosNoRot thePic cr = (,) emptySH $ uncurryV translate (_crPos cr) thePic
src/Dodge/Data/Machine.hs
+16 -18
View File
@@ -26,43 +26,41 @@ import Dodge.Data.ObjectType
import Geometry.Data
import Sound.Data
data MachineDraw
= MachineDrawMempty
| MachineDrawTerminal
| MachineDrawTurret
| MachineDrawDamageSensor Float (PaletteColor, DecorationShape)
deriving (Eq, Show, Read)
data Machine = Machine
{ _mcID :: Int
, _mcWallIDs :: IS.IntSet
, _mcDraw :: MachineDraw
, _mcMaterial :: Material
, _mcPos :: Point2
, _mcDir :: Float
, _mcColor :: Color
, _mcHP :: Int
, _mcSensor :: Sensor
, _mcDamage :: [Damage]
, _mcType :: MachineType
, _mcMounts :: M.Map ObjectType Int
, _mcName :: String
, _mcCloseSound :: Maybe SoundID
, _mcWidth :: Float
}
deriving (Eq, Show, Read)
data MachineType
= StaticMachine
| Turret
{ _tuWeapon :: Item
, _tuTurnSpeed :: Float
, _tuFireTime :: Int
, _tuMCrID :: Maybe Int
}
= McStatic
| McTerminal
| McSensor Sensor
| McTurret Turret
deriving (Eq, Show, Read)
data Turret = Turret
{ _tuWeapon :: Item
, _tuTurnSpeed :: Float
, _tuFireTime :: Int
, _tuDir :: Float
}
deriving (Eq, Show, Read)
makeLenses ''Machine
makeLenses ''MachineType
deriveJSON defaultOptions ''MachineDraw
makeLenses ''Turret
makePrisms ''MachineType
deriveJSON defaultOptions ''Machine
deriveJSON defaultOptions ''MachineType
deriveJSON defaultOptions ''Turret
src/Dodge/Data/Machine/Sensor.hs
+4 -2
View File
@@ -3,6 +3,8 @@
module Dodge.Data.Machine.Sensor where
import Dodge.Data.GenParams
import Color
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
@@ -10,11 +12,11 @@ import Dodge.Data.Item.Combine
import Dodge.Data.Damage.Type
data Sensor
= NoSensor
| DamageSensor
= DamageSensor
{ _sensToggle :: Bool
, _sensAmount :: Int
, _sensType :: DamageType
, _sensDraw :: (PaletteColor, DecorationShape)
}
| ProximitySensor
{ _proxStatus :: CloseToggle
src/Dodge/Default.hs
+2 -3
View File
@@ -40,18 +40,17 @@ defaultMachine =
Machine
{ _mcID = 0
, _mcWallIDs = mempty
, _mcDraw = MachineDrawMempty
, _mcColor = white
, _mcPos = V2 0 0
, _mcDir = 0
, _mcHP = 1000
, _mcSensor = NoSensor
, _mcMaterial = Electronics
, _mcDamage = []
, _mcType = StaticMachine
, _mcType = McStatic
, _mcName = ""
, _mcMounts = mempty
, _mcCloseSound = Nothing
, _mcWidth = 10
}
defaultButton :: Button
src/Dodge/Floor.hs
+1
View File
@@ -21,6 +21,7 @@ initialAnoTree =
intersperse
(AnTree corDoor)
[ IntAnno $ AnTree . startRoom
, IntAnno $ AnTree . lasSensorTurretTest
, -- , AnRoom $ tanksRoom [] [] <&> rmPmnts .~ []
-- , AnRoom $ tanksRoom [] []
-- , AnRoom $ roomCCrits 0
src/Dodge/HeldUse.hs
+14
View File
@@ -355,6 +355,12 @@ useMod hm = case hm of
cr & crDir %~ tweenAngles x (_crOldDir cr)
& crPos %~ tweenPoints x (_crOldPos cr)
mcUseHeld :: HeldItemType -> Item -> Machine -> World -> World
mcUseHeld hit = case hit of
LASGUN -> mcShootLaser
_ -> \_ _ -> id
useHeld :: HeldUse -> Item -> Creature -> World -> World
useHeld hu = case hu of
HeldDoNothing -> const $ const id
@@ -480,3 +486,11 @@ coneRandItemParams = do
{ _muzVel = muzv
, _rifling = rifl
}
mcShootLaser :: Item -> Machine -> World -> World
mcShootLaser it mc = cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
where
pos = _mcPos mc
dir = mc ^?! mcType . _McTurret . tuDir
phasev = _phaseV . _itParams $ it
dam = _lasDamage $ _itParams it
src/Dodge/Item/Draw.hs
+2 -65
View File
@@ -1,6 +1,4 @@
module Dodge.Item.Draw (
pictureWeaponOnAim,
pictureWeaponAim,
twoFlatHRot,
itemSPic,
itemEquipPict,
@@ -12,72 +10,11 @@ import Dodge.Data.Creature
import Dodge.Item.Draw.SPic
import Dodge.Item.Equipment.Shape
import Dodge.Item.HeldOffset
import qualified IntMapHelp as IM
import ShapePicture
itemEquipPict :: Creature -> Item -> SPic
itemEquipPict cr it = case it ^?! itUse of
HeldUse{} -> pictureWeaponOnAim cr it
itemEquipPict cr it = case it ^. itUse of
HeldUse{} | _itIsHeld it -> overPosSP (heldItemOffset it cr) (itemSPic it)
ituse -> case ituse ^? equipEffect of
Just _ -> pictureOnEquip (itemSPic it) cr it
Nothing -> mempty
pictureWeaponOnAim ::
Creature ->
Item ->
SPic
pictureWeaponOnAim = pictureWeaponAim itemSPic
pictureWeaponAim ::
(Item -> SPic) ->
Creature ->
Item ->
SPic
pictureWeaponAim f cr itm = case _itLocation itm of
InInv _ i -> pictureWeaponOnAimItem (f itm) cr i
_ -> mempty
-- | Places an item picture onto a creature when the item is selected.
pictureWeaponOnAimItem ::
SPic ->
Creature ->
-- | Position of item in inventory
Int ->
SPic
pictureWeaponOnAimItem p' cr posInInv
| _itIsHeld theIt = overPosSP (heldItemOffset theIt cr) p'
| otherwise = mempty
where
-- | isSelected && _posture (_crStance cr) == Aiming =
-- shoulderD $ translateSPf (aimingWeaponZeroPos cr theIt) 0 p'
-- | isSelected && isTwoHandFlat
-- = handD holsteredTwoFlat
-- | isSelected && isOneHand
-- = handD holsteredOneHandWep
-- | isSelected
-- = handD holsteredWep
-- | otherwise = mempty
-- shoulderD = translateSPz 18
-- handD = translateSPz 15
-- isSelected = crSel cr == posInInv
-- twistWep = translateSPf (-5) 0 p
-- holsteredWep = translateSPf (_crRad cr) 0
-- (rotateSP (strideRot cr + 1.2) (translateSPf (-5) 0 twistWep))
-- holsteredTwoFlat = translateSPf (_crRad cr) 0 (rotateSP (twoFlatHRot cr) p)
-- holsteredOneHandWep = translateSPf (_crRad cr * 0.7 + handPos) (_crRad cr * negate 0.7)
-- (translateSPf (-2) 0 p)
-- handPos = case cr^? crStance . carriage of
-- Just (Walking x LeftForward) -> f x * 50
-- _ -> 0
theIt = _crInv cr IM.! posInInv
-- p = fromMaybe p' $ do
-- x <- theIt ^? itUse . useAim . aimHandlePos
-- return $translateSPf (-x) 0 p'
-- isOneHand = theIt ^? itUseAimStance == Just OneHand
-- || isNothing (theIt ^? itUseAimStance)
-- isTwoHandFlat = theIt ^? itUseAimStance == Just TwoHandFlat
-- itUseAimStance = itUse . useAim . aimStance
-- f i = 0.1 * fromIntegral (sLen - i) / fromIntegral sLen
-- sLen = _strideLength $ _crStance cr
src/Dodge/Item/Weapon/BatteryGuns.hs
+1
View File
@@ -142,6 +142,7 @@ shootTeslaArc it cr w =
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
dir = _crDir cr
shootLaser :: Item -> Creature -> World -> World
shootLaser it cr = cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
where
src/Dodge/Machine/Draw.hs
+30 -8
View File
@@ -1,19 +1,25 @@
module Dodge.Machine.Draw
where
import Dodge.Placement.Instance.Sensor
import Dodge.Placement.Instance.Turret
import Dodge.Placement.TopDecoration
--import Dodge.Placement.Instance.Turret
import Shape
import Picture
import Geometry
import Dodge.Data.Machine
import ShapePicture
drawMachine :: MachineDraw -> Machine -> SPic
drawMachine md = case md of
MachineDrawMempty -> const mempty
MachineDrawTerminal -> terminalSPic
MachineDrawTurret -> drawTurret
MachineDrawDamageSensor w pcds -> sensorSPic w pcds
drawMachine :: Machine -> SPic
drawMachine mc = case _mcType mc of
McStatic -> mempty
McTerminal -> terminalSPic mc
McTurret tu -> drawTurret tu mc
McSensor se -> drawSensor se mc
drawSensor :: Sensor -> Machine -> SPic
drawSensor sens = case sens of
DamageSensor {_sensDraw = pcds} -> sensorSPic pcds
ProximitySensor {} -> const mempty
terminalSPic :: Machine -> SPic
terminalSPic = noPic . terminalShape
@@ -31,3 +37,19 @@ terminalShape mc = colorSH col (prismPoly
where
col = _mcColor mc
drawTurret :: Turret -> Machine -> SPic
drawTurret _ mc =
( rotateSH (- _mcDir mc) . colorSH (_mcColor mc) $ upperPrismPoly 20 (square w)
, mempty -- setLayer 5 $ scale 0.5 0.5 $ text $ show $ _mcDir mc )
)
where
w = _mcWidth mc
sensorSPic :: (PaletteColor, DecorationShape) -> Machine -> SPic
sensorSPic (pc, ds) mc =
noPic $
colorSH (_mcColor mc) (upperPrismPoly 25 (square w))
<> decorationToShape ds w w 25 col col
where
col = paletteToColor pc
w = _mcWidth mc
src/Dodge/Machine/Update.hs
+39 -60
View File
@@ -1,13 +1,13 @@
module Dodge.Machine.Update where
import Dodge.Item.Held.BatteryGuns
import Data.List (partition)
import Data.Maybe
import Dodge.Base.Collide
import Dodge.Base.You
import Dodge.Data.World
import Dodge.Default
import Dodge.FloorItem
import Dodge.HeldUse
import Dodge.Item.Held.BatteryGuns
import Dodge.Machine.Destroy
import Dodge.Movement.Turn
import Dodge.SoundLogic
@@ -28,8 +28,8 @@ updateMachine mc
. mcSensorUpdate mc
mcTurretUpdate :: Machine -> World -> World
mcTurretUpdate mc = case _mcType mc of
mt@Turret{} -> updateTurret (_tuTurnSpeed mt) mc
mcTurretUpdate mc = case mc ^? mcType . _McTurret of
Just tu -> updateTurret (_tuTurnSpeed tu) mc
_ -> id
-- this needs a major cleanup
@@ -40,40 +40,12 @@ updateTurret rotSpeed mc w
& deleteWallIDs (_mcWallIDs mc)
& makeExplosionAt mcpos
& copyItemToFloor mcpos lasGun
& deleteHomonculus
| otherwise =
w
& initHomonculus
& dodamage
& maybeFire
& mcUseItem mc
& 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])
@@ -82,16 +54,10 @@ updateTurret rotSpeed mc w
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
--mcdir = _mcDir mc
seesYou = hasLOSIndirect mcpos ypos w
(elecDams, dams) = partition isElectrical $ _mcDamage mc
dam = sum $ map _dmAmount dams
@@ -101,8 +67,21 @@ updateTurret rotSpeed mc w
| 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)
| closeFireAngle = cWorld . machines . ix mcid . mcType . _McTurret . tuFireTime .~ 20
| otherwise = cWorld . machines . ix mcid . mcType . _McTurret . tuFireTime %~ (max 0 . subtract 1)
mcUseItem :: Machine -> World -> World
mcUseItem mc = fromMaybe id $ do
tu <- mc ^? mcType . _McTurret
let it = tu ^. tuWeapon
hit <- it ^? itType . iyBase . ibtHeld
return $ mcUseHeld hit it mc
-- maybeFire
-- | _tuFireTime (_mcType mc) > 0 =
-- fromMaybe id $ do
-- return $ tuUseItem
-- | otherwise = id
mcSensorTriggerUpdate :: Machine -> World -> World
mcSensorTriggerUpdate mc = fromMaybe id $ do
@@ -111,10 +90,10 @@ mcSensorTriggerUpdate mc = fromMaybe id $ do
return $ cWorld . triggers . ix trid .~ bval
mcTriggerVal :: Machine -> Maybe Bool
mcTriggerVal mc = case mc ^. mcSensor of
NoSensor -> Nothing
s@ProximitySensor{} -> s ^? sensToggle
s@DamageSensor{} -> Just $ _sensAmount s > 900
mcTriggerVal mc = case mc ^? mcType . _McSensor of
Nothing -> Nothing
Just s@ProximitySensor{} -> s ^? sensToggle
Just s@DamageSensor{} -> Just $ _sensAmount s > 900
mcPlaySound :: Machine -> World -> World
mcPlaySound mc w = case _mcCloseSound mc of
@@ -127,17 +106,17 @@ mcPlaySound mc w = case _mcCloseSound mc of
mid = _mcID mc
mcApplyDamage :: [Damage] -> Machine -> World -> World
mcApplyDamage ds mc = case _mcSensor mc of
NoSensor ->
mcApplyDamage ds mc = case mc ^? mcType . _McSensor of
Nothing ->
cWorld . machines . ix (_mcID mc)
%~ ((mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)))
_ -> id
mcSensorUpdate :: Machine -> World -> World
mcSensorUpdate mc w = case _mcSensor mc of
NoSensor -> w
s@DamageSensor{} -> senseDamage (_sensType s) mc w
ProximitySensor{} -> mcProximitySensorUpdate mc w
mcSensorUpdate mc w = case mc ^? mcType . _McSensor of
Nothing -> w
Just s@DamageSensor{} -> senseDamage (_sensType s) mc w
Just ProximitySensor{} -> mcProximitySensorUpdate mc w
mcProximitySensorUpdate :: Machine -> World -> World
mcProximitySensorUpdate mc w = case ( _proxStatus sens
@@ -148,21 +127,21 @@ mcProximitySensorUpdate mc w = case ( _proxStatus sens
(_, True, _, _) -> w
(_, False, True, True) ->
w
& cWorld . machines . ix (_mcID mc) . mcSensor . sensToggle .~ True
& cWorld . machines . ix (_mcID mc) . mcType . _McSensor . sensToggle .~ True
& playsound dedaS
& cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
& cWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose
(NotClose, _, False, True) ->
w & playsound dedumS
& cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
(_, _, _, False) -> w & cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ NotClose
& cWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose
(_, _, _, False) -> w & cWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ NotClose
_ -> w
where
playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
ycr = you w
sens = _mcSensor mc
sens = mc ^?! mcType . _McSensor
mcProxTest :: Machine -> World -> Bool
mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
mcProxTest mc w = case mc ^? mcType . _McSensor . proxRequirement of
Just (RequireHealth x) -> _crHP cr >= x
Just (RequireEquipment ct) -> any (\itm -> _iyBase (_itType itm) == ct) (_crInv cr)
_ -> False
@@ -174,10 +153,10 @@ senseDamage dt mc =
(cWorld . machines . ix mcid %~ upmc)
. updatels
where
upmc = mcSensor . sensAmount %~ min 1000 . max 0 . (+ (newsense - 5))
upmc = mcType . _McSensor . sensAmount %~ min 1000 . max 0 . (+ (newsense - 5))
mcid = _mcID mc
newsense = sum . map _dmAmount $ filter ((== dt) . _dmType) (_mcDamage mc)
ni = fromIntegral (_sensAmount $ _mcSensor mc) / 1000
ni = fromIntegral (mc ^?! mcType . _McSensor . sensAmount) / 1000
updatels = fromMaybe id $ do
lsid <- mc ^? mcMounts . ix ObLightSource
return $ cWorld . lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni
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
src/Dodge/Render/ShapePicture.hs
+2 -2
View File
@@ -321,8 +321,8 @@ btSPic :: Button -> SPic
btSPic bt = uncurryV translateSPf (_btPos bt)
$ rotateSP (_btRot bt) (drawButton (_btPict bt) bt)
mcSPic :: Machine -> SPic
mcSPic bt = uncurryV translateSPf (_mcPos bt)
$ rotateSP (_mcDir bt) (drawMachine (_mcDraw bt) bt)
mcSPic mc = uncurryV translateSPf (_mcPos mc)
$ rotateSP (_mcDir mc) (drawMachine mc)
soundPic :: Configuration -> World -> Sound -> Picture
soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
src/Dodge/Terminal.hs
+1 -1
View File
@@ -186,7 +186,7 @@ getSensor f tm w =
maybe
[]
(makeTermPara . map toUpper . show . f)
(w ^? cWorld . machines . ix (_tmMachineID tm) . mcSensor)
(w ^? cWorld . machines . ix (_tmMachineID tm) . mcType . _McSensor)
toggleCommand :: TerminalCommand
toggleCommand =