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

Allow for random choice between placements in different rooms

Browse Source
This commit is contained in:
justin
2021-11-26 12:20:20 +00:00
parent aad79bdf25
commit 123bcd2c94
27 changed files with 260 additions and 191 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/Instance/Door.hs
+4 -4
View File
@@ -15,8 +15,8 @@ putDoubleDoor pathing col cond a b speed = putDoubleDoorThen pathing col cond a
putDoubleDoorThen :: Bool -> Color -> (World -> Bool)
-> Point2 -> Point2 -> Float -> Maybe Placement -> Placement
putDoubleDoorThen pathing col cond a b speed mayp = ps0j (PutSlideDoor pathing col cond a half speed)
$ Placement (PS (V2 0 0) 0) ( PutSlideDoor pathing col cond b half speed) Nothing $ const mayp
putDoubleDoorThen pathing col cond a b speed mayp = ps0j (PutSlideDr pathing col cond a half speed)
$ Placement (PS (V2 0 0) 0) ( PutSlideDr pathing col cond b half speed) Nothing $ const mayp
where
half = 0.5 *.* (a +.+ b)
@@ -33,8 +33,8 @@ putAutoDoor a b = PlacementUsingPos (addZ 0 a)
switchDoor :: Point2 -> Float -> Point2 -> Point2 -> Color -> Placement
switchDoor btpos btrot dra drb col = pContID (PS btpos btrot) (PutButton $ makeSwitch col red id id)
$ \btid -> jsps0J (PutSlideDoor False col (cond btid) dra drc 2)
$ sps0 (PutSlideDoor False col (cond btid) drb drc 2)
$ \btid -> jsps0J (PutSlideDr False col (cond btid) dra drc 2)
$ sps0 (PutSlideDr False col (cond btid) drb drc 2)
where
drc = 0.5 *.* (dra +.+ drb)
cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
src/Dodge/Placement/Instance/LightSource.hs
+4 -4
View File
@@ -20,7 +20,7 @@ mntLSOn
-> Maybe Color -- ^ describing a possible color override for the shape
-> LightSource -> Point2 -> Point3 -> (Placement -> Maybe Placement) -> Placement
mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _)
= ps0jPushPS (PutForeground . setCol $ shapeF wallp lsp)
= ps0jPushPS (PutShape . setCol $ shapeF wallp lsp)
. pt0 (PutLS $ ls {_lsPos = lsp'})
where
lsp' = lsp -.-.- V3 x y 1
@@ -106,20 +106,20 @@ unusedLnkToPS rp _ = case rp of
spanLSLightI :: LightSource -> Float -> Point2 -> Point2 -> Placement
spanLSLightI ls h a b = ps0j (PutLS ls {_lsPos = V3 x y h})
$ sps0 $ PutForeground $ thinHighBar h a b
$ sps0 $ PutShape $ thinHighBar h a b
where
V2 x y = 0.5 *.* (a +.+ b)
spanLS :: LightSource -> Point2 -> Point2 -> Placement
spanLS ls a b = Placement (PS (V2 x y) 0) (PutLS ls) Nothing
$ const $ Just $ sps0 $ PutForeground $ thinHighBar h a b
$ const $ Just $ sps0 $ PutShape $ thinHighBar h a b
where
V3 _ _ h = _lsPos ls + 5
V2 x y = 0.5 *.* (a +.+ b)
spanColLightI :: Point3 -> Float -> Point2 -> Point2 -> Placement
spanColLightI col h a b = ps0j (PutLS $ colorLightAt col (V3 x y (h-5)) 0)
$ sps0 $ PutForeground $ thinHighBar h a b
$ sps0 $ PutShape $ thinHighBar h a b
where
V2 x y = 0.5 *.* (a +.+ b)
src/Dodge/Placement/Instance/Tank.hs
+6 -6
View File
@@ -12,7 +12,7 @@ import Color
roundTank :: Color -> Float -> Float -> Placement
roundTank col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
(PutShape $ colorSH col $
upperPrismPoly 31 thecircle
<> foldMap toprail ( take 8 [0,pi/4..])
)
@@ -23,7 +23,7 @@ roundTank col x y = shiftPlacement (V2 x y,0) $ ps0j
roundTankCross :: Color -> Float -> Float -> Placement
roundTankCross col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
(PutShape $ colorSH col $
upperPrismPoly 31 thecircle
<> thinHighBar 31 (V2 20 0) (V2 (-20) 0)
<> thinHighBar 31 (V2 0 20) (V2 0 (-20))
@@ -34,7 +34,7 @@ roundTankCross col x y = shiftPlacement (V2 x y,0) $ ps0j
tankRectCross :: Float -> Float -> Color -> Float -> Float -> Placement
tankRectCross w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
(PutShape $ colorSH col $
upperPrismPoly 31 therect
<> thinHighBar 31 (V2 w 0) (V2 (-w) 0)
<> thinHighBar 31 (V2 0 h) (V2 0 (-h))
@@ -49,7 +49,7 @@ tankSquareCross = tankRectCross 20 20
tankRect :: Float -> Float -> Color -> Float -> Float -> Placement
tankRect w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col
(PutShape $ colorSH col
$ upperPrismPoly 31 therect
<> foldMap f [(w',-w',h',h'),(w',-w',-h',-h'),(w',w',h',-h'),(-w',-w',h',-h')]
)
@@ -65,7 +65,7 @@ tankSquare = tankRect 20 20
tankRectEmboss :: Float -> Float -> Color -> Float -> Float -> Placement
tankRectEmboss w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
(PutShape $ colorSH col $
upperPrismPoly 31 therect
<> embossingR
<> rotateSH pi embossingR
@@ -84,7 +84,7 @@ tankSquareEmboss = tankRectEmboss 20 20
tankRectEmboss4 :: Float -> Float -> Color -> Float -> Float -> Placement
tankRectEmboss4 w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
(PutShape $ colorSH col $
upperPrismPoly 31 therect
<> foldMap f [(w,h),(-w,h),(w,-h),(-w,-h)]
)
src/Dodge/Placement/Instance/Wall.hs
+4 -4
View File
@@ -11,7 +11,7 @@ import Data.List
import Control.Lens
heightWallPS :: PlacementSpot -> Float -> [Point2] -> Placement
heightWallPS spot h ps = psj spot (PutForeground . colorSH col $ upperPrismPoly h ps)
heightWallPS spot h ps = psj spot (PutShape . colorSH col $ upperPrismPoly h ps)
$ sps spot $ PutWall ps theWall
where
col = _wlColor defaultWall
@@ -22,7 +22,7 @@ heightWallPS spot h ps = psj spot (PutForeground . colorSH col $ upperPrismPoly
}
heightWall :: Float -> [Point2] -> Placement
heightWall h ps = ps0j (PutForeground . colorSH col $ upperPrismPoly h ps)
heightWall h ps = ps0j (PutShape . colorSH col $ upperPrismPoly h ps)
$ sps0 $ PutWall ps theWall
where
col = _wlColor defaultWall
@@ -33,7 +33,7 @@ heightWall h ps = ps0j (PutForeground . colorSH col $ upperPrismPoly h ps)
}
midWall :: [Point2] -> Placement
midWall ps = ps0j (PutForeground . colorSH col $ upperPrismPoly 50 ps)
midWall ps = ps0j (PutShape . colorSH col $ upperPrismPoly 50 ps)
$ sps0 $ PutWall ps theWall
where
col = _wlColor defaultWall
@@ -47,7 +47,7 @@ midWall ps = ps0j (PutForeground . colorSH col $ upperPrismPoly 50 ps)
singleBlock :: Point2 -> [Placement]
singleBlock a =
[sPS a 0
$ PutBlock StoneBlock [5,20,20] baseBlockPane
$ PutBlock StoneBlock 5 [20,20] baseBlockPane
$ reverse
$ square 10
]