Cleanup

src/Dodge/Combine/Combinations.hs

@@ -81,14 +81,29 @@ itemCombinations =
     , p [p 2 $ cr DRUM] plateCraft
 
     , p [p 2 $ cr PLATE] flatShield
+    
+    , po [cr MICROCHIP, cr PRISM] (makeTypeCraft LIGHTSENSOR)
+    , po [cr MICROCHIP, cr MAGNET] (makeTypeCraft SOUNDSENSOR)
+    , po [cr MICROCHIP, cr THERMOMETER] (makeTypeCraft HEATSENSOR)
+
+    , po [cr MICROCHIP, cr TRANSMITTER, cr LIGHTSENSOR] (autoDetector ITEMDETECTOR)
+    , po [cr MICROCHIP, cr TRANSMITTER, cr SOUNDSENSOR] (autoDetector WALLDETECTOR)
+    , po [cr MICROCHIP, cr TRANSMITTER, cr HEATSENSOR]  (autoDetector CREATUREDETECTOR)
+    
+    , po [cr BATTERY, cr LED] torch
+
+    , po [hd TORCH, eq HAT] headLamp
+
+    , po [cr LIGHTER, cr THERMOMETER, cr MICROCHIP] (makeTypeCraft INCENDIARYMODULE)
+    , po [cr TRANSFORMER, cr BATTERY, cr MICROCHIP] (makeTypeCraft STATICMODULE)
     ] 
     ++ map (\i -> po [HELD (LASWIDE i),cr TRANSFORMER] $ lasWide (i+1)) [2..9]
 --    ++ map (\i -> po [LASGUNWIDE i,cr HARDWARE] $ lasFocus i) [2..10]
     ++ map (\i -> po [cr PIPE,HELD (BANGSTICK i)] $ bangStick (i+1)) [1..8]
