From c0480f0ad60f7d7ce493904f1c7bf3a0ecca9f91 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 26 Sep 2021 15:21:32 +0100 Subject: [PATCH] Tweak pipes and girders --- src/Dodge/Creature/Inanimate.hs | 9 ++++----- src/Dodge/LevelGen.hs | 4 +++- src/Dodge/LightSources.hs | 5 +++++ src/Dodge/Room/Corridor.hs | 9 +++++++-- src/Dodge/Room/Foreground.hs | 32 ++++++++++++++++++++------------ 5 files changed, 39 insertions(+), 20 deletions(-) diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 1bf151368..2f4c13b3a 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -37,7 +37,7 @@ colorLamp colorLamp col h = defaultInanimate { _crUpdate = initialiseColorLamp col h , _crHP = 100 - , _crPict = picAtCrPosNoRot (lampPic h) + , _crPict = picAtCrPosNoRot (lampCrPic h) , _crRad = 3 , _crMass = 3 } @@ -46,14 +46,13 @@ lamp :: Float -> Creature lamp h = defaultInanimate { _crUpdate = initialiseLamp h , _crHP = 100 - , _crPict = picAtCrPosNoRot (lampPic h) + , _crPict = picAtCrPosNoRot (lampCrPic h) , _crRad = 3 , _crMass = 3 } -- it is not clear that any of the attempts with Foldl help at all here -lampPic :: Float -> Picture ---{-# INLINE lampPic #-} -lampPic h = pictures +lampCrPic :: Float -> Picture +lampCrPic h = pictures [ setLayer 1 (setDepth h . color white $ circleSolid 3) , concatMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1) ] diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 1506cffd4..883bee70f 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -19,6 +19,7 @@ import Dodge.LevelGen.TriggerDoor import Dodge.LevelGen.Switch import Dodge.LevelGen.Data import Geometry +import Geometry.Vector3D import Shape --import Geometry.Data import Picture @@ -199,9 +200,10 @@ placeCr crF p rot = over creatures addCr placeLS :: LightSource -> Picture -> Point3 -> Float -> World -> World placeLS ls dec (V3 x y z) rot w = over lightSources addLS $ over decorations addDec w where + startPos = _lsPos ls addLS lss = IM.insert (IM.newKey lss) - (ls {_lsPos = V3 x y z,_lsDir = rot,_lsID = IM.newKey lss}) + (ls {_lsPos = V3 x y z +.+.+ startPos,_lsDir = rot,_lsID = IM.newKey lss}) lss addDec decs = IM.insert (IM.newKey decs) diff --git a/src/Dodge/LightSources.hs b/src/Dodge/LightSources.hs index f030a0a6b..37be32be6 100644 --- a/src/Dodge/LightSources.hs +++ b/src/Dodge/LightSources.hs @@ -3,10 +3,12 @@ module Dodge.LightSources , tLight , lightAt , colorLightAt + , lampPic ) where import Dodge.Data import Geometry.Data +import Picture import Control.Lens @@ -57,3 +59,6 @@ tLight t rmax col (V3 x y z) = TLS | otherwise = Just $ tls & tlsTime -~ 1 +lampPic :: Float -> Picture +--{-# INLINE lampPic #-} +lampPic h = setLayer 1 (setDepth h . color white $ circleSolid 3) diff --git a/src/Dodge/Room/Corridor.hs b/src/Dodge/Room/Corridor.hs index 875eb3b5c..fcebb2e4c 100644 --- a/src/Dodge/Room/Corridor.hs +++ b/src/Dodge/Room/Corridor.hs @@ -1,9 +1,11 @@ module Dodge.Room.Corridor where import Dodge.Room.Data +import Dodge.Room.Foreground import Dodge.Default.Room +import Dodge.LevelGen.Data +import Dodge.LightSources import Geometry ---import Geometry.Data import Tile import Data.Bifunctor @@ -14,7 +16,10 @@ corridor = defaultRoom { _rmPolys = [poly] , _rmLinks = lnks , _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks - , _rmPS = [] + , _rmPS = + [ sPS (V2 20 40) 0 $ PutLS (lightAt (V3 0 0 50) 0) (lampPic 50) + , sPS (V2 0 0) 0 $ PutForeground $ highPipe 55 (V2 0 40) (V2 40 40) + ] , _rmBound = [ rectNSWE 50 30 0 40 ] , _rmFloor = [makeTileFromPoly poly 2] } diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs index ab618ed75..3ffa8ff02 100644 --- a/src/Dodge/Room/Foreground.hs +++ b/src/Dodge/Room/Foreground.hs @@ -6,7 +6,7 @@ module Dodge.Room.Foreground import Picture import Geometry --import Geometry.Data ---import Geometry.Vector3D +import Geometry.Vector3D import Shape import Data.List @@ -47,22 +47,30 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints ] yN = d * 0.5 *.* normalizeV (pa -.- pb) -highPipe :: Float -> Point2 -> Point2 -> Shape -highPipe h x y = translateSHz h $ colorSH orange $ upperPrismPoly 5 +highBar :: Float -> Point2 -> Point2 -> Shape +highBar h x y = translateSHz h $ colorSH orange $ upperPrismPoly 5 [x +.+ n, y +.+ n, y -.- n, x -.- n] where n = 2.5 *.* normalizeV (vNormal (y -.- x)) +highPipe :: Float -> Point2 -> Point2 -> Shape +highPipe h x y = colorSH orange $ prismPoly + (map (addZ (h + 5)) [x +.+ n2, y +.+ n2, y -.- n2, x -.- n2]) + (map (addZ h) [x +.+ n, y +.+ n, y -.- n, x -.- n] ) + where + n2 = 1.25 *.* normalizeV (vNormal (y -.- x)) + n = 2.5 *.* normalizeV (vNormal (y -.- x)) + girderZ :: Float -- ^ height -> Float -- ^ distance between cross bars -> Float -- ^ width -> Point2 -> Point2 -> Shape girderZ h d w x y = colorSH red $ mconcat $ - [ highPipe h xt yt - , highPipe h xb yb + [ highBar h xt yt + , highBar h xb yb ] - <> zipWith (highPipe (h- 5)) ps qs + <> zipWith (highBar (h- 5)) ps qs where n = w *.* normalizeV (vNormal $ y -.- x) xb = x +.+ n @@ -78,10 +86,10 @@ girderV -> Float -- ^ width -> Point2 -> Point2 -> Shape girderV h d w x y = colorSH red $ mconcat $ - [ highPipe h xt yt - , highPipe h xb yb + [ highBar h xt yt + , highBar h xb yb ] - <> zipWith (highPipe (h- 5)) ps qs + <> zipWith (highBar (h- 5)) ps qs where n = w *.* normalizeV (vNormal $ y -.- x) xb = x +.+ n @@ -101,10 +109,10 @@ girder -> Float -- ^ width -> Point2 -> Point2 -> Shape girder h d w x y = colorSH red $ mconcat $ - [ highPipe h xt yt - , highPipe h xb yb + [ highBar h xt yt + , highBar h xb yb ] - <> zipWith (highPipe (h- 5)) ps qs + <> zipWith (highBar (h- 5)) ps qs where n = w *.* normalizeV (vNormal $ y -.- x) xb = x +.+ n