From 2b9ad58f6f3be58ce2da3c942fc50e446c6217a5 Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 4 Jun 2022 11:19:14 +0100 Subject: [PATCH] Tweak gibs --- src/Color.hs | 3 +++ src/Dodge/Creature.hs | 19 ++++++++++----- src/Dodge/Creature/ArmourChase.hs | 3 ++- src/Dodge/Creature/AutoCrit.hs | 3 ++- src/Dodge/Creature/ChaseCrit.hs | 6 +++-- src/Dodge/Creature/LauncherCrit.hs | 3 ++- src/Dodge/Creature/LtAutoCrit.hs | 3 ++- src/Dodge/Creature/Picture.hs | 8 +++--- src/Dodge/Creature/PistolCrit.hs | 3 ++- src/Dodge/Creature/SpreadGunCrit.hs | 3 ++- src/Dodge/Creature/State.hs | 4 ++- src/Dodge/Creature/SwarmCrit.hs | 3 ++- src/Dodge/Data.hs | 2 ++ src/Dodge/Default.hs | 1 + src/Dodge/Prop/Gib.hs | 38 ++++++++++++++++++++--------- src/Quaternion.hs | 10 ++++++++ 16 files changed, 79 insertions(+), 33 deletions(-) diff --git a/src/Color.hs b/src/Color.hs index bc6b3c22f..1f18c093b 100644 --- a/src/Color.hs +++ b/src/Color.hs @@ -110,3 +110,6 @@ numColor 10 = toV4 (0.5,1,0,1) numColor 11 = toV4 (1,0.5,0,1) numColor 12 = toV4 (1,1,1,1) numColor _ = toV4 (1,1,1,1) + +light4 :: Color -> Color +light4 = light . light . light . light diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index a90564e13..15d24917d 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -59,13 +59,15 @@ spawnerCrit :: Creature spawnerCrit = defaultCreature { --_crUpdate = stateUpdate $ spawnerAI chaseCrit _crHP = 300 - , _crPict = basicCrPict blue + , _crPict = basicCrPict + , _crSkinColor = blue , _crInv = IM.empty -- IM.fromList [(0,frontArmour)] } miniGunCrit :: Creature miniGunCrit = defaultCreature - { _crPict = basicCrPict red + { _crPict = basicCrPict + , _crSkinColor = red , _crUpdate = defaultImpulsive [sentinelFireType (const shootTillEmpty)] , _crActionPlan = ActionPlan { _crImpulse = [] @@ -84,7 +86,8 @@ miniGunCrit = defaultCreature } longCrit :: Creature longCrit = defaultCreature - { _crPict = basicCrPict red + { _crPict = basicCrPict + , _crSkinColor = red -- , _crUpdate = stateUpdate sniperAI , _crUpdate = defaultImpulsive [sentinelFireType $ const shootTillEmpty] , _crActionPlan = ActionPlan @@ -100,7 +103,8 @@ longCrit = defaultCreature } multGunCrit :: Creature multGunCrit = defaultCreature - { _crPict = basicCrPict red + { _crPict = basicCrPict + , _crSkinColor = red -- , _crUpdate = stateUpdate (twitchMissAI 300 350) , _crInv = IM.fromList [(0,bangCaneX 4),(1,medkit 100)] , _crInvSel = 0 @@ -147,7 +151,8 @@ startCr = defaultCreature , _crDir = pi/2 , _crMvDir = pi/2 , _crID = 0 - , _crPict = basicCrPict black + , _crPict = basicCrPict + , _crSkinColor = black , _crUpdate = stateUpdate yourControl , _crRad = 10 , _crMass = 10 @@ -197,7 +202,9 @@ inventoryX c = case c of [ blinkGun , unsafeBlinkGun , autoDetector WALLDETECTOR - , effectGun "GIBBER" (addGibsAt . _crPos) + , effectGun "GIBBER" + (\cr -> addGibsAt (_crSkinColor cr) (_crPos cr) + . addGibsAt (_crSkinColor cr) (_crPos cr)) ] _ -> [] diff --git a/src/Dodge/Creature/ArmourChase.hs b/src/Dodge/Creature/ArmourChase.hs index ed1be6e51..3fa1ed0d0 100644 --- a/src/Dodge/Creature/ArmourChase.hs +++ b/src/Dodge/Creature/ArmourChase.hs @@ -36,7 +36,8 @@ flockArmourChaseCrit = defaultCreature ] , _crName = "armourChaseCrit" , _crHP = 300 - , _crPict = basicCrPict green + , _crPict = basicCrPict + , _crSkinColor = green , _crInv = IM.fromList [(0,frontArmour) ,(1,medkit 200) diff --git a/src/Dodge/Creature/AutoCrit.hs b/src/Dodge/Creature/AutoCrit.hs index 6c8912d47..ebe5cd054 100644 --- a/src/Dodge/Creature/AutoCrit.hs +++ b/src/Dodge/Creature/AutoCrit.hs @@ -21,7 +21,8 @@ import qualified Data.IntMap.Strict as IM autoCrit :: Creature autoCrit = defaultCreature - { _crPict = basicCrPict red + { _crPict = basicCrPict + , _crSkinColor = red , _crUpdate = defaultImpulsive [sentinelAI] , _crActionPlan = ActionPlan { _crImpulse = [] diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs index 0b5d3147e..584d53260 100644 --- a/src/Dodge/Creature/ChaseCrit.hs +++ b/src/Dodge/Creature/ChaseCrit.hs @@ -26,7 +26,8 @@ smallChaseCrit :: Creature smallChaseCrit = chaseCrit { _crHP = 1 , _crRad = 4 - , _crPict = basicCrPict green + , _crPict = basicCrPict + , _crSkinColor = green , _crInv = IM.fromList [(0,medkit 200)] , _crCorpse = setDepth 5 $ color (greyN 0.5) $ circleSolid 4 } @@ -52,7 +53,8 @@ chaseCrit = defaultCreature ] , _crName = "chaseCrit" , _crHP = 150 - , _crPict = basicCrPict green + , _crPict = basicCrPict + , _crSkinColor = green , _crInv = IM.fromList [(0,medkit 200)] , _crMeleeCooldown = 0 , _crFaction = ColorFaction green diff --git a/src/Dodge/Creature/LauncherCrit.hs b/src/Dodge/Creature/LauncherCrit.hs index 390fac4ab..686ec1bdc 100644 --- a/src/Dodge/Creature/LauncherCrit.hs +++ b/src/Dodge/Creature/LauncherCrit.hs @@ -24,7 +24,8 @@ import Control.Lens launcherCrit :: Creature launcherCrit = defaultCreature - { _crPict = basicCrPict red + { _crPict = basicCrPict + , _crSkinColor = red , _crUpdate = defaultImpulsive [ performActions , watchUpdateStrat diff --git a/src/Dodge/Creature/LtAutoCrit.hs b/src/Dodge/Creature/LtAutoCrit.hs index 34c850bb6..81618dcdf 100644 --- a/src/Dodge/Creature/LtAutoCrit.hs +++ b/src/Dodge/Creature/LtAutoCrit.hs @@ -22,7 +22,8 @@ import Control.Lens ltAutoCrit :: Creature ltAutoCrit = defaultCreature - { _crPict = basicCrPict red + { _crPict = basicCrPict + , _crSkinColor = red , _crUpdate = defaultImpulsive [ performActions , watchUpdateStrat diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 87a5cde4e..0fc8d2ede 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -29,12 +29,11 @@ import ShapePicture import Control.Lens import qualified Data.IntMap.Strict as IM import qualified Data.Vector as V -basicCrPict :: Color -- ^ Creature color - -> Creature +basicCrPict :: Creature -> Configuration -> World -> SPic -basicCrPict col cr cfig w = +basicCrPict cr cfig w = drawCrEquipment cr <> (basicCrShape col cr @@ -45,6 +44,7 @@ basicCrPict col cr cfig w = ] ) where + col = _crSkinColor cr targetingPic = IM.elems $ IM.mapMaybeWithKey f $ _crInv cr f invid it = fmap (\g -> g invid it cr cfig w) (it ^? itTargeting . tgDraw) @@ -240,8 +240,6 @@ shoulderSH = translateSHz 20 --waistSH :: Shape -> Shape --waistSH = translateSHz 10 -light4 :: Color -> Color -light4 = light . light . light . light --drawAwakeLevel -- :: Creature diff --git a/src/Dodge/Creature/PistolCrit.hs b/src/Dodge/Creature/PistolCrit.hs index 884324810..289ae9a25 100644 --- a/src/Dodge/Creature/PistolCrit.hs +++ b/src/Dodge/Creature/PistolCrit.hs @@ -26,7 +26,8 @@ import Control.Monad.State pistolCrit :: Creature pistolCrit = defaultCreature - { _crPict = basicCrPict red + { _crPict = basicCrPict + , _crSkinColor = red , _crUpdate = defaultImpulsive [ performActions , watchUpdateStrat diff --git a/src/Dodge/Creature/SpreadGunCrit.hs b/src/Dodge/Creature/SpreadGunCrit.hs index 24b720051..c8f149fa1 100644 --- a/src/Dodge/Creature/SpreadGunCrit.hs +++ b/src/Dodge/Creature/SpreadGunCrit.hs @@ -24,7 +24,8 @@ import Control.Lens spreadGunCrit :: Creature spreadGunCrit = defaultCreature - { _crPict = basicCrPict red + { _crPict = basicCrPict + , _crSkinColor = red , _crUpdate = defaultImpulsive [performActions ,watchUpdateStrat diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index d6271a6e2..6f17d7c00 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -76,7 +76,9 @@ checkDeath cr w where removecr | _crID cr == 0 = (creatures . ix (_crID cr) . crUpdate .~ const id) - . addGibsAt (_crPos cr) + . (creatures . ix (_crID cr) . crPict .~ const mempty) + . addGibsAt (_crSkinColor cr) (_crPos cr) + . addGibsAt (_crSkinColor cr) (_crPos cr) | otherwise = creatures . at (_crID cr) .~ Nothing addCorpse = IM.insertNewKey $ uncurryV translate (_crOldPos cr) diff --git a/src/Dodge/Creature/SwarmCrit.hs b/src/Dodge/Creature/SwarmCrit.hs index 91e00606f..c761c46ed 100644 --- a/src/Dodge/Creature/SwarmCrit.hs +++ b/src/Dodge/Creature/SwarmCrit.hs @@ -30,7 +30,8 @@ swarmCrit = defaultCreature , _crHP = 1 , _crRad = 2 , _crMass = 2 - , _crPict = basicCrPict yellow + , _crPict = basicCrPict + , _crSkinColor = yellow , _crCorpse = setDepth 5 $ color (greyN 0.5) $ circleSolid 2 , _crFaction = ColorFaction yellow , _crMeleeCooldown = 0 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index f891dc47f..6662b4a75 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -323,6 +323,7 @@ data Creature = Creature , _crTwist :: Float , _crID :: Int , _crPict :: Creature -> Configuration -> World -> SPic + , _crSkinColor :: Color , _crUpdate :: Creature -> World -> World , _crRad :: Float , _crMass :: Float @@ -849,6 +850,7 @@ data Prop , _pjTimer :: Int , _pjQuat :: Q.Quaternion Float , _pjQuatSpin :: Q.Quaternion Float + , _pjColor :: Color } | Drone { _pjPos :: Point2 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 53b2cf805..d7a94e7c4 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -31,6 +31,7 @@ defaultCreature = Creature , _crTwist = 0 , _crID = 1 , _crPict = \_ _ _ -> mempty + , _crSkinColor = white , _crUpdate = const id , _crRad = 10 , _crMass = 10 diff --git a/src/Dodge/Prop/Gib.hs b/src/Dodge/Prop/Gib.hs index 842bcd34f..a910fed2f 100644 --- a/src/Dodge/Prop/Gib.hs +++ b/src/Dodge/Prop/Gib.hs @@ -12,14 +12,15 @@ import Dodge.RandomHelp import System.Random import Control.Monad.State -import qualified Linear.Quaternion as Q +import qualified Quaternion as Q +import Data.List (zip4) aGib :: Prop aGib = PropZ {_pjPos = 0 ,_pjStartPos = 0 ,_pjVel = 0 - ,_prDraw = drawGib + ,_prDraw = drawGib 4 ,_pjID = 0 ,_pjUpdate = updateGib ,_pjPosZ = 10 @@ -27,15 +28,21 @@ aGib = PropZ ,_pjTimer = 20 ,_pjQuat = Q.axisAngle (V3 1 0 0) 0 ,_pjQuatSpin = Q.axisAngle (V3 1 1 0) 0.1 + ,_pjColor = white } -drawGib :: Prop -> SPic -drawGib pr = noPic +drawGib :: Float -> Prop -> SPic +drawGib x pr = noPic . translateSHz (_pjPosZ pr) . uncurryV translateSHf (_pjPos pr) - . colorSH red . overPosSH (Q.rotate (_pjQuat pr)) - . translateSHz (negate 5) - $ upperPrismPoly 10 $ square 5 + $ flesh <> skin + where + flesh = colorSH (dark $ dark red) + . translateSHz (negate x) + $ upperPrismPoly (2*x) $ square x + skin = colorSH (light4 $ _pjColor pr) + . translateSH (V3 1 1 (1 - x)) + $ upperPrismPoly (2*x) $ square x updateGib :: Prop -> World -> World updateGib pr w = w & props . ix (_pjID pr) %~ updateGib' w @@ -65,16 +72,23 @@ updateGib' w pr Nothing -> pjPos +~ v Just (p,v') -> (pjPos .~ p) . (pjVel .~ v') -addGibsAt :: Point2 -> World -> World -addGibsAt p w = foldr addg w (zip vels zspeeds) +addGibsAt :: Color -> Point2 -> World -> World +addGibsAt col p w = foldr addg w (zip4 vels zspeeds quats hs) + & randGen .~ newg where - speeds = replicateM 4 (state (randomR (1,4))) & evalState $ _randGen w + (speeds,newg) = replicateM 4 (state (randomR (1,4))) & runState $ _randGen w + hs = replicateM 4 (state (randomR (5,15))) & evalState $ _randGen w dirs = unitVectorAtAngle <$> (randsOnCirc 4 & evalState $ _randGen w) vels = zipWith (*.*) speeds dirs - zspeeds = replicateM 4 (state (randomR (1,8))) & evalState $ _randGen w - addg (v,zs) = plNew props pjID (aGib & pjPos .~ p + zspeeds = replicateM 4 (state (randomR (-8,8))) & evalState $ _randGen w + quats :: [Q.Quaternion Float] + quats = replicateM 4 (Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere) & evalState $ _randGen w + addg (v,zs,q,h) = plNew props pjID (aGib & pjPos .~ p +.+ (5 *.* normalizeV v) + & pjColor .~ col & pjVel .~ v & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1) + & pjQuat .~ q & pjVelZ .~ zs + & pjPosZ .~ h ) diff --git a/src/Quaternion.hs b/src/Quaternion.hs index 86856a500..c6ef61c85 100644 --- a/src/Quaternion.hs +++ b/src/Quaternion.hs @@ -1,9 +1,12 @@ module Quaternion ( rotateToZ + , vToQuat + , module Linear.Quaternion ) where import Geometry.Data import Geometry.Vector3D import qualified Linear.Quaternion as Q +import Linear.Quaternion -- apply a rotation as if the z axis moves to the new point. rotateToZ :: Point3 -> Point3 -> Point3 @@ -12,3 +15,10 @@ rotateToZ z1 | otherwise = Q.rotate $ Q.axisAngle cprod (angleVV3 z1 (V3 0 0 1)) where cprod = crossProd z1 (V3 0 0 1) + +vToQuat :: Point3 -> Point3 -> Q.Quaternion Float +vToQuat a b + | cprod == V3 0 0 0 = Q.axisAngle (V3 0 0 1) 0 + | otherwise = Q.axisAngle cprod (angleVV3 a b) + where + cprod = crossProd a b