-    ++ map (\i -> po [HELD (REVOLVERX i),cr CAN]  $ revolverX (i+1)) [1..5]
+    ++ map (\i -> po [hd (REVOLVERX i),cr CAN]  $ revolverX (i+1)) [1..5]
-    ++ map (\i -> po [HELD (VOLLEYGUN i),HELD (BANGSTICK 1)] $ volleyGun (i+1)) [3..5]
+    ++ map (\i -> po [hd (VOLLEYGUN i),HELD (BANGSTICK 1)] $ volleyGun (i+1)) [3..5]
-    ++ map (\i -> po [HELD (MINIGUNX i),HELD (BANGSTICK 1)] $ miniGunX (i+1)) [3..15]
+    ++ map (\i -> po [hd (MINIGUNX i),HELD (BANGSTICK 1)] $ miniGunX (i+1)) [3..15]
-    ++ map (\i -> po [HELD (GRAPECANNON i),cr DRUM] $ grapeCannon (i+1)) [1,2,3]
+    ++ map (\i -> po [hd (GRAPECANNON i),cr DRUM] $ grapeCannon (i+1)) [1,2,3]
 
     ++ [ po (_iyBase (_itType it):mtype) $ it & itType . iyModules . ix modtype .~ m
             | (modtype,is,ms) <- moduleCombinations
@@ -100,13 +115,15 @@ itemCombinations =
     po xs it = (map o xs,it)
     o = (1,)
     cr = CRAFT
+    hd = HELD
+    eq = EQUIP
 
 moduleCombinations :: [( ModuleSlot, [Item], [([ItemBaseType],ItemModuleType)] )]
 moduleCombinations =
     [   ( ModRifleMag
         ,   [repeater
             ,autoRifle
---            ,burstRifle
+            ,burstRifle
 --            ,fastBurstRifle
             ]
         ,   [amod [cr DRUM,cr HARDWARE]  DRUMMAG
@@ -131,9 +148,9 @@ moduleCombinations =
         )
     ,   ( ModTarget
         , homingLaunchers ++ bulletWeapons
-        ,   [amod [cr MICROCHIP,cr CREATURESENSOR]    TARGCR
+        ,   [amod [cr MICROCHIP,cr HEATSENSOR]  TARGCR
-            ,amod [cr MICROCHIP,cr PRISM]             TARGLAS
+            ,amod [cr MICROCHIP,cr LIGHTSENSOR] TARGLAS
-            ,amod [cr MICROCHIP,cr TIN]               TARGPOS
+            ,amod [cr MICROCHIP,cr SOUNDSENSOR] TARGPOS
             ]
         )
     ,   ( ModBulletTrajectory

src/Dodge/Combine/Data.hs

@@ -31,6 +31,7 @@ data CraftType
     | MOTOR
     | TRANSFORMER
     | PRISM
+    | THERMOMETER
     | LIGHTER
     | MAGNET
     | ANTIMATTER
@@ -94,12 +95,12 @@ data EquipItemType
     | WRISTARMOUR
     | INVISIBILITYEQUIPMENT EquipSite
     | BRAINHAT
+    | HAT
     | HEADLAMP
     | HEADLAMP1
     | POWERLEGS
     | SPEEDLEGS
     | JUMPLEGS
-    | FLATSHIELD
     | JETPACK
     | AUTODETECTOR Detector
   deriving (Eq,Ord,Show,Read)
@@ -171,6 +172,8 @@ data HeldItemType
     | FORCEFIELDGUN
 
     | HELDDETECTOR Detector
+    | TORCH
+    | FLATSHIELD
   deriving (Eq,Ord,Show,Read)
 
 data ItemModuleType 
@@ -212,6 +215,7 @@ data ModuleSlot
     | ModBattery
     | ModTeleport
     | ModDualBeam
+    | ModAlongsideWeapon
   deriving (Eq,Ord,Show)
 
 makeLenses ''ItemType

src/Dodge/Data.hs

@@ -482,6 +482,7 @@ data ItemUse
         , _useMods      :: [(Item -> Creature -> World -> World) -> Item -> Creature -> World -> World]
         , _useHammer    :: HammerPosition
         , _useAim       :: AimParams
+        , _heldAttachment :: HeldAttachment
         , _heldScroll   :: Float -> Creature -> Item -> Item
         }
     | LeftUse  
@@ -509,6 +510,10 @@ data Equipment = Equipment
 _itUseAimStance :: Item -> AimStance
 _itUseAimStance = _aimStance . _useAim . _itUse
 
+data HeldAttachment
+    = Torch
+    | NoHeldAttachment
+
 data ItemConsumption
     = LoadableAmmo
         { _laAmmoType   :: AmmoType
@@ -545,7 +550,7 @@ data Item = Item
     , _itInvColor   :: Color
     , _itTargeting  :: Targeting
     , _itDimension  :: ItemDimension
-    , _itCurseStatus :: CurseStatus
+    , _itCurseStatus    :: CurseStatus
     , _itTweaks     :: ItemTweaks
     , _itScope      :: Scope
     , _itValue      :: ItemValue
@@ -579,7 +584,6 @@ data ItemPortage
     | WornItem
     | NoPortage
 
-
 -- I believe this is called every frame, not sure when though
 data ItEffect 
     = NoItEffect

src/Dodge/Debug/Terminal.hs

@@ -71,7 +71,9 @@ parseItem (x:xs)
     =   (readMaybe (x++" {_xNum=" ++ show (parseNum xs)++"}") <&> (,1))
     <|> (readMaybe x <&> (,parseNum xs) )
     <|> (readMaybe ("CRAFT "++x) <&> (,parseNum xs))
-    <|> (readMaybe ("HELD "++x) <&> (,parseNum xs))
+    <|> (readMaybe ("HELD {_ibtHeld="++x++"}") <&> (,parseNum xs))
+    <|> (readMaybe ("EQUIP {_ibtEquip="++x++"}") <&> (,parseNum xs))
+    <|> (readMaybe ("LEFT {_ibtLEFT="++x++"}") <&> (,parseNum xs))
     <|> (readMaybe ("HELD ("++x++" {_xNum=" ++ show (parseNum xs)++"}") <&> (,1))
     <|> parseItem (xs & ix 0 .++~ (x ++ " "))
 parseItem [] = Nothing

src/Dodge/Default.hs

@@ -8,7 +8,10 @@ module Dodge.Default
     ( module Dodge.Default
     , module Dodge.Default.Item
     , module Dodge.Default.LightSource
+    , module Dodge.Default.Weapon
+    , module Dodge.Default.Wall
     ) where
+import Dodge.Default.Wall
 import Dodge.Default.Weapon
 import Dodge.Default.LightSource
 import Dodge.Default.Item

src/Dodge/Default/Weapon.hs

@@ -1,7 +1,6 @@
 module Dodge.Default.Weapon
     where
 import Dodge.Data
-import Dodge.Item.Weapon.AmmoParams
 import Dodge.Reloading.Action
 import Dodge.Item.Weapon.Bullet
 import Dodge.Default.Item
@@ -65,6 +64,7 @@ defaultrUse = RightUse
     , _useMods = []
     , _useHammer  = HammerUp
     , _useAim = defaultAimParams
+    , _heldAttachment = NoHeldAttachment
     , _heldScroll = \_ _ -> id
     }
 defaultlUse :: ItemUse
@@ -109,7 +109,7 @@ defaultWeapon = defaultItem
 defaultBulletWeapon :: Item
 defaultBulletWeapon = defaultWeapon 
     & itConsumption .~ defaultBulletLoadable 
-    & itUse .~ ruseAmmoParams
+    & itUse .~ defaultrUse
 
 defaultItemValue :: ItemValue
 defaultItemValue = ItemValue 10 MundaneItem

src/Dodge/Item.hs

@@ -40,12 +40,12 @@ itemFromEquipType et = case et of
     INVISIBILITYEQUIPMENT GoesOnWrist -> wristInvisibility
     INVISIBILITYEQUIPMENT _ -> error "need to define invisibility for more than wrist"
     BRAINHAT        -> brainHat
+    HAT             -> hat
     HEADLAMP        -> headLamp
     HEADLAMP1       -> headLamp1
     POWERLEGS       -> powerLegs
     SPEEDLEGS       -> speedLegs
     JUMPLEGS        -> jumpLegs
-    FLATSHIELD      -> flatShield
     JETPACK     -> jetPack
     AUTODETECTOR  d -> autoDetector d
 itemFromLeftType :: LeftItemType -> Item
@@ -59,6 +59,7 @@ itemFromLeftType lt = case lt of
     -- Equipment
 itemFromHeldType :: HeldItemType -> Item
 itemFromHeldType ht = case ht of
+    TORCH       -> torch
     SHATTERGUN        -> shatterGun
     BANGSTICK i -> bangStick i
     PISTOL      -> pistol
@@ -116,6 +117,8 @@ itemFromHeldType ht = case ht of
     FORCEFIELDGUN       -> forceFieldGun
 
     HELDDETECTOR d -> clickDetector d
+
+    FLATSHIELD      -> flatShield
 baseToFamily :: ItemBaseType -> ItemFamily
 baseToFamily ibt = case ibt of
     NOTDEFINED -> undefined

src/Dodge/Item/Draw/SPic.hs

@@ -35,25 +35,26 @@ equipItemSPic et _ = case et of
         ,color yellow $ thickArc (3*pi/2) (2*pi) 10 5
         ])
     WRISTARMOUR     -> defSPic
-    INVISIBILITYEQUIPMENT _ -> (noPic (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2))
+    INVISIBILITYEQUIPMENT _ -> noPic (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2)
     BRAINHAT  -> noPic (colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4)
+    HAT         -> noPic (colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4)
     HEADLAMP  -> noPic headLampShape
     HEADLAMP1 -> noPic headLampShape
     POWERLEGS -> legsSPic yellow
     SPEEDLEGS -> legsSPic green
     JUMPLEGS  -> legsSPic red
-    FLATSHIELD -> flatShieldEquipSPic
+    JETPACK -> (,) emptySH $ setDepth 20
-    JETPACK -> ((,) emptySH $ setDepth 20
         $ pictures [color yellow $ polygon $ reverse $ rectNSWE 5 (-5) (-11) (-3) ]
-        )
+    AUTODETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPoly 3 $ rectWH 2 2)
-    AUTODETECTOR dt -> (noPic (colorSH (detectorColor dt) $ upperPrismPoly 3 $ rectWH 2 2))
 leftItemSPic :: LeftItemType -> Item -> SPic
 leftItemSPic lt _ = case lt of
     BLINKER -> defSPic
     _       -> defSPic
 heldItemSPic :: HeldItemType -> Item -> SPic
 heldItemSPic ht it = case ht of
+    FLATSHIELD -> flatShieldEquipSPic
     FORCEFIELDGUN   -> defSPic
+    TORCH   -> defSPic
     BANGSTICK i     -> noPic $ baseStickShapeX it i <> stickClip it
     PISTOL          -> noPic $ baseStickShape <> makeTinClipAt pi (V3 5 2 0) it
     REVOLVER        -> noPic $ baseStickShape <> revolverClip it
@@ -314,4 +315,4 @@ latchkeyPic = color yellow $
                        ,thickLine 2 $ map toV2 [(4,0),(4,-4)]
                        ]
 legsSPic :: Color -> SPic
