81 lines
2.9 KiB
Haskell
81 lines
2.9 KiB
Haskell
module Dodge.LightSources.Fitting
|
|
where
|
|
import Dodge.LightSources.Lamp
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.Room.Foreground
|
|
import Geometry
|
|
|
|
mountedLight :: Point2 -> Point3 -> Placement
|
|
mountedLight wallPos lampPos@(V3 x y z)
|
|
= ps0j (PutForeground $ thinHighBar (z+5) wallPos pout)
|
|
$ sps0 $ PutLS (colorLightAt 0.75 lampPos 0)
|
|
where
|
|
pout = V2 x y +.+ safeNormalizeV (V2 x y -.- wallPos)
|
|
|
|
mountLightL :: Point2 -> Point3 -> Placement
|
|
mountLightL wallpos lamppos@(V3 x y z)
|
|
= ps0j (PutLS $ colorLightAt 0.75 lamppos 0)
|
|
$ sps0 $ PutForeground $ 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
|
|
|
|
mountedLightJ :: Point2 -> Point3 -> Placement
|
|
mountedLightJ wallpos lamppos@(V3 x y z)
|
|
= ps0 (PutLS $ colorLightAt 0.75 lamppos 0)
|
|
$ \_ -> jsps0 $ PutForeground $ thinHighBar (z + 5) wallposUp turn1
|
|
<> thinHighBar (z + 5) turn1 turn2
|
|
<> thinHighBar (z + 5) turn2 (endpos `extendAway` turn2)
|
|
where
|
|
n = vNormal (wallpos -.- endpos)
|
|
wallposUp = wallpos +.+ n
|
|
endpos = V2 x y
|
|
turnpos = endpos +.+ n
|
|
turn1 = 0.5 *.* (wallposUp +.+ turnpos)
|
|
turn2 = 0.5 *.* (turnpos +.+ endpos)
|
|
|
|
wallMountl :: Point2 -> Point3 -> Placement
|
|
wallMountl wallpos lamppos@(V3 x y z)
|
|
= ps0 (PutLS $ colorLightAt 0.75 lamppos 0)
|
|
$ \_ -> jsps0 $ PutForeground $ 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
|
|
|
|
mountLightA :: Point2 -> Point3 -> Placement
|
|
mountLightA wallpos lamppos@(V3 x y z)
|
|
= ps0 (PutLS $ colorLightAt 0.75 lamppos 0)
|
|
$ \_ -> jsps0 $ PutForeground $ girder (z+10) 20 10 pout wallpos
|
|
where
|
|
pout = V2 x y -.- 2 *.* safeNormalizeV (V2 x y -.- wallpos)
|
|
|
|
mountColLightI :: Point3 -> Float -> Point2 -> Point2 -> Placement
|
|
mountColLightI 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)
|
|
|
|
mountedLightI :: Float -> Point2 -> Point2 -> Placement
|
|
mountedLightI h a b = ps0j (PutLS $ lightAt (V3 x y h) 0)
|
|
$ sps0 $ PutForeground $ highPipe (h + 5) a b
|
|
where
|
|
V2 x y = 0.5 *.* (a +.+ b)
|
|
|
|
mountedLightV :: Point2 -> Point3 -> Placement
|
|
mountedLightV wallpos lamppos@(V3 x y z)
|
|
= ps0 (PutLS $ colorLightAt 0.75 lamppos 0)
|
|
$ \_ -> jsps0 $ PutForeground $ 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
|
|
|
|
extendAway :: Point2 -> Point2 -> Point2
|
|
extendAway p x = p +.+ safeNormalizeV (p -.- x)
|