justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Commit before making all walls zoned

Browse Source
This commit is contained in:
justin
2021-09-30 13:36:07 +01:00
parent d7f975d40e
commit eb393708c4
7 changed files with 34 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/LightSources/Fitting.hs
+15 -1
View File
@@ -22,6 +22,20 @@ wallMountL wallpos lamppos@(V3 x y z)
wallposUp = wallpos +.+ n
turnpos = V2 x y +.+ n
wallMountJ :: Point2 -> Point3 -> Placement
wallMountJ wallpos lamppos@(V3 x y z)
= place0 (PutLS $ colorLightAt 0.75 lamppos 0)
$ \_ -> jsps0 $ PutForeground $ highBar (z + 5) wallposUp turn1
<> highBar (z + 5) turn1 turn2
<> highBar (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)
= place0 (PutLS $ colorLightAt 0.75 lamppos 0)
@@ -57,4 +71,4 @@ jsps0 :: PSType -> Maybe Placement
jsps0 pst = Just $ sPS (V2 0 0) 0 pst
place0 :: PSType -> (Int -> Maybe Placement) -> Placement
place0 pst plm = Placement (PS (V2 0 0) 0 pst) plm
place0 pst = Placement (PS (V2 0 0) 0 pst)