-legsSPic col = (noPic $ translateSH (V3 0 4 0) $ colorSH col $ upperPrismPoly 3 $ rectWH 2 2)
+legsSPic col = noPic $ translateSH (V3 0 4 0) $ colorSH col $ upperPrismPoly 3 $ rectWH 2 2

src/Dodge/Item/Equipment.hs

@@ -1,10 +1,12 @@
 module Dodge.Item.Equipment 
     ( module Dodge.Item.Equipment.Booster
+    , torch
     , magShield
     , powerLegs
     , flatShield
     , wristInvisibility
     , wristArmour
+    , hat
     , brainHat
     , frontArmour
     , headLamp
@@ -19,7 +21,6 @@ import Dodge.Item.Draw
 import Dodge.Item.Equipment.Booster
 import Dodge.LightSource
 import Dodge.Default
-import Dodge.Default.Wall
 import Dodge.Creature.Test
 import Dodge.Creature.HandPos
 import Dodge.Wall
@@ -105,13 +106,22 @@ setWristShieldPos itm cr w = w
       | otherwise = id
     f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
 
+torch :: Item
+torch = defaultWeapon
+    & itEffect .~ effectOnOffHeld createHeldLight (const $ const id)
+
+createHeldLight :: Creature -> Int -> World -> World
+createHeldLight cr i w = w
+
+removeHeldLight :: Creature -> Int -> World -> World
+removeHeldLight cr i w = w
 
 flatShield :: Item
-flatShield = defaultEquipment
+flatShield = defaultWeapon
-    { _itEffect = effectOnOffHeld createShieldWall removeShieldWall
+    & itEffect .~ effectOnOffHeld createShieldWall removeShieldWall
         -- the above seems to work, but I am not sure why: it may break on edge
         -- cases
-    , _itUse  = RightUse
+    & itUse .~ defaultrUse
         { _rUse = \_ _ -> id
         , _useDelay = NoDelay
         , _useMods = []
@@ -126,9 +136,8 @@ flatShield = defaultEquipment
             }
         , _heldScroll = \_ _ -> id
         }
-    , _itInvSize = 3
+    & itInvSize .~ 3
-    }
+    & itType . iyBase .~ HELD FLATSHIELD
-    & itType . iyBase .~ EQUIP FLATSHIELD
 
 shieldWall :: Int -> Wall
 shieldWall crid = defaultWall
