Move main to allow for new executables

This commit is contained in:
2021-08-11 17:54:48 +02:00
parent b74bb45a4c
commit 4bbe5d0cf1
64 changed files with 521 additions and 345 deletions
+15 -15
View File
@@ -31,8 +31,8 @@ airlockOneWay n = defaultRoom
--, _rmBound = rectNSWE 90 30 (-30) 30
, _rmBound = [rectNSWE 75 15 0 40]
}
where lnks = [((V2 0 85),0)
,((V2 0 5),pi)
where lnks = [(V2 0 85,0)
,(V2 0 5,pi)
]
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
col = dim $ dim $ bright red
@@ -56,8 +56,8 @@ airlock0 n = defaultRoom
, rectNSWE 65 35 (-40) 20
]
, _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 =
[sPS (V2 0 20) 0 $ PutDoubleDoor col (not . cond) (V2 1 0) (V2 39 0)
@@ -65,13 +65,13 @@ airlock0 n = defaultRoom
,sPS (V2 35 50) (pi/2) $ PutButton $ makeSwitch col
(over worldState (M.insert (DoorNumOpen n) True))
(over worldState (M.insert (DoorNumOpen n) False))
,sPS (V2 (-25) ( 50)) 0 putLamp
,sPS (V2 (-25) 50) 0 putLamp
]
, _rmBound = [rectNSWE 75 15 0 40]
}
where
lnks = [((V2 20 95),0)
,((V2 20 5),pi)
lnks = [(V2 20 95,0)
,(V2 20 5,pi)
]
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
col = dim $ dim $ bright red
@@ -91,12 +91,12 @@ airlock90 n = defaultRoom
]
]
, _rmLinks =
[((V2 0 40),pi/2)
,((V2 40 0),pi)
[(V2 0 40,pi/2)
,(V2 40 0,pi)
]
, _rmPath =
[((V2 0 40),(V2 40 0))
,((V2 40 0),(V2 0 40))
[(V2 0 40,V2 40 0)
,(V2 40 0,V2 0 40)
]
, _rmPS =
[sPS (V2 5 5) 0 $ PutDoor col (not . cond) pss
@@ -116,7 +116,7 @@ airlock90 n = defaultRoom
where
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
col = dim $ dim $ bright red
pss = ((V2 0 0) ,) <$> arcStepwise 3 (negate $ pi/2) (V2 0 0) (V2 0 55)
pss = (V2 0 0 ,) <$> arcStepwise 3 (negate $ pi/2) (V2 0 0) (V2 0 55)
airlockCrystal
:: Int -- ^ Door id
@@ -132,8 +132,8 @@ airlockCrystal n = defaultRoom
]
]
, _rmLinks =
[((V2 20 130),0)
,((V2 20 0),pi)
[(V2 20 130,0)
,(V2 20 0 ,pi)
]
, _rmPath =
[
@@ -154,5 +154,5 @@ airlockCrystal n = defaultRoom
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
col = dim $ dim $ bright red
pss :: [(Point2,Point2)]
pss = reverse $ fmap ( (\x -> ((V2 50 x),(V2 (50) (x+50))) ) . fromIntegral)
pss = reverse $ fmap ( (\x -> (V2 50 x,V2 50 (x+50)) ) . fromIntegral)
[20::Int,22..70]
+27 -27
View File
@@ -29,21 +29,21 @@ roomGlassOctogon x = defaultRoom
,rectNSWE 0 (-(x + 40)) (-20) 20
]
, _rmLinks =
[((V2 0 x),0)
,((V2 (0) (-(x+40))),pi)
[(V2 0 x,0)
,(V2 0 (-(x+40)),pi)
]
, _rmPath = [((V2 (0) (x)),(V2 (0) (-(x+40))))
,((V2 (0) (-(x+40))),(V2 (0) (x)))]
, _rmPath = [(V2 0 x,V2 0 (-(x+40)))
,(V2 0 (-(x+40)),V2 0 x)]
, _rmPS =
[sPS (V2 fx fx) 0 putLamp
,sPS (V2 (-fx) (fx)) 0 putLamp
,sPS (V2 (fx) (-fx)) 0 putLamp
,sPS (V2 (-fx) fx) 0 putLamp
,sPS (V2 fx (-fx)) 0 putLamp
,sPS (V2 (-fx) (-fx)) 0 putLamp
,crystalLine (V2 (-x) (x/2)) (V2 (negate (x/2)) ( x))
,crystalLine (V2 (x) (x/2)) (V2 (x/2) ( x))
,crystalLine (V2 (x/2) (-x)) (V2 (x) (negate (x/2)))
,crystalLine (V2 (-x) (x/2)) (V2 (negate (x/2)) x)
,crystalLine (V2 x (x/2)) (V2 (x/2) x)
,crystalLine (V2 (x/2) (-x)) (V2 x (negate (x/2)))
,crystalLine (V2 (negate $ x/2) (-x)) (V2 (-x) (negate (x/2)))
,blockLine (V2 (-40) (40-x)) (V2 (40) (40-x))
,blockLine (V2 (-40) (40-x)) (V2 40 (40-x))
]
, _rmBound = [rectNSWE x (-x) (-x) x]
}
@@ -55,7 +55,7 @@ bossRoom cr = randomMediumRoom <&> rmPS %~ ( sPS (V2 0 100) (negate $ pi/2) (Put
armouredChasers :: RandomGen g => State g (Tree Room)
armouredChasers = do
ps <- takeN 5 [(V2 x y) | x <- [-100,-80 .. 100] ,y <- [-100,-80 .. 100] ]
ps <- takeN 5 [V2 x y | x <- [-100,-80 .. 100] ,y <- [-100,-80 .. 100] ]
as <- replicateM 5 . state $ randomR (0,2*pi)
let theCrits = zipWith3 (\p a c -> sPS p a (PutCrit c)) ps as cs
treeFromPost [corridor,corridor] <$> (randomMediumRoom <&> rmPS %~ (++ theCrits))
@@ -80,21 +80,21 @@ roomCross x y = defaultRoom
,rectNSWE (-x) x y (-y)
]
, _rmLinks =
[((V2 (x) (y-20)),negate $ pi/2)
,((V2 (x) (20-y)),negate $ pi/2)
,((V2 (20-y) (x)),0)
,((V2 (y-20) (x)),0)
,((V2 (-x) (y-20)),pi/2)
,((V2 (-x) (20-y)),pi/2)
,((V2 (20-y) (-x)),pi)
,((V2 (y-20) (-x)),pi)
[(V2 x (y-20),negate $ pi/2)
,(V2 x (20-y),negate $ pi/2)
,(V2 (20-y) x ,0)
,(V2 (y-20) x ,0)
,(V2 (-x) (y-20),pi/2)
,(V2 (-x) (20-y),pi/2)
,(V2 (20-y) (-x),pi)
,(V2 (y-20) (-x),pi)
]
, _rmPath = []
, _rmPS =
[sPS (V2 ( x) ( 0)) 0 putLamp
,sPS (-V2 (x) ( 0)) 0 putLamp
,sPS (V2 ( 0) ( x)) 0 putLamp
,sPS (V2 ( 0) (-x)) 0 putLamp
[sPS (V2 x 0) 0 putLamp
,sPS (-V2 x 0) 0 putLamp
,sPS (V2 0 x) 0 putLamp
,sPS (V2 0 (-x)) 0 putLamp
]
, _rmBound =
[rectNSWE y (-y) (-x) x
@@ -115,12 +115,12 @@ roomShuriken x y =
] ]
corner = defaultRoom
{ _rmPolys = ps
, _rmLinks = [((V2 (x-1) (y-20)),negate $ pi/2)]
, _rmLinks = [(V2 (x-1) (y-20),negate $ pi/2)]
, _rmPath = []
, _rmPS = [sPS (V2 (x/2) (x/2)) 0 putLamp]
, _rmBound = ps
}
in foldr1 combineRooms $ map (\r -> shiftRoomBy ((V2 0 0), r) corner) [0,pi/2,pi,3*pi/2]
in foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2]
{- | TODO: pathing
Precondition: first float is less than the second by at least 40. -}
roomTwistCross
@@ -139,9 +139,9 @@ roomTwistCross x y z =
]
corner = defaultRoom
{ _rmPolys = ps
, _rmLinks = [((V2 (z) (y-20)), pi/2)]
, _rmLinks = [(V2 z (y-20), pi/2)]
, _rmPath = []
, _rmPS = [sPS (V2 (x/2) (x/2)) 0 putLamp]
, _rmBound = ps
}
in foldr1 combineRooms $ map (\r -> shiftRoomBy ((V2 0 0), r) corner) [0,pi/2,pi,3*pi/2]
in foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2]
+3 -3
View File
@@ -55,10 +55,10 @@ corridorN = defaultRoom
, _rmPS = []
, _rmBound = [ rectNSWE 50 30 0 40 ]
}
where lnks = [((V2 20 70) ,0)
,((V2 20 10) ,pi)
where lnks = [(V2 20 70 ,0)
,(V2 20 10 ,pi)
]
pth = doublePair ((V2 20 70),(V2 20 10))
pth = doublePair (V2 20 70,V2 20 10)
tEast :: Room
tEast = defaultRoom
+3 -3
View File
@@ -15,13 +15,13 @@ door :: Room
door = defaultRoom
{ _rmPolys = [rectNSWE 40 0 0 40]
, _rmLinks = lnks
, _rmPath = [((V2 20 35),(V2 20 5))]
, _rmPath = [(V2 20 35,V2 20 5)]
-- door extends into side walls (for shadows as rendered 12/03)
, _rmPS = [sPS (V2 0 20) 0 $ PutAutoDoor (V2 0 0) (V2 40 0)]
, _rmBound = []
}
where lnks = [((V2 20 35),0)
,((V2 20 5),pi)
where lnks = [(V2 20 35,0)
,(V2 20 5,pi)
]
+1 -1
View File
@@ -50,7 +50,7 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
highPipe :: Float -> Point2 -> Point2 -> [Polyhedra]
highPipe h x@(V2 xx xy) y =
[ Polyhedron . map (map ( (,orange) . (+.+.+ (V3 xx xy h))))
[ Polyhedron . map (map ( (,orange) . (+.+.+ V3 xx xy h)))
$ boxABC (V3 a b 0) (V3 a' b' 0) (V3 0 0 5)
]
where
+2 -2
View File
@@ -59,8 +59,8 @@ This is intended to work when the external point is an outgoing link from anothe
shiftRoomToLink :: (Point2,Float) -> Room -> Room
shiftRoomToLink l r
= shiftRoomBy l
. shiftRoomBy ((V2 0 0) -.- rotateV (pi-a) p , 0)
$ shiftRoomBy ((V2 0 0) ,pi-a)
. shiftRoomBy (V2 0 0 -.- rotateV (pi-a) p , 0)
$ shiftRoomBy (V2 0 0 ,pi-a)
r
where
(p,a) = last $ _rmLinks r
+15 -15
View File
@@ -1,4 +1,4 @@
{-# LANGUAGE TupleSections #-}
--{-# LANGUAGE TupleSections #-}
{- | Rooms containing long doors, probably with a big reveal behind them.
-}
module Dodge.Room.LongDoor
@@ -33,18 +33,18 @@ twinSlowDoorRoom
twinSlowDoorRoom drID w h x = defaultRoom
{ _rmPolys = ps
, _rmLinks =
[ ((V2 (w) (h/2)) , negate $ pi/2)
, ((V2 (-w) (h/2)) , pi/2)
, ((V2 (0) (-h)), pi)
[ (V2 w (h/2) , negate $ pi/2)
, (V2 (-w) (h/2) , pi/2)
, (V2 0 (-h), pi)
]
, _rmPath = []
, _rmPS =
[ sPS (V2 (0) (h/2)) 0 putLamp
, sPS (V2 (25) (5)) 0 putLamp
, sPS (V2 (negate 25) (5)) 0 putLamp
[ sPS (V2 0 (h/2)) 0 putLamp
, sPS (V2 25 5) 0 putLamp
, sPS (V2 (negate 25) 5) 0 putLamp
, sPS (V2 0 0) 0 $ PutDoor col (not . cond) drL
, sPS (V2 0 0) 0 $ PutDoor col (not . cond) drR
, sPS (V2 (0) (h-5)) pi $ PutButton $ makeButton col
, sPS (V2 0 (h-5)) pi $ PutButton $ makeButton col
(over worldState (M.insert (DoorNumOpen drID) True))
]
, _rmBound = ps
@@ -54,9 +54,9 @@ twinSlowDoorRoom drID w h x = defaultRoom
[rectNSWE h (-2) (-w) w
,rectNSWE 20 (-h) (negate x) x
]
drL = fmap ((\h' -> ((V2 (x) (-h')),(V2 (x) (h-h')))) . (* h) . (/ fromIntegral nDrp) . fromIntegral)
drL = fmap ((\h' -> (V2 x (-h'),V2 x (h-h'))) . (* h) . (/ fromIntegral nDrp) . fromIntegral)
[0..nDrp]
drR = fmap ((\h' -> ((V2 (-x) (-h')),(V2 (-x) (h-h')))) . (* h) . (/ fromIntegral nDrp) . fromIntegral)
drR = fmap ((\h' -> (V2 (-x) (-h'),V2 (-x) (h-h'))) . (* h) . (/ fromIntegral nDrp) . fromIntegral)
[0..nDrp]
nDrp = ceiling h :: Int
cond w' = or $ M.lookup (DoorNumOpen drID) (_worldState w')
@@ -67,8 +67,8 @@ twinSlowDoorChasers
=> Int -- ^ Door id
-> State g Room
twinSlowDoorChasers drid = do
let lps = (V2 (-65)) <$> [20,40 .. 180]
rps = (V2 65) <$> [20,40 .. 180]
let lps = V2 (-65) <$> [20,40 .. 180]
rps = V2 65 <$> [20,40 .. 180]
ps <- takeN 4 $ lps ++ rps
let plmnts = map (\p -> sPS p 0 $ PutCrit chaseCrit) ps
return $ twinSlowDoorRoom drid 80 200 40 & rmPS %~ (plmnts ++)
@@ -79,8 +79,8 @@ slowDoorRoom = do
y <- state $ randomR (400,800)
h <- state $ randomR (200,min (y-100) 500)
(butPos,butRot) <- takeOne
[( (V2 (x/2-50) (5)),0)
,( (V2 (x/2+50) (5)),0)
[( V2 (x/2-50) 5,0)
,( V2 (x/2+50) 5,0)
]
let n = 25
xs <- replicateM n $ state $ randomR (10,x-10)
@@ -90,7 +90,7 @@ slowDoorRoom = do
xs' <- replicateM 5 $ state $ randomR (10,x-10)
ys' <- replicateM 5 $ state $ randomR (h+20,y)
let crits = zipWith (\p r -> sPS p r randC1) ps rs
lsources = [sPS (V2 (x/2) (30)) 0 putLamp, sPS (V2 (x/2) (y-30)) 0 putLamp]
lsources = [sPS (V2 (x/2) 30) 0 putLamp, sPS (V2 (x/2) (y-30)) 0 putLamp]
barrels = zipWith (\x' y' -> sPS (V2 x' y') 0 $ PutCrit explosiveBarrel) xs' ys'
pillarsa = []
pillarsb = putBlockRect (x/5-20) (x/5+20) (h/2-20) (h/2+20)
+1 -1
View File
@@ -33,7 +33,7 @@ centerVaultExplosiveExit drID = do
[sPS (V2 0 175) 0 $ PutCrit explosiveBarrel
,sPS (V2 5 195) 0 $ PutCrit explosiveBarrel
,sPS (V2 0 200) 0 $ PutCrit explosiveBarrel
,sPS (V2 (-4) (195)) 0 $ PutCrit explosiveBarrel
,sPS (V2 (-4) 195) 0 $ PutCrit explosiveBarrel
,sPS (V2 0 0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll)
]
r <- centerVaultRoom drID 200 200 50 <&> rmPS %~ (extraPS ++)
+6 -6
View File
@@ -28,7 +28,7 @@ Width 9, also extends out from each point by 9.
-}
blockLine :: Point2 -> Point2 -> Placement
blockLine a b = SinglePlacement $ PS
{ _psPos = (V2 0 0)
{ _psPos = V2 0 0
, _psRot = 0
, _psType = PutLineBlock baseBlockPane 9 9 a b
}
@@ -39,7 +39,7 @@ Width 8, also extends out from each point by 8.
-}
windowLine :: Point2 -> Point2 -> Placement
windowLine a b = SinglePlacement $ PS
{ _psPos = (V2 0 0)
{ _psPos = V2 0 0
, _psRot = 0
, _psType = PutLineBlock baseWindowPane 8 8 a b
}
@@ -50,7 +50,7 @@ Width 7, also extends out from each point by 7.
-}
crystalLine :: Point2 -> Point2 -> Placement
crystalLine a b = SinglePlacement $ PS
{ _psPos = (V2 0 0)
{ _psPos = V2 0 0
, _psRot = 0
, _psType = PutWall ps defaultCrystalWall
}
@@ -68,7 +68,7 @@ Depth 15, does not extend wider than points.
-}
wallLine :: Point2 -> Point2 -> Placement
wallLine a b = SinglePlacement $ PS
{ _psPos = (V2 0 0)
{ _psPos = V2 0 0
, _psRot = 0
, _psType = PutWall ps defaultWall
}
@@ -87,7 +87,7 @@ windowLineType = PutLineBlock baseWindowPane 8 8
baseBlockPane :: Wall
baseBlockPane = Block
{ _wlLine = ((V2 0 0),(V2 50 0))
{ _wlLine = (V2 0 0,V2 50 0)
, _wlID = 0
, _wlColor = greyN 0.5
, _wlSeen = False
@@ -100,7 +100,7 @@ baseBlockPane = Block
}
baseWindowPane :: Wall
baseWindowPane = Block
{ _wlLine = ((V2 0 0),(V2 50 0))
{ _wlLine = (V2 0 0,V2 50 0)
, _wlID = 0
, _wlColor = withAlpha 0.2 cyan
, _wlSeen = False
+29 -29
View File
@@ -50,9 +50,9 @@ roomRect x y xn yn = defaultRoom
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
, _rmFloor = [Tile
{ _tilePoly = rectNSWE y 0 0 x
, _tileCenter = (V2 0 0)
, _tileX = (V2 50 0)
, _tileY = (V2 0 50)
, _tileCenter = V2 0 0
, _tileX = V2 50 0
, _tileY = V2 0 50
, _tileZ = 16
} ]
}
@@ -79,7 +79,7 @@ makeGrid x nx y ny
$ gridPoints x nx y ny
gridPoints :: Float -> Int -> Float -> Int -> [Point2]
gridPoints x nx y ny = [(V2 a b) | a <- take nx $ scanl (+) 0 $ repeat x
gridPoints x nx y ny = [V2 a b | a <- take nx $ scanl (+) 0 $ repeat x
, b <- take ny $ scanl (+) 0 $ repeat y
]
@@ -124,9 +124,9 @@ fourthWall :: RandomGen g => Float -> State g Room
fourthWall w = do
b <- takeOne
[ [ sPS (V2 (20-w) (w-40)) 0 putLamp
, sPS (V2 (0) (40)) 0 putLamp
, sPS (V2 0 40) 0 putLamp
, sPS (V2 (w-20) (w-20)) pi PutNothing
, blockLine (V2 (w/2) (w/2)) (V2 (w/2) (w))
, blockLine (V2 (w/2) (w/2)) (V2 (w/2) w)
]
, [ sPS (V2 (20-w) (w-40)) 0 putLamp
, sPS (V2 0 40) 0 putLamp
@@ -136,16 +136,16 @@ fourthWall w = do
, [ sPS (V2 (20-w) (w-40)) 0 putLamp
, sPS (V2 0 20) 0 putLamp
, 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))
, blockLine (V2 (w/2) (w/2)) (V2 0 (w/2))
, blockLine (V2 (-29) w) (V2 0 (w/2))
]
]
pure $ defaultRoom
{ _rmPolys = [ map toV2 [(0,0),(w,w),(-w,w)] ]
, _rmLinks = [((V2 0 w), 0)]
, _rmPath = [((V2 0 w),(V2 0 0)),((V2 0 0),(V2 0 w))]
, _rmLinks = [(V2 0 w, 0)]
, _rmPath = [(V2 0 w,V2 0 0),(V2 0 0,V2 0 w)]
, _rmPS = b
, _rmBound = [[(V2 0 0),(V2 w w),(V2 (-w) (w))]]
, _rmBound = [[V2 0 0,V2 w w,V2 (-w) w]]
}
--fourthCorner :: Float -> Room
--fourthCorner w = Room
@@ -162,36 +162,36 @@ fourthWall w = do
fourthCornerWall :: RandomGen g => Float -> State g Room
fourthCornerWall w = do
b <- takeOne
[ [ sPS (V2 (10-w) (w)) 0 putLamp
, sPS (V2 (w-10) (w)) 0 putLamp
[ [ sPS (V2 (10-w) w) 0 putLamp
, sPS (V2 (w-10) w) 0 putLamp
, sPS (V2 0 10) 0 putLamp
, sPS (V2 (0) (2*w-20)) pi PutNothing
, sPS (V2 0 (2*w-20)) pi PutNothing
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
, blockLine (V2 (negate $ w/2) (w/2)) (V2 0 w)
]
, [ sPS (V2 (0) (3*w/2)) 0 putLamp
, sPS (V2 (w-10) (w)) 0 putLamp
, sPS (V2 (10-w) (w-20)) 0 putLamp
, sPS (V2 0 10) 0 putLamp
, sPS (V2 (0) (2*w-20)) pi PutNothing
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
, blockLine (V2 (negate w) (w)) (V2 0 w)
, [ sPS (V2 0 (3*w/2)) 0 putLamp
, sPS (V2 (w-10) w) 0 putLamp
, sPS (V2 (10-w) (w-20) ) 0 putLamp
, sPS (V2 0 10 ) 0 putLamp
, sPS (V2 0 (2*w-20)) pi PutNothing
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
, blockLine (V2 (negate w) w ) (V2 0 w)
]
, [ sPS (V2 (10-w) (w)) 0 putLamp
, sPS (V2 (w-10) (w)) 0 putLamp
, sPS (V2 0 10) 0 putLamp
, sPS (V2 (20) (2*w-40)) pi PutNothing
, [ sPS (V2 (10-w) w ) 0 putLamp
, sPS (V2 (w-10) w ) 0 putLamp
, sPS (V2 0 10 ) 0 putLamp
, sPS (V2 20 (2*w-40)) pi PutNothing
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
, blockLine (V2 0 w) (V2 (0) (w*2))
, blockLine (V2 0 w) (V2 0 (w*2))
]
]
pure $ defaultRoom
{ _rmPolys = [ map toV2 [(0,0),(w,w),(0,2*w),(-w,w)] ]
, _rmLinks =
[((V2 (w/2) (3*w/2)), negate $ pi/4)
,((V2 (negate $ w/2) (3*w/2)), pi/4)
[(V2 (w/2) (3*w/2), negate $ pi/4)
,(V2 (negate $ w/2) (3*w/2), pi/4)
]
, _rmPath = [((V2 0 w),(V2 0 0)),((V2 0 0),(V2 0 w))]
, _rmPath = [(V2 0 w,V2 0 0),(V2 0 0,V2 0 w)]
, _rmPS = b
, _rmBound = [map toV2 [(w,w),(0,2*w),(-w,w)]]
}