From 8aeabf3f6c55b928f49652cd64dca62d60451986 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 28 Jul 2022 12:35:19 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Creature/Picture.hs | 93 +------------------- src/Dodge/Data/Machine.hs | 34 ++++---- src/Dodge/Data/Machine/Sensor.hs | 6 +- src/Dodge/Default.hs | 5 +- src/Dodge/Floor.hs | 1 + src/Dodge/HeldUse.hs | 14 +++ src/Dodge/Item/Draw.hs | 67 +-------------- src/Dodge/Item/Weapon/BatteryGuns.hs | 1 + src/Dodge/Machine/Draw.hs | 38 +++++++-- src/Dodge/Machine/Update.hs | 99 +++++++++------------ src/Dodge/Placement/Instance/Analyser.hs | 4 +- src/Dodge/Placement/Instance/Sensor.hs | 14 +-- src/Dodge/Placement/Instance/Terminal.hs | 2 +- src/Dodge/Placement/Instance/Turret.hs | 104 +---------------------- src/Dodge/Render/ShapePicture.hs | 4 +- src/Dodge/Terminal.hs | 2 +- 16 files changed, 123 insertions(+), 365 deletions(-) diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 4a64466ef..d4ff8c615 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -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 diff --git a/src/Dodge/Data/Machine.hs b/src/Dodge/Data/Machine.hs index 8b29d62fc..b6c687b6e 100644 --- a/src/Dodge/Data/Machine.hs +++ b/src/Dodge/Data/Machine.hs @@ -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 diff --git a/src/Dodge/Data/Machine/Sensor.hs b/src/Dodge/Data/Machine/Sensor.hs index 46eaf6f97..f7aee5ea9 100644 --- a/src/Dodge/Data/Machine/Sensor.hs +++ b/src/Dodge/Data/Machine/Sensor.hs @@ -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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 36e1812bf..821b06bbf 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -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 diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 4869c32e7..e8d7cde9d 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -21,6 +21,7 @@ initialAnoTree = intersperse (AnTree corDoor) [ IntAnno $ AnTree . startRoom + , IntAnno $ AnTree . lasSensorTurretTest , -- , AnRoom $ tanksRoom [] [] <&> rmPmnts .~ [] -- , AnRoom $ tanksRoom [] [] -- , AnRoom $ roomCCrits 0 diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index 159b0d42a..2abcb2534 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -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 diff --git a/src/Dodge/Item/Draw.hs b/src/Dodge/Item/Draw.hs index 1ec8bf8e9..7e74f0fee 100644 --- a/src/Dodge/Item/Draw.hs +++ b/src/Dodge/Item/Draw.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index db9b79f04..533126225 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -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 diff --git a/src/Dodge/Machine/Draw.hs b/src/Dodge/Machine/Draw.hs index be3e132aa..4047f1e0c 100644 --- a/src/Dodge/Machine/Draw.hs +++ b/src/Dodge/Machine/Draw.hs @@ -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 diff --git a/src/Dodge/Machine/Update.hs b/src/Dodge/Machine/Update.hs index 41904727e..67c8ab3ef 100644 --- a/src/Dodge/Machine/Update.hs +++ b/src/Dodge/Machine/Update.hs @@ -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 diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index 61d8e9e18..8f44c304e 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -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 diff --git a/src/Dodge/Placement/Instance/Sensor.hs b/src/Dodge/Placement/Instance/Sensor.hs index c06aedf52..75f0f8a95 100644 --- a/src/Dodge/Placement/Instance/Sensor.hs +++ b/src/Dodge/Placement/Instance/Sensor.hs @@ -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 diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index ea7a80f1c..cb885f82b 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -45,7 +45,7 @@ putMessageTerminal col = putTerminal $ defaultMachine & mcColor .~ col - & mcDraw .~ MachineDrawTerminal --terminalSPic + & mcType .~ McTerminal & mcHP .~ 100 termButton :: Button diff --git a/src/Dodge/Placement/Instance/Turret.hs b/src/Dodge/Placement/Instance/Turret.hs index b5f234987..987718608 100644 --- a/src/Dodge/Placement/Instance/Turret.hs +++ b/src/Dodge/Placement/Instance/Turret.hs @@ -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 diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 526b527d7..ce1275bf7 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -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 diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 765cc1ce5..dc6e55882 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -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 =