Refactor vault room
This commit is contained in:
@@ -6,9 +6,9 @@ import Dodge.Room.Foreground
|
||||
import Dodge.Placement
|
||||
import Geometry
|
||||
|
||||
wallMount :: Point2 -> Point3 -> Placement
|
||||
wallMount wallPos lampPos@(V3 x y z)
|
||||
= Placement (PS (V2 0 0) 0 $ PutForeground $ highBar (z+5) wallPos pout)
|
||||
mountedLight :: Point2 -> Point3 -> Placement
|
||||
mountedLight wallPos lampPos@(V3 x y z)
|
||||
= Placement (PS (V2 0 0) 0 $ PutForeground $ thinHighBar (z+5) wallPos pout)
|
||||
$ \_ -> Just $ sPS (V2 0 0) 0 $ PutLS (colorLightAt 0.75 lampPos 0)
|
||||
where
|
||||
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 wallpos lamppos@(V3 x y z)
|
||||
= place0 (PutLS $ colorLightAt 0.75 lamppos 0)
|
||||
$ \_ -> jsps0 $ PutForeground $ highBar (z + 5) wallposUp (turnpos `extendAway` wallposUp)
|
||||
<> highBar (z + 5) turnpos (V2 x y `extendAway` turnpos)
|
||||
$ \_ -> jsps0 $ PutForeground $ thinHighBar (z + 5) wallposUp (turnpos `extendAway` wallposUp)
|
||||
<> thinHighBar (z + 5) turnpos (V2 x y `extendAway` turnpos)
|
||||
where
|
||||
n = vNormal (wallpos -.- V2 x y)
|
||||
wallposUp = wallpos +.+ n
|
||||
@@ -26,9 +26,9 @@ wallMountL wallpos lamppos@(V3 x y z)
|
||||
wallMountJ :: Point2 -> Point3 -> Placement
|
||||
wallMountJ wallpos lamppos@(V3 x y z)
|
||||
= place0 (PutLS $ colorLightAt 0.75 lamppos 0)
|
||||
$ \_ -> jsps0 $ PutForeground $ highBar (z + 5) wallposUp turn1
|
||||
<> highBar (z + 5) turn1 turn2
|
||||
<> highBar (z + 5) turn2 (endpos `extendAway` turn2)
|
||||
$ \_ -> jsps0 $ PutForeground $ thinHighBar (z + 5) wallposUp turn1
|
||||
<> thinHighBar (z + 5) turn1 turn2
|
||||
<> thinHighBar (z + 5) turn2 (endpos `extendAway` turn2)
|
||||
where
|
||||
n = vNormal (wallpos -.- endpos)
|
||||
wallposUp = wallpos +.+ n
|
||||
@@ -40,8 +40,8 @@ wallMountJ wallpos lamppos@(V3 x y z)
|
||||
wallMountl :: Point2 -> Point3 -> Placement
|
||||
wallMountl wallpos lamppos@(V3 x y z)
|
||||
= place0 (PutLS $ colorLightAt 0.75 lamppos 0)
|
||||
$ \_ -> jsps0 $ PutForeground $ highBar (z + 5) wallposUp (turnpos `extendAway` wallposUp)
|
||||
<> highBar (z + 5) turnpos (V2 x y `extendAway` turnpos)
|
||||
$ \_ -> jsps0 $ PutForeground $ thinHighBar (z + 5) wallposUp (turnpos `extendAway` wallposUp)
|
||||
<> thinHighBar (z + 5) turnpos (V2 x y `extendAway` turnpos)
|
||||
where
|
||||
n = vNormal (V2 x y -.- wallpos)
|
||||
wallposUp = wallpos +.+ n
|
||||
@@ -54,11 +54,11 @@ wallMountA wallpos lamppos@(V3 x y z)
|
||||
where
|
||||
pout = V2 x y -.- 2 *.* safeNormalizeV (V2 x y -.- wallpos)
|
||||
|
||||
wallMountV :: Point2 -> Point3 -> Placement
|
||||
wallMountV wallpos lamppos@(V3 x y z)
|
||||
mountedLightV :: Point2 -> Point3 -> Placement
|
||||
mountedLightV wallpos lamppos@(V3 x y z)
|
||||
= place0 (PutLS $ colorLightAt 0.75 lamppos 0)
|
||||
$ \_ -> jsps0 $ PutForeground $ highBar (z + 5) wallposUp (lxy `extendAway` wallposUp)
|
||||
<> highBar (z + 5) wallposDown (lxy `extendAway` wallposDown)
|
||||
$ \_ -> jsps0 $ PutForeground $ thinHighBar (z + 5) wallposUp (lxy `extendAway` wallposUp)
|
||||
<> thinHighBar (z + 5) wallposDown (lxy `extendAway` wallposDown)
|
||||
where
|
||||
lxy = V2 x y
|
||||
n = vNormal (wallpos -.- lxy)
|
||||
|
||||
@@ -6,6 +6,9 @@ import Dodge.LevelGen.Data
|
||||
jsps0 :: PSType -> Maybe Placement
|
||||
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 pst plm = Just $ Placement (PS (V2 0 0) 0 pst) $ \_ -> Just plm
|
||||
|
||||
|
||||
@@ -2,8 +2,8 @@
|
||||
module Dodge.Render.Picture
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Update.Camera
|
||||
import Dodge.GameRoom
|
||||
--import Dodge.Update.Camera
|
||||
--import Dodge.GameRoom
|
||||
import Dodge.Base
|
||||
import Dodge.Base.Window
|
||||
import Dodge.Zone
|
||||
@@ -64,11 +64,12 @@ customMouseCursor w =
|
||||
$ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ]
|
||||
|
||||
testPic :: World -> Picture
|
||||
testPic w = setLayer 5 $ color green (concatMap (polygonWire . _grBound) grs)
|
||||
<> color yellow (concatMap (\q -> line [p,q]) $ farWallPoints p w)
|
||||
where
|
||||
p = _crPos $ you w
|
||||
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
|
||||
testPic _ = []
|
||||
--testPic w = setLayer 5 $ color green (concatMap (polygonWire . _grBound) grs)
|
||||
-- <> color yellow (concatMap (\q -> line [p,q]) $ farWallPoints p w)
|
||||
-- where
|
||||
-- p = _crPos $ you w
|
||||
-- grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
|
||||
-- where
|
||||
-- thepic = setDepth 20 . color green . polygon $ rectNSEW 5 (-5) (-5) (5)
|
||||
--testPic _ = blank
|
||||
|
||||
@@ -47,11 +47,17 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
|
||||
]
|
||||
yN = d * 0.5 *.* normalizeV (pa -.- pb)
|
||||
|
||||
highBar :: Float -> Point2 -> Point2 -> Shape
|
||||
highBar h x y = translateSHz h $ colorSH orange $ upperPrismPoly 5
|
||||
thinHighBar :: Float -> Point2 -> Point2 -> Shape
|
||||
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]
|
||||
where
|
||||
n = 2.5 *.* normalizeV (vNormal (y -.- x))
|
||||
n = 0.5 * thickness *.* normalizeV (vNormal (y -.- x))
|
||||
|
||||
highPipe :: Float -> Point2 -> Point2 -> Shape
|
||||
highPipe h x y = colorSH orange $ prismPoly
|
||||
@@ -67,10 +73,10 @@ girderZ
|
||||
-> Float -- ^ width
|
||||
-> Point2 -> Point2 -> Shape
|
||||
girderZ h d w x y = colorSH red $ mconcat $
|
||||
[ highBar h xt yt
|
||||
, highBar h xb yb
|
||||
[ thinHighBar h xt yt
|
||||
, thinHighBar h xb yb
|
||||
]
|
||||
<> zipWith (highBar (h- 5)) ps qs
|
||||
<> zipWith (thinHighBar (h- 1)) ps qs
|
||||
where
|
||||
n = w *.* normalizeV (vNormal $ y -.- x)
|
||||
xb = x +.+ n
|
||||
@@ -86,10 +92,10 @@ girderV
|
||||
-> Float -- ^ width
|
||||
-> Point2 -> Point2 -> Shape
|
||||
girderV h d w x y = colorSH red $ mconcat $
|
||||
[ highBar h xt yt
|
||||
, highBar h xb yb
|
||||
[ thinHighBar h xt yt
|
||||
, thinHighBar h xb yb
|
||||
]
|
||||
<> zipWith (highBar (h- 5)) ps qs
|
||||
<> zipWith (thinHighBar (h- 1)) ps qs
|
||||
where
|
||||
n = w *.* normalizeV (vNormal $ y -.- x)
|
||||
xb = x +.+ n
|
||||
@@ -109,10 +115,10 @@ girder
|
||||
-> Float -- ^ width
|
||||
-> Point2 -> Point2 -> Shape
|
||||
girder h d w x y = colorSH red $ mconcat $
|
||||
[ highBar h xt yt
|
||||
, highBar h xb yb
|
||||
[ thinHighBar h xt yt
|
||||
, thinHighBar h xb yb
|
||||
]
|
||||
<> zipWith (highBar (h- 5)) ps qs
|
||||
<> zipWith (thinHighBar (h- 1)) ps qs
|
||||
where
|
||||
n = w *.* normalizeV (vNormal $ y -.- x)
|
||||
xb = x +.+ n
|
||||
|
||||
@@ -10,13 +10,16 @@ module Dodge.Room.Procedural
|
||||
, makeGrid
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Default.Wall
|
||||
import Dodge.Room.Data
|
||||
import Dodge.Room.Placement
|
||||
import Dodge.Room.Link
|
||||
import Dodge.Room.Path
|
||||
import Dodge.Placement
|
||||
import Dodge.Default.Room
|
||||
import Dodge.Item.Consumable
|
||||
import Dodge.Item.Equipment
|
||||
import Dodge.Room.Foreground
|
||||
import Dodge.Item.Weapon
|
||||
import Dodge.RandomHelp
|
||||
import Dodge.LevelGen
|
||||
@@ -222,9 +225,10 @@ centerVaultRoom n w h d = do
|
||||
nsDoors = rectNSWE (d + 20) (negate (d +20)) (-20) 20
|
||||
weDoors = rectNSWE 20 (-20) (d + 20) (negate (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
|
||||
{ _rmPolys = polys
|
||||
--{ _rmPolys = polys
|
||||
{ _rmPolys = [rectNSWE h (-h) (-w) w]
|
||||
, _rmLinks =
|
||||
[(V2 0 h , 0 )
|
||||
,(V2 w 0 ,-pi/2)
|
||||
@@ -233,11 +237,15 @@ centerVaultRoom n w h d = do
|
||||
]
|
||||
, _rmPath = []
|
||||
, _rmPS =
|
||||
[sPS (V2 (d-25) (d-25)) 0 putLamp
|
||||
,sPS (V2 (w-5) (h-5)) 0 putLamp
|
||||
,sPS (V2 (w-5) (5-h)) 0 putLamp
|
||||
,sPS (V2 (5-w) (h-5)) 0 putLamp
|
||||
,sPS (V2 (5-w) (5-h)) 0 putLamp
|
||||
[sps0 $ PutWall (rectNSEW ( d) (d - 30) ( d) (d - 30)) defaultWall
|
||||
,sps0 $ PutWall (rectNSEW ( d) (d - 30) (-d) (30 - d)) defaultWall
|
||||
,sps0 $ PutWall (rectNSEW (-d) (30 - d) ( d) (d - 30)) defaultWall
|
||||
,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
|
||||
,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)
|
||||
[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
|
||||
col = dim $ dim $ bright red
|
||||
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
|
||||
(over worldState (M.insert (DoorNumOpen i) True))
|
||||
(over worldState (M.insert (DoorNumOpen i) False))
|
||||
|
||||
Reference in New Issue
Block a user