Add missing file

2022-02-13 09:46:06 +00:00
parent ede5a4e5d0
commit afb178fe8a
1 changed files with 153 additions and 0 deletions
@@ -0,0 +1,153 @@
+module Dodge.Item.Weapon.SonicGuns where
+import Dodge.Data
+import Dodge.Creature.HandPos
+--import Dodge.Particle.TeslaArc
+--import Dodge.SoundLogic.LoadSound
+--import Dodge.WorldEvent
+import Dodge.WorldEvent.ThingsHit
+--import Dodge.Default
+--import Dodge.Item.Weapon.InventoryDisplay
+import Dodge.Item.Weapon.TriggerType
+--import Dodge.Item.Weapon.AmmoParams
+import Dodge.Default.Weapon
+--import Dodge.Item.Attachment
+--import Dodge.WorldEvent.HelperParticle
+--import Dodge.Base
+--import Dodge.Zone
+import Geometry
+import Picture
+import Shape
+import ShapePicture
+--import Dodge.Picture
+import LensHelp
+
+--import Data.Maybe
+--import Data.List
+--import Data.Bifunctor
+--import System.Random
+--import Data.Tuple
+--import qualified Data.IntMap.Strict as IM
+
+sonicGun :: Item
+sonicGun = defaultAutoGun 
+    { _itName = "SONICGUN"
+    , _itType = SONICGUN
+    , _itConsumption = defaultAmmo
+        { _ammoMax = 10
+        , _ammoLoaded = 10
+        , _reloadTime = 80
+        }
+    , _itUse = ruseRate 8 aSonicWave (HasHammer HammerUp)
+        [ ammoHammerCheck
+        , useTimeCheck
+        , useAmmoAmount 1
+        ]
+        & useAim . aimSpeed .~ 0.4
+        & useAim . aimRange .~ 1
+        & useAim . aimStance .~ TwoHandTwist
+    , _itParams = NoParams
+    , _itTweaks = NoTweaks
+    , _itDimension = ItemDimension
+        { _dimRad = 10
+        , _dimCenter = V3 15 0 0
+        , _dimPortage = HeldItem 5 25
+        , _dimSPic = const $ noPic baseSonicShape
+        }
+    }
+baseSonicShape :: Shape
+baseSonicShape = colorSH rose $ upperPrismPoly 3 $ rectXH 25 2
+
+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
+    { _ptDraw = drawSonicWave
+    , _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 1 . 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')
+  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))  -> onHead (pair:) $ dosplit xs
+        Just (pair,(False,True)) -> [] : onHead (pair:) (dosplit xs)
+        Just (pair,(True,False)) -> [pair] : dosplit xs
+        Just (_,(False,False)) -> [] : dosplit xs
+    dosplit [] = [[]]
+
+onHead :: (a -> a) -> [a] -> [a]
+onHead f (x:xs) = f x: xs
+onHead _ [] = []
+        
+        
+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 _ _ = []
+