Further add information to room positions
This commit is contained in:
@@ -50,8 +50,9 @@ roomRect x y xn yn = defaultRoom
|
||||
, _rmName = "rect"
|
||||
, _rmPath = concatMap doublePair pth
|
||||
--, _rmPos = map (roomposat (RoomPosOnPath S.empty)) posps
|
||||
, _rmPos = map (makeonpos) posps'
|
||||
++ map (roomposat (RoomPosOffPath S.empty)) interposps
|
||||
-- ++ map (roomposat (RoomPosOffPath S.empty)) interposps
|
||||
, _rmPos = map makeonpos posps'
|
||||
++ map makeoffpos interposps'
|
||||
, _rmPmnts = []
|
||||
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
|
||||
, _rmFloor = Tiled [Tile
|
||||
@@ -90,12 +91,20 @@ roomRect x y xn yn = defaultRoom
|
||||
makerpedges (a,b) = S.fromList
|
||||
[PathFromEdge South b
|
||||
,PathFromEdge North (yn-b)
|
||||
,PathFromEdge East (yn-a)
|
||||
,PathFromEdge East (xn-a)
|
||||
,PathFromEdge West a
|
||||
]
|
||||
posps' = map (over _1 (+.+ V2 20 20)) $ gridPoints'' xd (xn+1) yd (xn+1)
|
||||
interposps' = map (over _1 (+.+ V2 (20 + xd/2) (20 + yd/2))) $ gridPoints'' xd xn yd yn
|
||||
posps = map (+.+ V2 20 20) $ gridPoints xd (xn+1) yd (yn+1)
|
||||
interposps = map (+.+ V2 (20 + xd/2) (20 + yd/2)) $ gridPoints xd xn yd yn
|
||||
makeoffpos (p,a) = RoomPos p 0 (S.singleton $ RoomPosOffPath $ makerpedges' a) NotLink 0
|
||||
makerpedges' (a,b) = S.fromList
|
||||
[PathFromEdge South b
|
||||
,PathFromEdge North (yn-(b+1))
|
||||
,PathFromEdge East (xn-(a+1))
|
||||
,PathFromEdge West a
|
||||
]
|
||||
|
||||
zipCountDown :: [a] -> [(Int,a)]
|
||||
zipCountDown xs = zip [length xs - 1, length xs - 2 ..] xs
|
||||
|
||||
Reference in New Issue
Block a user