145 lines
4.7 KiB
Haskell
145 lines
4.7 KiB
Haskell
module Dodge.Placement.Instance.LightSource where
|
|
import Dodge.Data
|
|
import Dodge.LightSource
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.Room.Foreground
|
|
import Geometry
|
|
--import Geometry.Vector3D
|
|
import Dodge.Creature.Inanimate
|
|
import Shape.Data
|
|
import Dodge.Default
|
|
import Dodge.RandomHelp
|
|
import Color
|
|
import Shape
|
|
|
|
import Control.Lens
|
|
|
|
-- | mount a light source on a shape
|
|
mntLSOn
|
|
:: (Point2 -> Point3 -> Shape) -- ^ function describing the mount shape
|
|
-> Maybe Color -- ^ describing a possible color override for the shape
|
|
-> LightSource -> Point2 -> Point3 -> (Placement -> Maybe Placement) -> Placement
|
|
mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _)
|
|
= ps0jPushPS (PutShape . setCol $ shapeF wallp lsp)
|
|
. pt0 (PutLS $ ls & lsParam . lsPos .~ lsp')
|
|
where
|
|
lsp' = lsp -.-.- V3 x y 1
|
|
-- hack! perturb the light position
|
|
V2 x y = rotateV 1 . (0.1 *.*) . normalizeV $ wallp -.- V2 lx ly
|
|
setCol = maybe id colorSH mcol
|
|
|
|
iShape :: Point2 -> Point3 -> Shape
|
|
iShape wp (V3 x y z) = thinHighBar z wp (V2 x y)
|
|
|
|
lShape :: Point2 -> Point3 -> Shape
|
|
lShape wp (V3 x y z) = thinHighBar z wallposUp turnpos
|
|
<> thinHighBar z turnpos (V2 x y)
|
|
where
|
|
n = vNormal (wp -.- V2 x y)
|
|
wallposUp = wp +.+ n
|
|
turnpos = V2 x y +.+ n
|
|
|
|
jShape :: Point2 -> Point3 -> Shape
|
|
jShape wallpos (V3 x y z) = thinHighBar z wallposUp turn1
|
|
<> thinHighBar z turn1 turn2
|
|
<> thinHighBar z turn2 endpos
|
|
where
|
|
n = vNormal (wallpos -.- V2 x y)
|
|
wallposUp = wallpos +.+ n
|
|
turnpos = V2 x y +.+ n
|
|
endpos = V2 x y
|
|
turn1 = 0.5 *.* (wallposUp +.+ turnpos)
|
|
turn2 = 0.5 *.* (turnpos +.+ endpos)
|
|
|
|
liShape :: Point2 -> Point3 -> Shape
|
|
liShape wallpos (V3 x y z) =
|
|
thinHighBar z wallposUp turnpos
|
|
<> thinHighBar z turnpos (V2 x y)
|
|
where
|
|
n = vNormal (V2 x y -.- wallpos)
|
|
wallposUp = wallpos +.+ n
|
|
turnpos = V2 x y +.+ n
|
|
|
|
aShape :: Point2 -> Point3 -> Shape
|
|
aShape wallpos (V3 x y z) =
|
|
girder (z+2) 20 10 pout wallpos
|
|
where
|
|
pout = V2 x y -.- 2 *.* squashNormalizeV (V2 x y -.- wallpos)
|
|
|
|
vShape :: Point2 -> Point3 -> Shape
|
|
vShape wallpos (V3 x y z) =
|
|
thinHighBar z wallposUp lxy
|
|
<> thinHighBar z wallposDown lxy
|
|
where
|
|
lxy = V2 x y
|
|
n = vNormal (wallpos -.- lxy)
|
|
wallposUp = wallpos +.+ n
|
|
wallposDown = wallpos -.- n
|
|
|
|
mntLS :: (Point2 -> Point3 -> Shape) -> Point2 -> Point3 -> Placement
|
|
mntLS shp wallp lampp = mntLSOn shp Nothing defaultLS wallp lampp (const Nothing)
|
|
|
|
mntLSCol :: (Point2 -> Point3 -> Shape) -> Color -> Point2 -> Point3 -> Placement
|
|
mntLSCol shp col wallp lampp = mntLSOn shp (Just col) defaultLS wallp lampp (const Nothing)
|
|
|
|
mntLSLampCol :: (Point2 -> Point3 -> Shape) -> Color -> Point2 -> Point3 -> Placement
|
|
mntLSLampCol shp (V4 x y z _) wallp lampp = mntLSOn shp Nothing (defaultLS & lsParam . lsCol .~ col)
|
|
wallp lampp (const Nothing)
|
|
where
|
|
col = V3 x y z
|
|
|
|
mntLSCond :: (Point2 -> Point3 -> Shape)
|
|
-> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
|
|
-> Placement
|
|
mntLSCond shp shift = -- updatePSToLevel 1 (const $ PSLnk shift (const id) Nothing) $
|
|
mntLS shp 0 (V3 0 (-40) 90)
|
|
& plSpot .~ PSPos shift (const id) Nothing
|
|
-- note that this perhaps pushes the vshape light out too far
|
|
|
|
mntLight :: Point2 -> Point2 -> Placement
|
|
mntLight a b = RandomPlacement $ do
|
|
shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
|
|
return $ mntLS shp a (addZ 90 b)
|
|
|
|
mntLightLnkCond :: (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
|
|
-> Placement
|
|
mntLightLnkCond f = RandomPlacement $ do
|
|
shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
|
|
return $ mntLSCond shp f
|
|
|
|
unusedLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
|
|
unusedLnkToPS rp _ = case rp of
|
|
UnusedLink p a -> Just (PS p a,UsedSpot p a)
|
|
_ -> Nothing
|
|
|
|
spanLSLightI :: LightSource -> Float -> Point2 -> Point2 -> Placement
|
|
spanLSLightI ls h a b = ps0j (PutLS $ ls & lsParam . lsPos .~ V3 x y h)
|
|
$ sps0 $ PutShape $ thinHighBar h a b
|
|
where
|
|
V2 x y = 0.5 *.* (a +.+ b)
|
|
|
|
spanLS :: LightSource -> Point2 -> Point2 -> Placement
|
|
spanLS ls a b = Placement (PS (V2 x y) 0) (PutLS ls) Nothing
|
|
$ const $ Just $ sps0 $ PutShape $ thinHighBar h a b
|
|
where
|
|
V3 _ _ h = _lsPos (_lsParam ls) + 5
|
|
V2 x y = 0.5 *.* (a +.+ b)
|
|
|
|
spanColLightI :: Point3 -> Float -> Point2 -> Point2 -> Placement
|
|
spanColLightI col h a b = ps0j (PutLS $ lsColPos col (V3 x y (h-5)))
|
|
$ sps0 $ PutShape $ thinHighBar h a b
|
|
where
|
|
V2 x y = 0.5 *.* (a +.+ b)
|
|
|
|
spanLightI :: Point2 -> Point2 -> Placement
|
|
spanLightI = spanColLightI 0.75 50
|
|
|
|
extendAway :: Point2 -> Point2 -> Point2
|
|
extendAway p x = p +.+ squashNormalizeV (p -.- x)
|
|
|
|
putColorLamp :: Point3 -> PSType
|
|
putColorLamp col = PutCrit (colorLamp col 90)
|
|
|
|
putLamp :: PSType
|
|
putLamp = PutCrit (lamp 90)
|