Cleanup

src/Dodge/Creature/State.hs

@@ -3,16 +3,13 @@ module Dodge.Creature.State (
     doDamage,
 ) where
 
-import Dodge.HeldUse
-import Dodge.BaseTriggerType
-import Dodge.Data.DoubleTree
-import Dodge.Item.Orientation
 import Control.Applicative
 import Control.Monad
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Data.Monoid
 import Dodge.Base
+import Dodge.BaseTriggerType
 import Dodge.Corpse.Make
 import Dodge.Creature.Action
 import Dodge.Creature.Damage
@@ -22,16 +19,19 @@ import Dodge.Creature.Test
 import Dodge.Damage
 import Dodge.Data.ComposedItem
 import Dodge.Data.Damage.Type
+import Dodge.Data.DoubleTree
 --import Dodge.Data.DoubleTree
 import Dodge.Data.World
 import Dodge.DoubleTree
 import Dodge.Euse
+import Dodge.HeldUse
 import Dodge.Inventory.SelectionList
 import Dodge.Item.BackgroundEffect
 import Dodge.Item.Grammar
 import Dodge.Item.HeldOffset
 import Dodge.Item.Location
 import Dodge.Item.MaxAmmo
+import Dodge.Item.Orientation
 import Dodge.Prop.Gib
 import Dodge.SoundLogic
 import Dodge.Targeting.Draw
@@ -158,44 +158,45 @@ invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
     EQUIP WRIST_ECG | haspulse -> tryUseParent loc w
     COPIER _ -> copierItemUpdate itm cr w
     HELD FLATSHIELD -> rootNotrootEff createShieldWall removeShieldWall itm cr w
-    HELD MINIGUNX{}
+    HELD MINIGUNX{} -> coolMinigun itm w
-        | itm ^? itParams . isWarming == Just True ->
+    HELD MACHINEPISTOL{} -> coolMachinePistol cr itm w
-            w
-                & pointerToItem itm . itParams . isWarming .~ False
-        | otherwise ->
-            w & pointerToItem itm . itParams . wTime
-                %~ (max 0 . subtract 1)
-        -- hard code values?
-    HELD MACHINEPISTOL{}
-        | fromMaybe 0 (itm ^? itParams . wTime) >= _coolEnd (baseItemTriggerType itm) ->
-            w & pointerToItem itm . itParams . wTime
-                .~ 0
-                & pointerToItem itm . itParams . coolSound .~ Nothing
-        | fromMaybe 0 (itm ^? itParams . wTime) == _coolStart (baseItemTriggerType itm) ->
-            w
-                & randGen .~ g
-                & pointerToItem itm . itParams . wTime +~ 1
-                & pointerToItem itm . itParams . coolSound ?~ sid
-                & soundContinue (CrWeaponSound (_crID cr) (fromIntegral $ _itID itm)) (_crPos cr) sid (Just 1)
-        | fromMaybe 0 (itm ^? itParams . wTime) > _coolStart (baseItemTriggerType itm) ->
-            w
-                & pointerToItem itm . itParams . wTime +~ 1
-                & soundContinue (CrWeaponSound (_crID cr) (fromIntegral $ _itID itm)) (_crPos cr) (fromMaybe undefined (itm ^? itParams . coolSound . _Just)) (Just 1)
-        | itm ^? itParams . isWarming == Just True ->
-            w
-                & pointerToItem itm . itParams . isWarming .~ False
-        | fromMaybe 0 (itm ^? itParams . wTime) >= _warmStart (baseItemTriggerType itm) ->
-            w & pointerToItem itm . itParams . wTime
-                .~ _coolStart (baseItemTriggerType itm)
-        | otherwise ->
-            w & pointerToItem itm . itParams . wTime
-                .~ 0
     _ -> w
   where
     haspulse =
         w ^? cWorld . lWorld . creatures . ix 0 . crType . avatarPulse . pulseProgress
             == Just 0
     itm = loc ^. locLDT . ldtValue . _1
+
+coolMinigun :: Item -> World -> World
+coolMinigun itm
+    | itm ^? itParams . isWarming == Just True = d . isWarming .~ False
+    | otherwise = d . wTime %~ (max 0 . subtract 1)
+  where
+    d = pointerToItem itm . itParams
+
+coolMachinePistol :: Creature -> Item -> World -> World
+coolMachinePistol cr itm w
+    | fromMaybe 0 (itm ^? itParams . wTime) >= _coolEnd (baseItemTriggerType itm) =
+        w & d . wTime .~ 0
+            & d . coolSound .~ Nothing
+    | fromMaybe 0 (itm ^? itParams . wTime) == _coolStart (baseItemTriggerType itm) =
+        w
+            & randGen .~ g
+            & d . wTime +~ 1
+            & d . coolSound ?~ sid
+            & dosound sid
+    | fromMaybe 0 (itm ^? itParams . wTime) > _coolStart (baseItemTriggerType itm) =
+        w
+            & d . wTime +~ 1
+            & dosound (fromMaybe undefined (itm ^? itParams . coolSound . _Just))
+    | itm ^? itParams . isWarming == Just True = w & d . isWarming .~ False
+    | fromMaybe 0 (itm ^? itParams . wTime) >= _warmStart (baseItemTriggerType itm) =
+        w & d . wTime .~ _coolStart (baseItemTriggerType itm)
+    | otherwise = w & d . wTime .~ 0
+  where
+    dosound s = soundContinue 
+        (CrWeaponSound (_crID cr) (fromIntegral $ _itID itm)) (_crPos cr) s (Just 1)
+    d = pointerToItem itm . itParams
     (sid, g) = runState (takeOne [whirdownSmall1S, whirdownSmall2S]) (w ^. randGen)
 
 copierItemUpdate :: Item -> Creature -> World -> World