@@ -186,7 +195,7 @@ effectOnOffHeld f f' = ItInvEffectID
   where
     g itm cr w
         | crSel cr == invid = f  cr invid w
-        | otherwise             = f' cr invid w
+        | otherwise         = f' cr invid w
       where
         invid = _ipInvID $ _itPos itm
 
@@ -205,6 +214,13 @@ brainHat = defaultEquipment
     }
     & itUse . eqEq . eqSite .~ GoesOnHead
     & itType . iyBase .~ EQUIP BRAINHAT
+hat :: Item
+hat = defaultEquipment
+    { _itEffect = NoItEffect
+    , _itID = Nothing
+    }
+    & itUse . eqEq . eqSite .~ GoesOnHead
+    & itType . iyBase .~ EQUIP HAT
 
 headLamp1 :: Item
 headLamp1 = defaultEquipment

src/Dodge/Item/Weapon/AmmoParams.hs

@@ -1,6 +1,5 @@
 module Dodge.Item.Weapon.AmmoParams
-    ( ruseAmmoParams
+    ( useAmmoParams
-    , useAmmoParams
     , fractionLoadedAmmo
     , fractionLoadedAmmo2
     ) where
@@ -16,25 +15,6 @@ import LensHelp
 import Data.Maybe
 --import Control.Lens
 
-ruseAmmoParams :: ItemUse
-ruseAmmoParams = RightUse
-    { _rUse = useAmmoParams Nothing
-    , _useDelay = FixedRate {_rateMax = 10, _rateTime = 0}
-    , _useMods = []
-    , _useHammer = HammerUp
-    , _useAim = defaultAimParams
-    , _heldScroll = \_ _ -> id
-    }
-
---defaultAimParams :: AimParams
---defaultAimParams = AimParams
---    { _aimWeight = 0
---    , _aimRange = 0
---    , _aimZoom = ItZoom 20 0.2 1
---    , _aimStance = OneHand
---    , _aimHandlePos = 10
---    , _aimMuzPos = 20
---    }
 useAmmoParams :: Maybe Float -> Item -> Creature -> World -> World
 useAmmoParams vfact it cr w = w & instantParticles .:~ aBulAt 
     vfact 

src/Dodge/Item/Weapon/BulletGun/Cane.hs

@@ -191,7 +191,7 @@ burstRifle = repeater
 --        , withRecoil
 --        ]
 miniGunUse :: Int -> ItemUse
