From d46de1ca8063ebf7c8fba71e8b14452ca520371f Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 5 Oct 2021 22:57:54 +0100 Subject: [PATCH] Add tank furniture, stop autorotate when aiming --- src/Dodge/Data.hs | 14 ++--- src/Dodge/Default/Wall.hs | 20 ++++++- src/Dodge/Floor.hs | 4 +- src/Dodge/Item/Weapon.hs | 6 +- src/Dodge/LevelGen/Block.hs | 2 + src/Dodge/LevelGen/TriggerDoor.hs | 5 +- src/Dodge/LightSources/Fitting.hs | 26 +++++---- src/Dodge/Render/Picture.hs | 2 +- src/Dodge/Room/Boss.hs | 11 ++-- src/Dodge/Room/Foreground.hs | 16 +++++ src/Dodge/Room/Furniture.hs | 97 +++++++++++++++++++++++++++++++ src/Dodge/Room/Placement.hs | 6 +- src/Dodge/Room/Procedural.hs | 2 +- src/Dodge/Room/RoadBlock.hs | 1 + src/Dodge/Room/Start.hs | 11 ++-- src/Dodge/Room/Treasure.hs | 5 +- src/Dodge/Update.hs | 6 +- 17 files changed, 186 insertions(+), 48 deletions(-) create mode 100644 src/Dodge/Room/Furniture.hs diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 3b5b78794..42396a3c6 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -554,16 +554,8 @@ data Wall , _wlSeen :: Bool , _wlIsSeeThrough :: Bool , _wlPathable :: Bool - } - | BlockAutoDoor - { _wlLine :: (Point2,Point2) - , _wlID :: Int - , _doorMech :: World -> World - , _wlColor :: Color - , _wlSeen :: Bool - , _blIDs :: [Int] - , _blHP :: Int - , _wlIsSeeThrough :: Bool + , _wlDraw :: Bool + , _wlRotateTo :: Bool } | Block { _wlLine :: (Point2,Point2) @@ -576,6 +568,8 @@ data Wall , _blVisible :: Bool , _blDegrades :: [Int] , _blShadows :: [Int] + , _wlDraw :: Bool + , _wlRotateTo :: Bool } data ForceField = FF { _ffLine :: [Point2] , _ffID :: Int diff --git a/src/Dodge/Default/Wall.hs b/src/Dodge/Default/Wall.hs index c4e92ee17..833035adb 100644 --- a/src/Dodge/Default/Wall.hs +++ b/src/Dodge/Default/Wall.hs @@ -12,10 +12,28 @@ defaultWall = Wall , _wlSeen = False , _wlIsSeeThrough = False , _wlPathable = False + , _wlDraw = True + , _wlRotateTo = True } +defaultBlock :: Wall +defaultBlock = Block + { _wlLine = (V2 0 0,V2 50 0) + , _wlID = 0 + , _wlColor = greyN 0.5 + , _wlSeen = False + , _blIDs = [] + , _blHP = 5 + , _wlIsSeeThrough = False + , _blVisible = True + , _blShadows = [] + , _blDegrades = [20,20] + , _wlDraw = True + , _wlRotateTo = True + } + {- Indestructible see-through wall. -} defaultCrystalWall :: Wall -defaultCrystalWall = Wall +defaultCrystalWall = defaultWall { _wlLine = (V2 0 0,V2 50 0) , _wlID = 0 , _wlColor = withAlpha 0.5 aquamarine diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index a811b47b1..94163ae27 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -81,8 +81,8 @@ initialRoomTree = do --- ,[DoorNumAno 0,AirlockAno]] --- ] --- ,[FirstWeapon] - ,[CorridorDebug] - ,[SpecificRoom $ fmap (pure . Right) randomFourCornerRoom] +--- ,[CorridorDebug] +--- ,[SpecificRoom $ fmap (pure . Right) randomFourCornerRoom] ,[Corridor] ,[OrAno [[SpecificRoom $ branchRectWith $ fmap (fmap Left) armouredChasers] diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 05679bd9c..7f6e9371c 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -430,12 +430,10 @@ miniGun = defaultAutoGun miniGunPictItem :: Item -> SPic miniGunPictItem it = miniGunPict spin (loadedAmmo it) where - spin = 10 * _wpLoadedAmmo it + _wpCurWarmUp it - + spin = (-10) * _wpLoadedAmmo it + _wpCurWarmUp it miniGunPict :: Int -> Int -> SPic miniGunPict spin am = - --( ( rotateSHx a .translateSH (V3 5 0 (-9)) . colorSH red $ upperPrismPoly 18 $ rectNESW 9 7 (-9) (-5)) ( colorSH red (rotateSHx a barrels) <> colorSH red (upperPrismPoly 5 $ rectNESW 8 8 (-8) 4) <> colorSH red (prismPoly @@ -452,7 +450,7 @@ miniGunPict spin am = (map (addZ 0) $ rectNESW 4 12 (-4) (-5)) barrels = concatMap (\an -> aBarrel & rotateSHx an) [0,0.5* pi, pi, 1.5*pi] a = fromIntegral spin / 100 - x = fromIntegral am / 20 + x = fromIntegral am / 10 clip y z = translateSH (V3 0 (-1) z) (rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW (negate $ 3 + 0.25 * x) y 3 (y-5)) diff --git a/src/Dodge/LevelGen/Block.hs b/src/Dodge/LevelGen/Block.hs index 2f2b5f5f6..c46f302e7 100644 --- a/src/Dodge/LevelGen/Block.hs +++ b/src/Dodge/LevelGen/Block.hs @@ -122,6 +122,8 @@ addBlock (p:ps) hp col isSeeThrough degradability w , _blVisible = True , _blShadows = [] , _blDegrades = degradability + , _wlDraw = True + , _wlRotateTo = True } ) is lns wallInZone wl diff --git a/src/Dodge/LevelGen/TriggerDoor.hs b/src/Dodge/LevelGen/TriggerDoor.hs index 7a3c82189..7a6cde1d3 100644 --- a/src/Dodge/LevelGen/TriggerDoor.hs +++ b/src/Dodge/LevelGen/TriggerDoor.hs @@ -8,6 +8,7 @@ module Dodge.LevelGen.TriggerDoor import Dodge.Data import Dodge.Base import Dodge.Zone +import Dodge.Default.Wall import Dodge.LevelGen.Switch import Dodge.LevelGen.Pathing import Dodge.LevelGen.MoveDoor @@ -66,7 +67,7 @@ putDoor col cond pss w = (drid, addWalls w & doors %~ addDoor) wlids = take 4 [IM.newKey $ _walls w ..] wlps' = uncurry (rectanglePairs 9) $ head pss addWalls w' = foldl' addWall w' $ zip wlids wlps' - addWall w' (wlid, wlps) = w' & walls %~ IM.insert wlid Wall + addWall w' (wlid, wlps) = w' & walls %~ IM.insert wlid defaultWall { _wlLine = wlps , _wlID = wlid , _wlColor = col @@ -142,7 +143,7 @@ putSingleDoor isPathable col cond a b speed w = (drid, addWalls w , _drMech = doorMechanism drid speed (zip3 wlids shiftedPairs pairs) } addWalls w' = foldl' addWall w' $ zip wlids pairs - addWall w' (wlid, wlps) = w' & walls %~ IM.insert wlid Wall + addWall w' (wlid, wlps) = w' & walls %~ IM.insert wlid defaultWall { _wlLine = wlps , _wlID = wlid , _wlColor = col diff --git a/src/Dodge/LightSources/Fitting.hs b/src/Dodge/LightSources/Fitting.hs index 68d5ad558..e6e20946a 100644 --- a/src/Dodge/LightSources/Fitting.hs +++ b/src/Dodge/LightSources/Fitting.hs @@ -7,23 +7,23 @@ import Geometry mountedLight :: Point2 -> Point3 -> Placement mountedLight wallPos lampPos@(V3 x y z) - = Placement (PS (V2 0 0) 0 $ PutForeground $ thinHighBar (z+5) wallPos pout) - $ \_ -> Just $ sPS (V2 0 0) 0 $ PutLS (colorLightAt 0.75 lampPos 0) + = ps0j (PutForeground $ thinHighBar (z+5) wallPos pout) + $ sps0 $ PutLS (colorLightAt 0.75 lampPos 0) where pout = V2 x y +.+ safeNormalizeV (V2 x y -.- wallPos) -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) +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 -wallMountJ :: Point2 -> Point3 -> Placement -wallMountJ wallpos lamppos@(V3 x y z) +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 @@ -46,13 +46,19 @@ wallMountl wallpos lamppos@(V3 x y z) wallposUp = wallpos +.+ n turnpos = V2 x y +.+ n -wallMountA :: Point2 -> Point3 -> Placement -wallMountA wallpos lamppos@(V3 x y z) +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 diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 1c9d33574..7e3b9bd33 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -259,7 +259,7 @@ wallsAndWindows w = (map f wls, map f $ filter (fromMaybe True . (^? blVisible)) wins) where f wl = (_wlLine wl, _wlColor wl) - (wins,wls) = partition _wlIsSeeThrough . IM.elems $ wallsDoubleScreen w + (wins,wls) = partition _wlIsSeeThrough . IM.elems . IM.filter _wlDraw $ wallsDoubleScreen w --(wins,wls) = partition _wlIsSeeThrough . IM.elems $ wallsOnScreen w wallsToList :: [((Point2,Point2),Point4)] -> [Float] diff --git a/src/Dodge/Room/Boss.hs b/src/Dodge/Room/Boss.hs index 0b5f11a06..f0406b622 100644 --- a/src/Dodge/Room/Boss.hs +++ b/src/Dodge/Room/Boss.hs @@ -5,6 +5,7 @@ module Dodge.Room.Boss where import Dodge.Data import Dodge.Default.Room +import Dodge.LightSources.Fitting import Dodge.Room.Data import Dodge.Room.Procedural import Dodge.Room.Placement @@ -97,10 +98,8 @@ roomCross x y = defaultRoom ] , _rmPath = [] , _rmPS = - [sPS (V2 x 0) 0 putLamp - ,sPS (-V2 x 0) 0 putLamp - ,sPS (V2 0 x) 0 putLamp - ,sPS (V2 0 (-x)) 0 putLamp + [ mountedLightI 70 (V2 (x+5) x) (V2 (x+5) (-x)) + , mountedLightI 70 (V2 (-x-5) x) (V2 (-x-5) (-x)) ] , _rmBound = [rectNSWE y (-y) (-x) x @@ -123,7 +122,7 @@ roomShuriken x y = { _rmPolys = ps , _rmLinks = [(V2 (x-1) (y-20),negate $ pi/2)] , _rmPath = [] - , _rmPS = [sPS (V2 (x/2) (x/2)) 0 putLamp] + , _rmPS = [mountedLight (V2 x x) (V3 (x-20) x 70)] , _rmBound = ps } in foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2] @@ -147,7 +146,7 @@ roomTwistCross x y z = { _rmPolys = ps , _rmLinks = [(V2 z (y-20), pi/2)] , _rmPath = [] - , _rmPS = [sPS (V2 (x/2) (x/2)) 0 putLamp] + , _rmPS = [mountedLight (V2 x x) (V3 (x-20) (x-20) 70)] , _rmBound = ps } in foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2] diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs index a92842ff6..477a8897d 100644 --- a/src/Dodge/Room/Foreground.hs +++ b/src/Dodge/Room/Foreground.hs @@ -127,3 +127,19 @@ girder h d w x y = colorSH red $ mconcat $ yt = y -.- n ps = divideLineExact d xb yb qs = divideLineExact d xt yt + +robotArm :: Shape +robotArm = undefined + +pipePP :: Float -> Point3 -> Point3 -> Shape +pipePP w a b = prismPoly + (map ((+.+.+ a) . addZ 0) $ polyCirc 4 w) + (map ((+.+.+ b) . addZ 0) $ polyCirc 4 w) + +tankTopPipe :: Shape +tankTopPipe = colorSH orange $ + upperPrismPoly 31 (polyCirc 4 20) + <> prismPoly + (map (addZ 41) $ polyCirc 4 5) + (map (addZ 31) $ polyCirc 4 20) +-- <> pipePP 5 (V3 0 0 51) (V3 0 0 41) diff --git a/src/Dodge/Room/Furniture.hs b/src/Dodge/Room/Furniture.hs new file mode 100644 index 000000000..92699d618 --- /dev/null +++ b/src/Dodge/Room/Furniture.hs @@ -0,0 +1,97 @@ +module Dodge.Room.Furniture + where +import Dodge.Data +import Dodge.LevelGen +import Dodge.LevelGen.Data +import Dodge.Room.Foreground +import Dodge.Default.Wall +import Geometry +import Shape +import Color + +roundTankTopRail :: Color -> Float -> Float -> Placement +roundTankTopRail col x y = shiftPlacement (V2 x y,0) $ ps0j + (PutForeground $ colorSH col $ + upperPrismPoly 31 thecircle + <> foldMap toprail ( take 8 [0,pi/4..]) + ) + $ sps0 $ PutWall thecircle defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False} + where + toprail a = rotateSH a $ thinHighBar 31 (V2 0 20) (rotateV (pi/4) $ V2 0 20) + thecircle = polyCirc 4 20 + +roundTankCross :: Color -> Float -> Float -> Placement +roundTankCross col x y = shiftPlacement (V2 x y,0) $ ps0j + (PutForeground $ colorSH col $ + upperPrismPoly 31 thecircle + <> thinHighBar 31 (V2 20 0) (V2 (-20) 0) + <> thinHighBar 31 (V2 0 20) (V2 0 (-20)) + ) + $ sps0 $ PutWall thecircle defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False} + where + thecircle = polyCirc 4 20 + +tankRectCross :: Float -> Float -> Color -> Float -> Float -> Placement +tankRectCross w h col x y = shiftPlacement (V2 x y,0) $ ps0j + (PutForeground $ colorSH col $ + upperPrismPoly 31 therect + <> thinHighBar 31 (V2 w 0) (V2 (-w) 0) + <> thinHighBar 31 (V2 0 h) (V2 0 (-h)) + ) + $ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False} + where + therect = rectWH w h + +tankSquareCross :: Color -> Float -> Float -> Placement +tankSquareCross = tankRectCross 20 20 + +tankRect :: Float -> Float -> Color -> Float -> Float -> Placement +tankRect w h col x y = shiftPlacement (V2 x y,0) $ ps0j + (PutForeground $ colorSH col $ + upperPrismPoly 31 therect + <> foldMap f [(w',-w',h',h'),(w',-w',-h',-h'),(w',w',h',-h'),(-w',-w',h',-h')] + ) + $ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False} + where + therect = rectWH w h + w' = w - 1.5 + h' = h - 1.5 + f (a,b,c,d) = thinHighBar 31 (V2 a b) (V2 c d) + +tankSquare :: Color -> Float -> Float -> Placement +tankSquare = tankRect 20 20 + +tankRectEmboss :: Float -> Float -> Color -> Float -> Float -> Placement +tankRectEmboss w h col x y = shiftPlacement (V2 x y,0) $ ps0j + (PutForeground $ colorSH col $ + upperPrismPoly 31 therect + <> embossingR + <> rotateSH pi embossingR + <> thinHighBar 38 (V2 (-0.3*w) 0) (V2 (0.3*w) 0) + ) + $ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False} + where + w' = 0.3 * w + therect = rectWH w h + embossingR = prismPoly + [V3 w h 31,V3 w (0.3*h) 41,V3 w (-0.3*h) 41,V3 w (-h) 31] + [V3 w' h 31,V3 w' (0.3*h) 41,V3 w' (-0.3*h) 41,V3 w' (-h) 31] + + +tankSquareEmboss :: Color -> Float -> Float -> Placement +tankSquareEmboss = tankRectEmboss 20 20 + +tankRectEmboss4 :: Float -> Float -> Color -> Float -> Float -> Placement +tankRectEmboss4 w h col x y = shiftPlacement (V2 x y,0) $ ps0j + (PutForeground $ colorSH col $ + upperPrismPoly 31 therect + <> foldMap f [(w,h),(-w,h),(w,-h),(-w,-h)] + ) + $ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False} + where + therect = rectWH w h + f (a,b) = translateSH (V3 (a/2) (b/2) 31) embossing + embossing = upperPrismPolyHalf 10 $ rectNSEW (h/2) (-h/2) (w/2) (-w/2) + +tankSquareEmboss4 :: Color -> Float -> Float -> Placement +tankSquareEmboss4 = tankRectEmboss4 20 20 diff --git a/src/Dodge/Room/Placement.hs b/src/Dodge/Room/Placement.hs index 221d9cdb9..87214956b 100644 --- a/src/Dodge/Room/Placement.hs +++ b/src/Dodge/Room/Placement.hs @@ -91,7 +91,7 @@ windowLineType :: Point2 -> Point2 -> PSType windowLineType = PutLineBlock baseWindowPane 8 8 baseBlockPane :: Wall -baseBlockPane = Block +baseBlockPane = defaultBlock { _wlLine = (V2 0 0,V2 50 0) , _wlID = 0 , _wlColor = greyN 0.5 @@ -102,9 +102,10 @@ baseBlockPane = Block , _blVisible = True , _blShadows = [] , _blDegrades = [20,20] + , _wlDraw = True } baseWindowPane :: Wall -baseWindowPane = Block +baseWindowPane = defaultBlock { _wlLine = (V2 0 0,V2 50 0) , _wlID = 0 , _wlColor = withAlpha 0.2 cyan @@ -115,6 +116,7 @@ baseWindowPane = Block , _blVisible = True , _blShadows = [] , _blDegrades = [5,5] + , _wlDraw = True } {- Replaces instances of a given 'PutID' with 'PSType's drawn from a list. -} replacePutID diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index 727832053..0b8c9ae45 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -48,7 +48,7 @@ roomRect x y xn yn = defaultRoom { _rmPolys = [rectNSWE y 0 0 x ] , _rmLinks = lnks , _rmPath = concatMap doublePair pth - , _rmPS = [wallMountL (V2 (x/2) 0) (V3 (x/2) 40 50)] + , _rmPS = [mountLightA (V2 (x/2) 0) (V3 (x/2) 40 50)] , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)] , _rmFloor = [Tile { _tilePoly = rectNSWE y 0 0 x diff --git a/src/Dodge/Room/RoadBlock.hs b/src/Dodge/Room/RoadBlock.hs index 6832da71f..b723d5ecf 100644 --- a/src/Dodge/Room/RoadBlock.hs +++ b/src/Dodge/Room/RoadBlock.hs @@ -43,6 +43,7 @@ litCorridor90 = do ] , _rmPS = [ sPS (V2 20 (h-5)) 0 putLamp + , mountedLightI 70 (V2 0 (0.4*h)) (V2 40 (0.4*h)) , windowLine (V2 0 (h-20)) (V2 40 (h-20)) , sPS (V2 (-50) (h-85)) 0 putLamp , windowLine (V2 (-40) (h-60)) (V2 (-40) (h-100)) diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index 1533e90bb..128c59cdc 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -4,13 +4,13 @@ import Dodge.Room.Data import Dodge.Room.Door import Dodge.Room.Link import Dodge.Room.Procedural ---import Dodge.Room.Placement import Dodge.Room.Foreground +import Dodge.Room.Furniture import Dodge.Layout.Tree.Polymorphic import Dodge.LevelGen.Data import Dodge.LightSources.Fitting ---import Picture import Geometry.Data +import Color import Data.Tree import Control.Monad.State @@ -18,7 +18,8 @@ import Control.Lens import System.Random rezBox :: Room -rezBox = shiftRoomBy (V2 (-20) (-10),0) $ roomRect 40 20 1 1 & rmPS .~ [] +rezBox = shiftRoomBy (V2 (-20) (-10),0) $ roomRect 40 20 1 1 + & rmPS .~ [ mountColLightI (V3 0 0.7 0.2) 70 (V2 0 10) (V2 40 10) ] startRoom :: RandomGen g => State g (Tree (Either Room Room)) startRoom = do @@ -32,6 +33,8 @@ startRoom = do <$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0) $ roomRectAutoLinks w h & rmPS .~ [ fground - , wallMountJ (V2 0 (h/3)) (V3 40 (h/3) 70) + , mountedLightJ (V2 0 (h/3)) (V3 40 (h/3) 70) + , tankSquareEmboss4 (dim orange) 50 (h-60) + , tankSquareEmboss4 (dim orange) 50 50 ] ) diff --git a/src/Dodge/Room/Treasure.hs b/src/Dodge/Room/Treasure.hs index 9552e8ebd..564e68854 100644 --- a/src/Dodge/Room/Treasure.hs +++ b/src/Dodge/Room/Treasure.hs @@ -9,6 +9,7 @@ import Dodge.Room.Data import Dodge.Room.Placement import Dodge.Default.Room import Dodge.LevelGen.Data +import Dodge.LightSources.Fitting import Geometry --import Data.List @@ -32,9 +33,7 @@ triLootRoom w h = pure $ defaultRoom [sPS (V2 (15-w) 15 ) 0 $ PutID 0 ,sPS (V2 (w-15) 15 ) pi $ PutID 0 ,sPS (V2 0 (h-35)) 0 $ PutID 2 - ,sPS (V2 ( -5) (h-10)) 0 putLamp - ,sPS (V2 5 (h-10)) 0 putLamp - ,sPS (V2 0 (h-15)) 0 putLamp + ,mountedLightV (V2 0 (h-20)) (V3 0 (h-80) 70) ,sPS (V2 0 ( -60)) 0 putLamp ] , _rmBound = [tri , base] diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 90cc92688..be8f76b62 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -25,6 +25,7 @@ import Dodge.Floor import Geometry import Geometry.Vector3D +import SDL (MouseButton (..)) import Data.List import Data.Maybe import Data.Function @@ -251,7 +252,8 @@ crCrSpring c1 c2 w ifConfigWallRotate :: World -> World ifConfigWallRotate w - | _rotate_to_wall $ _config w = rotateToOverlappingWall w + | (_rotate_to_wall $ _config w ) && not (ButtonRight `S.member` _mouseButtons w) + = rotateToOverlappingWall w | otherwise = w rotateToOverlappingWall :: World -> World @@ -269,7 +271,7 @@ rotateToOverlappingWall w = case theWall of b' = fromIntegral (round b :: Int) cr = you w p = _crPos cr - theWall = overlapCircWallsReturnWall p (_crRad cr + 5) (wallsNearPoint p w) + theWall = overlapCircWallsReturnWall p (_crRad cr + 5) (IM.filter _wlRotateTo $ wallsNearPoint p w) {- Finds the IDs of visible walls from a point to another point. -}