@@ -290,19 +291,14 @@ updateAttachedItems itmtree cr =
         (LocLDT TopLDT itmtree)
 
 -- need to check rotation
-chainLinkOrientation ::
+chainLinkOrientation :: Point3Q -> CItem -> ItemLink -> CItem -> Point3Q
-    (Point3, Q.Quaternion Float) ->
+chainLinkOrientation o par lt child =
-    CItem ->
+    o
-    ItemLink ->
+        `Q.comp` orientAttachment (par ^. _1) lt (child ^. _1)
-    CItem ->
-    (Point3, Q.Quaternion Float)
-chainLinkOrientation (p, q) par lt child = (p + Q.rotate q p1, q * q1)
-  where
-    (p1, q1) = orientAttachment (par ^. _1) lt (child ^. _1)
 
 updateItemWithOrientation ::
     Creature ->
-    (Point3, Q.Quaternion Float) ->
+    Point3Q ->
     LocationLDT ItemLink CItem ->
     World ->
     World
@@ -351,10 +347,7 @@ shineTargetLaser cr loc o w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $
                     }
   where
     itmtree = loc ^. locLDT
-    --(p,q) = heldItemRelativeOrient (locToTop loc ^. locLDT . ldtValue . _1) cr 
-    --    $ orientLocation (V3 0 0 0,Q.qID) (fmap fst loc) (V3 5 0 0,Q.qID)
     (p, q) = o `Q.comp` (V3 5 0 0, Q.qID)
---        $ orientLocation (V3 0 0 0,Q.qID) (fmap fst loc) (V3 5 0 0,Q.qID)
     x = 1
     isammolink AmmoInLink{} = True
     isammolink _ = False
@@ -366,47 +359,6 @@ shineTargetLaser cr loc o w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $
     invid = _ilInvID $ _itLocation itm
     col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
 
---shineTargetLaser ::
---    Creature ->
---    LDTree ItemLink CItem ->
---    (Point3, Q.Quaternion Float) ->
---    World ->
---    World
---shineTargetLaser cr itmtree (p, q) w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ do
---    guard (crIsAiming cr)
---    (_, mag) <- find (isammolink . fst) (itmtree ^. ldtLeft)
---    i <- mag ^. ldtValue . _1 . itConsumables
---    guard $ i >= x
---    maginvid <- mag ^? ldtValue . _1 . itLocation . ilInvID
---    return $
---        w
---            & worldEventFlags . at InventoryChange ?~ ()
---            & cWorld . lWorld . creatures . ix (_crID cr)
---                . crInv
---                . ix maginvid
---                . itConsumables
---                . _Just
---                -~ x
---            & cWorld . lWorld . lasers
---                .:~ Laser
---                    { _lpPhaseV = 1
---                    , _lpDir = _crDir cr + argV (Q.qToV2 q)
---                    , _lpPos = pos
---                    , _lpColor = col
---                    , _lpType = TargetingLaser (_itID itm)
---                    }
---  where
---    x = 1
---    isammolink AmmoInLink{} = True
---    isammolink _ = False
---    pos = _crPos cr + xyV3 (rotate3 cdir (p + V3 5 0 0))
---    cdir = _crDir cr
---    itm = itmtree ^. ldtValue . _1
---    pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
---    cid = _crID cr
---    invid = _ilInvID $ _itLocation itm
---    col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
-
 shineTorch :: Creature -> LDTree ItemLink CItem -> Point3Q -> World -> World
 shineTorch cr itmtree (p, q) = fromMaybe id $ do
     (_, mag) <- find (isammolink . fst) (itmtree ^. ldtLeft)

src/Dodge/Data/Item/Location.hs

@@ -29,9 +29,9 @@ data ItemLocation
     = InInv 
         { _ilCrID :: Int
         , _ilInvID :: Int
-        , _ilIsRoot :: Bool
+        , _ilIsRoot :: Bool -- of any item
         , _ilIsSelected :: Bool
-        , _ilIsAttached :: Bool
+        , _ilIsAttached :: Bool -- to selected item
         , _ilEquipSite :: Maybe EquipSite
         }
     | OnTurret {_ilTuID :: Int}

src/Dodge/TestString.hs

@@ -27,9 +27,11 @@ import qualified Data.Map.Strict as M
 
 testStringInit :: Universe -> [String]
 testStringInit u = prettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv
-            . ix 0 . itTimeLastUsed)
+            . ix 0 . itLocation . ilIsRoot)
         <> prettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv
-            . ix 0 . itParams . wTime)
+            . ix 0 . itLocation . ilIsSelected)
+        <> prettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv
+            . ix 0 . itLocation . ilIsAttached)
         --return . foldMap (prettyLDT (show . (^. _1 . itType))) . invLDT $ _crInv cr
 --  where
 --    idp = invDisplayParams $ u ^. uvWorld

src/Quaternion.hs

@@ -60,9 +60,7 @@ qToAng = argV . qToV2
 qID :: Q.Quaternion Float
 qID = Q.axisAngle (V3 1 0 0) 0
 
-comp :: (Point3, Q.Quaternion Float)
+comp :: Point3Q -> Point3Q -> Point3Q
-    -> (Point3, Q.Quaternion Float)
-    -> (Point3, Q.Quaternion Float)
 comp (p,q) (p1,q1) = (p + Q.rotate q p1, q * q1)
 
 --deriving instance (Flat a => Flat (Quaternion a))