138 lines
4.8 KiB
Haskell
138 lines
4.8 KiB
Haskell
module Dodge.Placements.LightSource
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.LightSources.Lamp
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.Room.Foreground
|
|
import Dodge.Placements.Spot
|
|
import Geometry
|
|
import Dodge.Creature.Inanimate
|
|
import Shape.Data
|
|
import Dodge.Default
|
|
import Dodge.RandomHelp
|
|
import Color
|
|
import Shape
|
|
|
|
mountLightOnShape
|
|
:: (Point2 -> Point3 -> Shape) -- ^ function describing the mount shape
|
|
-> Maybe Color -- ^ describing a possible color override for the shape
|
|
-> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
|
|
mountLightOnShape shapeF mcol ls wallp lsp = ps0j (PutForeground . setCol $ shapeF wallp lsp)
|
|
. ps0 (PutLS $ ls {_lsPos = lsp})
|
|
where
|
|
setCol = case mcol of
|
|
Just col -> colorSH col
|
|
Nothing -> id
|
|
|
|
mountLightID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
|
|
mountLightID = mountLightOnShape f
|
|
where
|
|
f wp (V3 x y z) = thinHighBar (z+5) wp pout
|
|
where
|
|
pout = V2 x y +.+ safeNormalizeV (V2 x y -.- wp)
|
|
|
|
redMID :: (Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement)
|
|
-> Point2 -> Point3 -> Placement
|
|
redMID f wallp lampp = f Nothing defaultLS wallp lampp (const Nothing)
|
|
|
|
mountLight :: Point2 -> Point3 -> Placement
|
|
mountLight = redMID mountLightID
|
|
|
|
mountLightLID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
|
|
mountLightLID = mountLightOnShape f
|
|
where
|
|
f wallpos (V3 x y z) = thinHighBar (z + 5) wallposUp (turnpos `extendAway` wallposUp)
|
|
<> thinHighBar (z + 5) turnpos (V2 x y `extendAway` turnpos)
|
|
where
|
|
n = vNormal (wallpos -.- V2 x y)
|
|
wallposUp = wallpos +.+ n
|
|
turnpos = V2 x y +.+ n
|
|
|
|
mountLightL :: Point2 -> Point3 -> Placement
|
|
mountLightL = redMID mountLightLID
|
|
|
|
mountLightJID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
|
|
mountLightJID = mountLightOnShape f
|
|
where
|
|
f wallpos (V3 x y z) = thinHighBar (z + 5) wallposUp turn1
|
|
<> thinHighBar (z + 5) turn1 turn2
|
|
<> thinHighBar (z + 5) turn2 (endpos `extendAway` turn2)
|
|
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)
|
|
|
|
mountLightJ :: Point2 -> Point3 -> Placement
|
|
mountLightJ = redMID mountLightJID
|
|
|
|
mountLightlID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
|
|
mountLightlID = mountLightOnShape f
|
|
where
|
|
f wallpos (V3 x y z) = thinHighBar (z + 5) wallposUp (turnpos `extendAway` wallposUp)
|
|
<> thinHighBar (z + 5) turnpos (V2 x y `extendAway` turnpos)
|
|
where
|
|
n = vNormal (V2 x y -.- wallpos)
|
|
wallposUp = wallpos +.+ n
|
|
turnpos = V2 x y +.+ n
|
|
|
|
mountLightll :: Point2 -> Point3 -> Placement
|
|
mountLightll = redMID mountLightlID
|
|
|
|
mountLightAID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
|
|
mountLightAID = mountLightOnShape f
|
|
where
|
|
f wallpos (V3 x y z) = girder (z+10) 20 10 pout wallpos
|
|
where
|
|
pout = V2 x y -.- 2 *.* safeNormalizeV (V2 x y -.- wallpos)
|
|
|
|
mountLightA :: Point2 -> Point3 -> Placement
|
|
mountLightA = redMID mountLightAID
|
|
|
|
mountLightACond :: ((Point2,Float) -> Bool) -> Placement
|
|
mountLightACond f = updatePSToLevel 2 (const thePS) $ mountLightA 0 (V3 0 (-40) 40)
|
|
where
|
|
thePS = PSLnk f (\(p,a)->(p,a))
|
|
|
|
mountLightVCond :: ((Point2,Float) -> Bool) -> Placement
|
|
mountLightVCond f = updatePSToLevel 2 (const thePS) $ mountLightV 0 (V3 0 (-20) 40)
|
|
where
|
|
thePS = PSLnk f id
|
|
|
|
mntLightCond :: ((Point2,Float) -> Bool) -> Placement
|
|
mntLightCond f = RandomPlacement $ takeOne [mountLightVCond f,mountLightACond f]
|
|
|
|
mountLightVID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
|
|
mountLightVID = mountLightOnShape f
|
|
where
|
|
f wallpos (V3 x y z) = thinHighBar (z + 5) wallposUp (lxy `extendAway` wallposUp)
|
|
<> thinHighBar (z + 5) wallposDown (lxy `extendAway` wallposDown)
|
|
where
|
|
lxy = V2 x y
|
|
n = vNormal (wallpos -.- lxy)
|
|
wallposUp = wallpos +.+ n
|
|
wallposDown = wallpos -.- n
|
|
|
|
mountLightV :: Point2 -> Point3 -> Placement
|
|
mountLightV = redMID mountLightVID
|
|
|
|
spanColLightI :: Point3 -> Float -> Point2 -> Point2 -> Placement
|
|
spanColLightI col h a b = ps0j (PutLS $ colorLightAt col (V3 x y h) 0)
|
|
$ sps0 $ PutForeground $ highPipe (h + 5) a b
|
|
where
|
|
V2 x y = 0.5 *.* (a +.+ b)
|
|
|
|
spanLightI :: Float -> Point2 -> Point2 -> Placement
|
|
spanLightI = spanColLightI 0.75
|
|
|
|
extendAway :: Point2 -> Point2 -> Point2
|
|
extendAway p x = p +.+ safeNormalizeV (p -.- x)
|
|
|
|
putColorLamp :: Point3 -> PSType
|
|
putColorLamp col = PutCrit (colorLamp col 90)
|
|
|
|
putLamp :: PSType
|
|
putLamp = PutCrit (lamp 90)
|