Split autodoor module
This commit is contained in:
@@ -750,3 +750,13 @@ wallsLOS !ls !c !p = all (\l -> wallLOS l c p) ls
|
||||
|
||||
translateDrawing = translate
|
||||
rotateDrawing = rotate
|
||||
|
||||
mvPointTowardAtSpeed :: Float -> Point2 -> Point2 -> Point2
|
||||
mvPointTowardAtSpeed speed !ep !p
|
||||
| dist p ep < speed = ep
|
||||
| otherwise = p +.+ speed *.* normalizeV (ep -.- p)
|
||||
|
||||
mvPointToward :: Point2 -> Point2 -> Point2
|
||||
mvPointToward !ep !p | dist p ep < 1 = ep
|
||||
| otherwise = p +.+ normalizeV (ep -.- p)
|
||||
|
||||
|
||||
+2
-111
@@ -14,17 +14,17 @@ import Dodge.Data
|
||||
import Dodge.Base
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.Prototypes
|
||||
|
||||
import Dodge.LevelGen.Block
|
||||
import Dodge.LevelGen.Pathing
|
||||
|
||||
import Dodge.LevelGen.StaticWalls
|
||||
import Dodge.LevelGen.AutoDoor
|
||||
|
||||
import Geometry
|
||||
import Picture
|
||||
|
||||
import System.Random
|
||||
|
||||
import Control.DeepSeq (deepseq)
|
||||
|
||||
import Control.Monad.State
|
||||
import Data.List
|
||||
@@ -293,9 +293,6 @@ triggerDoorPane c cond n [a,b] [a',b'] = Door
|
||||
changeZonedWall' (!x,!y)
|
||||
= over wallsZone $ adjustIMZone closeDoor x y n
|
||||
|
||||
addAutoDoor :: Point2 -> Point2 -> World -> World
|
||||
addAutoDoor a b = over walls (autoDoorAt a b)
|
||||
|
||||
putWindowBlock :: Point2 -> Point2 -> World -> World
|
||||
putWindowBlock a b w = removePathsCrossing a b $ foldr makeBlockAt w $ zip ps ns
|
||||
where d = dist a b
|
||||
@@ -363,113 +360,7 @@ putWindowBlock a b w = removePathsCrossing a b $ foldr makeBlockAt w $ zip ps ns
|
||||
f = IM.insert k0 l . IM.insert k1 t . IM.insert k2 r . IM.insert k3 b
|
||||
in over walls f w
|
||||
|
||||
autoDoorAt :: Point2 -> Point2 -> IM.IntMap Wall -> IM.IntMap Wall
|
||||
autoDoorAt a b wls = IM.union wls $ IM.fromList $ zip is $ mkAutoDoor a b is
|
||||
where i = newKey wls
|
||||
is = [i..]
|
||||
|
||||
mkAutoDoor :: Point2 -> Point2 -> [Int] -> [Wall]
|
||||
mkAutoDoor pl pr xs = addSound $ zipWith4 (autoDoorPane [pl,pr])
|
||||
xs
|
||||
[ True
|
||||
, False
|
||||
, True
|
||||
, True
|
||||
, False
|
||||
, True
|
||||
]
|
||||
[ [pld,hwd,hw,pl]
|
||||
, [hwd,hwu]
|
||||
, [hwu,plu,pl,hw]
|
||||
, [pru,hwu,hw,pr]
|
||||
, [hwu,hwd]
|
||||
, [hwd,prd,pr,hw]
|
||||
]
|
||||
[ [plld,pld,pl,pl]
|
||||
, [pld,plu]
|
||||
, [plu,pllu,pl,pl]
|
||||
, [prru,pru,pr,pr]
|
||||
, [pru,prd]
|
||||
, [prd,prrd,pr,pr]
|
||||
]
|
||||
where norm = 15.1 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
|
||||
-- .1 hack, there was flickering
|
||||
hw = 0.5 *.* (pl +.+ pr)
|
||||
parallel = 20 *.* normalizeV (pl -.- pr)
|
||||
plu = pl +.+ norm
|
||||
pld = pl -.- norm
|
||||
pru = pr +.+ norm
|
||||
prd = pr -.- norm
|
||||
hwu = hw +.+ norm
|
||||
hwd = hw -.- norm
|
||||
pllu = plu +.+ parallel
|
||||
plld = pld +.+ parallel
|
||||
prru = pru -.- parallel
|
||||
prrd = prd -.- parallel
|
||||
addSound (x:xs) = f x : xs
|
||||
f wl = over doorMech g wl
|
||||
g dm w | dist wp pld > 1 && dist wp hwd > 1 = soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0
|
||||
$ dm w
|
||||
| otherwise = dm w
|
||||
where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1
|
||||
|
||||
mvPointTowardAtSpeed :: Float -> Point2 -> Point2 -> Point2
|
||||
mvPointTowardAtSpeed speed !ep !p
|
||||
| dist p ep < speed = ep
|
||||
| otherwise = p +.+ speed *.* normalizeV (ep -.- p)
|
||||
|
||||
mvPointToward :: Point2 -> Point2 -> Point2
|
||||
mvPointToward !ep !p | dist p ep < 1 = ep
|
||||
| otherwise = p +.+ normalizeV (ep -.- p)
|
||||
|
||||
drawAutoDoor :: Wall -> Drawing
|
||||
drawAutoDoor wl = onLayerL [levLayer WlLayer, layer2]
|
||||
$ pictures [color c $ polygon [x,x +.+ n2,y +.+ n2, y]
|
||||
,color (dark c) $ line [x,y]
|
||||
]
|
||||
where
|
||||
(x:y:_) = _wlLine wl
|
||||
c = _wlColor wl
|
||||
nm = errorNormalizeV 543 (y -.- x)
|
||||
t = 5 *.* nm
|
||||
n = vNormal t
|
||||
n2 = 3 *.* n
|
||||
layer2 | _wlIsSeeThrough wl = 0
|
||||
| isJust $ wl ^? doorMech = 1
|
||||
| otherwise = 2
|
||||
|
||||
autoDoorPane :: [Point2] -> Int -> Bool -> [Point2] -> [Point2] -> Wall
|
||||
autoDoorPane trigL n castShad closedPos openPos = AutoDoor
|
||||
{ _wlLine = closedPos
|
||||
, _wlID = n
|
||||
, _doorMech = dm
|
||||
, _wlColor = dim $ yellow
|
||||
, _wlDraw = Nothing
|
||||
, _wlSeen = False
|
||||
, _wlIsSeeThrough = False
|
||||
, _wlCastShadow = castShad
|
||||
}
|
||||
where
|
||||
a = closedPos !! 0
|
||||
b = closedPos !! 1
|
||||
dm w | crsNearLine 40 trigL w
|
||||
= flip (foldr changeZonedWall) zoneps
|
||||
$ over walls (IM.adjust openDoor n) w
|
||||
| otherwise = flip (foldr changeZonedWall') zoneps
|
||||
$ over walls (IM.adjust closeDoor n) w
|
||||
mvP !ep !p = mvPointTowardAtSpeed 2 ep p
|
||||
moveToward :: [Point2] -> Wall -> Wall
|
||||
moveToward !ps w = let !newPs = zipWith mvP ps $ _wlLine w
|
||||
in deepseq newPs $ w {_wlLine = newPs}
|
||||
--deepseq ps $ w & wlLine %~ zipWith mvP ps
|
||||
openDoor = moveToward openPos
|
||||
closeDoor = moveToward closedPos
|
||||
zoneps | dist a b <= 2 * zoneSize = [zoneOfPoint $ pHalf a b]
|
||||
| otherwise = map zoneOfPoint $ divideLine (2*zoneSize) a b
|
||||
changeZonedWall (!x,!y)
|
||||
= over wallsZone $ adjustIMZone openDoor x y n
|
||||
changeZonedWall' (!x,!y)
|
||||
= over wallsZone $ adjustIMZone closeDoor x y n
|
||||
|
||||
shiftPointBy (pos,rot) p = pos +.+ rotateV rot p
|
||||
|
||||
|
||||
@@ -0,0 +1,118 @@
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Dodge.LevelGen.AutoDoor
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Base
|
||||
import Dodge.SoundLogic
|
||||
|
||||
import Geometry
|
||||
import Picture
|
||||
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
|
||||
import Control.Lens
|
||||
import Control.DeepSeq (deepseq)
|
||||
|
||||
addAutoDoor :: Point2 -> Point2 -> World -> World
|
||||
addAutoDoor a b = over walls (autoDoorAt a b)
|
||||
|
||||
autoDoorAt :: Point2 -> Point2 -> IM.IntMap Wall -> IM.IntMap Wall
|
||||
autoDoorAt a b wls = IM.union wls $ IM.fromList $ zip is $ mkAutoDoor a b is
|
||||
where i = newKey wls
|
||||
is = [i..]
|
||||
|
||||
mkAutoDoor :: Point2 -> Point2 -> [Int] -> [Wall]
|
||||
mkAutoDoor pl pr xs = addSound $ zipWith4 (autoDoorPane [pl,pr])
|
||||
xs
|
||||
[ True
|
||||
, False
|
||||
, True
|
||||
, True
|
||||
, False
|
||||
, True
|
||||
]
|
||||
[ [pld,hwd,hw,pl]
|
||||
, [hwd,hwu]
|
||||
, [hwu,plu,pl,hw]
|
||||
, [pru,hwu,hw,pr]
|
||||
, [hwu,hwd]
|
||||
, [hwd,prd,pr,hw]
|
||||
]
|
||||
[ [plld,pld,pl,pl]
|
||||
, [pld,plu]
|
||||
, [plu,pllu,pl,pl]
|
||||
, [prru,pru,pr,pr]
|
||||
, [pru,prd]
|
||||
, [prd,prrd,pr,pr]
|
||||
]
|
||||
where norm = 15.1 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
|
||||
-- .1 hack, there was flickering
|
||||
hw = 0.5 *.* (pl +.+ pr)
|
||||
parallel = 20 *.* normalizeV (pl -.- pr)
|
||||
plu = pl +.+ norm
|
||||
pld = pl -.- norm
|
||||
pru = pr +.+ norm
|
||||
prd = pr -.- norm
|
||||
hwu = hw +.+ norm
|
||||
hwd = hw -.- norm
|
||||
pllu = plu +.+ parallel
|
||||
plld = pld +.+ parallel
|
||||
prru = pru -.- parallel
|
||||
prrd = prd -.- parallel
|
||||
addSound (x:xs) = f x : xs
|
||||
f wl = over doorMech g wl
|
||||
g dm w | dist wp pld > 1 && dist wp hwd > 1 = soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0
|
||||
$ dm w
|
||||
| otherwise = dm w
|
||||
where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1
|
||||
|
||||
drawAutoDoor :: Wall -> Drawing
|
||||
drawAutoDoor wl = onLayerL [levLayer WlLayer, layer2]
|
||||
$ pictures [color c $ polygon [x,x +.+ n2,y +.+ n2, y]
|
||||
,color (dark c) $ line [x,y]
|
||||
]
|
||||
where
|
||||
(x:y:_) = _wlLine wl
|
||||
c = _wlColor wl
|
||||
nm = errorNormalizeV 543 (y -.- x)
|
||||
t = 5 *.* nm
|
||||
n = vNormal t
|
||||
n2 = 3 *.* n
|
||||
layer2 | _wlIsSeeThrough wl = 0
|
||||
| isJust $ wl ^? doorMech = 1
|
||||
| otherwise = 2
|
||||
|
||||
autoDoorPane :: [Point2] -> Int -> Bool -> [Point2] -> [Point2] -> Wall
|
||||
autoDoorPane trigL n castShad closedPos openPos = AutoDoor
|
||||
{ _wlLine = closedPos
|
||||
, _wlID = n
|
||||
, _doorMech = dm
|
||||
, _wlColor = dim $ yellow
|
||||
, _wlDraw = Nothing
|
||||
, _wlSeen = False
|
||||
, _wlIsSeeThrough = False
|
||||
, _wlCastShadow = castShad
|
||||
}
|
||||
where
|
||||
a = closedPos !! 0
|
||||
b = closedPos !! 1
|
||||
dm w | crsNearLine 40 trigL w
|
||||
= flip (foldr changeZonedWall) zoneps
|
||||
$ over walls (IM.adjust openDoor n) w
|
||||
| otherwise = flip (foldr changeZonedWall') zoneps
|
||||
$ over walls (IM.adjust closeDoor n) w
|
||||
mvP !ep !p = mvPointTowardAtSpeed 2 ep p
|
||||
moveToward :: [Point2] -> Wall -> Wall
|
||||
moveToward !ps w = let !newPs = zipWith mvP ps $ _wlLine w
|
||||
in deepseq newPs $ w {_wlLine = newPs}
|
||||
--deepseq ps $ w & wlLine %~ zipWith mvP ps
|
||||
openDoor = moveToward openPos
|
||||
closeDoor = moveToward closedPos
|
||||
zoneps | dist a b <= 2 * zoneSize = [zoneOfPoint $ pHalf a b]
|
||||
| otherwise = map zoneOfPoint $ divideLine (2*zoneSize) a b
|
||||
changeZonedWall (!x,!y)
|
||||
= over wallsZone $ adjustIMZone openDoor x y n
|
||||
changeZonedWall' (!x,!y)
|
||||
= over wallsZone $ adjustIMZone closeDoor x y n
|
||||
@@ -0,0 +1,29 @@
|
||||
module Dodge.LevelGen.Pathing
|
||||
where
|
||||
import Geometry
|
||||
|
||||
import Control.Lens
|
||||
|
||||
import Dodge.Data
|
||||
import Dodge.Base
|
||||
|
||||
import Data.Maybe
|
||||
import Data.List
|
||||
|
||||
import qualified Data.IntMap as IM
|
||||
import Data.Graph.Inductive hiding ((&))
|
||||
import Data.Graph.Inductive.NodeMap
|
||||
|
||||
pairsToGraph :: (Ord a, Eq a, Eq b) => (a -> a -> b) -> [(a,a)] -> Gr a b
|
||||
pairsToGraph f pairs = let nodes = nub (map fst pairs ++ map snd pairs)
|
||||
pairs' = map (\(x,y)->(x,y,f x y)) pairs
|
||||
in undir $ run_ Data.Graph.Inductive.empty $ insMapNodesM nodes >> insMapEdgesM pairs'
|
||||
|
||||
removePathsCrossing :: Point2 -> Point2 -> World -> World
|
||||
removePathsCrossing a b w = set pathGraph newGraph $ set pathGraph' pg'
|
||||
$ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
|
||||
w
|
||||
where pg' = filter (not . isJust . uncurry (intersectSegSeg' a b)) $ _pathGraph' w
|
||||
insertPoint pp@(_,(x,y)) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
|
||||
newGraph = pairsToGraph dist pg'
|
||||
|
||||
+3
-2
@@ -48,7 +48,7 @@ lev1 = do
|
||||
-- [randomiseLinks =<< pistolerRoom]
|
||||
[return $ return $ Right deadEndRoom
|
||||
]
|
||||
++ [roomMiniIntro]
|
||||
++ [slowDoorRoom]
|
||||
++ [return $ connectRoom corridor
|
||||
,return $ connectRoom door]
|
||||
-- ++ [randomiseLinks =<< longRoom]
|
||||
@@ -711,7 +711,8 @@ slowDoorRoom = do
|
||||
xs' <- sequence $ replicate 5 $ state $ randomR (10,x-10)
|
||||
ys' <- sequence $ replicate 5 $ state $ randomR (h+20,y)
|
||||
let crits = zipWith (\p r -> PS p r randC1) ps rs
|
||||
lsources = [PS (x/2,30) 0 basicLS, PS (x/2,y-30) 0 basicLS]
|
||||
--lsources = [PS (x/2,30) 0 basicLS, PS (x/2,y-30) 0 basicLS]
|
||||
lsources = [PS (x/2,y-30) 0 basicLS]
|
||||
let barrels = zipWith (\x y -> PS (x,y) 0 $ PutCrit explosiveBarrel) xs' ys'
|
||||
let pillarsa = []
|
||||
let pillarsb = putBlockRect (x/5-20) (x/5+20) (h/2-20) (h/2+20)
|
||||
|
||||
@@ -109,7 +109,7 @@ autoGun = defaultGun
|
||||
, _wpReloadTime = 80
|
||||
, _wpReloadState = 0
|
||||
-- , _wpFireRate = 6
|
||||
, _wpFireRate = 5
|
||||
, _wpFireRate = 6
|
||||
, _wpFireState = 0
|
||||
, _wpFire = autoFireMode
|
||||
, _wpSpread = autogunSpread
|
||||
@@ -383,7 +383,7 @@ hvAutoGun = autoGun
|
||||
, _wpReloadState = 0
|
||||
, _wpFireRate = 25
|
||||
, _wpFireState = 0
|
||||
, _wpFire = rateIncAB 24 12 (torqueBeforeForced 0.1 mkHvBul)
|
||||
, _wpFire = rateIncAB 24 10 (torqueBeforeForced 0.1 mkHvBul)
|
||||
$torqueAfter 0.2 mkHvBul
|
||||
, _wpSpread = autogunSpread
|
||||
, _wpRange = 20
|
||||
|
||||
Reference in New Issue
Block a user