Tweak weapon pictures

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

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

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

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
     }

src/Dodge/Item/Data.hs

@@ -42,7 +42,7 @@ data ItemIdentity
     (Eq,Show,Ord,Enum)
 data AimStance
     = TwoHandTwist
-    | TwoHand
+    | TwoHandFlat
     | OneHand
     | LeaveHolstered
   deriving 

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

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

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 :: Item -> SPic
-teslaGunPic = 
+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 :: Item -> SPic
-lasGunPic = 
+lasGunPic it = 
     ( colorSH blue $ 
-        (upperPrismPoly 4 $ rectNESW 3 15 1 (-15))
+        upperPrismPoly 4 (rectNESW 3 15 1 (-15))
-        <> (upperPrismPoly 4 $ rectNESW (-1) 15 (-3) (-15))
+        <> upperPrismPoly 4 (rectNESW (-1) 15 (-3) (-15))
         -- <> (upperPrismPoly 4 $ rectNESW (5) l (-5) (l-2))
-        <> (upperPrismPoly 1 $ rectNESW (3) 15 (-3) (-15))
+        <> upperPrismPoly 1 (rectNESW 3 15 (-3) (-15))
-    , mempty
+    , 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 :: Item -> SPic
-hvAutoGunPic = 
+hvAutoGunPic it = 
-    ( colorSH orange $ upperPrismPoly 5 $ rectNESW 5 12 (-5) (-12)
+    ( 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 :: Item -> SPic
-ltAutoGunPic = 
+ltAutoGunPic it = 
-    ( colorSH green $ upperPrismPoly 5 $ mirrorXAxis [V2 (-5) 5, V2 5 5, V2 10 0]
+    ( 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))
+    --(   ( rotateSHx a .translateSH (V3 5 0 (-9)) .  colorSH red $ upperPrismPoly 18 $ rectNESW 9 7 (-9) (-5))
-        <> (colorSH red $ prismPoly 
+    (   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
+        <> clip (-1) 0
-        <> f (-7) 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 :: Item -> SPic
-spreadGunPic = 
+spreadGunPic it = 
-    ( colorSH green $ upperPrismPoly 5 $ map toV2[(-3,0),(3,6),(3,-6)]
+    ( 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 :: Item -> SPic
-multGunSPic = 
+multGunSPic it = 
-    ( colorSH red $
+    ( (colorSH red $
         upperPrismPoly 2 (rectNESW 4 8 (-4) (-12)) ++
-        translateSHf 8 0 (mconcat 
+        translateSHf 8 0 (concatMap barrel [12,7,2,-3,-8] <> 
-            [ upperPrismPoly 5 $ rectNSEW 12   8     2 (-2)
+            (upperPrismPoly 2 $ map toV2 [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)])
-            , 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)]
-            ]
             )
+    ) <> 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 :: Item -> SPic
-flamerPic = 
+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

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

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
+    , _itFloorPict = bezierGunSPic
-    , _itEquipPict = pictureWeaponOnAim $ \it -> bezierGunSPic
+    , _itEquipPict = pictureWeaponOnAim bezierGunSPic
     , _itAttachment = NoItAttachment
     , _itScroll   = \_ _ -> removeItTarget
     , _itHammer = HammerUp
@@ -47,11 +48,8 @@ bezierGun = defaultGun
     , _itUseRate = 6
     , _itAimStance = TwoHandTwist
     }
-bezierGunSPic :: SPic
+bezierGunSPic :: Item -> SPic
-bezierGunSPic = 
+bezierGunSPic = autoGunPic
-    ( colorSH red $ upperPrismPoly 5 $ rectNESW 4 12 (-4) (-12)
-    , mempty
-    )
 
 shootBezier :: Point2 -> Creature -> World -> World
 shootBezier targetp cr w = w & particles %~ (theBullet :)

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

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 :: Item -> SPic
-launcherPic = 
+launcherPic _ = 
-    ( colorSH cyan $ upperPrismPoly 7 $ rectNESW 5 10 (-5) (-10)
+    ( 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'

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

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

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

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

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

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)