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

Refactor vault room

Browse Source
This commit is contained in:
justin
2021-10-01 00:48:19 +01:00
parent 1414d08d88
commit 4b5a75f4af
5 changed files with 59 additions and 41 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/LightSources/Fitting.hs
+14 -14
View File
@@ -6,9 +6,9 @@ import Dodge.Room.Foreground
import Dodge.Placement import Dodge.Placement
import Geometry import Geometry
wallMount :: Point2 -> Point3 -> Placement mountedLight :: Point2 -> Point3 -> Placement
wallMount wallPos lampPos@(V3 x y z) mountedLight wallPos lampPos@(V3 x y z)
= Placement (PS (V2 0 0) 0 $ PutForeground $ highBar (z+5) wallPos pout) = Placement (PS (V2 0 0) 0 $ PutForeground $ thinHighBar (z+5) wallPos pout)
$ \_ -> Just $ sPS (V2 0 0) 0 $ PutLS (colorLightAt 0.75 lampPos 0) $ \_ -> Just $ sPS (V2 0 0) 0 $ PutLS (colorLightAt 0.75 lampPos 0)
where where
pout = V2 x y +.+ safeNormalizeV (V2 x y -.- wallPos) pout = V2 x y +.+ safeNormalizeV (V2 x y -.- wallPos)
@@ -16,8 +16,8 @@ wallMount wallPos lampPos@(V3 x y z)
wallMountL :: Point2 -> Point3 -> Placement wallMountL :: Point2 -> Point3 -> Placement
wallMountL wallpos lamppos@(V3 x y z) wallMountL wallpos lamppos@(V3 x y z)
= place0 (PutLS $ colorLightAt 0.75 lamppos 0) = place0 (PutLS $ colorLightAt 0.75 lamppos 0)
$ \_ -> jsps0 $ PutForeground $ highBar (z + 5) wallposUp (turnpos `extendAway` wallposUp) $ \_ -> jsps0 $ PutForeground $ thinHighBar (z + 5) wallposUp (turnpos `extendAway` wallposUp)
<> highBar (z + 5) turnpos (V2 x y `extendAway` turnpos) <> thinHighBar (z + 5) turnpos (V2 x y `extendAway` turnpos)
where where
n = vNormal (wallpos -.- V2 x y) n = vNormal (wallpos -.- V2 x y)
wallposUp = wallpos +.+ n wallposUp = wallpos +.+ n
@@ -26,9 +26,9 @@ wallMountL wallpos lamppos@(V3 x y z)
wallMountJ :: Point2 -> Point3 -> Placement wallMountJ :: Point2 -> Point3 -> Placement
wallMountJ wallpos lamppos@(V3 x y z) wallMountJ wallpos lamppos@(V3 x y z)
= place0 (PutLS $ colorLightAt 0.75 lamppos 0) = place0 (PutLS $ colorLightAt 0.75 lamppos 0)
$ \_ -> jsps0 $ PutForeground $ highBar (z + 5) wallposUp turn1 $ \_ -> jsps0 $ PutForeground $ thinHighBar (z + 5) wallposUp turn1
<> highBar (z + 5) turn1 turn2 <> thinHighBar (z + 5) turn1 turn2
<> highBar (z + 5) turn2 (endpos `extendAway` turn2) <> thinHighBar (z + 5) turn2 (endpos `extendAway` turn2)
where where
n = vNormal (wallpos -.- endpos) n = vNormal (wallpos -.- endpos)
wallposUp = wallpos +.+ n wallposUp = wallpos +.+ n
@@ -40,8 +40,8 @@ wallMountJ wallpos lamppos@(V3 x y z)
wallMountl :: Point2 -> Point3 -> Placement wallMountl :: Point2 -> Point3 -> Placement
wallMountl wallpos lamppos@(V3 x y z) wallMountl wallpos lamppos@(V3 x y z)
= place0 (PutLS $ colorLightAt 0.75 lamppos 0) = place0 (PutLS $ colorLightAt 0.75 lamppos 0)
$ \_ -> jsps0 $ PutForeground $ highBar (z + 5) wallposUp (turnpos `extendAway` wallposUp) $ \_ -> jsps0 $ PutForeground $ thinHighBar (z + 5) wallposUp (turnpos `extendAway` wallposUp)
<> highBar (z + 5) turnpos (V2 x y `extendAway` turnpos) <> thinHighBar (z + 5) turnpos (V2 x y `extendAway` turnpos)
where where
n = vNormal (V2 x y -.- wallpos) n = vNormal (V2 x y -.- wallpos)
wallposUp = wallpos +.+ n wallposUp = wallpos +.+ n
@@ -54,11 +54,11 @@ wallMountA wallpos lamppos@(V3 x y z)
where where
pout = V2 x y -.- 2 *.* safeNormalizeV (V2 x y -.- wallpos) pout = V2 x y -.- 2 *.* safeNormalizeV (V2 x y -.- wallpos)
wallMountV :: Point2 -> Point3 -> Placement mountedLightV :: Point2 -> Point3 -> Placement
wallMountV wallpos lamppos@(V3 x y z) mountedLightV wallpos lamppos@(V3 x y z)
= place0 (PutLS $ colorLightAt 0.75 lamppos 0) = place0 (PutLS $ colorLightAt 0.75 lamppos 0)
$ \_ -> jsps0 $ PutForeground $ highBar (z + 5) wallposUp (lxy `extendAway` wallposUp) $ \_ -> jsps0 $ PutForeground $ thinHighBar (z + 5) wallposUp (lxy `extendAway` wallposUp)
<> highBar (z + 5) wallposDown (lxy `extendAway` wallposDown) <> thinHighBar (z + 5) wallposDown (lxy `extendAway` wallposDown)
where where
lxy = V2 x y lxy = V2 x y
n = vNormal (wallpos -.- lxy) n = vNormal (wallpos -.- lxy)
src/Dodge/Placement.hs
+3
View File
@@ -6,6 +6,9 @@ import Dodge.LevelGen.Data
jsps0 :: PSType -> Maybe Placement jsps0 :: PSType -> Maybe Placement
jsps0 pst = Just $ sPS (V2 0 0) 0 pst jsps0 pst = Just $ sPS (V2 0 0) 0 pst
sps0 :: PSType -> Placement
sps0 pst = sPS (V2 0 0) 0 pst
jspsJ :: PSType -> Placement -> Maybe Placement jspsJ :: PSType -> Placement -> Maybe Placement
jspsJ pst plm = Just $ Placement (PS (V2 0 0) 0 pst) $ \_ -> Just plm jspsJ pst plm = Just $ Placement (PS (V2 0 0) 0 pst) $ \_ -> Just plm
src/Dodge/Render/Picture.hs
+8 -7
View File
@@ -2,8 +2,8 @@
module Dodge.Render.Picture module Dodge.Render.Picture
where where
import Dodge.Data import Dodge.Data
import Dodge.Update.Camera --import Dodge.Update.Camera
import Dodge.GameRoom --import Dodge.GameRoom
import Dodge.Base import Dodge.Base
import Dodge.Base.Window import Dodge.Base.Window
import Dodge.Zone import Dodge.Zone
@@ -64,11 +64,12 @@ customMouseCursor w =
$ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ] $ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ]
testPic :: World -> Picture testPic :: World -> Picture
testPic w = setLayer 5 $ color green (concatMap (polygonWire . _grBound) grs) testPic _ = []
<> color yellow (concatMap (\q -> line [p,q]) $ farWallPoints p w) --testPic w = setLayer 5 $ color green (concatMap (polygonWire . _grBound) grs)
where -- <> color yellow (concatMap (\q -> line [p,q]) $ farWallPoints p w)
p = _crPos $ you w -- where
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w) -- p = _crPos $ you w
-- grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
-- where -- where
-- thepic = setDepth 20 . color green . polygon $ rectNSEW 5 (-5) (-5) (5) -- thepic = setDepth 20 . color green . polygon $ rectNSEW 5 (-5) (-5) (5)
--testPic _ = blank --testPic _ = blank
src/Dodge/Room/Foreground.hs
+18 -12
View File
@@ -47,11 +47,17 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
] ]
yN = d * 0.5 *.* normalizeV (pa -.- pb) yN = d * 0.5 *.* normalizeV (pa -.- pb)
highBar :: Float -> Point2 -> Point2 -> Shape thinHighBar :: Float -> Point2 -> Point2 -> Shape
highBar h x y = translateSHz h $ colorSH orange $ upperPrismPoly 5 thinHighBar = highBar 3
thickHighBar :: Float -> Point2 -> Point2 -> Shape
thickHighBar = highBar 5
highBar :: Float -> Float -> Point2 -> Point2 -> Shape
highBar thickness h x y = translateSHz h $ colorSH orange $ upperPrismPoly thickness
[x +.+ n, y +.+ n, y -.- n, x -.- n] [x +.+ n, y +.+ n, y -.- n, x -.- n]
where where
n = 2.5 *.* normalizeV (vNormal (y -.- x)) n = 0.5 * thickness *.* normalizeV (vNormal (y -.- x))
highPipe :: Float -> Point2 -> Point2 -> Shape highPipe :: Float -> Point2 -> Point2 -> Shape
highPipe h x y = colorSH orange $ prismPoly highPipe h x y = colorSH orange $ prismPoly
@@ -67,10 +73,10 @@ girderZ
-> Float -- ^ width -> Float -- ^ width
-> Point2 -> Point2 -> Shape -> Point2 -> Point2 -> Shape
girderZ h d w x y = colorSH red $ mconcat $ girderZ h d w x y = colorSH red $ mconcat $
[ highBar h xt yt [ thinHighBar h xt yt
, highBar h xb yb , thinHighBar h xb yb
] ]
<> zipWith (highBar (h- 5)) ps qs <> zipWith (thinHighBar (h- 1)) ps qs
where where
n = w *.* normalizeV (vNormal $ y -.- x) n = w *.* normalizeV (vNormal $ y -.- x)
xb = x +.+ n xb = x +.+ n
@@ -86,10 +92,10 @@ girderV
-> Float -- ^ width -> Float -- ^ width
-> Point2 -> Point2 -> Shape -> Point2 -> Point2 -> Shape
girderV h d w x y = colorSH red $ mconcat $ girderV h d w x y = colorSH red $ mconcat $
[ highBar h xt yt [ thinHighBar h xt yt
, highBar h xb yb , thinHighBar h xb yb
] ]
<> zipWith (highBar (h- 5)) ps qs <> zipWith (thinHighBar (h- 1)) ps qs
where where
n = w *.* normalizeV (vNormal $ y -.- x) n = w *.* normalizeV (vNormal $ y -.- x)
xb = x +.+ n xb = x +.+ n
@@ -109,10 +115,10 @@ girder
-> Float -- ^ width -> Float -- ^ width
-> Point2 -> Point2 -> Shape -> Point2 -> Point2 -> Shape
girder h d w x y = colorSH red $ mconcat $ girder h d w x y = colorSH red $ mconcat $
[ highBar h xt yt [ thinHighBar h xt yt
, highBar h xb yb , thinHighBar h xb yb
] ]
<> zipWith (highBar (h- 5)) ps qs <> zipWith (thinHighBar (h- 1)) ps qs
where where
n = w *.* normalizeV (vNormal $ y -.- x) n = w *.* normalizeV (vNormal $ y -.- x)
xb = x +.+ n xb = x +.+ n
src/Dodge/Room/Procedural.hs
+16 -8
View File
@@ -10,13 +10,16 @@ module Dodge.Room.Procedural
, makeGrid , makeGrid
) where ) where
import Dodge.Data import Dodge.Data
import Dodge.Default.Wall
import Dodge.Room.Data import Dodge.Room.Data
import Dodge.Room.Placement import Dodge.Room.Placement
import Dodge.Room.Link import Dodge.Room.Link
import Dodge.Room.Path import Dodge.Room.Path
import Dodge.Placement
import Dodge.Default.Room import Dodge.Default.Room
import Dodge.Item.Consumable import Dodge.Item.Consumable
import Dodge.Item.Equipment import Dodge.Item.Equipment
import Dodge.Room.Foreground
import Dodge.Item.Weapon import Dodge.Item.Weapon
import Dodge.RandomHelp import Dodge.RandomHelp
import Dodge.LevelGen import Dodge.LevelGen
@@ -222,9 +225,10 @@ centerVaultRoom n w h d = do
nsDoors = rectNSWE (d + 20) (negate (d +20)) (-20) 20 nsDoors = rectNSWE (d + 20) (negate (d +20)) (-20) 20
weDoors = rectNSWE 20 (-20) (d + 20) (negate (d +20)) weDoors = rectNSWE 20 (-20) (d + 20) (negate (d +20))
centerPoly = rectWdthHght (d - 20) (d - 20) centerPoly = rectWdthHght (d - 20) (d - 20)
polys = centerPoly : nsDoors : weDoors : take 4 (iterate (map vNormal) northPoly) --polys = centerPoly : nsDoors : weDoors : take 4 (iterate (map vNormal) northPoly)
return $ defaultRoom return $ defaultRoom
{ _rmPolys = polys --{ _rmPolys = polys
{ _rmPolys = [rectNSWE h (-h) (-w) w]
, _rmLinks = , _rmLinks =
[(V2 0 h , 0 ) [(V2 0 h , 0 )
,(V2 w 0 ,-pi/2) ,(V2 w 0 ,-pi/2)
@@ -233,11 +237,15 @@ centerVaultRoom n w h d = do
] ]
, _rmPath = [] , _rmPath = []
, _rmPS = , _rmPS =
[sPS (V2 (d-25) (d-25)) 0 putLamp [sps0 $ PutWall (rectNSEW ( d) (d - 30) ( d) (d - 30)) defaultWall
,sPS (V2 (w-5) (h-5)) 0 putLamp ,sps0 $ PutWall (rectNSEW ( d) (d - 30) (-d) (30 - d)) defaultWall
,sPS (V2 (w-5) (5-h)) 0 putLamp ,sps0 $ PutWall (rectNSEW (-d) (30 - d) ( d) (d - 30)) defaultWall
,sPS (V2 (5-w) (h-5)) 0 putLamp ,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
,sPS (V2 (5-w) (5-h)) 0 putLamp ,sps0 $ PutForeground $ girder 55 10 10 (V2 (-w) (h/2)) (V2 w (h/2))
,sps0 $ PutForeground $ girder 55 10 10 (V2 (-w) (h/2)) (V2 w (h/2))
,mountedLight (V2 (-w) (h/2-20)) (V3 (20-w) (h/2-20) 70)
,mountedLight (V2 w (h/2-20)) (V3 (w-20) (h/2-20) 70)
,mountedLightV (V2 0 (d-20)) (V3 0 0 70)
] ]
++ concat (zipWith (\i r -> map (shiftPSBy (V2 0 0,r)) $ theDoor i) ++ concat (zipWith (\i r -> map (shiftPSBy (V2 0 0,r)) $ theDoor i)
[n, n+1, n+2, n+3] [0,pi/2,pi,3*pi/2]) [n, n+1, n+2, n+3] [0,pi/2,pi,3*pi/2])
@@ -246,7 +254,7 @@ centerVaultRoom n w h d = do
where where
col = dim $ dim $ bright red col = dim $ dim $ bright red
theDoor i = theDoor i =
[ sPS (V2 0 (d-10)) 0 $ PutDoubleDoor col (cond i) (V2 (-19) 0) (V2 19 0) 2 [ sPS (V2 0 (d-10)) 0 $ PutDoubleDoor col (cond i) (V2 (-21) 0) (V2 21 0) 2
, sPS (V2 35 (d+4)) 0 $ PutButton $ makeSwitch col red , sPS (V2 35 (d+4)) 0 $ PutButton $ makeSwitch col red
(over worldState (M.insert (DoorNumOpen i) True)) (over worldState (M.insert (DoorNumOpen i) True))
(over worldState (M.insert (DoorNumOpen i) False)) (over worldState (M.insert (DoorNumOpen i) False))