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

Separate placement spot from placement type

Browse Source
This commit is contained in:
justin
2021-11-02 21:12:11 +00:00
parent 59f43a3602
commit 0b058674ea
16 changed files with 77 additions and 85 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/LevelGen.hs
+5 -5
View File
@@ -24,12 +24,12 @@ import qualified Data.IntSet as IS
placeSpot :: World -> ((Point2,Float) , Placement) -> World placeSpot :: World -> ((Point2,Float) , Placement) -> World
placeSpot w (shift, plmnt@Placement{}) = placeSpot w (shift, plmnt@Placement{}) =
let (i,w') = placeSpotID (shiftPSBy shift (_placementSpot plmnt)) w let (i,w') = placeSpotID (shiftPSBy shift (_placementSpot plmnt)) (_psType plmnt) w
in maybe w' (curry (placeSpot w') shift) (_idPlacement plmnt i) in maybe w' (curry (placeSpot w') shift) (_idPlacement plmnt i)
placeSpot w (shift, PlacementPos p subpl) = placeSpot w (shift, subpl (shiftPoint3By shift p)) placeSpot w (shift, PlacementPos p subpl) = placeSpot w (shift, subpl (shiftPoint3By shift p))
shiftPlacement :: (Point2,Float) -> Placement -> Placement shiftPlacement :: (Point2,Float) -> Placement -> Placement
shiftPlacement shift (Placement ps f) = Placement (shiftPSBy shift ps) shiftPlacement shift (Placement ps pt f) = Placement (shiftPSBy shift ps) pt
(fmap (fmap $ shiftPlacement shift) f) (fmap (fmap $ shiftPlacement shift) f)
shiftPlacement shift (PlacementPos p f) = PlacementPos (shiftPoint3By shift p) shiftPlacement shift (PlacementPos p f) = PlacementPos (shiftPoint3By shift p)
(fmap (shiftPlacement shift) f) (fmap (shiftPlacement shift) f)
@@ -41,8 +41,8 @@ shiftPSBy (pos,rot) ps = ps
-- the Int here allows for passing parameters down to other placements: -- the Int here allows for passing parameters down to other placements:
-- button ids, etc -- button ids, etc
placeSpotID :: PlacementSpot -> World -> (Int, World) placeSpotID :: PlacementSpot -> PSType -> World -> (Int, World)
placeSpotID ps w = case _psType ps of placeSpotID ps pt w = case pt of
PutProp prop -> placeProp prop p rot w PutProp prop -> placeProp prop p rot w
PutButton bt -> placeBt bt p rot w PutButton bt -> placeBt bt p rot w
PutFlIt itm -> placeFlIt itm p rot w PutFlIt itm -> placeFlIt itm p rot w
@@ -50,7 +50,7 @@ placeSpotID ps w = case _psType ps of
PutMachine col wallpoly mc -> placeMachine col (map doShift wallpoly) mc p rot w PutMachine col wallpoly mc -> placeMachine col (map doShift wallpoly) mc p rot w
PutLS ls -> placeLS ls p' rot w PutLS ls -> placeLS ls p' rot w
PutPressPlate pp -> placePressPlate pp p rot w PutPressPlate pp -> placePressPlate pp p rot w
RandPS rgen -> placeSpotID (set psType evaluatedType ps) (set randGen g w) RandPS rgen -> placeSpotID ps evaluatedType (set randGen g w)
where where
(evaluatedType, g) = runState rgen (_randGen w) (evaluatedType, g) = runState rgen (_randGen w)
PutDoor col f pss -> placeDoor col f (map (bimap doShift doShift) pss) w PutDoor col f pss -> placeDoor col f (map (bimap doShift doShift) pss) w
src/Dodge/LevelGen/Data.hs
+8 -8
View File
@@ -31,19 +31,19 @@ data PSType = PutCrit {_unPutCrit :: Creature}
data PlacementSpot = PS data PlacementSpot = PS
{ _psPos :: Point2 { _psPos :: Point2
, _psRot :: Float , _psRot :: Float
, _psType :: PSType
} }
data Placement = Placement data Placement = Placement
{ _placementSpot :: PlacementSpot { _placementSpot :: PlacementSpot
, _psType :: PSType
, _idPlacement :: Int -> Maybe Placement , _idPlacement :: Int -> Maybe Placement
} }
| PlacementPos Point3 (Point3 -> Placement) | PlacementPos Point3 (Point3 -> Placement)
sPS :: Point2 -> Float -> PSType -> Placement sPS :: Point2 -> Float -> PSType -> Placement
sPS p a pt = Placement (PS p a pt) (const Nothing) sPS p a pt = Placement (PS p a) pt (const Nothing)
jsps :: Point2 -> Float -> PSType -> Maybe Placement jsps :: Point2 -> Float -> PSType -> Maybe Placement
jsps p a pst = Just $ Placement (PS p a pst) $ const Nothing jsps p a pst = Just $ Placement (PS p a) pst $ const Nothing
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
@@ -52,19 +52,19 @@ sps0 :: PSType -> Placement
sps0 = sPS (V2 0 0) 0 sps0 = sPS (V2 0 0) 0
jspsJ :: Point2 -> Float -> PSType -> Placement -> Maybe Placement jspsJ :: Point2 -> Float -> PSType -> Placement -> Maybe Placement
jspsJ p a pst plm = Just $ Placement (PS p a pst) $ \_ -> Just plm jspsJ p a pst plm = Just $ Placement (PS p a) pst $ \_ -> Just plm
jsps0J :: PSType -> Placement -> Maybe Placement jsps0J :: PSType -> Placement -> Maybe Placement
jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0 pst) $ \_ -> Just plm jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0) pst $ \_ -> Just plm
ps0 :: PSType -> (Int -> Maybe Placement) -> Placement ps0 :: PSType -> (Int -> Maybe Placement) -> Placement
ps0 pst = Placement (PS (V2 0 0) 0 pst) ps0 pst = Placement (PS (V2 0 0) 0) pst
jps0 :: PSType -> (Int -> Maybe Placement) -> Maybe Placement jps0 :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
jps0 pst = Just . Placement (PS (V2 0 0) 0 pst) jps0 pst = Just . Placement (PS (V2 0 0) 0) pst
ps0j :: PSType -> Placement -> Placement ps0j :: PSType -> Placement -> Placement
ps0j pst plmnt = Placement (PS (V2 0 0) 0 pst) (const $ Just plmnt) ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst (const $ Just plmnt)
makeLenses ''PSType makeLenses ''PSType
makeLenses ''PlacementSpot makeLenses ''PlacementSpot
src/Dodge/Machine/Sensor.hs
+1 -1
View File
@@ -16,7 +16,7 @@ import Data.Either
damageSensor damageSensor
:: (DamageType -> Either Int Int) -- Left gets sensed, Right does damage :: (DamageType -> Either Int Int) -- Left gets sensed, Right does damage
-> Point2 -> Float -> Placement -> Point2 -> Float -> Placement
damageSensor damF p r = Placement (PS p r $ PutLS theLS) damageSensor damF p r = Placement (PS p r) ( PutLS theLS)
$ \lsid -> jsps p r $ PutMachine blue (reverse $ square wdth) defaultMachine $ \lsid -> jsps p r $ PutMachine blue (reverse $ square wdth) defaultMachine
{ _mcDraw = sensorSPic { _mcDraw = sensorSPic
, _mcUpdate = sensorUpdate damF , _mcUpdate = sensorUpdate damF
src/Dodge/Placements/Button.hs
+2 -2
View File
@@ -12,11 +12,11 @@ import Dodge.Placements.LightSource
import Control.Lens import Control.Lens
putLitButtonID :: Color -> Point2 -> Float -> (Int -> Maybe Placement) -> Placement putLitButtonID :: Color -> Point2 -> Float -> (Int -> Maybe Placement) -> Placement
putLitButtonID col p a subpl = mountLightlID ls p'' (addZ 40 p') putLitButtonID col p a subpl = mountLightAID ls p'' (addZ 40 p')
$ \lsid -> jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = p, _btRot = a}) $ \lsid -> jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = p, _btRot = a})
subpl subpl
where where
p' = p -.- 20 *.* vNormal (unitVectorAtAngle a) p' = p -.- 30 *.* vNormal (unitVectorAtAngle a)
p'' = p +.+ 10 *.* vNormal (unitVectorAtAngle a) p'' = p +.+ 10 *.* vNormal (unitVectorAtAngle a)
changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0 changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 } ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
src/Dodge/Placements/Door.hs
+2 -2
View File
@@ -17,7 +17,7 @@ putDoubleDoor pathing col cond a b speed = putDoubleDoorThen pathing col cond a
putDoubleDoorThen :: Bool -> Color -> (World -> Bool) putDoubleDoorThen :: Bool -> Color -> (World -> Bool)
-> Point2 -> Point2 -> Float -> Maybe Placement -> Placement -> Point2 -> Point2 -> Float -> Maybe Placement -> Placement
putDoubleDoorThen pathing col cond a b speed mayp = ps0j (PutSlideDoor pathing col cond a half speed) 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)) $ const mayp $ Placement (PS (V2 0 0) 0) ( (PutSlideDoor pathing col cond b half speed)) $ const mayp
where where
half = 0.5 *.* (a +.+ b) half = 0.5 *.* (a +.+ b)
@@ -31,7 +31,7 @@ putAutoDoor a b = PlacementPos (addZ 0 a)
cond az bz = any (crNearSeg 40 (stripZ az) (stripZ bz)) . IM.filter isAnimate . _creatures cond az bz = any (crNearSeg 40 (stripZ az) (stripZ bz)) . IM.filter isAnimate . _creatures
switchDoor :: Point2 -> Float -> Point2 -> Point2 -> Color -> Placement switchDoor :: Point2 -> Float -> Point2 -> Point2 -> Color -> Placement
switchDoor btpos btrot dra drb col = Placement (PS btpos btrot $ PutButton $ makeSwitch col red id id) switchDoor btpos btrot dra drb col = Placement (PS btpos btrot) (PutButton $ makeSwitch col red id id)
$ \btid -> jsps0J (PutSlideDoor False col (cond btid) dra drc 2) $ \btid -> jsps0J (PutSlideDoor False col (cond btid) dra drc 2)
$ sps0 (PutSlideDoor False col (cond btid) drb drc 2) $ sps0 (PutSlideDoor False col (cond btid) drb drc 2)
where where
src/Dodge/Placements/LightSource.hs
+21 -19
View File
@@ -72,29 +72,20 @@ mountLightlID = mountLightOnShape f
mountLightll :: Point2 -> Point3 -> Placement mountLightll :: Point2 -> Point3 -> Placement
mountLightll = redMID mountLightlID mountLightll = redMID mountLightlID
mountLightA :: Point2 -> Point3 -> Placement mountLightAID :: LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
mountLightA wallpos lamppos@(V3 x y z) mountLightAID = mountLightOnShape f
= ps0 (PutLS $ colorLightAt 0.75 lamppos 0) where
$ \_ -> jsps0 $ PutForeground $ girder (z+10) 20 10 pout wallpos f wallpos (V3 x y z) = girder (z+10) 20 10 pout wallpos
where where
pout = V2 x y -.- 2 *.* safeNormalizeV (V2 x y -.- wallpos) pout = V2 x y -.- 2 *.* safeNormalizeV (V2 x y -.- wallpos)
mountColLightI :: Point3 -> Float -> Point2 -> Point2 -> Placement mountLightA :: Point2 -> Point3 -> Placement
mountColLightI col h a b = ps0j (PutLS $ colorLightAt col (V3 x y h) 0) mountLightA = redMID mountLightAID
$ sps0 $ PutForeground $ highPipe (h + 5) a b
where
V2 x y = 0.5 *.* (a +.+ b)
mountLightI :: Float -> Point2 -> Point2 -> Placement mountLightVID :: LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
mountLightI h a b = ps0j (PutLS $ lightAt (V3 x y h) 0) mountLightVID = mountLightOnShape f
$ sps0 $ PutForeground $ highPipe (h + 5) a b
where where
V2 x y = 0.5 *.* (a +.+ b) f wallpos (V3 x y z) = thinHighBar (z + 5) wallposUp (lxy `extendAway` wallposUp)
mountLightV :: Point2 -> Point3 -> Placement
mountLightV wallpos lamppos@(V3 x y z)
= ps0 (PutLS $ colorLightAt 0.75 lamppos 0)
$ \_ -> jsps0 $ PutForeground $ thinHighBar (z + 5) wallposUp (lxy `extendAway` wallposUp)
<> thinHighBar (z + 5) wallposDown (lxy `extendAway` wallposDown) <> thinHighBar (z + 5) wallposDown (lxy `extendAway` wallposDown)
where where
lxy = V2 x y lxy = V2 x y
@@ -102,6 +93,18 @@ mountLightV wallpos lamppos@(V3 x y z)
wallposUp = wallpos +.+ n wallposUp = wallpos +.+ n
wallposDown = wallpos -.- n wallposDown = wallpos -.- n
mountLightV :: Point2 -> Point3 -> Placement
mountLightV = redMID mountLightVID
spanColLightI :: Point3 -> Float -> Point2 -> Point2 -> Placement
spanColLightI col h a b = ps0j (PutLS $ colorLightAt col (V3 x y h) 0)
$ sps0 $ PutForeground $ highPipe (h + 5) a b
where
V2 x y = 0.5 *.* (a +.+ b)
spanLightI :: Float -> Point2 -> Point2 -> Placement
spanLightI = spanColLightI 0.75
extendAway :: Point2 -> Point2 -> Point2 extendAway :: Point2 -> Point2 -> Point2
extendAway p x = p +.+ safeNormalizeV (p -.- x) extendAway p x = p +.+ safeNormalizeV (p -.- x)
@@ -110,4 +113,3 @@ putColorLamp col = PutCrit (colorLamp col 90)
putLamp :: PSType putLamp :: PSType
putLamp = PutCrit (lamp 90) putLamp = PutCrit (lamp 90)
src/Dodge/Placements/Wall.hs
+8 -26
View File
@@ -21,33 +21,20 @@ Places a line of blocks between two points.
Width 9, also extends out from each point by 9. Width 9, also extends out from each point by 9.
-} -}
blockLine :: Point2 -> Point2 -> Placement blockLine :: Point2 -> Point2 -> Placement
blockLine a b = Placement PS blockLine a b = sps0 $ PutLineBlock baseBlockPane 9 9 a b
{ _psPos = V2 0 0
, _psRot = 0
, _psType = PutLineBlock baseBlockPane 9 9 a b
} (const Nothing)
{- {-
Places an breakable window between two points. Places an breakable window between two points.
Width 8, also extends out from each point by 8. Width 8, also extends out from each point by 8.
-} -}
windowLine :: Point2 -> Point2 -> Placement windowLine :: Point2 -> Point2 -> Placement
windowLine a b = Placement PS windowLine a b = sps0 $ PutLineBlock baseWindowPane 8 8 a b
{ _psPos = V2 0 0
, _psRot = 0
, _psType = PutLineBlock baseWindowPane 8 8 a b
} (const Nothing)
{- {-
Places an unbreakable window between two points. Places an unbreakable window between two points.
Width 7, also extends out from each point by 7. Width 7, also extends out from each point by 7.
-} -}
crystalLine :: Point2 -> Point2 -> Placement crystalLine :: Point2 -> Point2 -> Placement
crystalLine a b = Placement PS crystalLine a b = sps0 $ PutWall ps defaultCrystalWall
{ _psPos = V2 0 0
, _psRot = 0
, _psType = PutWall ps defaultCrystalWall
} (const Nothing)
where where
ps = ps =
[ a +.+ left +.+ up [ a +.+ left +.+ up
@@ -61,14 +48,9 @@ crystalLine a b = Placement PS
Depth 15, does not extend wider than points. Depth 15, does not extend wider than points.
-} -}
wallLine :: Point2 -> Point2 -> Placement wallLine :: Point2 -> Point2 -> Placement
wallLine a b = Placement PS wallLine a b = sps0 $ PutWall ps defaultWall
{ _psPos = V2 0 0
, _psRot = 0
, _psType = PutWall ps defaultWall
} (const Nothing)
where where
ps = ps = [ a +.+ up
[ a +.+ up
, a -.- up , a -.- up
, b -.- up , b -.- up
, b +.+ up , b +.+ up
@@ -107,14 +89,14 @@ replacePutID
-> Room -> Room
-> Room -> Room
replacePutID i psts r = replacePutID i psts r =
r & rmPS %~ flip (subZipWith (isPutID i) (\ps pt -> ps & placementSpot . psType .~ pt)) psts r & rmPS %~ flip (subZipWith (isPutID i) (\ps pt -> ps & psType .~ pt)) psts
{- Partition a list by a predicate, apply a zip to those elements {- Partition a list by a predicate, apply a zip to those elements
that satisfy the predicate, concatenate that satisfy the predicate, concatenate
the new zipped list and the other (unchanged) half. -} the new zipped list and the other (unchanged) half. -}
subZipWith subZipWith
:: (a -> Bool) -- ^ Filter: elements to apply zip to :: (a -> Bool) -- ^ Filter: elements to apply zip to
-> (a -> b -> a) -- ^ Combining function -> (a -> b -> a) -- ^ Combining function
-> [a] -- ^ List to be partition -> [a] -- ^ List to be partitioned
-> [b] -- ^ Modifying list -> [b] -- ^ Modifying list
-> [a] -> [a]
subZipWith f g xs ys = subZipWith f g xs ys =
@@ -122,7 +104,7 @@ subZipWith f g xs ys =
in zipWith g zs ys ++ ws in zipWith g zs ys ++ ws
isPutID :: Int -> Placement -> Bool isPutID :: Int -> Placement -> Bool
isPutID i ps = Just i == ps ^? placementSpot . psType . putID isPutID i ps = Just i == ps ^? psType . putID
putBlockRect :: Float -> Float -> Float -> Float -> [Placement] putBlockRect :: Float -> Float -> Float -> Float -> [Placement]
putBlockRect a x b y = putBlockRect a x b y =
src/Dodge/Room.hs
+1 -1
View File
@@ -66,7 +66,7 @@ roomPadCut ps p = defaultRoom
roomPillars :: Room roomPillars :: Room
roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2 roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2
where where
plmnts = mountLightI 70 (V2 120 24) (V2 120 216) plmnts = spanLightI 70 (V2 120 24) (V2 120 216)
: mountLightV (V2 12 12) (V3 25 25 70) : mountLightV (V2 12 12) (V3 25 25 70)
: mountLightV (V2 228 228) (V3 215 215 70) : mountLightV (V2 228 228) (V3 215 215 70)
: sps0 (PutForeground $ thinHighBar 75 (V2 26 25) (V2 120 25)) : sps0 (PutForeground $ thinHighBar 75 (V2 26 25) (V2 120 25))
src/Dodge/Room/Airlock.hs
+4 -4
View File
@@ -25,10 +25,10 @@ airlock0 = defaultRoom
, _rmLinks = lnks , _rmLinks = lnks
, _rmPath = [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20 5) ] , _rmPath = [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20 5) ]
, _rmPS = , _rmPS =
[Placement (PS (V2 (-35) 50) (negate $ pi/2) $ PutButton $ makeSwitch col red id id) [Placement (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id)
$ \btid -> Just $ putDoubleDoorThen False col (not . cond' btid) (V2 (-1) 20) (V2 41 20) 2 $ \btid -> Just $ putDoubleDoorThen False col (not . cond' btid) (V2 (-1) 20) (V2 41 20) 2
$ Just $ putDoubleDoorThen False col (cond' btid) (V2 (-1) 80) (V2 41 80) 2 Nothing $ Just $ putDoubleDoorThen False col (cond' btid) (V2 (-1) 80) (V2 41 80) 2 Nothing
,mountLightI 70 (V2 (-2) 30) (V2 (-2) 70) ,spanLightI 70 (V2 (-2) 30) (V2 (-2) 70)
,sps0 $ PutForeground $ thinHighBar 75 (V2 40 50) (V2 (-1) 50) ,sps0 $ PutForeground $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
] ]
, _rmBound = [rectNSWE 75 15 0 40] , _rmBound = [rectNSWE 75 15 0 40]
@@ -61,7 +61,7 @@ airlock90 = defaultRoom
,(V2 40 0,V2 0 40) ,(V2 40 0,V2 0 40)
] ]
, _rmPS = , _rmPS =
[ Placement (PS (V2 120 120) (3 * pi/4) (PutButton $ makeSwitch col red id id)) [ Placement (PS (V2 120 120) (3 * pi/4)) ((PutButton $ makeSwitch col red id id))
$ \btid -> jsps (V2 5 5) 0 $ PutDoor col (cond btid) pss $ \btid -> jsps (V2 5 5) 0 $ PutDoor col (cond btid) pss
,mountLightV (V2 20 20) (V3 70 70 50) ,mountLightV (V2 20 20) (V3 70 70 50)
] ]
@@ -89,7 +89,7 @@ airlockCrystal = defaultRoom
, _rmLinks = [(V2 20 130,0) ,(V2 20 0 ,pi) ] , _rmLinks = [(V2 20 130,0) ,(V2 20 0 ,pi) ]
, _rmPath = [ ] , _rmPath = [ ]
, _rmPS = , _rmPS =
[ Placement (PS (V2 145 70) (pi/2) (PutButton $ makeSwitch col red id id)) [ Placement (PS (V2 145 70) (pi/2)) ( (PutButton $ makeSwitch col red id id))
$ \btid -> jsps0 $ PutDoor col (cond btid) pss $ \btid -> jsps0 $ PutDoor col (cond btid) pss
, crystalLine (V2 0 70) (V2 40 70) , crystalLine (V2 0 70) (V2 40 70)
, mountLightV (V2 150 70) (V3 110 70 70) , mountLightV (V2 150 70) (V3 110 70 70)
src/Dodge/Room/Boss.hs
+2 -2
View File
@@ -97,8 +97,8 @@ roomCross x y = defaultRoom
] ]
, _rmPath = [] , _rmPath = []
, _rmPS = , _rmPS =
[ mountLightI 70 (V2 (x+5) x) (V2 (x+5) (-x)) [ spanLightI 70 (V2 (x+5) x) (V2 (x+5) (-x))
, mountLightI 70 (V2 (-x-5) x) (V2 (-x-5) (-x)) , spanLightI 70 (V2 (-x-5) x) (V2 (-x-5) (-x))
] ]
, _rmBound = , _rmBound =
[rectNSWE y (-y) (-x) x [rectNSWE y (-y) (-x) x
src/Dodge/Room/Corridor.hs
+1 -1
View File
@@ -17,7 +17,7 @@ corridor = defaultRoom
{ _rmPolys = [poly] { _rmPolys = [poly]
, _rmLinks = lnks , _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks , _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
, _rmPS = [ mountLightI 50 (V2 0 40) (V2 40 40) ] , _rmPS = [ spanLightI 50 (V2 0 40) (V2 40 40) ]
, _rmBound = [ rectNSWE 50 30 0 40 ] , _rmBound = [ rectNSWE 50 30 0 40 ]
, _rmFloor = [makeTileFromPoly poly 2] , _rmFloor = [makeTileFromPoly poly 2]
} }
src/Dodge/Room/Foreground.hs
+11 -3
View File
@@ -110,12 +110,13 @@ girderV h d w x y = colorSH red $ mconcat $
evenDouble (a:_:xs) = a:a:evenDouble xs evenDouble (a:_:xs) = a:a:evenDouble xs
evenDouble xs = xs evenDouble xs = xs
girder girderCol
:: Float -- ^ height :: Color
-> Float -- ^ height
-> Float -- ^ distance between cross bars -> Float -- ^ distance between cross bars
-> Float -- ^ width -> Float -- ^ width
-> Point2 -> Point2 -> Shape -> Point2 -> Point2 -> Shape
girder h d w x y = colorSH red $ mconcat $ girderCol col h d w x y = colorSH col $ mconcat $
[ thinHighBar h xt yt [ thinHighBar h xt yt
, thinHighBar h xb yb , thinHighBar h xb yb
] ]
@@ -129,6 +130,13 @@ girder h d w x y = colorSH red $ mconcat $
ps = divideLineExact d xb yb ps = divideLineExact d xb yb
qs = divideLineExact d xt yt qs = divideLineExact d xt yt
girder
:: Float -- ^ height
-> Float -- ^ distance between cross bars
-> Float -- ^ width
-> Point2 -> Point2 -> Shape
girder = girderCol red
robotArm :: Shape robotArm :: Shape
robotArm = undefined robotArm = undefined
src/Dodge/Room/LongDoor.hs
+1 -1
View File
@@ -39,7 +39,7 @@ twinSlowDoorRoom w h x = defaultRoom
] ]
, _rmPath = [] , _rmPath = []
, _rmPS = , _rmPS =
[ Placement (PS (V2 0 (h-5)) pi $ PutButton $ makeButton col id) [ Placement (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col id)
$ \btid -> jsps0J (PutSlideDoor False col (cond' btid) (V2 x 1) (V2 x h) wlSpeed) $ \btid -> jsps0J (PutSlideDoor False col (cond' btid) (V2 x 1) (V2 x h) wlSpeed)
$ ps0 (PutSlideDoor False col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed) $ ps0 (PutSlideDoor False col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed)
$ \did -> jps0 (PutLS (colorLightAt (V3 0.75 0 0) (V3 0 (h-1) lampHeight) 0)) $ \did -> jps0 (PutLS (colorLightAt (V3 0.75 0 0) (V3 0 (h-1) lampHeight) 0))
src/Dodge/Room/Procedural.hs
+2 -2
View File
@@ -169,7 +169,7 @@ fillNothingPlacement :: PSType -> Room -> Room
fillNothingPlacement pst r = fillNothingPlacement pst r =
r & rmPS %~ replaceNothingWith pst r & rmPS %~ replaceNothingWith pst
where where
replaceNothingWith x (Placement (PS p rot PutNothing) _: pss) = sPS p rot x : pss replaceNothingWith x (Placement (PS p rot) PutNothing _: pss) = sPS p rot x : pss
replaceNothingWith x (ps:pss) = ps : replaceNothingWith x pss replaceNothingWith x (ps:pss) = ps : replaceNothingWith x pss
replaceNothingWith _ [] = [] replaceNothingWith _ [] = []
{- | Successively fill 'PutNothing' placements with a list of given 'PSType's. {- | Successively fill 'PutNothing' placements with a list of given 'PSType's.
@@ -231,7 +231,7 @@ centerVaultRoom w h d = do
where where
col = dim $ dim $ bright red col = dim $ dim $ bright red
theDoor = theDoor =
[ Placement (PS (V2 35 (d+4)) 0 $ PutButton $ makeSwitch col red id id) [ Placement (PS (V2 35 (d+4)) 0) (PutButton $ makeSwitch col red id id)
$ \btid -> jspsJ (V2 0 (d-10)) 0 (PutSlideDoor False col (cond' btid) (V2 (-21) 0) (V2 0 0) 2) $ \btid -> jspsJ (V2 0 (d-10)) 0 (PutSlideDoor False col (cond' btid) (V2 (-21) 0) (V2 0 0) 2)
$ sPS (V2 0 (d-10)) 0 (PutSlideDoor False col (cond' btid) (V2 21 0) (V2 0 0) 2) $ sPS (V2 0 (d-10)) 0 (PutSlideDoor False col (cond' btid) (V2 21 0) (V2 0 0) 2)
] ]
src/Dodge/Room/RoadBlock.hs
+2 -2
View File
@@ -42,7 +42,7 @@ litCorridor90 = do
] ]
, _rmPS = , _rmPS =
[ sPS (V2 20 (h-5)) 0 putLamp [ sPS (V2 20 (h-5)) 0 putLamp
, mountLightI 70 (V2 0 (0.4*h)) (V2 40 (0.4*h)) , spanLightI 70 (V2 0 (0.4*h)) (V2 40 (0.4*h))
, windowLine (V2 0 (h-20)) (V2 40 (h-20)) , windowLine (V2 0 (h-20)) (V2 40 (h-20))
, sPS (V2 (-50) (h-85)) 0 putLamp , sPS (V2 (-50) (h-85)) 0 putLamp
, windowLine (V2 (-40) (h-60)) (V2 (-40) (h-100)) , windowLine (V2 (-40) (h-60)) (V2 (-40) (h-100))
@@ -75,6 +75,6 @@ blockedCorridor = do
let plmnts = let plmnts =
[sPS (V2 20 40) r $ PutBlock [5,5,5] (V4 (150/256) ( 75/256) 0 ( 250/256)) [sPS (V2 20 40) r $ PutBlock [5,5,5] (V4 (150/256) ( 75/256) 0 ( 250/256))
$ reverse $ rectNSWE 10 (-10) (-10) 10 $ reverse $ rectNSWE 10 (-10) (-10) 10
,mountLightI 55 (V2 0 15) (V2 40 15) ,spanLightI 55 (V2 0 15) (V2 40 15)
] ]
sequence $ treeFromPost [] $ return $ Right $ set rmPS plmnts corridor sequence $ treeFromPost [] $ return $ Right $ set rmPS plmnts corridor
src/Dodge/Room/Start.hs
+1 -1
View File
@@ -21,7 +21,7 @@ import System.Random
rezBox :: Room rezBox :: Room
rezBox = shiftRoomBy (V2 (-20) (-10),0) $ roomRect 40 20 1 1 rezBox = shiftRoomBy (V2 (-20) (-10),0) $ roomRect 40 20 1 1
& rmPS .~ [ mountColLightI (V3 0 0.7 0.2) 70 (V2 0 10) (V2 40 10) ] & rmPS .~ [ spanColLightI (V3 0 0.7 0.2) 70 (V2 0 10) (V2 40 10) ]
startRoom :: RandomGen g => State g (Tree (Either Room Room)) startRoom :: RandomGen g => State g (Tree (Either Room Room))
startRoom = do startRoom = do