From 743c1c878dbce20c5f5f03f7747e92f7a054902e Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 27 Sep 2021 12:28:53 +0100 Subject: [PATCH] Make buttons have shape, expose multiple bugs --- src/Dodge/Data.hs | 2 +- src/Dodge/Default.hs | 18 ++++++--- src/Dodge/Floor.hs | 36 ++++++++--------- src/Dodge/GameRoom.hs | 1 + src/Dodge/Layout.hs | 2 +- src/Dodge/LevelGen/Switch.hs | 39 +++++++++--------- src/Dodge/LevelGen/TriggerDoor.hs | 2 +- src/Dodge/LightSources.hs | 66 +++++++++++++++++++++++++++---- src/Dodge/Render/Picture.hs | 2 +- src/Dodge/Render/Shape.hs | 4 ++ src/Dodge/Room/Airlock.hs | 6 +-- src/Dodge/Room/Corridor.hs | 4 +- src/Dodge/Room/LongDoor.hs | 6 ++- src/Dodge/Room/Procedural.hs | 2 +- src/Dodge/Room/Start.hs | 13 +++--- src/Dodge/Update/Camera.hs | 11 ++++-- src/Geometry/Vector3D.hs | 6 +++ src/Shader/Poke.hs | 3 ++ src/Shape.hs | 5 +++ 19 files changed, 157 insertions(+), 71 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 8d09a4aa6..cc24b3b8f 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -240,7 +240,7 @@ data WorldState | CrNumAlive Int deriving (Eq,Ord) data Button = Button - { _btPict :: Picture + { _btPict :: Button -> SPic , _btPos :: Point2 , _btRot :: Float , _btEvent :: Button -> World -> World diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index be3640eed..d17435d21 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -19,7 +19,7 @@ import Dodge.SoundLogic.LoadSound import Dodge.Picture.Layer import Geometry import Picture ---import ShapePicture +import ShapePicture import Shape import Control.Lens @@ -208,14 +208,22 @@ defaultIt = Consumable , _itHammer = HammerUp , _itAimStance = LeaveHolstered } +defaultDrawButton :: Color -> Button -> SPic +defaultDrawButton col bt + | _btState bt == BtOff = + ( translateSHz 15 . colorSH col $ upperPrismPoly 5 $ rectNSEW 5 (-5) 10 (-10) + , mempty + ) + | otherwise = + ( translateSHz 15 . colorSH red $ upperPrismPoly 5 $ rectNSEW (-3) (-5) 10 (-10) + , mempty + ) defaultButton :: Button defaultButton = Button - { _btPict = onLayer WlLayer $ color red $ polygon $ rectNSEW 5 (-5) 10 (-10) + { _btPict = defaultDrawButton (dark red) , _btPos = V2 0 0 , _btRot = 0 - , _btEvent = \b w -> - set (buttons . ix (_btID b) . btPict) (onLayer WlLayer $ color red $ polygon $ rectNSEW (-4) (-5) 10 (-10)) - . set (buttons . ix (_btID b) . btState) BtNoLabel + , _btEvent = \b w -> set (buttons . ix (_btID b) . btState) BtNoLabel . soundStart (LeverSound 0) (_btPos b) click1S Nothing $ w , _btID = 0 , _btText = "Button" diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 23d758f66..316a803ba 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -52,24 +52,24 @@ initialRoomTree = do [[StartRoom] ,[Corridor] ,[Corridor] - ,[SpecificRoom roomCCrits] - ,[Corridor] - ,[Corridor] - ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 - & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit - ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit - ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit - ]++) - ] - --,[Corridor] - --,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 - -- & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++) - -- ] - ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 - & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++) - ] - ,[Corridor] - ,[Corridor] +---- ,[SpecificRoom roomCCrits] +---- ,[Corridor] +---- ,[Corridor] +---- ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 +---- & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit +---- ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit +---- ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit +---- ]++) +---- ] +---- --,[Corridor] +---- --,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 +---- -- & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++) +---- -- ] +---- ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 +---- & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++) +---- ] +---- ,[Corridor] +---- ,[Corridor] -- --,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers 30] ,[SpecificRoom $ pure $ (pure . Right) (twinSlowDoorRoom 30 80 200 40)] ,[Corridor] diff --git a/src/Dodge/GameRoom.hs b/src/Dodge/GameRoom.hs index df511f5a9..88f1c8f8c 100644 --- a/src/Dodge/GameRoom.hs +++ b/src/Dodge/GameRoom.hs @@ -7,6 +7,7 @@ import Geometry data GameRoom = GameRoom { _grViewpoints :: [Point2] + , _grViewpointsEx :: [Point2] , _grBound :: [Point2] , _grDir :: Float -- ^ gives direction of room , _grName :: String diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 0f18ebcd8..47eaffd1b 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -138,7 +138,7 @@ gameRoomsFromRooms = map f where f rm = GameRoom { _grViewpoints = (map fst . foldl' (flip cutWalls) [] $ _rmPolys rm) - ++ map fst (_rmLinks rm) + , _grViewpointsEx = map fst (_rmLinks rm) , _grBound = expandPolyByFixed 100 $ orderPolygon $ convexHullSafe $ concat $ _rmBound rm ++ _rmPolys rm , _grDir = snd . last $ _rmLinks rm , _grName = _rmName rm diff --git a/src/Dodge/LevelGen/Switch.hs b/src/Dodge/LevelGen/Switch.hs index ea2cfbeb9..49da70914 100644 --- a/src/Dodge/LevelGen/Switch.hs +++ b/src/Dodge/LevelGen/Switch.hs @@ -1,11 +1,13 @@ module Dodge.LevelGen.Switch where import Dodge.Data +import Dodge.Default import Dodge.Data.SoundOrigin import Dodge.SoundLogic import Dodge.SoundLogic.LoadSound -import Dodge.Picture.Layer import Picture +import ShapePicture +import Shape import Geometry --import Geometry.Data @@ -15,8 +17,8 @@ makeButton :: Color -> (World -> World) -- ^ Effect when pressed -> Button -makeButton c eff = Button - { _btPict = setLayer 0 . onLayer WlLayer $ color c $ polygon $ rectNSEW 5 (-5) 10 (-10) +makeButton col eff = Button + { _btPict = defaultDrawButton col , _btPos = V2 0 0 , _btRot = 0 , _btEvent = \b w -> eff . over buttons (IM.adjust turnOn (_btID b)) @@ -27,17 +29,28 @@ makeButton c eff = Button , _btState = BtOff } where - turnOn bt = bt {_btState = BtNoLabel, _btPict = onPict, _btEvent = const id} - onPict = setLayer 0 $ onLayer WlLayer (color c $ polygon $ rectNSEW (-3) (-5) 10 (-10)) + turnOn bt = bt {_btState = BtNoLabel, _btEvent = const id} btpos b w' = _btPos $ _buttons w' IM.! _btID b +drawSwitch :: Color -> Color -> Button -> SPic +drawSwitch col1 col2 bt + | _btState bt == BtOff = flick $ pi/4 + | otherwise = flick (negate (pi/4)) + where + flick a = ( mconcat + [ colorSH col1 . translateSHz 10 . upperPrismPoly 10 $ rectNSEW (-2) (-5) 10 (-10) + , colorSH col2 . translateSH (V3 0 (-2) 15) . rotateSH a . upperPrismPoly 2 $ rectNSEW 10 (0) 2 (-2) + ] + , mempty) + makeSwitch - :: Color + :: Color + -> Color -> (World -> World) -- ^ Switch on effect -> (World -> World) -- ^ Switch off effect -> Button -makeSwitch c effOn effOff = Button - { _btPict = offPict +makeSwitch col1 col2 effOn effOff = Button + { _btPict = drawSwitch col1 col2 , _btPos = V2 0 0 , _btRot = 0 , _btEvent = flipSwitch @@ -52,24 +65,14 @@ makeSwitch c effOn effOff = Button BtOff -> effOn . over buttons (IM.adjust turnOn (_btID b)) BtOn -> effOff . over buttons (IM.adjust turnOff (_btID b)) _ -> error "Trying to switch a button with no label" - offPict = setLayer 0 . onLayer WlLayer $ color c $ pictures [--translate (-8) 4 $ circleSolid 5 - polygon $ rectNSEW (-2) (-5) (-10) 10 - ,polygon $ map toV2 [(-2,-5),(-10,4),(-6,4),(2,-5)] - ] - onPict = setLayer 0 . onLayer WlLayer $ color c $ pictures [--translate (8) 4 $ circleSolid 5 - polygon $ rectNSEW (-2) (-5) (-10) 10 - ,polygon $ map toV2 [(-2,-5), (6,4),( 10,4),(2,-5)] - ] turnOn :: Button -> Button turnOn bt = bt { _btState = BtOn - , _btPict = onPict , _btText = "SWITCH\\" } turnOff :: Button -> Button turnOff bt = bt { _btState = BtOff - , _btPict = offPict , _btText = "SWITCH/" } diff --git a/src/Dodge/LevelGen/TriggerDoor.hs b/src/Dodge/LevelGen/TriggerDoor.hs index fc71c89e9..f998cfd6f 100644 --- a/src/Dodge/LevelGen/TriggerDoor.hs +++ b/src/Dodge/LevelGen/TriggerDoor.hs @@ -52,7 +52,7 @@ addSwitchDoor c btp btr a b speed w = over buttons (IM.insert bid bt) where bid = IM.newKey $ _buttons w cond w' = BtOn == _btState (_buttons w' IM.! bid) - bt = (makeSwitch c openDoor closeDoor) {_btPos = btp, _btRot = btr, _btID = bid} + bt = (makeSwitch c red openDoor closeDoor) {_btPos = btp, _btRot = btr, _btID = bid} (newGraphPairs,removedPairs) = partition (isNothing . uncurry (intersectSegSeg a b)) $ _pathGraphP w newGraph = pairsToGraph dist newGraphPairs diff --git a/src/Dodge/LightSources.hs b/src/Dodge/LightSources.hs index 73a78b0e4..5929e9b0a 100644 --- a/src/Dodge/LightSources.hs +++ b/src/Dodge/LightSources.hs @@ -5,6 +5,8 @@ module Dodge.LightSources , colorLightAt , lampPic , lampCover + , doubleLampCover + , verticalLampCover ) where import Dodge.Data @@ -72,22 +74,72 @@ lampCover h = ShapeProp { _pjPos = V2 0 0 , _pjID = 0 , _pjRot = 0 - , _pjUpdate = updateLampCover + , _pjUpdate = rotateProp 0.15 , _prDraw = drawLampCover h } -updateLampCover :: Prop -> World -> World -updateLampCover pr w = w - & props . ix (_pjID pr) . pjRot +~ 0.15 +doubleLampCover :: Float -> Prop +doubleLampCover h = ShapeProp + { _pjPos = V2 0 0 + , _pjID = 0 + , _pjRot = 0 + , _pjUpdate = rotateProp 0.15 + , _prDraw = drawDoubleLampCover h + } + +-- on the current (27/9/21) version of shadow stencilling, this glitches +-- slightly when the shadow rotates towards the screen +verticalLampCover :: Float -> Prop +verticalLampCover h = ShapeProp + { _pjPos = V2 0 0 + , _pjID = 0 + , _pjRot = 0 + , _pjUpdate = rotateProp 0.15 + , _prDraw = drawVerticalLampCover h + } + +rotateProp :: Float -> Prop -> World -> World +rotateProp rotAmount pr w = w + & props . ix (_pjID pr) . pjRot +~ rotAmount drawLampCover :: Float -> Prop -> SPic drawLampCover h pr = ( translateSHz (h-2.5) . uncurryV translateSHf pos $ rotateSH a $ mconcat - [ upperPrismPoly 5 $ rectNSEW 6 5 6 (-4) - , upperPrismPoly 5 $ rectNSEW 6 (-4) 6 5 + [ translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 2 3 (-1) + , translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2 + , translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 2 3 (-1) + , translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2 --, translateSHz 2.5 . upperPrismPoly 1 $ [V2 5 5,V2 (-4) 5,V2 5 (-4)] - , upperPrismPoly 1 $ [V2 5 5,V2 (-4) 5,V2 5 (-4)] + , upperPrismPoly 1 $ [V2 2 2,V2 (-1) 2,V2 2 (-1)] + ] + , mempty + ) + where + a = _pjRot pr + pos = _pjPos pr + +drawDoubleLampCover :: Float -> Prop -> SPic +drawDoubleLampCover h pr = + ( translateSHz (h-2.5) . uncurryV translateSHf pos + $ rotateSH a $ mconcat + [ upperPrismPoly 5 $ rectNSEW 6 5 6 (-6) + , upperPrismPoly 5 $ rectNSEW (-5) (-6) 6 (-6) + , upperPrismPoly 1 [V2 0 (-1),V2 6 5,V2 (-6) 5] + , upperPrismPoly 1 [V2 0 (1),V2 (-6) (-5),V2 6 (-5)] + ] + , mempty + ) + where + a = _pjRot pr + pos = _pjPos pr + +drawVerticalLampCover :: Float -> Prop -> SPic +drawVerticalLampCover h pr = + ( translateSHz h . uncurryV translateSHf pos + $ rotateSHx a $ mconcat + [ + translateSHz (-3) . upperPrismPoly 1 $ rectNSEW 2 (-2) 5 (-5) ] , mempty ) diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 9131d5162..c8b0d9e52 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -93,7 +93,7 @@ crDraw w c = _spPicture $ _crPict c c w ppDraw :: PressPlate -> Picture ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c) btDraw :: Button -> Picture -btDraw c = uncurryV translate (_btPos c) $ rotate (_btRot c) (_btPict c) +btDraw c = uncurryV translate (_btPos c) $ rotate (_btRot c) (_spPicture $ _btPict c c) clDraw :: Cloud -> Picture clDraw c = translate3 (_clPos c) (_clPict c c) diff --git a/src/Dodge/Render/Shape.hs b/src/Dodge/Render/Shape.hs index 11dd8cc43..f0d6bd5f0 100644 --- a/src/Dodge/Render/Shape.hs +++ b/src/Dodge/Render/Shape.hs @@ -15,10 +15,14 @@ worldShape w = _foregroundShape w <> foldMap (crShape w) (IM.filter (pointIsClose . _crPos) (_creatures w)) <> foldMap (_spShape . floorItemSPic) (IM.filter (pointIsClose . _flItPos) $ _floorItems w) <> foldMap (_spShape . dbArg _prDraw) (IM.filter (pointIsClose . _pjPos) $ _props w) + <> foldMap btShape (IM.filter (pointIsClose . _btPos) $ _buttons w) where pointIsClose p = dist camCen p < winSize winSize = 30 + max (getWindowX w) (getWindowY w) camCen = _cameraCenter w +btShape :: Button -> Shape +btShape bt = uncurryV translateSHf (_btPos bt) $ rotateSH (_btRot bt) (_spShape $ _btPict bt bt) + crShape :: World -> Creature -> Shape crShape w c = _spShape $ _crPict c c w diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs index b3aef9625..0695b7c30 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/src/Dodge/Room/Airlock.hs @@ -62,7 +62,7 @@ airlock0 n = defaultRoom , _rmPS = [sPS (V2 0 20) 0 $ PutDoubleDoor col (not . cond) (V2 1 0) (V2 39 0) 2 ,sPS (V2 0 80) 0 $ PutDoubleDoor col cond (V2 1 0) (V2 39 0) 2 - ,sPS (V2 35 50) (pi/2) $ PutButton $ makeSwitch col + ,sPS (V2 35 50) (pi/2) $ PutButton $ makeSwitch col red (over worldState (M.insert (DoorNumOpen n) True)) (over worldState (M.insert (DoorNumOpen n) False)) ,sPS (V2 (-25) 50) 0 putLamp @@ -100,7 +100,7 @@ airlock90 n = defaultRoom ] , _rmPS = [sPS (V2 5 5) 0 $ PutDoor col (not . cond) pss - ,sPS (V2 120 120) (3* pi/4) $ PutButton $ makeSwitch col + ,sPS (V2 120 120) (3* pi/4) $ PutButton $ makeSwitch col red (over worldState (M.insert (DoorNumOpen n) True)) (over worldState (M.insert (DoorNumOpen n) False)) ,sPS (V2 60 60) 0 putLamp @@ -140,7 +140,7 @@ airlockCrystal n = defaultRoom ] , _rmPS = [sPS (V2 0 0) 0 $ PutDoor col (not . cond) pss - ,sPS (V2 145 70) (pi/2) $ PutButton $ makeSwitch col + ,sPS (V2 145 70) (pi/2) $ PutButton $ makeSwitch col red (over worldState (M.insert (DoorNumOpen n) True)) (over worldState (M.insert (DoorNumOpen n) False)) ,crystalLine (V2 0 70) (V2 40 70) diff --git a/src/Dodge/Room/Corridor.hs b/src/Dodge/Room/Corridor.hs index 93e7b678d..8bc3c9946 100644 --- a/src/Dodge/Room/Corridor.hs +++ b/src/Dodge/Room/Corridor.hs @@ -17,8 +17,8 @@ corridor = defaultRoom , _rmLinks = lnks , _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks , _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) + [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/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 0bb44995c..5a1a18a56 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -15,6 +15,7 @@ import Dodge.LevelGen.Switch import Dodge.RandomHelp import Dodge.Creature.Inanimate import Dodge.Creature +import Dodge.LightSources import Picture import Geometry @@ -44,14 +45,17 @@ twinSlowDoorRoom drID w h x = defaultRoom , sPS (V2 (negate 25) 5) 0 putLamp , sPS (V2 0 0) 0 $ PutSingleDoor col cond (V2 x 1) (V2 x h) 1 , sPS (V2 0 0) 0 $ PutSingleDoor col cond (V2 (-x) 1) (V2 (-x) h) 1 - , sPS (V2 0 (h-5)) pi $ PutButton $ makeSwitch col + , sPS (V2 0 (h-5)) pi $ PutButton $ makeSwitch col red (over worldState (M.insert (DoorNumOpen drID) True)) (over worldState (M.insert (DoorNumOpen drID) False)) +-- , sPS (V2 0 (h-1)) 0 $ PutLS (colorLightAt (V3 0.75 0 0) (V3 0 0 lampHeight) 0) (lampPic lampHeight) +-- , sPS (V2 0 (h-1)) 0 $ PutProp $ lampCover lampHeight ] , _rmBound = ps , _rmName = "twinSlowDoorRoom" } where + lampHeight = 41 ps = [rectNSWE h 0 (-w) w ,rectNSWE 20 (-h) (negate x) x diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index 421838f5e..b7a5f22f2 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -246,7 +246,7 @@ centerVaultRoom n w h d = do col = dim $ dim $ bright red theDoor i = [ sPS (V2 0 (d-10)) 0 $ PutDoubleDoor col (cond i) (V2 (-19) 0) (V2 19 0) 2 - , sPS (V2 35 (d+4)) 0 $ PutButton $ makeSwitch col + , sPS (V2 35 (d+4)) 0 $ PutButton $ makeSwitch col red (over worldState (M.insert (DoorNumOpen i) True)) (over worldState (M.insert (DoorNumOpen i) False)) ] diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index 9246aa80c..d76210247 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -8,7 +8,7 @@ import Dodge.Room.Placement import Dodge.Room.Foreground import Dodge.Layout.Tree.Polymorphic import Dodge.LevelGen.Data -import Dodge.LightSources +--import Dodge.LightSources --import Picture import Geometry.Data @@ -33,13 +33,10 @@ startRoom = do <$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0) $ roomRectAutoLinks w h & rmPS .~ [ fground - --, theLamp - , sPS (V2 100 100) 0 $ PutLS (colorLightAt (V3 0.75 0 0) (V3 0 0 lampHeight) 0) (lampPic lampHeight) - , sPS (V2 100 100) 0 $ PutProp $ lampCover lampHeight + , theLamp + --, sPS (V2 100 100) 0 $ PutLS (colorLightAt (V3 0.75 0 0) (V3 0 0 lampHeight) 0) (lampPic lampHeight) + --, sPS (V2 100 100) 0 $ PutProp $ lampCover lampHeight ] ) where - lampHeight = 41 --- where --- cola = dark . dark . light . light $ light red --- colb = dark . dark . light . light $ light blue + --lampHeight = 41 diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index adaafd497..556f52698 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -147,7 +147,7 @@ autoZoomCam :: World -> World autoZoomCam w = over cameraZoom changeZoom w where camPos = _cameraViewFrom w - wallZoom = farWallDist' camPos w + wallZoom = farWallDist camPos w idealZoom | SDL.ButtonRight `S.member` _mouseButtons w = theScopeZoom * maybe zoomNoItem zoomFromItem (yourItem w ^? itAimZoom) wallZoom @@ -162,14 +162,17 @@ autoZoomCam w = over cameraZoom changeZoom w zoomOutSpeed = 15 theScopeZoom = fromMaybe 1 $ yourItem w ^? itAttachment . scopeZoom -farWallDist' :: Point2 -> World -> Float -farWallDist' p w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps +farWallDist :: Point2 -> World -> Float +farWallDist p w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps where findMax curMax pout = max curMax $ dist p $ collidePointUpToIndirectMinDist p pout curMax wos hw = halfWidth w hh = halfHeight w winFac = min hw hh - vps = concatMap _grViewpoints grs + vps = concatMap _grViewpoints grs ++ linkvps + linkvps = map extend (concatMap _grViewpointsEx grs) + extend :: Point2 -> Point2 + extend outp = p +.+ maxViewDistance *.* safeNormalizeV (outp -.- p) grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w) wos = wallsOnScreen w diff --git a/src/Geometry/Vector3D.hs b/src/Geometry/Vector3D.hs index be5e0cc70..a141db846 100644 --- a/src/Geometry/Vector3D.hs +++ b/src/Geometry/Vector3D.hs @@ -49,6 +49,12 @@ rotate3 a (V3 x y z) = V3 x' y' z where (V2 x' y') = rotateV a (V2 x y) +rotate3x :: Float -> Point3 -> Point3 +{-# INLINE rotate3x #-} +rotate3x a (V3 x y z) = V3 x y' z' + where + (V2 y' z') = rotateV a (V2 y z) + magV3 :: Point3 -> Float {-# INLINE magV3 #-} magV3 (V3 x y z) = sqrt $ x^i + y^i + z^i diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 71d62ed46..95d138147 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -159,11 +159,14 @@ topPrismEdgeIndices n = concatMap f [0..n-1] topPrismIndices :: Int -> [Int] topPrismIndices n = concatMap f [1..n-2] -- triangles on top face + ++ concatMap f' [1..n-2] -- triangles on bottom face + -- these should be checked ++ [2*n-2,2*n-1,1 ,2*n-2,1,0] -- last side triangle (applies mod 2n) ++ concatMap g [0..n-2] -- other triangles on sides where f x = [0,2*x,2*x+2] + f' x = [1,2*x+1,2*x+3] g x = [2*x,2*x+1,2*x+3 ,2*x,2*x+3,2*x+2] diff --git a/src/Shape.hs b/src/Shape.hs index 8a62cfbf0..2234811b1 100644 --- a/src/Shape.hs +++ b/src/Shape.hs @@ -10,6 +10,7 @@ module Shape , translateSHz , translateSHf , rotateSH + , rotateSHx , scaleSH , colorSH ) @@ -104,6 +105,10 @@ rotateSH :: Float -> Shape -> Shape {-# INLINE rotateSH #-} rotateSH a = overPos (rotate3 a) +rotateSHx :: Float -> Shape -> Shape +{-# INLINE rotateSHx #-} +rotateSHx a = overPos (rotate3x a) + scaleSH :: Point3 -> Shape -> Shape {-# INLINE scaleSH #-} scaleSH (V3 a b c) = overPos (\(V3 x y z) -> V3 (x*a) (y*b) (z*c))