-miniGunUse i = ruseAmmoParams
+miniGunUse i = defaultrUse
     & rUse .~ useAmmoParams (Just 1)
     & useDelay .~ NoDelay
     & useMods .~

src/Dodge/Item/Weapon/BulletGun/Stick.hs

@@ -11,13 +11,6 @@ import Dodge.Reloading.Action
 import Dodge.Data
 import Dodge.ChainEffect
 import Dodge.Default.Weapon
---import Dodge.Item.Weapon.InventoryDisplay
---import Dodge.Default
---import Dodge.Item.Attachment
---import Dodge.Item.Weapon.ExtraEffect
---import Dodge.Item.Weapon.InventoryDisplay
-import Dodge.Item.Weapon.AmmoParams
---import Dodge.Item.Draw
 import Dodge.Item.Weapon.TriggerType
 import Dodge.SoundLogic.LoadSound
 import Geometry
@@ -37,7 +30,7 @@ bangStickSoundChoice it
 
 bangStick :: Int -> Item
 bangStick i = defaultBulletWeapon 
-    { _itUse = ruseAmmoParams
+    { _itUse = defaultrUse
         & useDelay . rateMax .~ 8
         & useMods .~
             [ ammoHammerCheck

src/Dodge/Item/Weapon/Radar.hs

@@ -6,7 +6,6 @@ import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.UseEffect
 --import Dodge.Item.Weapon.Remote
-import Dodge.Default.Weapon
 import Dodge.SoundLogic
 
 import Control.Lens

src/Dodge/Item/Weapon/SprayGuns.hs

@@ -21,7 +21,6 @@ import Dodge.Default
 --import Dodge.Item.Weapon.BulletGuns
 --import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Item.Weapon.TriggerType
-import Dodge.Default.Weapon
 --import Dodge.Item.Attachment
 import Geometry
 import LensHelp

src/Dodge/Item/Weapon/Utility.hs

@@ -6,7 +6,6 @@ import Dodge.Default
 import Dodge.Creature.Action
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.ExtraEffect
-import Dodge.Default.Weapon
 import Dodge.Wall.ForceField
 import Dodge.Wall.Move
 --import Sound.Data

src/Dodge/LockAndKey.hs

@@ -27,14 +27,14 @@ lockRoomMultiItems =
 
 lockRoomKeyItems :: RandomGen g => [ (Int -> State g (MetaTree Room String) , State g ItemBaseType ) ]
 lockRoomKeyItems = 
-    [(lasCenSensEdge, takeOne [HELD LAUNCHER,HELD LASGUN,HELD SPARKGUN,EQUIP FLATSHIELD,HELD FORCEFIELDGUN] )
+    [(lasCenSensEdge, takeOne [HELD LAUNCHER,HELD LASGUN,HELD SPARKGUN,HELD FLATSHIELD,HELD FORCEFIELDGUN] )
     ,(sensorRoomRunPast ELECTRICAL, takeOne [CRAFT STATICMODULE,HELD SPARKGUN] )
     ,(sensorRoomRunPast FLAMING, takeOne [HELD FLAMESPITTER, CRAFT INCENDIARYMODULE] )
     ,(sensorRoomRunPast LASERING, return $ HELD LASGUN )
     ,(const slowDoorRoomRunPast, return $ HELD (MINIGUNX 3))
-    ,(const longRoomRunPast, takeOne [HELD SNIPERRIFLE,EQUIP FLATSHIELD])
+    ,(const longRoomRunPast, takeOne [HELD SNIPERRIFLE,HELD FLATSHIELD])
     ,(const glassLessonRunPast, takeOne [HELD LASGUN])
-    ,(const $ lasTunnelRunPast 400, takeOne [EQUIP FLATSHIELD,HELD FORCEFIELDGUN])
+    ,(const $ lasTunnelRunPast 400, takeOne [HELD FLATSHIELD,HELD FORCEFIELDGUN])
     ,(keyCardRoomRunPast 0, return (KEYCARD 0))
     ]
 keyCardRunPastRand :: RandomGen g => [ (Int -> State g (MetaTree Room String) , State g ItemBaseType ) ]
@@ -63,7 +63,7 @@ itemRooms =
         [rc $ map makeTypeCraft [LIGHTER,PUMP,CAN]
         ]
       )
-    , (EQUIP FLATSHIELD   , join $ takeOne 
+    , (HELD FLATSHIELD   , join $ takeOne 
         [rc $ map makeTypeCraft [PLATE,PLATE]
         ,rc $ map makeTypeCraft [DRUM,DRUM,PLATE]
         ]

src/Geometry/Polygon.hs

@@ -118,5 +118,5 @@ shrinkPolyOnEdges x (p:q:ps) = map (shrinkVert x) . slideWindow 3 $ (p:q:ps) ++
 shrinkPolyOnEdges _ _ = error "too few vertices in polygon"
 
 shrinkVert :: Float -> [Point2] -> Point2
-shrinkVert d (x:y:z:[]) = x +.+ (d *.* (normalizeV (x -.- y))) +.+ (d *.* (normalizeV (z -.- y)))
+shrinkVert d [x,y,z] = x +.+ (d *.* normalizeV (x -.- y)) +.+ (d *.* normalizeV (z -.- y))
 shrinkVert _ _ = error "wrong number of vertices"

src/Grid.hs

@@ -12,7 +12,7 @@ import qualified Streaming.Prelude as S
 --import qualified Data.Set as S
 
 gridInPolygon :: Float -> [Point2] -> [Point2]
-gridInPolygon gap ps = filter (flip pointInPolygon ps) 
+gridInPolygon gap ps = filter (`pointInPolygon` ps)
     .  maybe [] (boundedGrid gap) . boundPoints . S.each $ ps
 
 boundedGrid :: Float -> (Float,Float,Float,Float) -> [Point2]