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

Move main to allow for new executables

Browse Source
This commit is contained in:
justin
2021-08-11 17:54:48 +02:00
parent b74bb45a4c
commit 4bbe5d0cf1
64 changed files with 521 additions and 345 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Procedural.hs
+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)]]
}