Cleanup

src/Dodge/Data/Item/Combine.hs

@@ -155,7 +155,6 @@ data HeldItemType
     | LAUNCHER
     | LAUNCHERX {_xNum :: Int}
     | POISONSPRAYER
-    | DRONELAUNCHER
     | SHATTERGUN
     | TORCH
     | FLATSHIELD

src/Dodge/Item.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 
 module Dodge.Item (
-    module Dodge.Item.Weapon,
     module Dodge.Item.Held,
     module Dodge.Item.Equipment,
     module Dodge.Item.Craftable,
@@ -14,7 +13,6 @@ import Dodge.Item.Craftable
 import Dodge.Item.Equipment
 import Dodge.Item.Held
 import Dodge.Item.Scope
-import Dodge.Item.Weapon
 
 itemFromBase :: ItemType -> Item
 itemFromBase = \case

src/Dodge/Item/Craftable.hs

@@ -1,4 +1,5 @@
-module Dodge.Item.Craftable where
+module Dodge.Item.Craftable 
+     where
 
 import Dodge.Default.Item
 import Control.Lens

src/Dodge/Item/Draw/SPic.hs

@@ -199,7 +199,6 @@ heldItemSPic ht it = case ht of
     LAUNCHER -> launcherPic it
     LAUNCHERX _ -> launcherPic it
     POISONSPRAYER -> flamerPic it
-    DRONELAUNCHER -> defSPic
     BLINKER -> defSPic
     BLINKERUNSAFE -> defSPic
     REWINDER -> defSPic

src/Dodge/Item/Held.hs

@@ -11,7 +11,6 @@ module Dodge.Item.Held (
     module Dodge.Item.Held.BatteryGuns,
 ) where
 
-import Dodge.Item.Weapon.Utility
 import Dodge.Data.Item
 import Dodge.Item.Held.Launcher
 import Dodge.Item.Held.BatteryGuns
@@ -69,6 +68,5 @@ itemFromHeldType ht = case ht of
     LAUNCHERX i -> launcherX i
 --    REMOTELAUNCHER -> remoteLauncher
     POISONSPRAYER -> poisonSprayer
-    DRONELAUNCHER -> undefined
     DETECTOR d -> detector d
     FLATSHIELD -> flatShield

src/Dodge/Item/Held/Utility.hs

@@ -1,9 +1,20 @@
-module Dodge.Item.Held.Utility where
+module Dodge.Item.Held.Utility (
+    rewinder,
+    timeStopper,
+    timeScroller,
+    unsafeBlinker,
+    blinker,
+    keyCard,
+    torch,
+    detector,
+    flatShield,
+) where
 
-import Linear
-import Dodge.Default.Item
 import Control.Lens
 import Dodge.Data.Item
+import Dodge.Default.Item
+import Linear
+
 --import Geometry.Data
 
 flatShield :: Item
@@ -19,9 +30,6 @@ flatShield =
 keyCard :: Int -> Item
 keyCard n = defaultHeldItem & itType .~ HELD (KEYCARD n)
 
-latchkey :: Int -> Item
-latchkey _ = defaultHeldItem 
-
 torch :: Item
 torch =
     defaultHeldItem
@@ -29,7 +37,7 @@ torch =
         & itUse . heldAim . aimMuzzles . ix 0 . mzPos . _x .~ 10
         & itAmmoSlots .~ singleAmmo ElectricalAmmo
 
-{- | Sends out pulses that display walls.  -}
+-- | Sends out pulses that display walls.
 detector :: Detector -> Item
 detector dt =
     defaultHeldItem
@@ -42,3 +50,43 @@ detector dt =
         & itType .~ HELD (DETECTOR dt)
         & itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleDetector
         & itUse . heldAim . aimMuzzles . ix 0 . mzAmmoPerShot .~ UseExactly 100
+
+blinker :: Item
+blinker =
+    defaultHeldItem
+        & itUseCondition .~ UseableAnytime
+        & itUse . heldDelay . rateMax .~ 20
+        & itUse . heldAim . aimRange .~ 1
+        & itUse . heldAim . aimZoom .~ defaultItZoom{_izFac = 1}
+        & itAmmoSlots .~ singleAmmo ElectricalAmmo
+        & itUse . heldParams .~ DefaultHeldParams
+        & itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleBlink
+        & itUse . heldAim . aimMuzzles . ix 0 . mzAmmoPerShot .~ UseExactly 10000000
+        & itType .~ HELD BLINKER
+
+unsafeBlinker :: Item
+unsafeBlinker =
+    blinker
+        & itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleUnsafeBlink
+        & itType .~ HELD BLINKERUNSAFE
+
+--        & itUse . uequipEffect . eeViewDist ?~ 400
+
+rewinder :: Item
+rewinder =
+    blinker
+        & itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleRewind
+        & itType .~ HELD REWINDER
+        & itUse . heldAim . aimMuzzles . ix 0 . mzAmmoPerShot .~ UseExactly 100000
+
+timeStopper :: Item
+timeStopper =
+    blinker
+        & itType .~ HELD TIMESTOPPER
+        & itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleStopper
+
+timeScroller :: Item
+timeScroller =
+    timeStopper
+        & itType .~ HELD TIMESCROLLER
+        & itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleScroller

src/Dodge/Item/Info.hs

@@ -83,7 +83,6 @@ heldInfo hit = case hit of
     LAUNCHERX i -> over _head toUpper (showInt i) ++ " tubes that can launch self propelled projectiles. Tubes that do not face forward launch their projecitles at an angle."
 --    REMOTELAUNCHER -> "A large tube that can launch self propelled projectiles. Contains a transmitter allowing for remote control of launched projectiles."
     POISONSPRAYER -> "A weapon that releases noxious gases."
-    DRONELAUNCHER -> "A device for launching drones."
     SHATTERGUN -> "A seismic device that shatters hard items in its line of fire."
 --    FORCEFIELDGUN -> "A device that produces a durable forcefield."
     DETECTOR d -> "A device that detects " ++ detectorInfo d ++ " in an expanding radius."

src/Dodge/Item/Instance.hs

@@ -1,6 +0,0 @@
-module Dodge.Item.Instance 
-    ( module Dodge.Item.Weapon
-    , module Dodge.Item.Craftable
-    ) where
-import Dodge.Item.Weapon
-import Dodge.Item.Craftable

src/Dodge/Item/Weapon.hs

@@ -1,8 +0,0 @@
--- | Rexport all weapons
-module Dodge.Item.Weapon (
-    module Dodge.Item.Weapon.Utility,
-    module Dodge.Item.Weapon.Drone,
-) where
-
-import Dodge.Item.Weapon.Drone
-import Dodge.Item.Weapon.Utility

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -1,161 +0,0 @@
-module Dodge.Item.Weapon.BatteryGuns (
---    lasRayAt,
---    flameBeamCombine,
---    teslaBeamCombine,
---    splitBeamCombine,
---    --    shootTeslaArc,
---    shootLaser,
---    --circleLaser,
---    --shootDualLaser,
---    aTractorBeam,
-) where
-
---import Geometry.Data
---import Color.Data
---import Dodge.Data.World
---import LensHelp
-
-
---lasWidePulse :: Item
---lasWidePulse = lasGun
---    & itType . iyBase .~ LASGUNWIDEPULSE
---    & itParams . lasColor .~ orange
---    & itParams . lasDamage .~ 2
---    & itUse .~ ( ruseInstant shootLaser
---        [ ammoCheckI
---        , withItem $ \it -> withTempLight 1 (100 * frac it) (xyzV4 (_lasColor $ _itParams it))
---        , withItem $ \it -> withSoundForVol (frac it) tone440sawtoothquietS 2
---        , withItemUpdate itup
---            $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) (frac it * 0.8)
---        , useAmmoAmount 1
---        , withItemUpdate itup $ \it -> duplicateOffsets (xs it)
---        ]
---        & useAim . aimWeight .~ 6
---        & useAim . aimRange .~ 1
---        & useAim . aimStance .~ TwoHandTwist
---        )
---  where
---    itup it = it
---        & itParams . lasCycle %~ (\i -> (i+1) `mod` 40)
---        & itParams . lasDamage .~ ceiling ((22 :: Float) * frac it)
---        & itParams . lasColor .~ frac it * orange
---    frac it = 0.5 * (1 + sin (pi * fromIntegral (_lasCycle $ _itParams it) * 0.05))
---    xs it = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2)  | x <- [0..n'-1] ]
---      where
---        n' = (ceiling $ (150 :: Float) * frac it) :: Int
---lasSway :: Item
---lasSway = lasGun
---    & itType . iyBase .~ LASGUNSWAY
---    & itParams . lasColor .~ orange
---    & itParams . lasDamage .~ 11
---    & itUse .~ ( ruseInstant shootLaser
---        [ ammoCheckI
---        , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
---        , withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
---        , withSoundForI tone440sawtoothquietS 2
---        , useAmmoAmount 1
---        , withItemUpdate itup $ \it -> duplicateOffsets (x it)
---        ]
---        & useAim . aimWeight .~ 6
---        & useAim . aimRange .~ 1
---        & useAim . aimStance .~ TwoHandTwist
---        )
---  where
---    itup = itParams . lasCycle %~ (\i -> (i+1) `mod` 40)
---    x it = [ 15 * sin (pi * fromIntegral x' * 0.05) ]
---      where
---        x' = _lasCycle $ _itParams it
-
-
---shootLaser :: Item -> Creature -> World -> World
---shootLaser it cr =
---    cWorld . lWorld . lasers
---        .:~ lasRayAt
---            (_lasColor $ _itParams it)
---            (_lasDamage $ _itParams it)
---            (_phaseV $ _itParams it)
---            (_crPos cr)
---            (_crDir cr)
-
----- this has the feel of a left click item
---circleLaser :: Item -> Creature -> World -> World
---circleLaser it cr w
---    | hasLOSIndirect cpos pos w =
---        w
---            & cWorld . lWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
---    | otherwise = w
---  where
---    cpos = _crPos cr
---    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
---    pos = _crPos cr +.+ rotateV dir (V2 0 (max 70 $ dist cpos mwp))
---    dir = fromIntegral (_lasCycle (_itParams it)) * pi / 1000
---    phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
---    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
---    dam = _lasDamage $ _itParams it
-
---shootDualLaser :: Item -> Creature -> World -> World
---shootDualLaser it cr w =
---    w
---        & cWorld . lWorld . newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl
---        & cWorld . lWorld . newBeams . electronBeams .:~ basicBeamAt itid w (_lasColor2 $ _itParams it) dam phasev posr dirr
---  where
---    itid = _itID it
---    dir = _crDir cr
---    pos = _crPos cr +.+ aimlength *.* unitVectorAtAngle dir
---    aimlength = aimingMuzzleLength cr it
---    gap = _dbGap . _itParams $ it
---    posl = pos +.+ (- gap) *.* vNormal (unitVectorAtAngle dir)
---    posr = pos +.+ gap *.* vNormal (unitVectorAtAngle dir)
---    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
---    mwp'
---        | dist mwp (_crPos cr) < aimlength + 5 = _crPos cr +.+ (aimlength + 5) *.* unitVectorAtAngle dir
---        | otherwise = mwp
---    dirl = argV $ mwp' -.- posl
---    dirr = argV $ mwp' -.- posr
---    phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
---    itRef = cr ^?! crManipulation . manObject . inInventory . ispItem -- unsafe!! TODO change
---    dam = _lasDamage $ _itParams it
-
---basicBeamAt :: Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
---basicBeamAt itid w col dam phasev pos dir =
---    Beam
---        { _bmDraw = BasicBeamDraw --drawBeam
---        , _bmPos = pos
---        , _bmDir = dir
---        , _bmDamage = dam
---        , _bmRange = 800
---        , _bmPhaseV = phasev
---        , _bmColor = col
---        , _bmPoints = pos : ps
---        , _bmFirstPoints = []
---        , _bmOrigin = Just itid
---        , _bmType = BeamCombine NoBeamCombine
---        }
---  where
---    (_, ps) = reflectLaserAlong phasev pos (pos +.+ 800 *.* unitVectorAtAngle dir) w
-
---dualRayAt :: BeamType -> Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
---dualRayAt bt itid w col dam phasev pos dir =
---    basicBeamAt itid w col dam phasev pos dir
---        & bmType .~ bt
-
---aTractorBeam :: Item -> Creature -> World -> World
---aTractorBeam itm cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power
---  where
---    cpos = _crPos cr
---    spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
---    xpos = cpos +.+ 400 *.* unitVectorAtAngle dir
---    dir = _crDir cr
---    outpos = fst $ collidePointWallsFilter (const True) cpos xpos w
---    power = _attractionPower . _itParams $ itm
---
---tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
---tractorBeamAt pos outpos dir power =
---    TractorBeam
---        { _tbPos = pos
---        , _tbStartPos = outpos
---        , _tbVel = d
---        , _tbTime = 10
---        }
---  where
---    d = unitVectorAtAngle dir * power

src/Dodge/Item/Weapon/Drone.hs

@@ -1,52 +0,0 @@
-module Dodge.Item.Weapon.Drone where
-
-import Dodge.Default.Item
-import Control.Lens
-import Dodge.Data.World
-import Geometry
-import Picture
-import Shape
-import ShapePicture
-
-droneLauncher :: Item
-droneLauncher =
-    defaultHeldItem
-        & itUse . heldDelay . rateMax .~ 20
---        & itUse . heldMods .~ AmmoUseCheckMod
-        & itUse . heldAim . aimWeight .~ 8
-        & itUse . heldAim . aimRange .~ 0.5
-        & itUse . heldAim . aimStance .~ TwoHandOver
-        & itAmmoSlots .~ singleAmmo DroneAmmo
-        & itType .~ HELD DRONELAUNCHER
-
-lasDronesPic :: Item -> SPic
-lasDronesPic _ = noPic
-    ( colorSH chartreuse $
-        prismPoly Small Typical
-            (map (+.+.+ V3 10 0 4.5) $ polyCircx 4 5)
-            (map (+.+.+ V3 (-10) 0 4.5) $ polyCircx 4 5)
-    )
-
-aDroneWithItemParams ::
-    -- | Firing item
-    Item ->
-    Creature ->
-    World ->
-    World
-aDroneWithItemParams = undefined
-
---aDroneWithItemParams it cr w = over props (IM.insert i theShell) w
---  where
---    am = _itConsumption it
---    i = IM.newKey $ _props w
---    pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
---    dir = _crDir cr
---    --ammoMvs pj w' = foldr (\pjP -> _pjMoveParam pjP (_pjIntParam pjP) it cr pj) w' (_amPjParams am)
---    theShell = Drone
---        { _prPos = pos
---        , _pjStartPos = pos
---        , _pjVel = rotateV dir (V2 1 0)
---        , _prDraw = undefined
---        , _pjID = i
---        , _pjUpdate = const id
---        }

src/Dodge/Item/Weapon/SonicGuns.hs

@@ -1,114 +0,0 @@
-module Dodge.Item.Weapon.SonicGuns where
---import Dodge.Data
---import Dodge.Reloading.Action
---import Dodge.Creature.HandPos
---import Dodge.Default.Weapon
-----import Dodge.Item.Attachment
-----import Dodge.WorldEvent.HelperParticle
-----import Dodge.Base
-----import Dodge.Zone
---import Geometry
---import Picture
---import LensHelp
---
-----import Data.Maybe
-----import Data.List
-----import Data.Bifunctor
-----import System.Random
-----import Data.Tuple
-----import qualified IntMapHelp as IM
---
-----aSonicWave :: Item -> Creature -> World -> World
-----aSonicWave it cr = instantParticles .:~ sonicWave pos dir cpos
-----  where 
-----    pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
-----    cpos = _crPos cr
-----    dir = _crDir cr
---
-----sonicWave :: Point2 -> Float -> Point2 -> Particle
-----sonicWave pos dir cpos = ShockLine
-----    { _ptUpdate = mvSonicWave
-----    , _ptPointDirs = [[makePointDir $ pos +.+ clockOrth,makePointDir $ pos -.- clockOrth]]
-----    , _ptTimer = 1000
-----    , _ptColor = white
-----    , _ptCenter = cpos
-----    }
-----  where
-----    clockOrth = 10 *.* unitVectorAtAngle (dir + pi*0.5)
-----    makePointDir p = (p, argV $ p -.- cpos)
---
-----drawSonicWave :: Particle -> Picture
-----drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDepth 20 
-----    . lineThick 20
-----    . map fst)
-----    $ _ptPointDirs pt
-----
-----mvSonicWave :: World -> Particle -> (World, Maybe Particle)
-----mvSonicWave w pt
-----    | _ptTimer pt <= 0 = (w,Nothing)
-----    | otherwise = (w, Just $ pt & ptTimer -~ 1)
-------    | otherwise = (w, Just pt')
-------  where
-------    mvPointDir (p,a) = case wallsHit p ep w of
-------        [] -> Just ((ep, a), (True,True))
-------        (hp,wl):_ -> reflectShockLine wl p hp ep
-------      where
-------        ep = p +.+ 5 *.* unitVectorAtAngle a
-------    dividePointDir (x:y:xs) = f x y ++ dividePointDir (y:xs)
-------    dividePointDir xs = xs
-------    f (p,a) (q,b)
-------        | dist p q > 10 = [(p,a),(0.5 *.* (p +.+ q),mixAngles 0.5 a b)]
-------        | otherwise = [(p,a)]
-------    combineClose ((p,a):(q,b):pairs)
-------        | dist p q < 5 = combineClose (( 0.5 *.* (p+.+q), mixa) : pairs)
-------        | otherwise = (p,a) : combineClose ((q,b):pairs)
-------      where
-------        mixa = mixAngles 0.5 a b
-------    combineClose pairs = pairs
-------    pt' = pt & ptTimer -~ 10
-------        -- & ptPointDirs %~ (map dividePointDir . filter (not . null) . dosplit . map mvPointDir)
-------        & ptPointDirs %~ (map (dividePointDir . combineClose) . filter (not . null) 
-------            . concatMap (dosplit . map mvPointDir))
-------    --    & ptPointDirs %~ (filter (not . null) . concatMap (dosplit . map mvPointDir))
-------    dosplit :: [Maybe ((Point2,Float),(Bool,Bool))] -> [[(Point2,Float)]]
-------    dosplit (x:xs) = case x of
-------        Nothing -> [] : dosplit xs
-------        Just (pair,(True,True))  -> overHead (pair:) $ dosplit xs
-------        Just (pair,(False,True)) -> [] : overHead (pair:) (dosplit xs)
-------        Just (pair,(True,False)) -> [pair] : dosplit xs
-------        Just (_,(False,False)) -> [] : dosplit xs
-------    dosplit [] = [[]]
---
-----overHead :: (a -> a) -> [a] -> [a]
-----overHead f (x:xs) = f x: xs
-----overHead _ [] = []
-----        
-----        
-----reflectShockLine :: Wall -> Point2 -> Point2 -> Point2 -> Maybe ((Point2,Float),(Bool,Bool))
-----reflectShockLine wl sp hitp ep
-----    | angleVV wlV v < pi/3 = Just (pair, (False,True))
-----    | angleVV wlV v < 2 *pi/3 = Nothing
-----    | otherwise = Just (pair, (True,False))
-----  where
-----    reflv = reflectIn wlV (ep -.- hitp)
-----    np = hitp +.+ reflv
-----    pair = (np, argV reflv)
-----    wlV = uncurry (-.-) $ _wlLine wl
-----    v = hitp -.- sp
-----
-----reflectShockLine' :: Wall -> Point2 -> Point2 -> Point2 -> Maybe ((Point2,Float),(Bool,Bool))
-----reflectShockLine' wl sp hitp ep
-----    | angleVV wlV v < pi/3 = Just ((np +.+ wlVN,argV wlV), (False,True))
-----    | angleVV wlV v < 2 *pi/3 = Nothing
-----    | otherwise = Just ((np -.- wlVN,argV $ V2 0 0 -.- wlV), (True,False))
-----  where
-----    np = hitp +.+ normalizeV (sp -.- hitp)
-----    wlV = uncurry (-.-) $ _wlLine wl
-----    wlVN = dist hitp ep *.* normalizeV wlV
-----    v = hitp -.- sp
-----
-----dividePoly :: Float -> [Point2] -> [Point2]
-----dividePoly x (a:b:bs) = init (divideLine x a b) ++ dividePoly x (b:bs)
-----dividePoly _ [a] = [a]
-----dividePoly _ _ = []
---    

src/Dodge/Item/Weapon/Utility.hs

@@ -1,51 +0,0 @@
-module Dodge.Item.Weapon.Utility 
-    ( timeStopper
-    , rewinder
-    , timeScroller
-    , blinker
-    , unsafeBlinker
-    ) where
-
-import Control.Lens
-import Dodge.Data.Item
-import Dodge.Default
-
-
-blinker :: Item
-blinker =
-    defaultHeldItem
-        & itUseCondition .~ UseableAnytime
-        & itUse . heldDelay . rateMax .~ 20
-        & itUse . heldAim . aimRange .~ 1
-        & itUse . heldAim . aimZoom .~ defaultItZoom{_izFac = 1}
-        & itAmmoSlots .~ singleAmmo ElectricalAmmo
-        & itUse . heldParams .~ DefaultHeldParams
-        & itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleBlink
-        & itUse . heldAim . aimMuzzles . ix 0 . mzAmmoPerShot .~ UseExactly 10000000
-        & itType .~ HELD BLINKER
-
-unsafeBlinker :: Item
-unsafeBlinker =
-    blinker
-        & itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleUnsafeBlink
-        & itType .~ HELD BLINKERUNSAFE
---        & itUse . uequipEffect . eeViewDist ?~ 400
-
-rewinder :: Item
-rewinder =
-    blinker
-        & itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleRewind
-        & itType .~ HELD REWINDER
-        & itUse . heldAim . aimMuzzles . ix 0 . mzAmmoPerShot .~ UseExactly 100000
-
-timeStopper :: Item
-timeStopper =
-    blinker
-        & itType .~ HELD TIMESTOPPER
-        & itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleStopper
-
-timeScroller :: Item
-timeScroller =
-    timeStopper
-        & itType .~ HELD TIMESCROLLER
-        & itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleScroller