121 lines
3.0 KiB
Haskell
121 lines
3.0 KiB
Haskell
-- | Module defining helper placements for rooms.
|
|
module Dodge.Room.Placement
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.Room.Data
|
|
import Dodge.Creature.Inanimate
|
|
import Picture
|
|
import Geometry
|
|
|
|
import Data.List
|
|
import Control.Lens
|
|
|
|
|
|
putLamp = PutCrit lamp
|
|
|
|
singleBlock :: Point2 -> [PlacementSpot]
|
|
singleBlock a = [PS a 0 $ PutBlock [5,20,20] (greyN 0.5)
|
|
$ reverse $ rectNSWE 10 (-10) (-10) 10]
|
|
{-
|
|
Places a line of blocks between two points.
|
|
Width 9, also extends out from each point by 9.
|
|
-}
|
|
blockLine :: Point2 -> Point2 -> PlacementSpot
|
|
blockLine a b = PS
|
|
{ _psPos = (0,0)
|
|
, _psRot = 0
|
|
, _psType = PutLineBlock baseBlockPane 9 9 a b
|
|
}
|
|
|
|
{-
|
|
Places an breakable window between two points.
|
|
Width 8, also extends out from each point by 8.
|
|
-}
|
|
windowLine :: Point2 -> Point2 -> PlacementSpot
|
|
windowLine a b = PS
|
|
{ _psPos = (0,0)
|
|
, _psRot = 0
|
|
, _psType = PutLineBlock baseWindowPane 8 8 a b
|
|
}
|
|
|
|
{-
|
|
Places an unbreakable window between two points.
|
|
Width 7, also extends out from each point by 7.
|
|
-}
|
|
crystalLine :: Point2 -> Point2 -> PlacementSpot
|
|
crystalLine a b = PS
|
|
{ _psPos = (0,0)
|
|
, _psRot = 0
|
|
, _psType = PutWindow ps $ withAlpha 0.5 aquamarine
|
|
}
|
|
where
|
|
ps =
|
|
[ a +.+ left +.+ up
|
|
, (a +.+ left) -.- up
|
|
, (b -.- left) -.- up
|
|
, (b -.- left) +.+ up
|
|
]
|
|
left = 7 *.* normalizeV (a-.-b)
|
|
up = vNormal left
|
|
|
|
windowLineType :: Point2 -> Point2 -> PSType
|
|
windowLineType a b = PutLineBlock baseWindowPane 8 8 a b
|
|
|
|
baseBlockPane :: Wall
|
|
baseBlockPane = Block
|
|
{ _wlLine = []
|
|
, _wlID = 0
|
|
, _wlColor = greyN 0.5
|
|
, _wlDraw = Nothing
|
|
, _wlSeen = False
|
|
, _blIDs = []
|
|
, _blHP = 5
|
|
, _wlIsSeeThrough = False
|
|
, _blVisible = True
|
|
, _blShadows = []
|
|
, _blDegrades = [20,20]
|
|
}
|
|
baseWindowPane :: Wall
|
|
baseWindowPane = Block
|
|
{ _wlLine = []
|
|
, _wlID = 0
|
|
, _wlColor = withAlpha 0.2 cyan
|
|
, _wlDraw = Nothing
|
|
, _wlSeen = False
|
|
, _blIDs = []
|
|
, _blHP = 1
|
|
, _wlIsSeeThrough = True
|
|
, _blVisible = True
|
|
, _blShadows = []
|
|
, _blDegrades = [5,5]
|
|
}
|
|
|
|
{-
|
|
Replaces instances of a given 'PutID' with 'PSType's drawn from a list.
|
|
-}
|
|
replacePutID
|
|
:: Int -- ^ The id of 'PutID' to be replaced
|
|
-> [PSType] -- ^ List of replacements
|
|
-> Room
|
|
-> Room
|
|
replacePutID i psts r =
|
|
r & rmPS %~ flip (subZipWith (isPutID i) (\ps pt -> ps & psType .~ pt)) psts
|
|
|
|
{-
|
|
Partition a list by a predicate, apply a zip to those elements
|
|
that satisfy the predicate, concatenate
|
|
the new zipped list and the other (unchanged) half.
|
|
-}
|
|
subZipWith
|
|
:: (a -> Bool) -- ^ Filter: elements to apply zip to
|
|
-> (a -> b -> a) -- ^ Combining function
|
|
-> [a] -- ^ List to be partition
|
|
-> [b] -- ^ Modifying list
|
|
-> [a]
|
|
subZipWith f g xs ys =
|
|
let (zs,ws) = partition f xs
|
|
in zipWith g zs ys ++ ws
|
|
|
|
isPutID i ps = Just i == ps ^? psType . putID
|