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

Cleanup light mounts

Browse Source
This commit is contained in:
justin
2021-11-13 12:31:11 +00:00
parent 3624f22f2b
commit 96c72ef578
10 changed files with 80 additions and 110 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placements/Button.hs
+2 -2
View File
@@ -21,7 +21,7 @@ externalButton col ps = pContID ps (PutTrigger (const False))
offeff tid = triggers . ix tid .~ const False
putLitButtonID :: Color -> Point2 -> Float -> (Int -> Maybe Placement) -> Placement
putLitButtonID col p a subpl = mountLightAID (Just col) ls p'' (addZ 40 p')
putLitButtonID col p a subpl = mntLSOn aShape (Just col) ls p'' (addZ 40 p')
$ \lsid -> jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = p, _btRot = a})
subpl
where
@@ -32,7 +32,7 @@ putLitButtonID col p a subpl = mountLightAID (Just col) ls p'' (addZ 40 p')
putLitButtonID' :: Color -> ((Point2,Float) -> Bool) -> (Int -> Maybe Placement) -> Placement
putLitButtonID' col f subpl
= updatePSToLevel 3 (const thePS) $ mountLightAID (Just col) ls 0 (V3 0 (-40) 40)
= updatePSToLevel 3 (const thePS) $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40)
$ \lsid -> jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = V2 0 (-1), _btRot = pi})
subpl
where
src/Dodge/Placements/LightSource.hs
+54 -85
View File
@@ -1,5 +1,4 @@
module Dodge.Placements.LightSource
where
module Dodge.Placements.LightSource where
import Dodge.Data
import Dodge.LightSources.Lamp
import Dodge.LevelGen.Data
@@ -14,11 +13,12 @@ import Dodge.RandomHelp
import Color
import Shape
mountLightOnShape
-- | mount a light source on a shape
mntLSOn
:: (Point2 -> Point3 -> Shape) -- ^ function describing the mount shape
-> Maybe Color -- ^ describing a possible color override for the shape
-> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
mountLightOnShape shapeF mcol ls wallp lsp@(V3 lx ly _)
mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _)
= ps0j (PutForeground . setCol $ shapeF wallp lsp)
. ps0 (PutLS $ ls {_lsPos = lsp'})
where
@@ -27,106 +27,75 @@ mountLightOnShape shapeF mcol ls wallp lsp@(V3 lx ly _)
V2 x y = rotateV 1 . (0.1 *.*) . normalizeV $ wallp -.- V2 lx ly
setCol = maybe id colorSH mcol
mountLightID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
mountLightID = mountLightOnShape f
where
f wp (V3 x y z) = thinHighBar z wp (V2 x y)
redMID :: (Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement)
-> Point2 -> Point3 -> Placement
redMID f wallp lampp = f Nothing defaultLS wallp lampp (const Nothing)
mountLight :: Point2 -> Point3 -> Placement
mountLight = redMID mountLightID
iShape :: Point2 -> Point3 -> Shape
iShape wp (V3 x y z) = thinHighBar z wp (V2 x y)
mountLightLID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
mountLightLID = mountLightOnShape f
lShape :: Point2 -> Point3 -> Shape
lShape wp (V3 x y z) = thinHighBar z wallposUp turnpos
<> thinHighBar z turnpos (V2 x y)
where
f wallpos (V3 x y z) = thinHighBar z wallposUp turnpos
<> thinHighBar z turnpos (V2 x y)
where
n = vNormal (wallpos -.- V2 x y)
wallposUp = wallpos +.+ n
turnpos = V2 x y +.+ n
n = vNormal (wp -.- V2 x y)
wallposUp = wp +.+ n
turnpos = V2 x y +.+ n
mountLightL :: Point2 -> Point3 -> Placement
mountLightL = redMID mountLightLID
mountLightJID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
mountLightJID = mountLightOnShape f
jShape :: Point2 -> Point3 -> Shape
jShape wallpos (V3 x y z) = thinHighBar z wallposUp turn1
<> thinHighBar z turn1 turn2
<> thinHighBar z turn2 endpos
where
f wallpos (V3 x y z) = thinHighBar z wallposUp turn1
<> thinHighBar z turn1 turn2
<> thinHighBar z turn2 endpos
where
n = vNormal (wallpos -.- V2 x y)
wallposUp = wallpos +.+ n
turnpos = V2 x y +.+ n
endpos = V2 x y
turn1 = 0.5 *.* (wallposUp +.+ turnpos)
turn2 = 0.5 *.* (turnpos +.+ endpos)
n = vNormal (wallpos -.- V2 x y)
wallposUp = wallpos +.+ n
turnpos = V2 x y +.+ n
endpos = V2 x y
turn1 = 0.5 *.* (wallposUp +.+ turnpos)
turn2 = 0.5 *.* (turnpos +.+ endpos)
mountLightJ :: Point2 -> Point3 -> Placement
mountLightJ = redMID mountLightJID
mountLightlID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
mountLightlID = mountLightOnShape f
liShape :: Point2 -> Point3 -> Shape
liShape wallpos (V3 x y z) =
thinHighBar z wallposUp turnpos
<> thinHighBar z turnpos (V2 x y)
where
f wallpos (V3 x y z) = thinHighBar z wallposUp turnpos
<> thinHighBar z turnpos (V2 x y)
where
n = vNormal (V2 x y -.- wallpos)
wallposUp = wallpos +.+ n
turnpos = V2 x y +.+ n
n = vNormal (V2 x y -.- wallpos)
wallposUp = wallpos +.+ n
turnpos = V2 x y +.+ n
mountLightl :: Point2 -> Point3 -> Placement
mountLightl = redMID mountLightlID
mountLightAID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
mountLightAID = mountLightOnShape f
aShape :: Point2 -> Point3 -> Shape
aShape wallpos (V3 x y z) =
girder (z+2) 20 10 pout wallpos
where
f 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 *.* safeNormalizeV (V2 x y -.- wallpos)
mountLightA :: Point2 -> Point3 -> Placement
mountLightA = redMID mountLightAID
mountLightACond :: ((Point2,Float) -> Bool) -> Placement
mountLightACond f = updatePSToLevel 2 (const thePS) $ mountLightA 0 (V3 0 (-40) 40)
vShape :: Point2 -> Point3 -> Shape
vShape wallpos (V3 x y z) =
thinHighBar z wallposUp lxy
<> thinHighBar z wallposDown lxy
where
thePS = PSLnk f id Nothing
lxy = V2 x y
n = vNormal (wallpos -.- lxy)
wallposUp = wallpos +.+ n
wallposDown = wallpos -.- n
mountLightVCond :: ((Point2,Float) -> Bool) -> Placement
mountLightVCond f = updatePSToLevel 2 (const thePS) $ mountLightV 0 (V3 0 (-20) 40)
where
thePS = PSLnk f id Nothing
mntLS :: (Point2 -> Point3 -> Shape) -> Point2 -> Point3 -> Placement
mntLS shp = redMID $ mntLSOn shp
mntLSCond :: (Point2 -> Point3 -> Shape) -> ((Point2,Float) -> Bool) -> Placement
mntLSCond shp cond = updatePSToLevel 2 (const $ PSLnk cond id Nothing)
$ redMID (mntLSOn shp) 0 (V3 0 (-40) 40)
-- note that this perhaps pushes the vshape light out too far
mntLight :: Point2 -> Point2 -> Placement
mntLight a b = RandomPlacement $ takeOne
[ mountLightV a (addZ 50 b)
, mountLight a (addZ 50 b)
, mountLightL a (addZ 50 b)
, mountLightJ a (addZ 50 b)
, mountLightl a (addZ 50 b)
]
mntLight a b = RandomPlacement $ do
shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
return $ redMID (mntLSOn shp) a (addZ 50 b)
mntLightLnkCond :: ((Point2,Float) -> Bool) -> Placement
mntLightLnkCond f = RandomPlacement $ takeOne [mountLightVCond f,mountLightACond f]
mountLightVID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
mountLightVID = mountLightOnShape f
where
f wallpos (V3 x y z) = thinHighBar z wallposUp lxy
<> thinHighBar z wallposDown lxy
where
lxy = V2 x y
n = vNormal (wallpos -.- lxy)
wallposUp = wallpos +.+ n
wallposDown = wallpos -.- n
mountLightV :: Point2 -> Point3 -> Placement
mountLightV = redMID mountLightVID
mntLightLnkCond f = RandomPlacement $ do
shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
return $ mntLSCond shp f
spanColLightI :: Point3 -> Float -> Point2 -> Point2 -> Placement
spanColLightI col h a b = ps0j (PutLS $ colorLightAt col (V3 x y (h-5)) 0)
src/Dodge/Placements/Spot.hs
+2
View File
@@ -9,6 +9,8 @@ import Dodge.LevelGen.Data
setPS :: PlacementSpot -> Placement -> Placement
setPS = updatePS . const
-- TODO remove this, use previous placement spots in continued placements
-- instead
updatePSToLevel :: Int -> (PlacementSpot -> PlacementSpot) -> Placement -> Placement
updatePSToLevel 0 _ plmnt = plmnt
updatePSToLevel i f plmnt = case plmnt of
src/Dodge/Room/Airlock.hs
+4 -4
View File
@@ -92,8 +92,8 @@ airlockZ = defaultRoom
col = dim $ dim $ bright red
outDoorps = (V2 0 0 ,) <$> arcStepwise 3 (pi/2) (V2 0 0) (V2 0 (-61))
inDoorps = (V2 0 0 ,) <$> arcStepwise 3 (pi/2) (V2 0 0) (V2 (-61) 0)
cenlight = mountLightV (V2 90 60) (V3 90 40 50) `addPlmnt` mountLightV (V2 90 60) (V3 90 80 50)
cornlight = mountLightV (V2 0 120) (V3 30 90 50) `addPlmnt` mountLightV (V2 180 120) (V3 150 90 50)
cenlight = mntLS vShape (V2 90 60) (V3 90 40 50) `addPlmnt` mntLS vShape (V2 90 60) (V3 90 80 50)
cornlight = mntLS vShape (V2 0 120) (V3 30 90 50) `addPlmnt` mntLS vShape (V2 180 120) (V3 150 90 50)
`addPlmnt` sps0 (PutForeground (thinHighBar 50 (V2 30 90) (V2 150 90)))
lighting = RandomPlacement $ takeOne [cenlight,cornlight]
@@ -120,7 +120,7 @@ airlock90 = defaultRoom
, _rmPmnts =
[pContID (PS (V2 120 120) (3 * pi/4)) (PutButton $ makeSwitch col red id id)
$ \btid -> jsps (V2 5 5) 0 $ PutDoor col (cond btid) pss
,mountLightV (V2 20 20) (V3 70 70 50)
,mntLS vShape (V2 20 20) (V3 70 70 50)
]
, _rmBound =
[map toV2 [ (10,10)
@@ -149,7 +149,7 @@ airlockCrystal = defaultRoom
[pContID (PS (V2 145 70) (pi/2)) ( PutButton $ makeSwitch col red id id)
$ \btid -> jsps0 $ PutDoor col (cond btid) pss
, crystalLine (V2 0 70) (V2 40 70)
, mountLightV (V2 150 70) (V3 110 70 70)
, mntLS vShape (V2 150 70) (V3 110 70 70)
]
, _rmBound =
[ ]
src/Dodge/Room/Boss.hs
+2 -2
View File
@@ -119,7 +119,7 @@ roomShuriken x y =
{ _rmPolys = ps
, _rmLinks = [(V2 (x-1) (y-20),negate $ pi/2)]
, _rmPath = []
, _rmPmnts = [mountLight (V2 x x) (V3 (x-20) x 70)]
, _rmPmnts = [mntLS iShape (V2 x x) (V3 (x-20) x 70)]
, _rmBound = ps
}
in foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2]
@@ -143,7 +143,7 @@ roomTwistCross x y z =
{ _rmPolys = ps
, _rmLinks = [(V2 z (y-20), pi/2)]
, _rmPath = []
, _rmPmnts = [mountLight (V2 x x) (V3 (x-20) (x-20) 70)]
, _rmPmnts = [mntLS iShape (V2 x x) (V3 (x-20) (x-20) 70)]
, _rmBound = ps
}
in foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2]
src/Dodge/Room/Procedural.hs
+8 -8
View File
@@ -100,16 +100,16 @@ Add a light and a 'PutNothing' placement. -}
quarterRoomFlat :: RandomGen g => Float -> State g Room
quarterRoomFlat w = do
b <- takeOne
[ [ mountLightV (V2 0 w) (V3 0 (w-20) 70)
, mountLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
[ [ mntLS vShape (V2 0 w) (V3 0 (w-20) 70)
, mntLS iShape (V2 (w-20) w) (V3 (w-20) (w-20) 70)
, sPS (V2 (w-20) (w-20)) pi PutNothing
, blockLine (V2 (w/2) (w/2)) (V2 (w/2) w)
]
, [ mountLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
, [ mntLS iShape (V2 (w-20) w) (V3 (w-20) (w-20) 70)
, sPS (V2 (w-20) (w-20)) pi PutNothing
, blockLine (V2 (w/2) (w/2)) (V2 (negate $ w/2) (w/2))
]
, [ mountLight (V2 (w-20) w) (V3 (w-20) (w-20) 70)
, [ mntLS iShape (V2 (w-20) w) (V3 (w-20) (w-20) 70)
, sPS (V2 (w-20) (w-20)) pi PutNothing
, blockLine (V2 (w/2) (w/2)) (V2 0 (w/2))
, blockLine (V2 (-29) w) (V2 0 (w/2))
@@ -133,17 +133,17 @@ quarterRoomFlat w = do
fourthCornerWall :: RandomGen g => Float -> State g Room
fourthCornerWall w = do
b <- takeOne
[ [ mountLightV (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
[ [ mntLS vShape (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
, blockLine (V2 (negate $ w/2) (w/2)) (V2 0 w)
, sPS (V2 20 (2*w-40)) pi PutNothing
]
, [ mountLightV (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
, [ mntLS vShape (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
, blockLine (V2 (negate w) w ) (V2 0 w)
, sPS (V2 20 (2*w-40)) pi PutNothing
]
, [ mountLight (V2 (0.7*w) (1.3*w)) (V3 (0.7*w-20) (1.3*w-20) 70)
, [ mntLS iShape (V2 (0.7*w) (1.3*w)) (V3 (0.7*w-20) (1.3*w-20) 70)
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
, blockLine (V2 0 w) (V2 0 (w*2))
, sPS (V2 20 (2*w-40)) pi PutNothing
@@ -228,7 +228,7 @@ centerVaultRoom w h d = do
,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
,sps0 $ PutForeground $ girder 70 10 10 (V2 (d-11) (-d)) (V2 (d-11) (-h))
]
++ map (\a -> mountLightV (rotateV a $ V2 0 d) (rotate3z a $ V3 0 (d+30) 70))
++ map (\a -> mntLS vShape (rotateV a $ V2 0 d) (rotate3z a $ V3 0 (d+30) 70))
[0,0.5*pi,pi,1.5*pi]
++ concatMap (\r -> map (shiftPlacement (V2 0 0,r)) theDoor)
[0,pi/2,pi,3*pi/2]
src/Dodge/Room/RoadBlock.hs
+1 -1
View File
@@ -83,7 +83,7 @@ lasTunnel = defaultRoom
, _rmLinks = [(V2 20 190,1.5* pi),(V2 0 20,0.5* pi)]
, _rmPmnts = [putLasTurret & plSpot .~ PS (V2 10 240) (1.5*pi)
, lowWall (rectNSEW 65 40 0 25)
, mountLightV (V2 50 10) (V3 40 20 50)
, mntLS vShape (V2 50 10) (V3 40 20 50)
]
}
where
src/Dodge/Room/Room.hs
+4 -4
View File
@@ -55,8 +55,8 @@ roomPillars :: Room
roomPillars = over rmLinks init $ set rmPmnts plmnts $ roomRect 240 240 2 2
where
plmnts = spanLightI (V2 120 24) (V2 120 216)
: mountLightV (V2 12 12) (V3 25 25 70)
: mountLightV (V2 228 228) (V3 215 215 70)
: mntLS vShape (V2 12 12) (V3 25 25 70)
: mntLS vShape (V2 228 228) (V3 215 215 70)
: sps0 (PutForeground $ thinHighBar 75 (V2 26 25) (V2 120 25))
: sps0 (PutForeground $ thinHighBar 75 (V2 214 215) (V2 120 215))
: g 180 150 90 60
@@ -85,7 +85,7 @@ glassLesson = do
,sPS (V2 50 100) 0 $ PutCrit miniGunCrit
,RandomPlacement $ takeOne
[ spanLightI (V2 160 0) (V2 160 220)
, mountLightV (V2 180 200) (V3 160 180 50)
, mntLS vShape (V2 180 200) (V3 160 180 50)
]
]
topplmnts =
@@ -94,7 +94,7 @@ glassLesson = do
--,sPS (V2 50 50) 0 putLamp
,RandomPlacement $ takeOne
[ spanLightI (V2 160 (-20)) (V2 160 220)
, mountLightV (V2 180 200) (V3 160 180 50)
, mntLS vShape (V2 180 200) (V3 160 180 50)
]
]
src/Dodge/Room/Start.hs
+2 -3
View File
@@ -1,5 +1,4 @@
module Dodge.Room.Start
where
module Dodge.Room.Start where
import Dodge.Room.Data
import Dodge.Room.Door
import Dodge.Room.Link
@@ -33,7 +32,7 @@ startRoom = do
$ roomRectAutoLinks w h & rmPmnts %~
(
[ fground
, mountLightJ (V2 0 (h/3)) (V3 40 (h/3) 70)
, mntLS jShape (V2 0 (h/3)) (V3 40 (h/3) 70)
, tankSquareEmboss4 (dim orange) 50 (h-60)
, tankSquare (dim orange) 50 50
, tankSquare (dim orange) 50 120
src/Dodge/Room/Treasure.hs
+1 -1
View File
@@ -32,7 +32,7 @@ triLootRoom w h = pure $ defaultRoom
[sPS (V2 (15-w) 15 ) 0 $ PutID 0
,sPS (V2 (w-15) 15 ) pi $ PutID 0
,sPS (V2 0 (h-35)) 0 $ PutID 2
,mountLightV (V2 0 (h-20)) (V3 0 (h-80) 70)
,mntLS vShape (V2 0 (h-20)) (V3 0 (h-80) 70)
,sPS (V2 0 ( -60)) 0 putLamp
]
, _rmBound = [tri , base]