justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Start work on crafting/combinations

Browse Source
This commit is contained in:
justin
2021-12-02 00:50:29 +00:00
parent ce06845278
commit 85ededc158
28 changed files with 189 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine.hs
+5 -29
View File
@@ -1,37 +1,13 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Combine
(
)
where
(
) where
--import Dodge.Data
--import Dodge.Combine.Data
--import Dodge.Combine.Combinations
--import Data.Bifunctor
--import qualified Data.IntMap.Strict as IM
--import qualified Data.IntSet as IS
--import qualified Data.Map.Strict as M
--combineList :: IM.IntMap Item -> [(Item , IS.IntSet)]
--combineList
--invert :: (Ord a) => M.Map b a -> M.Map a [b]
--invert = M.foldrWithKey (\k val -> M.insertWith (++) val [k]) M.empty
--
--combineList :: [([ItemType], ItemType)]
--combineList =
-- [ ( [ TPistol, TPipe, THardware ] , TRifle )
-- , ( [ TRifle, THardware ] , TPistol )
-- , ( [ TPistol, TPistol, THardware ] , TSpreadGun 2 )
-- , ( [ TSpreadGun 2, TPistol, THardware ] , TSpreadGun 3 )
-- , ( [ TSpreadGun 3, TPistol, THardware ] , TSpreadGun 4 )
-- , ( [ TSpreadGun 4, TPistol, THardware ] , TSpreadGun 5 )
-- , ( [ TPistol, TAutoGun, THardware ] , TLtAutoGun )
-- , ( [ TLtAutoGun, TPipe, THardware ] , TAutoGun )
-- , ( [ TRifle, TRifle, THardware ] , TMultGun 2 )
-- , ( [ TMultGun 2, TRifle, THardware ] , TMultGun 3 )
-- , ( [ TMultGun 3, TRifle, THardware ] , TMultGun 4 )
-- , ( [ TMultGun 4, TRifle, THardware ] , TMultGun 5 )
-- , ( [ TLtAutoGun, TPipe, THardware ] , TAutoGun )
-- , ( [ TPistol, TBigTube, THardware] , TLauncher 1 )
-- , ( [ TLauncher 1, TBigTube, TPistol, THardware] , TLauncher 2)
-- , ( [ TLauncher 2, TBigTube, TPistol, THardware] , TLauncher 3)
-- ]
src/Dodge/Combine/Combinations.hs
+50
View File
@@ -0,0 +1,50 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Combine.Combinations
where
--import Dodge.Data
import Dodge.Combine.Data
import Data.Bifunctor
import qualified Data.IntMap.Strict as IM
--import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
import Control.Monad
import Data.Maybe
combineList :: IM.IntMap ItemCombineType -> [([Int],ItemCombineType)]
combineList m = mapMaybe (pushoutmaybe . second (combine . toMultiset) . unzip)
. powlist
$ IM.toList m
where
pushoutmaybe (_,Nothing) = Nothing
pushoutmaybe (x,Just y) = Just (x,y)
powlist :: [a] -> [[a]]
powlist = filterM (const [True,False])
combine :: M.Map ItemCombineType Int -> Maybe ItemCombineType
combine m = lookup m combinations
toMultiset :: Ord a => [a] -> M.Map a Int
toMultiset = foldr (uncurry $ M.insertWith (+)) M.empty . map (,1)
combinations :: [(M.Map ItemCombineType Int, ItemCombineType)]
combinations = map (first toMultiset)
[ ( [ TPistol, TPipe, THardware ] , TRifle )
, ( [ NoCombineType ] , TPistol )
, ( [ TRifle, THardware ] , TPistol )
, ( [ TPistol, TPistol, THardware ] , TSpreadGun 2 )
, ( [ TSpreadGun 2, TPistol, THardware ] , TSpreadGun 3 )
, ( [ TSpreadGun 3, TPistol, THardware ] , TSpreadGun 4 )
, ( [ TSpreadGun 4, TPistol, THardware ] , TSpreadGun 5 )
, ( [ TPistol, TAutoGun, THardware ] , TLtAutoGun )
, ( [ TLtAutoGun, TPipe, THardware ] , TAutoGun )
, ( [ TRifle, TRifle, THardware ] , TMultGun 2 )
, ( [ TMultGun 2, TRifle, THardware ] , TMultGun 3 )
, ( [ TMultGun 3, TRifle, THardware ] , TMultGun 4 )
, ( [ TMultGun 4, TRifle, THardware ] , TMultGun 5 )
, ( [ TLtAutoGun, TPipe, THardware ] , TAutoGun )
, ( [ TPistol, TTube, THardware] , TLauncher 1 )
, ( [ TLauncher 1, TTube, TPistol, THardware] , TLauncher 2)
, ( [ TLauncher 2, TTube, TPistol, THardware] , TLauncher 3)
]
src/Dodge/Combine/Data.hs
+10 -4
View File
@@ -1,10 +1,13 @@
module Dodge.Combine.Data
(ItemType (..)
(ItemCombineType (..)
)
where
data ItemType
data ItemCombineType
= TPipe
| TBigTube
| NoCombineType
| TLongPipe
| TVeryLongPipe
| TTube
| TPlate
| TMChip
| TMagnet
@@ -14,11 +17,13 @@ data ItemType
| TNailbox
| TPlank
| TPrism
| TIronBar
| TLightSensor
| TSoundSensor
| THeatSensor
| TCopperWire
| TEmptyCan
| TEmptyTin
| TPistol
| TAutoGun
| TRifle
@@ -29,8 +34,9 @@ data ItemType
| TSpreadGun Int
| TLauncher Int
| TBattery
| TFuelCell
| TPortableFusion
| TAutoFiringMech
| TFiringMech
| TTargetingModule
deriving (Eq,Ord)
deriving (Eq,Ord,Show)
src/Dodge/Creature/Action.hs
+1 -13
View File
@@ -10,7 +10,7 @@ module Dodge.Creature.Action
-- , startReloadingWeapon
, blinkAction
, sizeSelf
, crAutoReload
-- , crAutoReload
, copyInvItemToFloor
, youDropItem
, pickUpItem
@@ -144,18 +144,6 @@ performAction cr w ac = case ac of
(imps , _) -> (imps, Just $ DoReplicatePartial sac (t-1) sac)
NoAction -> ([],Nothing)
{- | Start reloading if clip is empty. -}
crAutoReload :: Creature -> Creature
crAutoReload cr = case cr ^? ptrItConsumption' . ammoLoaded of
Just 0 | _posture (_crStance cr) /= Aiming
-> cr & ptrItConsumption . reloadState .~ (strictify reloadT)
& ptrItConsumption . ammoLoaded %~ (`fromMaybe` maxA)
_ -> cr
where
ptrItConsumption = crInv . ix (_crInvSel cr) . itConsumption
ptrItConsumption' = crInv . ix (_crInvSel cr) . itConsumption
reloadT = cr ^? ptrItConsumption' . reloadTime
maxA = cr ^? ptrItConsumption' . ammoMax
{- | Teleport a creature to the mouse position -}
blinkAction
:: Creature
src/Dodge/Creature/Boid.hs
+13 -13
View File
@@ -14,26 +14,26 @@ interpWith x a b = x *.* a +.+ (1 - x) *.* b
invertEncircleDistP :: Float -> Creature -> Point2 -> Creature -> Point2
invertEncircleDistP d tcr cenp cr = ypos +.+
d *.* reflectIn (cenp -.- ypos) (safeNormalizeV (cpos -.- cenp))
d *.* reflectIn (cenp -.- ypos) (squashNormalizeV (cpos -.- cenp))
where
cpos = _crPos cr
ypos = _crPos tcr
encircleDistP :: Float -> Creature -> Point2 -> Creature -> Point2
encircleDistP d tcr cenp cr = ypos +.+ d *.* safeNormalizeV (cpos -.- cenp)
encircleDistP d tcr cenp cr = ypos +.+ d *.* squashNormalizeV (cpos -.- cenp)
where
cpos = _crPos cr
ypos = _crPos tcr
encircleP :: Creature -> Point2 -> Creature -> Point2
encircleP tcr cenp cr = ypos +.+ 50 *.* safeNormalizeV (cpos -.- cenp)
encircleP tcr cenp cr = ypos +.+ 50 *.* squashNormalizeV (cpos -.- cenp)
where
cpos = _crPos cr
ypos = _crPos tcr
--f x = 150 * sigmoid (x-10)
encircleCloseP :: Creature -> Point2 -> Creature -> Point2
encircleCloseP tcr cenp cr = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp)
encircleCloseP tcr cenp cr = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp)
where
cpos = _crPos cr
ypos = _crPos tcr
@@ -68,7 +68,7 @@ pincerP tcr cenp cr = tpos +.+ splitp -- +.+ 25 *.* (normalizeV $ tpos -.- cenp)
= negate 150 *.* orthCenpTpos
--d = min 150 (dist cpos tpos)
--orthCenpTpos = safeNormalizeV (vNormal $ tpos -.- cpos)
orthCenpTpos = safeNormalizeV (vNormal $ tpos -.- cenp)
orthCenpTpos = squashNormalizeV (vNormal $ tpos -.- cenp)
pincerP''' :: Creature -> Point2 -> Creature -> Point2
pincerP''' tcr cenp cr = interpWith (sigmoid $ 0.05 * dtcen) cenawayp cenclosep
@@ -85,15 +85,15 @@ pincerP''' tcr cenp cr = interpWith (sigmoid $ 0.05 * dtcen) cenawayp cenclosep
= f (max 0 (magV (tpos -.- cenp) - 80) ) *.* orthCenpTpos
| otherwise
= negate ( f $ max 0 $ magV (tpos -.- cenp) - 80) *.* orthCenpTpos
orthCenpTpos = safeNormalizeV (vNormal $ tpos -.- cenp)
orthCenpTpos = squashNormalizeV (vNormal $ tpos -.- cenp)
cenclosep
= tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp)
= tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp)
pincerP' :: Creature -> Point2 -> Creature -> Point2
pincerP' tcr cenp cr
| dist cenp tpos > dist cpos tpos
= cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp)
| otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp)
= cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp)
| otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp)
where
cpos = _crPos cr
tpos = _crPos tcr
@@ -102,10 +102,10 @@ pincerP' tcr cenp cr
pincerP'' :: Creature -> Point2 -> Creature -> Point2
pincerP'' tcr cenp cr
| dist cenp tpos > dist cpos tpos && isLHS cenp cpos tpos
= cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (vNormal $ tpos -.- cenp)
= cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (vNormal $ tpos -.- cenp)
| dist cenp tpos > dist cpos tpos
= cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (vNormal $ cenp -.- tpos)
| otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp)
= cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (vNormal $ cenp -.- tpos)
| otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp)
where
cpos = _crPos cr
tpos = _crPos tcr
@@ -114,7 +114,7 @@ pincerP'' tcr cenp cr
encircle :: Creature -> IM.IntMap Creature -> Creature -> Point2
encircle tcr crs cr
| length crs <= 1 = ypos
| otherwise = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp)
| otherwise = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp)
where
cpos = _crPos cr
ypos = _crPos tcr
src/Dodge/Data.hs
+3
View File
@@ -9,6 +9,7 @@ circular imports are probably not a good idea.
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data
( module Dodge.Data
, module Dodge.Combine.Data
, module Dodge.Distortion.Data
, module Dodge.Data.DamageType
, module Dodge.Data.SoundOrigin
@@ -27,6 +28,7 @@ import Dodge.Creature.Memory.Data
import Dodge.Distortion.Data
import Dodge.Data.SoundOrigin
import Dodge.Data.DamageType
import Dodge.Combine.Data
import Dodge.Config.Data
import Dodge.Config.KeyConfig
import Dodge.Item.Attachment.Data
@@ -337,6 +339,7 @@ data Item
, _itEquipPict :: Creature -> Int -> SPic
, _itScroll :: Float -> Creature -> Item -> Item
, _itIdentity :: ItemIdentity
, _itCombineType :: ItemCombineType
, _itAttachment :: ItAttachment
, _itID :: Maybe Int
, _itEffect :: ItEffect
src/Dodge/Default.hs
+1 -1
View File
@@ -176,7 +176,7 @@ applyIndividualDamage :: DamageType -> Creature -> (World -> World, Creature)
applyIndividualDamage (Concussive amount fromDir push pushexp pushRad) cr
= ( id
, over crHP (\hp -> hp - amount)
$ over crPos (+.+ (pushAmount *.* safeNormalizeV (_crPos cr -.- fromDir)))
$ over crPos (+.+ (pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir)))
cr
)
where
src/Dodge/Default/Weapon.hs
+1
View File
@@ -84,6 +84,7 @@ defaultAimParams = AimParams
defaultGun :: Item
defaultGun = Weapon
{ _itName = "default"
, _itCombineType = NoCombineType
, _itCurseStatus = Uncursed
, _itIdentity = Pistol
, _itConsumption = defaultAmmo
src/Dodge/Item/Weapon/BatteryGuns.hs
+4 -4
View File
@@ -46,7 +46,7 @@ teslaGun = defaultGun
[ ammoCheckI
, withTempLight 1 100 (V3 0 0 1)
, withSoundForI elecCrackleS 1
, useAmmo 1
, useAmmoAmount 1
]
& useAim . aimSpeed .~ 0.4
& useAim . aimStance .~ TwoHandFlat
@@ -73,7 +73,7 @@ lasGun = defaultAutoGun
[ ammoCheckI
, withTempLight 1 100 (V3 1 1 0)
, withSoundForI tone440sawtoothquietS 2
, useAmmo 1
, useAmmoAmount 1
]
& useAim . aimSpeed .~ 0.4
& useAim . aimRange .~ 1
@@ -286,7 +286,7 @@ tractorPullPos q p1 p = p -.- m *.* (0.3/ x' *.* q +.+ g y *.* p4)
| x > -5 = -0.02
| otherwise = (x - 10) / 250
--p4 = vNormal p5
p4 = vNormal $ safeNormalizeV q
p4 = vNormal $ squashNormalizeV q
p3 = p1 +.+ p4
tractorSPic :: Prop -> SPic
@@ -301,6 +301,6 @@ tractorSPic pj = (,) mempty $ setLayer 1 $ setDepth 20 $ color (withAlpha 0.5 co
size = fromIntegral (_pjTime pj)
spos = _pjPos pj
xpos = _pjStartPos pj
d = safeNormalizeV $ spos -.- xpos
d = squashNormalizeV $ spos -.- xpos
n = vNormal d
col = mixColors 0.5 0.5 white blue
src/Dodge/Item/Weapon/Bezier.hs
+1 -1
View File
@@ -28,7 +28,7 @@ bezierGun = defaultGun
[ ammoCheckI
, useTimeCheck
, withSoundStart tap2S
, useAmmo 1
, useAmmoAmount 1
, withMuzFlareI
. withRecoilI 40
. torqueBefore 0.05
src/Dodge/Item/Weapon/Booster.hs
+1 -1
View File
@@ -27,7 +27,7 @@ boostPoint x cr w = case mayp2 of
where
cpos = _crPos cr
r = 1.5 * _crRad cr
p1 = cpos +.+ x *.* safeNormalizeV (mouseWorldPos w -.- cpos)
p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos w -.- cpos)
mayp2 = reflectPointWalls cpos p1 $ wallsAlongLine cpos p1 w
boostSelfL
src/Dodge/Item/Weapon/BulletGuns.hs
+11 -10
View File
@@ -55,7 +55,7 @@ autoGun = defaultAutoGun
]
, withSoundForI autoBS 5
--, withSoundForI seagullChatterS 5
, useAmmo 1
, useAmmoAmount 1
, applyInaccuracy
, withMuzFlareI
, withSmoke 1 black 20 200 5
@@ -103,7 +103,7 @@ pistol = defaultGun
, hammerCheckI
, useTimeCheck
, withSoundStart tap3S
, useAmmo 1
, useAmmoAmount 1
, applyInaccuracy
, withMuzFlareI
]
@@ -189,7 +189,7 @@ ltAutoGun = defaultAutoGun
[ ammoCheckI
, useTimeCheck
, withSoundStart tap1S
, useAmmo 1
, useAmmoAmount 1
, applyInaccuracy
, torqueAfterI 0.2
, withSidePushI 50
@@ -252,7 +252,7 @@ miniGun = defaultAutoGun
, afterRecoil recoilAmount
, withRandomOffsetI 9
, withOldDir od3
, useAmmo 4
, useAmmoAmount 4
, withMuzFlareI
, withSmoke 1 black 20 200 5
]
@@ -328,7 +328,7 @@ spreadGun = defaultGun
, hammerCheckI
, useTimeCheck
, withSoundStart shotgunS
, useAmmo 1
, useAmmoAmount 1
, withRecoilI 100
, withMuzFlareI
, spreadNumI
@@ -358,19 +358,20 @@ multGun = defaultGun
, _itIdentity = MultGun
, _itConsumption = defaultAmmo
{ _aoType = basicBullet
, _ammoMax = 2
, _ammoMax = 5
, _ammoLoaded = 2
, _reloadTime = 40
, _reloadTime = 10
, _reloadType = ActivePartial 1
}
, _itUse = useAmmoParamsRate 20 upHammer
[ ammoCheckI
, hammerCheckI
, useTimeCheck
, withSoundStart shotgunS
, useAmmo 1
, useAllAmmo
, withRecoilI 200
, withMuzFlareI
, numI
, duplicateEachLoadedBarrel
]
& useAim . aimSpeed .~ 0.4
& useAim . aimRange .~ 1
@@ -418,7 +419,7 @@ longGun = defaultGun
, hammerCheckI
, useTimeCheck
, withSoundStart bangEchoS
, useAmmo 1
, useAmmoAmount 1
, withThickSmokeI
, torqueAfterI 0.05
, withMuzFlareI
src/Dodge/Item/Weapon/Drone.hs
+1 -1
View File
@@ -32,7 +32,7 @@ lasDrones = defaultGun
[ ammoCheckI
, useTimeCheck
, withSoundStart tap4S
, useAmmo 1
, useAmmoAmount 1
]
& useAim . aimSpeed .~ 0.2
& useAim . aimRange .~ 0.5
src/Dodge/Item/Weapon/Launcher.hs
+1 -1
View File
@@ -52,7 +52,7 @@ launcher = defaultGun
[ ammoCheckI
, useTimeCheck
, withSoundStart tap4S
, useAmmo 1
, useAmmoAmount 1
]
& useAim . aimSpeed .~ 0.2
& useAim . aimRange .~ 0.5
src/Dodge/Item/Weapon/SprayGuns.hs
+2 -2
View File
@@ -42,7 +42,7 @@ poisonSprayer = defaultAutoGun
, _itUse = ruseInstant (const aGasCloud) NoHammer
[ ammoCheckI
, withSoundForI foamSprayLoopS 5
, useAmmo 1
, useAmmoAmount 1
-- , spreadNumI
]
& useAim . aimSpeed .~ 0.2
@@ -65,7 +65,7 @@ flamer = defaultAutoGun
}
, _itUse = ruseInstant (\_ -> randWalkAngle aFlame) NoHammer
[ ammoCheckI
, useAmmo 1
, useAmmoAmount 1
, withSidePushI 5
--, withTempLight 1 100 (V3 1 0 0)
, withSidePushAfterI 20
src/Dodge/Item/Weapon/TriggerType.hs
+21 -8
View File
@@ -1,7 +1,8 @@
{- |
Weapon effects when pulling the trigger. -}
module Dodge.Item.Weapon.TriggerType
( useAmmo
( useAmmoAmount
, useAllAmmo
, withMuzFlareI
, withOldDir
, trigDoAlso
@@ -25,7 +26,8 @@ module Dodge.Item.Weapon.TriggerType
, withSidePushI
, withWarmUp
, spreadNumI
, numI
, numBarrels
, duplicateEachLoadedBarrel
, randWalkAngle -- ^ should be made into a modifier, perhaps
, hammerCheckI
, hammerCheckL
@@ -217,10 +219,11 @@ withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff
cid = _crID cr
push = over crPos (+.+ rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr)))
(pushAmount, g) = randomR (-maxSide,maxSide) $ _randGen w
useAmmo
:: Int -- ^ amount of ammo to use
-> ChainEffect
useAmmo amAmount eff item cr = eff item cr
useAllAmmo :: ChainEffect
useAllAmmo eff item cr = eff item cr
. (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded .~ 0)
useAmmoAmount :: Int -> ChainEffect
useAmmoAmount amAmount eff item cr = eff item cr
. (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded -~ amAmount)
{- |
Applies a world effect after an item use cooldown check. -}
@@ -393,8 +396,18 @@ spreadNumI eff item cr w = foldr f w dirs
f dir = eff item (cr & crDir +~ dir)
spread = _spreadAngle . _brlSpread . _gunBarrels $ _itParams item
numBul = _brlNum . _gunBarrels $ _itParams item
numI :: ChainEffect
numI eff item cr w = foldr f w poss
duplicateEachLoadedBarrel :: ChainEffect
duplicateEachLoadedBarrel eff item cr w = foldr f w poss
where
cp :: Float
cp = -0.5 * (fromIntegral numBar - 1)
poss :: [V2 Float]
poss = map (rotateV (_crDir cr) . V2 0 . (*5) . (+ cp) . fromIntegral) [0 .. numBul - 1]
f pos = eff item (cr & crPos %~ (+.+ pos))
numBar = _brlNum . _gunBarrels $ _itParams item
numBul = _ammoLoaded $ _itConsumption item
numBarrels :: ChainEffect
numBarrels eff item cr w = foldr f w poss
where
cp :: Float
cp = -0.5 * fromIntegral numBul
src/Dodge/LevelGen/StaticWalls.hs
+1 -1
View File
@@ -97,7 +97,7 @@ expandPolyBy x ps = map f ps
expandPolyByFixed :: Float -> [Point2] -> [Point2]
expandPolyByFixed x ps = map f ps
where
f p = p +.+ x *.* safeNormalizeV (p -.- centroid ps)
f p = p +.+ x *.* squashNormalizeV (p -.- centroid ps)
-- | Given a value and a poly, pushes points out by a fixed amount along an
-- angle determined by the corner, i.e. by the two other neighbour points
expandPolyCorners :: Float -> [Point2] -> [Point2]
src/Dodge/Particle/Bullet/HitEffect.hs
+6 -6
View File
@@ -35,7 +35,7 @@ bulHitCr bt p cr w
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
cid = _crID cr
colID = _btColor' bt
p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr)
p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)
bulletHitSound :: Point2 -> World -> World
bulletHitSound p = soundMultiFrom [CrHitSound 0] p hit1S (Just 10)
@@ -52,7 +52,7 @@ bulBounceArmCr' bt p cr w
addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
cid = _crID cr
newDir = safeNormalizeV (p -.- _crPos cr)
newDir = squashNormalizeV (p -.- _crPos cr)
pOut = p +.+ 2 *.* newDir
reflectVel = magV bulVel *.* newDir
addBouncer = worldEvents %~ ( over particles (bouncer :) . )
@@ -137,7 +137,7 @@ bulBounceWall bt p wl = damageWall (Blunt 50 sp p ep) wl . over worldEvents addB
where
ep = sp +.+ _btVel' bt
sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
pOut = p +.+ squashNormalizeV (sp -.- p)
bouncer = (aGenBulAt Nothing pOut reflectVel (_btHitEffect' bt) (_btWidth' bt)
) {_btTimer' = _btTimer' bt - 1}
reflectVel = reflVelWall wl (_btVel' bt)
@@ -157,9 +157,9 @@ bulIncWall bt p wl = damageWall (Blunt 50 sp p ep) wl . incFlamelets
where
ep = sp +.+ _btVel' bt
sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
pOut = p +.+ squashNormalizeV (sp -.- p)
wallV = uncurry (-.-) (_wlLine wl)
reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
reflectVel = squashNormalizeV $ reflectIn wallV (_btVel' bt)
incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut 20 reflectVel Nothing 3 20)
{- | Create a shockwave on wall-}
bulConWall
@@ -186,7 +186,7 @@ hvBulHitWall bt p wl w = damageWall (Piercing 200 sp p ep) wl
where
ep = sp +.+ _btVel' bt
sp = head $ _btTrail' bt
pOut = p +.+ safeNormalizeV (sp -.- p)
pOut = p +.+ squashNormalizeV (sp -.- p)
(a, g) = randomR (-0.2,0.2) $ _randGen w
sv = unitVectorAtAngle $ a + reflDirWall sp p wl
cs' = take 10 $ randomRs (0,11) $ _randGen w
src/Dodge/Placement/Instance/LightSource.hs
+2 -2
View File
@@ -65,7 +65,7 @@ aShape :: Point2 -> Point3 -> Shape
aShape wallpos (V3 x y z) =
girder (z+2) 20 10 pout wallpos
where
pout = V2 x y -.- 2 *.* safeNormalizeV (V2 x y -.- wallpos)
pout = V2 x y -.- 2 *.* squashNormalizeV (V2 x y -.- wallpos)
vShape :: Point2 -> Point3 -> Shape
vShape wallpos (V3 x y z) =
@@ -127,7 +127,7 @@ spanLightI :: Point2 -> Point2 -> Placement
spanLightI = spanColLightI 0.75 50
extendAway :: Point2 -> Point2 -> Point2
extendAway p x = p +.+ safeNormalizeV (p -.- x)
extendAway p x = p +.+ squashNormalizeV (p -.- x)
putColorLamp :: Point3 -> PSType
putColorLamp col = PutCrit (colorLamp col 90)
src/Dodge/Reloading.hs
+14
View File
@@ -3,6 +3,7 @@ import Dodge.Data
import Dodge.Base
--import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Control.Lens
startReloadingWeapon :: Creature -> World -> Maybe World
@@ -34,3 +35,16 @@ stepReloading cr = case cr ^? crInv . ix isel . itConsumption . reloadState . _J
& reloadState .~ Nothing'
_ -> itcon & ammoLoaded .~ _ammoMax itcon
& reloadState .~ Nothing'
{- | Start reloading if clip is empty. -}
crAutoReload :: Creature -> Creature
crAutoReload cr = case cr ^? ptrItConsumption' . ammoLoaded of
Just 0 | _posture (_crStance cr) /= Aiming
-> cr & ptrItConsumption . reloadState .~ strictify reloadT
& ptrItConsumption . ammoLoaded %~ (`fromMaybe` maxA)
_ -> cr
where
ptrItConsumption = crInv . ix (_crInvSel cr) . itConsumption
ptrItConsumption' = crInv . ix (_crInvSel cr) . itConsumption
reloadT = cr ^? ptrItConsumption' . reloadTime
maxA = cr ^? ptrItConsumption' . ammoMax
src/Dodge/Render/HUD.hs
+7 -1
View File
@@ -6,6 +6,7 @@ import Dodge.Data
import Dodge.WinScale
import Dodge.Base
import Dodge.Base.Window
import Dodge.Combine.Combinations
import Dodge.Inventory
import Dodge.Render.Connectors
import Dodge.Render.List
@@ -42,7 +43,9 @@ subInventoryDisplay cfig w = case _inventoryMode w of
, cursorsZ cfig cursPos it
, displayMidList cfig (ammoTweakStrings it) "TWEAK"
]
CombineInventory -> invHead cfig "COMBINE"
CombineInventory ->
displayMidList cfig (combineListStrings w) "COMBINE"
-- invHead cfig "COMBINE"
InspectInventory -> invHead cfig "INSPECT"
where
itCol = fromMaybe (greyN 0.5) . (^? _Just . itInvColor)
@@ -61,6 +64,9 @@ cursorsZ cfig ipos it = case it ^? _Just . itTweaks . tweakSel of
hw = halfWidth cfig
sp = V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
combineListStrings :: World -> [String]
combineListStrings = map (show . snd) . combineList . fmap _itCombineType . yourInv
ammoTweakStrings :: Maybe Item -> [String]
ammoTweakStrings it = case it ^? _Just . itTweaks . tweakParams of
Just l -> map tweakString $ IM.elems l
src/Dodge/Update/Camera.hs
+1 -1
View File
@@ -188,7 +188,7 @@ extendedViewPoints p grs = map extend
++ map addDir (concatMap _grLinkDirs grs)
)
where
extend outp = p +.+ maxViewDistance *.* safeNormalizeV (outp -.- p)
extend outp = p +.+ maxViewDistance *.* squashNormalizeV (outp -.- p)
addDir a = p +.+ unitVectorAtAngle a
farWallPoints :: Point2 -> World -> [Point2]
src/Dodge/Wall/Damage.hs
+1 -1
View File
@@ -37,7 +37,7 @@ wallEff dt wl = case dt of
PushDam {} -> id
PoisonDam {} -> id
where
outTo sp p = p +.+ safeNormalizeV (sp -.- p)
outTo sp p = p +.+ squashNormalizeV (sp -.- p)
pSparkCol = brightX 100 1.5 white
lSparkCol = V4 20 (-5) 0 1
src/Dodge/WallCreatureCollisions.hs
+17 -5
View File
@@ -126,8 +126,10 @@ pushOutFromWall rad cp2 (wp1,wp2)
-- --isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad
-- isOnWall = circOnSeg wp1 wp2 cp2 rad
pushOutFromCorners :: Float -> [(Point2,Point2)] -> Point2 -> Point2
pushOutFromCorners r ls p = foldr (intersectCirclePoint r . fst) p ls
pushOutFromCorners r ls p = foldr (squashIntersectCirclePoint r . fst) p ls
--pushOutFromCorners' :: World -> Creature -> Creature
--pushOutFromCorners' w cr = cr & crPos .~ newPos
@@ -138,8 +140,18 @@ pushOutFromCorners r ls p = foldr (intersectCirclePoint r . fst) p ls
--collideCorners :: Float -> [Point2] -> Point2 -> Point2
--collideCorners rad ps p2 = foldr (intersectCirclePoint rad) p2 ps
---- collide circles with points (outer corners)
intersectCirclePoint :: Float -> Point2 -> Point2 -> Point2
intersectCirclePoint rad p cCen
--safeIntersectCirclePoint :: Float -> Point2 -> Point2 -> Maybe Point2
--safeIntersectCirclePoint rad p cCen
-- | dist cCen p > rad = Just cCen
-- | otherwise = (p +.+) <$> ((rad *.*) <$> (safeNormalizeV (cCen -.- p)))
squashIntersectCirclePoint :: Float -> Point2 -> Point2 -> Point2
squashIntersectCirclePoint rad p cCen
| dist cCen p > rad = cCen
| otherwise = p +.+ (rad *.* errorNormalizeV 65 (cCen -.- p))
| otherwise = p +.+ (rad *.* squashNormalizeV (cCen -.- p))
---- collide circles with points (outer corners)
--intersectCirclePoint :: Float -> Point2 -> Point2 -> Point2
--intersectCirclePoint rad p cCen
-- | dist cCen p > rad = cCen
-- | otherwise = p +.+ (rad *.* errorNormalizeV 65 (cCen -.- p))
src/Dodge/WorldEvent/Shockwave.hs
+2 -2
View File
@@ -70,7 +70,7 @@ mvShockwave is w pt
damCr cr
| _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . crDamage %~
(PushDam dam (25 * push *.* safeNormalizeV (_crPos cr -.- p)) : )
(PushDam dam (25 * push *.* squashNormalizeV (_crPos cr -.- p)) : )
{- Create a shockwave going from an outside circle into a center point. -}
inverseShockwaveAt
:: Point2 -- Center position
@@ -109,7 +109,7 @@ moveInverseShockwave w pt
damCr cr
| dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . crDamage %~
(PushDam 1 (25 *.* safeNormalizeV (p -.- _crPos cr)) :)
(PushDam 1 (25 *.* squashNormalizeV (p -.- _crPos cr)) :)
drawInverseShockwave :: Particle -> Picture
drawInverseShockwave pt
src/Dodge/WorldEvent/SpawnParticle.hs
+1 -1
View File
@@ -109,7 +109,7 @@ moveFlame rotd w pt
, _btPos' = pOut p
, _btVel' = reflV wl
}
pOut p = p +.+ safeNormalizeV (sp -.- p)
pOut p = p +.+ squashNormalizeV (sp -.- p)
reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel )
+.+ (0.2 *.* vel)
src/Geometry/Vector.hs
+10 -3
View File
@@ -108,10 +108,17 @@ vNormal (V2 x y) = V2 y (negate x)
vInverse :: Point2 -> Point2
vInverse (V2 x y) = V2 (-x) (-y)
{- | Normalize a vector safely: on (0,0) return (0,0). -}
safeNormalizeV :: Point2 -> Point2
squashNormalizeV :: Point2 -> Point2
{-# INLINE squashNormalizeV #-}
squashNormalizeV p
| magV p == 0 = V2 0 0
| otherwise = (1/magV p ) *.* p
{- | Normalize a vector safely: on (0,0) return Nothing. -}
safeNormalizeV :: Point2 -> Maybe Point2
{-# INLINE safeNormalizeV #-}
safeNormalizeV (V2 0 0) = V2 0 0
safeNormalizeV p = (1/magV p ) *.* p
safeNormalizeV p
| magV p == 0 = Nothing
| otherwise = Just $ (1/magV p ) *.* p
{- | Magnitude of a vector. -}
magV :: Point2 -> Float
{-# INLINE magV #-}
src/Picture.hs
+1 -1
View File
@@ -259,7 +259,7 @@ thickLineCol ps t = pictures $ f ps
,(y +.+ n x y,c')
] : f ((y,c'):ys)
f _ = []
n a b = (t*0.5) *.* safeNormalizeV (vNormal (a -.- b))
n a b = (t*0.5) *.* squashNormalizeV (vNormal (a -.- b))
thickCircle :: Float -> Float -> Picture
{-# INLINE thickCircle #-}