From 0c6fa80ce0b411a5045925b1ff42cdf13134b948 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 3 Oct 2021 13:19:53 +0100 Subject: [PATCH] Tweak weapon pictures --- src/Dodge/Creature/Picture.hs | 8 + src/Dodge/Default/Weapon.hs | 2 +- src/Dodge/Item.hs | 4 +- src/Dodge/Item/Consumable.hs | 2 +- src/Dodge/Item/Data.hs | 2 +- src/Dodge/Item/Draw.hs | 8 +- src/Dodge/Item/Equipment.hs | 8 +- src/Dodge/Item/Weapon.hs | 368 +++++++++------------------- src/Dodge/Item/Weapon/AmmoParams.hs | 8 +- src/Dodge/Item/Weapon/Bezier.hs | 16 +- src/Dodge/Item/Weapon/Grenade.hs | 2 +- src/Dodge/Item/Weapon/Launcher.hs | 183 +++++++++++++- src/Dodge/Item/Weapon/Remote.hs | 10 + src/Dodge/Layout/Tree/Annotate.hs | 2 +- src/Dodge/Room/Procedural.hs | 1 + src/Geometry/Vector3D.hs | 12 + src/Shape.hs | 6 + src/ShapePicture.hs | 3 +- 18 files changed, 358 insertions(+), 287 deletions(-) create mode 100644 src/Dodge/Item/Weapon/Remote.hs diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 0f2b83423..b0acc3b3f 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -165,11 +165,14 @@ arms cr [ 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 where + --crIt = _crInv cr IM.! _crInvSel cr aHand :: Shape aHand = translateSHz (-4) . upperPrismPolyHalf 4 $ polyCirc 3 4 crad = _crRad cr @@ -192,6 +195,11 @@ oneH cr = crIsAiming' cr && crIt ^? itAimStance == Just OneHand where crIt = _crInv cr IM.! _crInvSel cr +twoFlat :: Creature -> Bool +twoFlat cr = crIsAiming' cr && crIt ^? itAimStance == Just TwoHandFlat + where + crIt = _crInv cr IM.! _crInvSel cr + twists :: Creature -> Bool twists cr = crIsAiming' cr && crIt ^? itAimStance == Just TwoHandTwist where diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index 7de98ee25..a96623e9b 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -29,7 +29,7 @@ defaultGun = Weapon , _wpSpread = 0.02 , _wpRange = 20 , _itHammer = HammerUp - , _itFloorPict = \_ -> emptyBlank + , _itFloorPict = const emptyBlank , _itAmount = 1 , _itMaxStack = 1 , _itAimingSpeed = 1 diff --git a/src/Dodge/Item.hs b/src/Dodge/Item.hs index c8873f6d2..754bdd6fe 100644 --- a/src/Dodge/Item.hs +++ b/src/Dodge/Item.hs @@ -16,7 +16,7 @@ keyToken n = defaultEquipment , _itName = "KEYTOKEN "++show n , _itMaxStack = 5 , _itAmount = 1 - , _itFloorPict = \it -> (,) emptySH $ setDepth 0.5 keyPic + , _itFloorPict = \_ -> (,) emptySH $ setDepth 0.5 keyPic , _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic , _itEffect = NoItEffect , _itHammer = HammerUp @@ -40,7 +40,7 @@ latchkey n = defaultEquipment , _itName = "KEY "++show n , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = \it -> (,) emptySH $ setDepth 0.5 latchkeyPic + , _itFloorPict = \_ -> (,) emptySH $ setDepth 0.5 latchkeyPic , _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic , _itEffect = NoItEffect , _itHammer = HammerUp diff --git a/src/Dodge/Item/Consumable.hs b/src/Dodge/Item/Consumable.hs index 4d7c64c2a..232cf0cec 100644 --- a/src/Dodge/Item/Consumable.hs +++ b/src/Dodge/Item/Consumable.hs @@ -22,7 +22,7 @@ medkit i = defaultConsumable , _itMaxStack = 9 , _itAmount = 1 , _cnEffect = heal i - , _itFloorPict = \it -> (,) emptySH $ setLayer 0 . onLayer FlItLayer . color blue $ circleSolid 3 + , _itFloorPict = \_ -> (,) emptySH $ setLayer 0 . onLayer FlItLayer . color blue $ circleSolid 3 , _itEquipPict = pictureItem $ (,) emptySH $ color blue $ circleSolid 3 , _itID = Nothing } diff --git a/src/Dodge/Item/Data.hs b/src/Dodge/Item/Data.hs index f5af13b05..275cf59c1 100644 --- a/src/Dodge/Item/Data.hs +++ b/src/Dodge/Item/Data.hs @@ -42,7 +42,7 @@ data ItemIdentity (Eq,Show,Ord,Enum) data AimStance = TwoHandTwist - | TwoHand + | TwoHandFlat | OneHand | LeaveHolstered deriving diff --git a/src/Dodge/Item/Draw.hs b/src/Dodge/Item/Draw.hs index 4286eeca9..366e041f3 100644 --- a/src/Dodge/Item/Draw.hs +++ b/src/Dodge/Item/Draw.hs @@ -39,8 +39,10 @@ pictureWeaponOnAimItem p cr posInInv = shoulderD twistWep | isSelected && _posture (_crStance cr) == Aiming && isOneHand = shoulderD oneHandWep - | isSelected && _posture (_crStance cr) == Aiming + | isSelected && _posture (_crStance cr) == Aiming && isTwoHandFlat = shoulderD drawnWep + | isSelected && isTwoHandFlat + = handD holsteredTwoFlat | isSelected && isOneHand = handD holsteredOneHandWep | isSelected @@ -50,10 +52,11 @@ pictureWeaponOnAimItem p cr posInInv shoulderD = translateSPz 18 handD = translateSPz 15 isSelected = _crInvSel cr == posInInv - drawnWep = translateSPf (_crRad cr) 0 p + drawnWep = translateSPf (1.2 * _crRad cr) 0 p twistWep = translateSPf (0.5 * _crRad cr) 0 p oneHandWep = translateSPf (1.5 * _crRad cr) 0 p holsteredWep = translateSPf (_crRad cr) 0 (rotateSP (sRot + 1.2) p) + holsteredTwoFlat = translateSPf (_crRad cr) 0 (rotateSP (2*sRot) p) holsteredOneHandWep = translateSPf (_crRad cr * 0.7 + handPos) (_crRad cr * negate 0.7) p handPos = case cr^? crStance . carriage of Just (Walking x LeftForward) -> f x * 50 @@ -61,6 +64,7 @@ pictureWeaponOnAimItem p cr posInInv theIt = _crInv cr IM.! posInInv isTwisting = _itAimStance theIt == TwoHandTwist isOneHand = _itAimStance theIt == OneHand + isTwoHandFlat = _itAimStance theIt == TwoHandFlat sRot = case cr ^? crStance . carriage of Just (Walking x LeftForward) -> f x Just (Walking x RightForward) -> - f x diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 3c5774561..400a8c293 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -15,7 +15,7 @@ magShield = defaultEquipment , _itName = "MAGSHIELD" , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \_ _ -> (,) emptySH blank , _itID = Nothing } @@ -25,7 +25,7 @@ flameShield = defaultEquipment , _itName = "FLAMESHIELD" , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \cr _ -> (,) emptySH $ onLayer CrLayer $ pictures [color cyan $ circle (_crRad cr+2)] , _itID = Nothing } @@ -36,7 +36,7 @@ frontArmour = defaultEquipment , _itName = "FARMOUR" , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ translate 0 (-5) $ pictures + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ translate 0 (-5) $ pictures [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5 ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5 ] @@ -54,7 +54,7 @@ jetPack = defaultEquipment , _itName = "JETPACK" , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \_ _ -> (,) emptySH $ onLayer CrLayer $ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ] , _itEffect = NoItEffect diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 5f88c3f0d..83d559017 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -10,7 +10,6 @@ import Dodge.Picture.Layer import Dodge.SoundLogic import Dodge.SoundLogic.LoadSound import Dodge.Creature.Action -import Dodge.RandomHelp import Dodge.WorldEvent import Dodge.Default --import Dodge.Default.Shell @@ -22,9 +21,9 @@ import Dodge.Item.Weapon.TriggerType import Dodge.Item.Weapon.ExtraEffect import Dodge.Item.Weapon.UseEffect import Dodge.Item.Weapon.Laser -import Dodge.Item.Weapon.Shell import Dodge.Item.Weapon.Bullet import Dodge.Item.Weapon.AmmoParams +import Dodge.Item.Weapon.Remote import Dodge.Item.Attachment.Data import Dodge.Default.Weapon import Dodge.Item.Weapon.Booster @@ -45,13 +44,8 @@ import Data.Function --import qualified Data.ByteString as B import qualified Data.Sequence as Seq import Control.Lens -import Control.Applicative -import Control.Monad.State --import Control.Monad -import qualified SDL import System.Random -import qualified Data.Set as S ---import qualified Data.Map as M pistol :: Item pistol = defaultGun @@ -95,18 +89,18 @@ pistol = defaultGun } pistolPic :: Item -> SPic pistolPic it = - ( (colorSH green $ prismPoly + ( colorSH green (prismPoly (map (addZ 3) $ rectNESW 3 3 (-3) (-3)) (map (addZ 0) $ rectNESW 5 3 (-5) (-7)) ) - <> translateSH (V3 (-4) (5.5) 4) (rotateSH (pi) $ bulletClip am) + <> translateSH (V3 (-4) 5.5 4) (rotateSH pi $ bulletClip am) , mempty ) where am = loadedAmmo it bulletClip :: Int -> Shape -bulletClip x = (rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW 3 0 (3 - 0.25 * am) (-5)) +bulletClip x = rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW 3 0 (3 - 0.25 * am) (-5) where am = fromIntegral x @@ -135,13 +129,13 @@ rezGun = defaultGun [] , _wpSpread = 0.001 , _wpRange = 20 - , _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ color chartreuse $ pictures + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color chartreuse $ pictures [polygon $ rectNESW 7 3 1 (-3) ,polygon $ rectNESW (-1) 3 (-7) (-3) ] , _itAimingSpeed = 0.4 , _itAimingRange = 0 - , _itEquipPict = pictureWeaponOnAim $ \it -> (,) emptySH $ color chartreuse $ pictures + , _itEquipPict = pictureWeaponOnAim $ \_ -> (,) emptySH $ color chartreuse $ pictures [polygon $ rectNESW 7 3 1 (-3) ,polygon $ rectNESW (-1) 3 (-7) (-3) ] @@ -155,6 +149,7 @@ teslaGun = defaultGun , _wpReloadTime = 80 , _wpReloadState = 0 , _itUseRate = 0 + , _itAimStance = TwoHandFlat , _itUseTime = 0 , _itUse = const aTeslaArc , _itUseModifiers = @@ -166,14 +161,14 @@ teslaGun = defaultGun ] , _wpSpread = 0.001 , _wpRange = 20 - , _itFloorPict = \it -> teslaGunPic + , _itFloorPict = teslaGunPic , _itAimingSpeed = 0.4 , _itZoom = defaultItZoom , _itAimingRange = 0 - , _itEquipPict = pictureWeaponOnAim $ \it -> teslaGunPic + , _itEquipPict = pictureWeaponOnAim teslaGunPic } -teslaGunPic :: SPic -teslaGunPic = +teslaGunPic :: Item -> SPic +teslaGunPic _ = ( colorSH blue $ upperPrismPoly 5 (rectNESW xb y xa (-y)) ++ upperPrismPoly 5 (rectNESW (-xa) y (-xb) (-y)) @@ -203,25 +198,27 @@ lasGun = defaultAutoGun ] , _wpSpread = 0.001 , _wpRange = 20 - , _itFloorPict = \it -> lasGunPic + , _itFloorPict = lasGunPic , _itAimingSpeed = 0.4 , _itAimingRange = 1 - , _itEquipPict = pictureWeaponOnAim $ \it -> lasGunPic + , _itEquipPict = pictureWeaponOnAim lasGunPic , _itAttachment = ItCharMode $ Seq.fromList "/VZ" , _itScroll = scrollCharMode , _itInvDisplay = basicWeaponDisplay } -lasGunPic :: SPic -lasGunPic = +lasGunPic :: Item -> SPic +lasGunPic it = ( colorSH blue $ - (upperPrismPoly 4 $ rectNESW 3 15 1 (-15)) - <> (upperPrismPoly 4 $ rectNESW (-1) 15 (-3) (-15)) + upperPrismPoly 4 (rectNESW 3 15 1 (-15)) + <> upperPrismPoly 4 (rectNESW (-1) 15 (-3) (-15)) -- <> (upperPrismPoly 4 $ rectNESW (5) l (-5) (l-2)) - <> (upperPrismPoly 1 $ rectNESW (3) 15 (-3) (-15)) - , mempty + <> upperPrismPoly 1 (rectNESW 3 15 (-3) (-15)) + , setLayer 1 . color col . setDepth 1.1 . polygon $ rectNESW 1 15 (-1) (-15) ) where - l = 0 + amFrac = fractionLoadedAmmo it + col = brightX 2 1.5 $ mixColors amFrac (1-amFrac) green red + forceFieldGun :: Item forceFieldGun = defaultGun { _itName = "FORCEFIELD" @@ -235,7 +232,7 @@ forceFieldGun = defaultGun , _itUse = undefined , _wpSpread = 0.02 , _wpRange = 20 - , _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)] + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)] , _itAimingSpeed = 0.4 , _itAimingRange = 0.5 } @@ -274,13 +271,13 @@ tractorGun = defaultAutoGun ] , _wpSpread = 0.00001 , _wpRange = 20 - , _itFloorPict = \it -> tractorGunSPic + , _itFloorPict = tractorGunSPic , _itAimingSpeed = 0.4 , _itAimingRange = 0.5 - , _itEquipPict = pictureWeaponOnAim $ \it -> tractorGunSPic + , _itEquipPict = pictureWeaponOnAim tractorGunSPic } -- TODO own picture for tractor gun -tractorGunSPic :: SPic +tractorGunSPic :: Item -> SPic tractorGunSPic = lasGunPic removeItAttachment :: Int -> Int -> World -> World @@ -288,34 +285,6 @@ removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachmen where cr = _creatures w IM.! i itRef = _crInvSel cr -remoteLauncher :: Item -remoteLauncher = defaultGun - { _itName = "ROCKO-REM" - , _itIdentity = RemoteLauncher - , _wpMaxAmmo = 1 - , _wpLoadedAmmo = 1 - , _wpReloadTime = 80 - , _wpReloadState = 0 - , _itUseRate = 10 - , _itUseTime = 0 - , _itUse = const fireRemoteLauncher - , _itUseModifiers = - [ ammoCheckI - , hammerCheckI - ] - , _wpSpread = 0.02 - , _wpRange = 20 - , _itFloorPict = \it -> remoteLauncherSPic - , _itAimingSpeed = 0.2 - , _itAimingRange = 0.5 - , _itEquipPict = pictureWeaponOnAim $ \it -> remoteLauncherSPic - , _itAttachment = ItScope (V2 0 0) 0 1 True - } -remoteLauncherSPic :: SPic -remoteLauncherSPic = - ( colorSH cyan $ upperPrismPoly 7 $ rectNESW 5 5 (-5) (-5) - , mempty - ) hvAutoGun :: Item hvAutoGun = defaultAutoGun @@ -336,17 +305,23 @@ hvAutoGun = defaultAutoGun , withMuzFlareI ] , _wpRange = 20 - , _itFloorPict = \it -> hvAutoGunPic + , _itFloorPict = hvAutoGunPic , _itAimingSpeed = 0.2 , _itAimingRange = 1 - , _itEquipPict = pictureWeaponOnAim $ \it -> hvAutoGunPic + , _itEquipPict = pictureWeaponOnAim hvAutoGunPic , _wpAmmo = hvBullet } -hvAutoGunPic :: SPic -hvAutoGunPic = - ( colorSH orange $ upperPrismPoly 5 $ rectNESW 5 12 (-5) (-12) +hvAutoGunPic :: Item -> SPic +hvAutoGunPic it = + ( colorSH orange (prismPoly + (map (addZ 5) $ rectNESW 3 12 (-3) (-8)) + (map (addZ 0) $ rectNESW 5 12 (-5) (-12)) + ) + <> bulletClip am , mempty ) + where + am = loadedAmmo it ltAutoGun :: Item ltAutoGun = defaultAutoGun { _itName = "AUTO-LT" @@ -370,19 +345,24 @@ ltAutoGun = defaultAutoGun ] , _wpSpread = 0.5 , _wpRange = 20 - , _itFloorPict = \it -> ltAutoGunPic + , _itFloorPict = ltAutoGunPic , _itAimingSpeed = 1 , _itAimingRange = 0 , _itZoom = defaultItZoom - , _itEquipPict = pictureWeaponOnAim $ \it -> ltAutoGunPic + , _itEquipPict = pictureWeaponOnAim ltAutoGunPic , _itAimStance = OneHand , _wpAmmo = ltBullet } -ltAutoGunPic :: SPic -ltAutoGunPic = - ( colorSH green $ upperPrismPoly 5 $ mirrorXAxis [V2 (-5) 5, V2 5 5, V2 10 0] +ltAutoGunPic :: Item -> SPic +ltAutoGunPic it = + ( colorSH green $ prismPoly + (map (addZ 5) $ mirrorXAxis [V2 (-2) 3, V2 5 3, V2 10 0]) + (map (addZ 0) $ mirrorXAxis [V2 (-5) 5, V2 5 5, V2 10 0]) + <> bulletClip am , mempty ) + where + am = loadedAmmo it miniGun :: Item miniGun = defaultAutoGun { _itName = "MINI-G" @@ -455,19 +435,27 @@ miniGunPictItem it = miniGunPict spin (loadedAmmo it) miniGunPict :: Int -> Int -> SPic miniGunPict spin am = - ( ( rotateSHx a .translateSH (V3 5 0 (-9)) . colorSH red $ upperPrismPoly 18 $ rectNESW 9 7 (-9) (-5)) - <> (colorSH red $ prismPoly + --( ( rotateSHx a .translateSH (V3 5 0 (-9)) . colorSH red $ upperPrismPoly 18 $ rectNESW 9 7 (-9) (-5)) + ( colorSH red (rotateSHx a barrels) + <> colorSH red (upperPrismPoly 5 $ rectNESW 8 8 (-8) 4) + <> colorSH red (prismPoly (map (addZ 5) $ rectNESW 2 12 (-2) (-12)) (map (addZ 0) $ rectNESW 4 12 (-4) (-16)) ) - <> f (-1) 0 - <> f (-7) 0 + <> clip (-1) 0 + <> clip (-7) 0 , mempty ) where + aBarrel = translateSH (V3 7 0 9) $ prismPoly + (map (addZ 5) $ rectNESW 2 12 (-2) (-1)) + (map (addZ 0) $ rectNESW 4 12 (-4) (-5)) + barrels = concatMap (\an -> aBarrel & rotateSHx an) [0,0.5* pi, pi, 1.5*pi] a = fromIntegral spin / 100 x = fromIntegral am / 20 - f y z = translateSH (V3 0 (-1) z) (rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW (negate $ 3 + 0.25 * x) (y) 3 (y-5)) + clip y z = translateSH (V3 0 (-1) z) (rotateSHx (negate $ pi/4) + . upperPrismPoly 2 + $ rectNESW (negate $ 3 + 0.25 * x) y 3 (y-5)) spreadGun :: Item spreadGun = defaultGun { _itName = "SPREAD" @@ -492,18 +480,21 @@ spreadGun = defaultGun ] , _wpSpread = spreadGunSpread , _wpRange = 20 - , _itFloorPict = \it -> spreadGunPic + , _itFloorPict = spreadGunPic , _itAimingSpeed = 1 , _itAimingRange = 0 - , _itEquipPict = pictureWeaponOnAim $ \it -> spreadGunPic + , _itEquipPict = pictureWeaponOnAim spreadGunPic , _wpAmmo = basicBullet , _wpNumBarrels = 50 } -spreadGunPic :: SPic -spreadGunPic = - ( colorSH green $ upperPrismPoly 5 $ map toV2[(-3,0),(3,6),(3,-6)] +spreadGunPic :: Item -> SPic +spreadGunPic it = + ( colorSH green (upperPrismPoly 5 $ map toV2[(-3,0),(3,6),(3,-6)]) + <> bulletClip am , mempty ) + where + am = loadedAmmo it multGun :: Item multGun = defaultGun { _itName = "MULTGUN" @@ -527,31 +518,31 @@ multGun = defaultGun ] , _wpSpread = spreadGunSpread , _wpRange = 20 - , _itFloorPict = \it -> multGunSPic + , _itFloorPict = multGunSPic , _itAimingSpeed = 0.4 , _itAimingRange = 1 , _itZoom = defaultItZoom , _itAimZoom = defaultItZoom {_itZoomFac = 1.5} - , _itEquipPict = pictureWeaponOnAim $ \it -> multGunSPic + , _itEquipPict = pictureWeaponOnAim multGunSPic , _itAimStance = TwoHandTwist , _wpAmmo = basicBullet , _wpNumBarrels = 5 } -multGunSPic :: SPic -multGunSPic = - ( colorSH red $ +multGunSPic :: Item -> SPic +multGunSPic it = + ( (colorSH red $ upperPrismPoly 2 (rectNESW 4 8 (-4) (-12)) ++ - translateSHf 8 0 (mconcat - [ upperPrismPoly 5 $ rectNSEW 12 8 2 (-2) - , upperPrismPoly 5 $ rectNSEW 7 3 2 (-2) - , upperPrismPoly 5 $ rectNSEW 2 (-2) 2 (-2) - , upperPrismPoly 5 $ rectNSEW (-3) (-7) 2 (-2) - , upperPrismPoly 5 $ rectNSEW (-8) (-12) 2 (-2) - , upperPrismPoly 2 $ map toV2 [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)] - ] + translateSHf 8 0 (concatMap barrel [12,7,2,-3,-8] <> + (upperPrismPoly 2 $ map toV2 [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)]) ) + ) <> bulletClip am , mempty ) + where + barrel y = prismPoly + (map (addZ 5) $ rectNSEW y (y-4) 2 0 ) + (map (addZ 0) $ rectNSEW y (y-4) 2 (-2)) + am = loadedAmmo it longGun :: Item longGun = defaultGun { _itName = "LONGGUN" @@ -575,12 +566,12 @@ longGun = defaultGun , withMuzFlareI ] , _wpRange = 200 - , _itFloorPict = \it -> longGunSPic + , _itFloorPict = \_ -> longGunSPic , _itAimingSpeed = 0.2 , _itAimingRange = 1 , _itZoom = defaultItZoom , _itAimZoom = defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5} - , _itEquipPict = pictureWeaponOnAim $ \it -> longGunSPic + , _itEquipPict = pictureWeaponOnAim $ \_ -> longGunSPic , _itScroll = zoomLongGun , _itAttachment = ItScope (V2 0 0) 0 1 False , _itEffect = itemLaserScopeEffect @@ -622,11 +613,11 @@ poisonSprayer = defaultAutoGun , spreadNumI ] , _wpRange = 8 - , _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) + , _itFloorPict = flamerPic , _itAimingSpeed = 0.2 , _itAimingRange = 0 , _itZoom = defaultItZoom - , _itEquipPict = pictureWeaponOnAim $ \it -> (,) emptySH $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) + , _itEquipPict = pictureWeaponOnAim flamerPic , _wpSpread = 0.1 , _wpNumBarrels = 3 } @@ -649,21 +640,27 @@ flamer = defaultAutoGun ] , _wpSpread = 0 , _wpRange = 8 - , _itFloorPict = \it -> flamerPic + , _itFloorPict = flamerPic , _itAimingSpeed = 0.5 , _itAimingRange = 0 , _itZoom = defaultItZoom , _itAimZoom = defaultItZoom {_itZoomMax = 5, _itZoomMin = 1.5} - , _itEquipPict = pictureWeaponOnAim $ \it -> flamerPic + , _itEquipPict = pictureWeaponOnAim flamerPic , _itAttachment = NoItAttachment } -flamerPic :: SPic -flamerPic = +flamerPic :: Item -> SPic +flamerPic it = ( colorSH yellow $ - translateSHf (negate 5) (negate 7) (upperPrismPoly 3 $ polyCirc 3 5) + translateSHf tx ty (upperPrismPoly tz $ polyCirc 3 r) ++ upperPrismPoly 5 (rectNESW 2 9 (-2) (-9)) - , mempty + , color black $ translate3 (V3 tx ty (tz+0.01)) $ circleSolid (r * am) ) + where + tx = - 5 + ty = - 6 + tz = 3 + r = 5 + am = fractionLoadedAmmo2 it blinkGun :: Item blinkGun = defaultGun { _itName = "BLINKER" @@ -682,7 +679,7 @@ blinkGun = defaultGun , _itLeftClickUse = Just $ hammerCheckL $ shootL aSelfL , _wpSpread = 0.05 , _wpRange = 20 - , _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2[(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)] + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2[(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)] , _itAimingSpeed = 1 , _itAimingRange = 0 } @@ -700,7 +697,7 @@ boosterGun = defaultGun , _itLeftClickUse = Just $ boostSelfL 10 , _wpSpread = 0.05 , _wpRange = 20 - , _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)] + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)] , _itAimingSpeed = 1 , _itAimingRange = 0 , _itEffect = resetAttachmentID @@ -721,28 +718,6 @@ aTeslaArc cr w chooseColor 2 = blue chooseColor _ = cyan -remoteShellDraw :: Prop -> SPic -remoteShellDraw pj - | t > 40 = (,) mempty $ onLayerL [levLayer CrLayer - 2] - $ uncurryV translate pos $ rotate dir $ remoteShellPic t - | otherwise = (,) mempty $ uncurryV translate pos $ rotate dir $ remoteShellPic t - where - t = _pjTimer pj - pos = _pjPos pj - dir = _pjDir pj - -remoteShellPic - :: Int -- ^ Timer - -> Picture -remoteShellPic t - | rem (t+200) 20 < 9 = setDepth 20 $ polygon $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] - | otherwise = pictures - [ setDepth 20 $ polygon $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] - , setLayer 1 . setDepth 20.5 . color col $ circleSolid 3 - ] - where - col | t > (-99) = green - | otherwise = red shellExplosionAt :: Point2 -> World -> World shellExplosionAt = makeExplosionAt @@ -774,26 +749,6 @@ aSelfL cr _ = blinkAction cr reflect :: Float -> Float -> Float reflect a b = a + 2*(a-b) - -pointToItem :: Applicative f => - ItemPos -> (Item -> f Item) -> World -> f World -pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid -pointToItem (OnFloor flid) = floorItems . ix flid . flIt - -retireRemoteRocket :: Int -> Int -> Int -> World -> World -retireRemoteRocket itid 0 pjid w = - set (pointToItem (_itemPositions w IM.! itid) . itAttachment . scopePos) (V2 0 0) - $ set (pointToItem (_itemPositions w IM.! itid) . itUse) (const fireRemoteLauncher) - (w & props %~ IM.delete pjid) -retireRemoteRocket itid t pjid w = setScope w - & props . ix pjid . pjUpdate .~ (\_ -> retireRemoteRocket itid (t-1) pjid) - where - setScope w' = case _itemPositions w' IM.! itid of - InInv cid invid -> w' - & creatures . ix cid . crInv . ix invid . itAttachment - . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) - _ -> w' - pos = fromMaybe (V2 0 0) $ w ^? props . ix pjid . pjPos retireRemoteBomb :: Int -> Int -> Int -> World -> World retireRemoteBomb itid 0 pjid w = w & pointToItem (_itemPositions w IM.! itid) %~ @@ -851,12 +806,6 @@ moveRemoteBomb itid time pID w (50 *.* unitVectorAtAngle (negate $ degToRad (10 * fromIntegral time))) [-0.2,-0.15,-0.1,-0.05,0,0.05,0.1,0.15,0.2] -setRemoteScope :: Int -> Prop -> World -> World -setRemoteScope itid pj w' = case w' ^? itemPositions . ix itid of - Just (InInv cid' invid ) - -> w' & creatures . ix cid' . crInv . ix invid . itAttachment - . scopePos .~ (_pjPos pj -.- _crPos (_creatures w' IM.! cid')) - _ -> w' setRemoteBombScope :: Int -> Prop -> World -> World setRemoteBombScope itid pj w' = case _itemPositions w' IM.! itid of @@ -873,7 +822,7 @@ grenade = Throwable , _itIdentity = Grenade , _itMaxStack = 8 , _itAmount = 1 - , _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _twMaxRange = 150 , _twAccuracy = 30 , _itUse = \_ -> throwGrenade makeExplosionAt @@ -884,7 +833,7 @@ grenade = Throwable , _itAimingRange = 0 , _itZoom = defaultItZoom , _itAimZoom = defaultItZoom {_itZoomMax = f fuseTime, _itZoomMin = f fuseTime} - , _itEquipPict = pictureWeaponOnAim $ \it -> grenadePic fuseTime + , _itEquipPict = pictureWeaponOnAim $ \_ -> grenadePic fuseTime , _itID = Nothing , _itUseRate = 25 , _itUseTime = 0 @@ -926,7 +875,7 @@ remoteBomb = defaultThrowable , _itIdentity = RemoteBomb , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _twMaxRange = 150 , _twAccuracy = 30 , _itUse = const throwRemoteBomb @@ -934,104 +883,9 @@ remoteBomb = defaultThrowable [ hammerCheckI ] , _itAttachment = ItScope (V2 0 0) 0 1 True - , _itEquipPict = pictureWeaponOnAim $ \it -> (,) emptySH remoteBombUnarmedPic + , _itEquipPict = pictureWeaponOnAim $ \_ -> (,) emptySH remoteBombUnarmedPic } -fireRemoteLauncher :: Creature -> World -> World -fireRemoteLauncher cr w = setLocation - $ resetFire - $ resetName - $ soundStart (CrWeaponSound cid 0) pos tap4S Nothing - $ over props addRemRocket w - where - i = IM.newKey $ _props w - cid = _crID cr - dir = _crDir cr - pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0) - addRemRocket = IM.insert i $ Shell - { _pjPos = pos - , _pjZ = 20 - , _pjStartPos = pos - , _pjVel = rotateV dir (V2 1 0) - , _prDraw = remoteShellDraw - , _pjID = i - , _pjUpdate = \pj -> decTimMvVel pj . setRemoteScope itid pj . moveRemoteShell cid itid pj - , _pjAcc = V2 0 0 - , _pjDir = dir - , _pjSpin = 0 - , _pjPayload = makeExplosionAt - , _pjTimer = 50 - } - j = _crInvSel cr - newitid = IM.newKey $ _itemPositions w - maybeitid = cr ^? crInv . ix j . itID . _Just - resetFire = set (creatures . ix cid . crInv . ix j . itUse) - $ \_ _ -> explodeRemoteRocket itid i - resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEROCKET" - setLocation :: World -> World - setLocation w' = case maybeitid of - Nothing -> w' & creatures . ix cid . crInv . ix j . itID ?~ newitid - & itemPositions %~ IM.insert newitid (InInv cid j) - _ -> w' - itid = fromMaybe newitid maybeitid - -moveRemoteShell :: Int -> Int -> Prop -> World -> World -moveRemoteShell cid itid pj w - | time > 40 = if circOnSomeWall oldPos 4 w - then doExplosion w - else w - | time >= 20 = case thingHit of - Just _ -> doExplosion w - Nothing -> w & props . ix i . pjDir .~ newdir - | time > -99 = case thingHit of - Just _ -> doExplosion $ stopSoundFrom (ShellSound i) w - Nothing -> w & set randGen g - & props . ix i %~ - ( ( pjVel %~ ( (accel +.+) . (frict *.*) ) ) - . ( pjDir .~ newdir ) - ) - & soundContinue (ShellSound i) newPos missileLaunchS (Just 1) - & smokeGen - & makeFlameletTimed oldPos 20 (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 - | time > -200 = case thingHit of - Just _ -> doExplosion $ stopSoundFrom (ShellSound i) w - Nothing -> w - | otherwise = doExplosion $ stopSoundFrom (ShellSound i) w - where - time = _pjTimer pj - i = _pjID pj - oldPos = _pjPos pj - vel = _pjVel pj - newPos = oldPos +.+ vel - newdir - | SDL.ButtonRight `S.member` _mouseButtons w - && w ^? creatures . ix cid . crInvSel == w ^? itemPositions . ix itid . itInvId - = _cameraRot w + argV (_mousePos w) - | otherwise = _pjDir pj - accel = rotateV newdir (V2 2 0) - (frict,g) = randomR (0.6,0.9) $ _randGen w - (sparkD,_) = randomR (-0.5,0.5) $ _randGen w - hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w - hitWl = fst <$> collideCircWalls oldPos newPos 2 (wallsNearPoint newPos w) - thingHit = hitCr <|> hitWl - r1 = _randGen w & evalState (randInCirc 10) - smokeGen = shellTrailCloud $ addZ 20 $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos) - doExplosion = explodeRemoteRocket itid i - -explodeRemoteRocket - :: Int -- ^ Item id - -> Int -- ^ Projectile id - -> World - -> World -explodeRemoteRocket itid pjid w - = set (props . ix pjid . pjUpdate) (\_ -> retireRemoteRocket itid 30 pjid) - $ set (props . ix pjid . prDraw) (const mempty) - $ set (itPoint . itUse) (\_ _ -> id) - $ resetName - $ makeExplosionAt (_pjPos (_props w IM.! pjid)) w - where - resetName = set (itPoint . itName) "REMOTELAUNCHER" - itPoint = pointToItem $ _itemPositions w IM.! itid throwRemoteBomb :: Creature -> World -> World throwRemoteBomb cr w = setLocation @@ -1084,7 +938,7 @@ explodeRemoteBomb itid pjid cr w cid = _crID cr resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB" resetPict = set (creatures . ix cid . crInv . ix j . itEquipPict ) - (pictureWeaponOnAim $ \it -> (,) emptySH remoteBombUnarmedPic) + (pictureWeaponOnAim $ \_ -> (,) emptySH remoteBombUnarmedPic) -- resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0) j = _crInvSel $ _creatures w IM.! cid remoteBombPic @@ -1106,7 +960,7 @@ pipe = Craftable , _itName = "PIPE" , _itMaxStack = 3 , _itAmount = 3 - , _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \_ _ -> emptyBlank , _itID = Nothing , _itInvDisplay = _itName @@ -1132,13 +986,13 @@ radar = defaultGun , _wpSpread = autogunSpread , _wpRange = 20 , _itHammer = HammerUp - , _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) , _itAmount = 1 , _itMaxStack = 1 , _itAimingRange = 1 , _itZoom = defaultItZoom { _itZoomMax = 1} , _itAimZoom = defaultItZoom { _itZoomMax = 1} - , _itEquipPict = pictureWeaponOnAim $ \it -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) + , _itEquipPict = pictureWeaponOnAim $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) } {- | Sends out pulses that display creatures. -} @@ -1158,13 +1012,13 @@ sonar = defaultGun ] , _wpRange = 20 , _itHammer = HammerUp - , _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) , _itAmount = 1 , _itMaxStack = 1 , _itAimingRange = 1 , _itZoom = defaultItZoom {_itZoomMax = 1} , _itAimZoom = defaultItZoom {_itZoomMax = 1} - , _itEquipPict = pictureWeaponOnAim $ \it -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) + , _itEquipPict = pictureWeaponOnAim $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5) } {- | Automatically sends out pulses that display creatures. -} @@ -1174,7 +1028,7 @@ autoSonar = defaultEquipment , _itName = "AUTOSONAR" , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \_ _ -> (,) emptySH blank , _itEffect = autoSonarEffect , _itID = Nothing @@ -1191,7 +1045,7 @@ autoRadar = defaultEquipment , _itName = "AUTORADAR" , _itMaxStack = 1 , _itAmount = 1 - , _itFloorPict = \it -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] + , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] , _itEquipPict = \_ _ -> (,) emptySH blank , _itEffect = autoRadarEffect , _itID = Nothing diff --git a/src/Dodge/Item/Weapon/AmmoParams.hs b/src/Dodge/Item/Weapon/AmmoParams.hs index 6bb4a5ada..79d6c9e25 100644 --- a/src/Dodge/Item/Weapon/AmmoParams.hs +++ b/src/Dodge/Item/Weapon/AmmoParams.hs @@ -49,5 +49,11 @@ withDelayedVelWthHiteff vfact vel width hiteff cr = over particles (newbul : ) loadedAmmo :: Item -> Int loadedAmmo it - | _wpReloadState it == 0 = fromIntegral $ _wpLoadedAmmo it + | _wpReloadState it == 0 = _wpLoadedAmmo it | otherwise = 0 + +fractionLoadedAmmo :: Item -> Float +fractionLoadedAmmo it = fromIntegral (loadedAmmo it) / fromIntegral (_wpMaxAmmo it) + +fractionLoadedAmmo2 :: Item -> Float +fractionLoadedAmmo2 it = 1 - (1 - fromIntegral (loadedAmmo it) / fromIntegral (_wpMaxAmmo it))**2 diff --git a/src/Dodge/Item/Weapon/Bezier.hs b/src/Dodge/Item/Weapon/Bezier.hs index 88146e670..6384bf0f3 100644 --- a/src/Dodge/Item/Weapon/Bezier.hs +++ b/src/Dodge/Item/Weapon/Bezier.hs @@ -6,6 +6,7 @@ import Dodge.Default.Weapon import Dodge.Item.Data import Dodge.Item.Draw import Dodge.Item.Weapon.Targeting +import Dodge.Item.Weapon.AutoGun import Dodge.Item.Weapon.TriggerType import Dodge.Item.Weapon.ExtraEffect import Dodge.Item.Attachment.Data @@ -15,10 +16,10 @@ import Dodge.Particle.Bullet.HitEffect import Dodge.WorldEvent.HitEffect import Dodge.RandomHelp import Dodge.SoundLogic.LoadSound -import Picture +--import Picture import Geometry import ShapePicture -import Shape +--import Shape import Data.Maybe import Control.Lens @@ -35,8 +36,8 @@ bezierGun = defaultGun . withRecoilI 40 . torqueBefore 0.05 ] - , _itFloorPict = \it -> bezierGunSPic - , _itEquipPict = pictureWeaponOnAim $ \it -> bezierGunSPic + , _itFloorPict = bezierGunSPic + , _itEquipPict = pictureWeaponOnAim bezierGunSPic , _itAttachment = NoItAttachment , _itScroll = \_ _ -> removeItTarget , _itHammer = HammerUp @@ -47,11 +48,8 @@ bezierGun = defaultGun , _itUseRate = 6 , _itAimStance = TwoHandTwist } -bezierGunSPic :: SPic -bezierGunSPic = - ( colorSH red $ upperPrismPoly 5 $ rectNESW 4 12 (-4) (-12) - , mempty - ) +bezierGunSPic :: Item -> SPic +bezierGunSPic = autoGunPic shootBezier :: Point2 -> Creature -> World -> World shootBezier targetp cr w = w & particles %~ (theBullet :) diff --git a/src/Dodge/Item/Weapon/Grenade.hs b/src/Dodge/Item/Weapon/Grenade.hs index 736f05cfc..9b6a7e80a 100644 --- a/src/Dodge/Item/Weapon/Grenade.hs +++ b/src/Dodge/Item/Weapon/Grenade.hs @@ -97,5 +97,5 @@ throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x } counterDown it | _itEffectCounter (_itEffect it) == 0 = it & itHammer .~ HammerUp - & itEquipPict .~ pictureWeaponOnAim (\itp -> grenadePic 50) + & itEquipPict .~ pictureWeaponOnAim (\_ -> grenadePic 50) | otherwise = it & itEffect . itEffectCounter -~ 1 diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index ac13721be..5f03ebc3a 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -7,8 +7,10 @@ import Dodge.Default.Shell import Dodge.SoundLogic.LoadSound import Dodge.WorldEvent.Explosion import Dodge.Item.Data +import Dodge.Item.Attachment.Data import Dodge.Item.Draw import Dodge.Item.Weapon.Shell +import Dodge.Item.Weapon.Remote import Dodge.Item.Weapon.TriggerType import Dodge.Base import Dodge.Zone @@ -16,6 +18,7 @@ import Dodge.SoundLogic import Dodge.WorldEvent.SpawnParticle import Dodge.WorldEvent.Cloud import Dodge.RandomHelp +import Dodge.Picture.Layer import Geometry import Geometry.Vector3D import Picture @@ -24,6 +27,8 @@ import Padding import ShapePicture import Shape +import qualified Data.Set as S +import qualified SDL import Data.Maybe import Control.Lens import Control.Applicative @@ -49,10 +54,10 @@ launcher = defaultGun ] , _wpSpread = 0.02 , _wpRange = 20 - , _itFloorPict = \it -> launcherPic + , _itFloorPict = launcherPic , _itAimingSpeed = 0.2 , _itAimingRange = 0.5 - , _itEquipPict = pictureWeaponOnAim $ \it -> launcherPic + , _itEquipPict = pictureWeaponOnAim launcherPic , _itHammer = NoHammer , _itEffect = NoItEffect , _wpAmmo = defaultShellAmmo @@ -64,9 +69,11 @@ launcher = defaultGun , _itAimStance = TwoHandTwist } -launcherPic :: SPic -launcherPic = - ( colorSH cyan $ upperPrismPoly 7 $ rectNESW 5 10 (-5) (-10) +launcherPic :: Item -> SPic +launcherPic _ = + ( colorSH cyan $ prismPoly + (map (+.+.+ V3 10 0 4.5) $ polyCircx 4 5) + (map (+.+.+ V3 (-10) 0 4.5) $ polyCircx 4 5) , mempty ) @@ -228,3 +235,169 @@ trySpinByCID cid i pj w = w & props . ix pjid . pjSpin .~ newSpin Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor _ -> 0 spinFactor = 5 * (6 - fromIntegral i) + + +remoteLauncher :: Item +remoteLauncher = defaultGun + { _itName = "ROCKO-REM" + , _itIdentity = RemoteLauncher + , _wpMaxAmmo = 1 + , _wpLoadedAmmo = 1 + , _wpReloadTime = 80 + , _wpReloadState = 0 + , _itUseRate = 10 + , _itUseTime = 0 + , _itUse = const fireRemoteLauncher + , _itUseModifiers = + [ ammoCheckI + , hammerCheckI + ] + , _wpSpread = 0.02 + , _wpRange = 20 + , _itFloorPict = launcherPic + , _itAimingSpeed = 0.2 + , _itAimingRange = 0.5 + , _itEquipPict = pictureWeaponOnAim launcherPic + , _itAttachment = ItScope (V2 0 0) 0 1 True + , _itAimStance = TwoHandTwist + } + +fireRemoteLauncher :: Creature -> World -> World +fireRemoteLauncher cr w = setLocation + $ resetFire + $ resetName + $ soundStart (CrWeaponSound cid 0) pos tap4S Nothing + $ over props addRemRocket w + where + i = IM.newKey $ _props w + cid = _crID cr + dir = _crDir cr + pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0) + addRemRocket = IM.insert i $ Shell + { _pjPos = pos + , _pjZ = 20 + , _pjStartPos = pos + , _pjVel = rotateV dir (V2 1 0) + , _prDraw = remoteShellDraw + , _pjID = i + , _pjUpdate = \pj -> decTimMvVel pj . setRemoteScope itid pj . moveRemoteShell cid itid pj + , _pjAcc = V2 0 0 + , _pjDir = dir + , _pjSpin = 0 + , _pjPayload = makeExplosionAt + , _pjTimer = 50 + } + j = _crInvSel cr + newitid = IM.newKey $ _itemPositions w + maybeitid = cr ^? crInv . ix j . itID . _Just + resetFire = set (creatures . ix cid . crInv . ix j . itUse) + $ \_ _ -> explodeRemoteRocket itid i + resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEROCKET" + setLocation :: World -> World + setLocation w' = case maybeitid of + Nothing -> w' & creatures . ix cid . crInv . ix j . itID ?~ newitid + & itemPositions %~ IM.insert newitid (InInv cid j) + _ -> w' + itid = fromMaybe newitid maybeitid + +moveRemoteShell :: Int -> Int -> Prop -> World -> World +moveRemoteShell cid itid pj w + | time > 40 = if circOnSomeWall oldPos 4 w + then doExplosion w + else w + | time >= 20 = case thingHit of + Just _ -> doExplosion w + Nothing -> w & props . ix i . pjDir .~ newdir + | time > -99 = case thingHit of + Just _ -> doExplosion $ stopSoundFrom (ShellSound i) w + Nothing -> w & set randGen g + & props . ix i %~ + ( ( pjVel %~ ( (accel +.+) . (frict *.*) ) ) + . ( pjDir .~ newdir ) + ) + & soundContinue (ShellSound i) newPos missileLaunchS (Just 1) + & smokeGen + & makeFlameletTimed oldPos 20 (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 + | time > -200 = case thingHit of + Just _ -> doExplosion $ stopSoundFrom (ShellSound i) w + Nothing -> w + | otherwise = doExplosion $ stopSoundFrom (ShellSound i) w + where + time = _pjTimer pj + i = _pjID pj + oldPos = _pjPos pj + vel = _pjVel pj + newPos = oldPos +.+ vel + newdir + | SDL.ButtonRight `S.member` _mouseButtons w + && w ^? creatures . ix cid . crInvSel == w ^? itemPositions . ix itid . itInvId + = _cameraRot w + argV (_mousePos w) + | otherwise = _pjDir pj + accel = rotateV newdir (V2 2 0) + (frict,g) = randomR (0.6,0.9) $ _randGen w + (sparkD,_) = randomR (-0.5,0.5) $ _randGen w + hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w + hitWl = fst <$> collideCircWalls oldPos newPos 2 (wallsNearPoint newPos w) + thingHit = hitCr <|> hitWl + r1 = _randGen w & evalState (randInCirc 10) + smokeGen = shellTrailCloud $ addZ 20 $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos) + doExplosion = explodeRemoteRocket itid i + +explodeRemoteRocket + :: Int -- ^ Item id + -> Int -- ^ Projectile id + -> World + -> World +explodeRemoteRocket itid pjid w + = set (props . ix pjid . pjUpdate) (\_ -> retireRemoteRocket itid 30 pjid) + $ set (props . ix pjid . prDraw) (const mempty) + $ set (itPoint . itUse) (\_ _ -> id) + $ resetName + $ makeExplosionAt (_pjPos (_props w IM.! pjid)) w + where + resetName = set (itPoint . itName) "REMOTELAUNCHER" + itPoint = pointToItem $ _itemPositions w IM.! itid + +remoteShellDraw :: Prop -> SPic +remoteShellDraw pj + | t > 40 = (,) mempty $ onLayerL [levLayer CrLayer - 2] + $ uncurryV translate pos $ rotate dir $ remoteShellPic t + | otherwise = (,) mempty $ uncurryV translate pos $ rotate dir $ remoteShellPic t + where + t = _pjTimer pj + pos = _pjPos pj + dir = _pjDir pj + +remoteShellPic + :: Int -- ^ Timer + -> Picture +remoteShellPic t + | rem (t+200) 20 < 9 = setDepth 20 $ polygon $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] + | otherwise = pictures + [ setDepth 20 $ polygon $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] + , setLayer 1 . setDepth 20.5 . color col $ circleSolid 3 + ] + where + col | t > (-99) = green + | otherwise = red +retireRemoteRocket :: Int -> Int -> Int -> World -> World +retireRemoteRocket itid 0 pjid w = + set (pointToItem (_itemPositions w IM.! itid) . itAttachment . scopePos) (V2 0 0) + $ set (pointToItem (_itemPositions w IM.! itid) . itUse) (const fireRemoteLauncher) + (w & props %~ IM.delete pjid) +retireRemoteRocket itid t pjid w = setScope w + & props . ix pjid . pjUpdate .~ (\_ -> retireRemoteRocket itid (t-1) pjid) + where + setScope w' = case _itemPositions w' IM.! itid of + InInv cid invid -> w' + & creatures . ix cid . crInv . ix invid . itAttachment + . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) + _ -> w' + pos = fromMaybe (V2 0 0) $ w ^? props . ix pjid . pjPos + +setRemoteScope :: Int -> Prop -> World -> World +setRemoteScope itid pj w' = case w' ^? itemPositions . ix itid of + Just (InInv cid' invid ) + -> w' & creatures . ix cid' . crInv . ix invid . itAttachment + . scopePos .~ (_pjPos pj -.- _crPos (_creatures w' IM.! cid')) + _ -> w' diff --git a/src/Dodge/Item/Weapon/Remote.hs b/src/Dodge/Item/Weapon/Remote.hs new file mode 100644 index 000000000..d0a90af32 --- /dev/null +++ b/src/Dodge/Item/Weapon/Remote.hs @@ -0,0 +1,10 @@ +module Dodge.Item.Weapon.Remote + where +import Dodge.Data + +import Control.Lens + +pointToItem :: Applicative f => + ItemPos -> (Item -> f Item) -> World -> f World +pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid +pointToItem (OnFloor flid) = floorItems . ix flid . flIt diff --git a/src/Dodge/Layout/Tree/Annotate.hs b/src/Dodge/Layout/Tree/Annotate.hs index a4485f6c1..ddfbc4d96 100644 --- a/src/Dodge/Layout/Tree/Annotate.hs +++ b/src/Dodge/Layout/Tree/Annotate.hs @@ -75,7 +75,7 @@ annoToRoomTree [OrAno as] = do annoToRoomTree [Corridor] = pure . Right <$> randomiseOutLinks corridor annoToRoomTree [CorridorDebug] = pure . Right <$> randomiseOutLinks corridorDebug annoToRoomTree [DoorAno] = roomThenCorridor door -annoToRoomTree [DoorNumAno i,AirlockAno] = airlock >>= roomThenCorridor +annoToRoomTree [DoorNumAno _,AirlockAno] = airlock >>= roomThenCorridor annoToRoomTree [FirstWeapon] = do branchWP <- branchRectWith weaponRoom blockedC <- longBlockedCorridor diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index 8a8f4f4e4..291d74e2f 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -20,6 +20,7 @@ import Dodge.Item.Consumable import Dodge.Item.Equipment import Dodge.Room.Foreground import Dodge.Item.Weapon +import Dodge.Item.Weapon.Launcher import Dodge.RandomHelp import Dodge.LevelGen import Dodge.LevelGen.Data diff --git a/src/Geometry/Vector3D.hs b/src/Geometry/Vector3D.hs index 60474afc4..deeb2566d 100644 --- a/src/Geometry/Vector3D.hs +++ b/src/Geometry/Vector3D.hs @@ -61,6 +61,18 @@ rotate3x a (V3 x y z) = V3 x y' z' where (V2 y' z') = rotateV a (V2 y z) +rotate3y :: Float -> Point3 -> Point3 +{-# INLINE rotate3y #-} +rotate3y a (V3 x y z) = V3 x' y z' + where + (V2 x' z') = rotateV a (V2 x z) + +vNormaly :: Point3 -> Point3 +{-# INLINE vNormaly #-} +vNormaly (V3 x y z) = V3 x' y z' + where + V2 x' z' = vNormal $ V2 x z + magV3 :: Point3 -> Float {-# INLINE magV3 #-} magV3 (V3 x y z) = sqrt $ x^i + y^i + z^i diff --git a/src/Shape.hs b/src/Shape.hs index 2234811b1..2dec774bc 100644 --- a/src/Shape.hs +++ b/src/Shape.hs @@ -11,6 +11,7 @@ module Shape , translateSHf , rotateSH , rotateSHx + , polyCircx , scaleSH , colorSH ) @@ -24,10 +25,15 @@ emptySH :: Shape {-# INLINE emptySH #-} emptySH = mempty +-- - approximate a circle by a polygon with n*2 points of radius x polyCirc :: Int -> Float -> [Point2] {-# INLINE polyCirc #-} polyCirc n x = map (\a -> rotateV a (V2 x 0)) $ take (n*2) [0,pi/fromIntegral n..] +-- - approximate a circle around the x axis by a polygon with n*2 points of radius r +polyCircx :: Int -> Float -> [Point3] +polyCircx n = map (vNormaly . addZ 0) . polyCirc n + -- very "unsafe": be careful with the inputs -- length of polys must be the same -- points should be correctly ordered so that diff --git a/src/ShapePicture.hs b/src/ShapePicture.hs index a954bad7c..e32fac45b 100644 --- a/src/ShapePicture.hs +++ b/src/ShapePicture.hs @@ -16,9 +16,8 @@ emptyBlank = (emptySH,blank) translateSPf :: Float -> Float -> SPic -> SPic translateSPf x y = bimap (translateSH (V3 x y 0)) (translate x y) --- TODO make this uniform: currently the shape translates and the picture is set to a constant translateSPz :: Float -> SPic -> SPic -translateSPz z = bimap (translateSH (V3 0 0 z)) (setDepth z) +translateSPz z = bimap (translateSH (V3 0 0 z)) (translate3 (V3 0 0 z)) rotateSP :: Float -> SPic -> SPic rotateSP a = bimap (rotateSH a) (rotate a)