diff --git a/shader/lighting/texture.frag b/shader/lighting/texture.frag index d9c20bf51..a9c8964cf 100644 --- a/shader/lighting/texture.frag +++ b/shader/lighting/texture.frag @@ -9,8 +9,7 @@ void main() vec3 distVec = texture(screenTexture,vTexPos).xyz - lightPos; float dist = dot(distVec,distVec); if (dist > lumRad.a) {discard;} - //vec3 dField = distVec / lumRad.a; - //vec3 c = pow (1 - min(1, dot(dField,dField)) , 2) * lumRad.rgb ; - vec3 c = (1 - dist / lumRad.a) * lumRad.rgb ; + float x = 1 - dist / lumRad.a ; + vec3 c = (x * x * x) * lumRad.rgb ; fColor = vec4(c,0); } diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 1ba6774cd..ed11f0127 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -71,7 +71,7 @@ data World = World , _floorTiles :: [(Point3,Point3)] , _randGen :: StdGen , _mousePos :: !Point2 - , _testString :: String + , _testString :: World -> [String] , _yourID :: !Int , _worldEvents :: World -> World , _pressPlates :: IM.IntMap PressPlate diff --git a/src/Dodge/Default/Room.hs b/src/Dodge/Default/Room.hs index 470bea4e7..39e0bf2b2 100644 --- a/src/Dodge/Default/Room.hs +++ b/src/Dodge/Default/Room.hs @@ -4,10 +4,11 @@ import Dodge.Room.Data defaultRoom :: Room defaultRoom = Room - { _rmPolys = [] - , _rmLinks = [] - , _rmPath = [] - , _rmPS = [] - , _rmBound = [] - , _rmFloor = [] + { _rmPolys = [] + , _rmLinks = [] + , _rmPath = [] + , _rmPS = [] + , _rmBound = [] + , _rmFloor = [] + , _rmName = "defaultRoom" } diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 36efcc96b..a55e98e7e 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -42,7 +42,7 @@ defaultWorld = World , _floorTiles = [] , _randGen = mkStdGen 2 , _mousePos = V2 0 0 - , _testString = [] + , _testString = const [] , _yourID = 0 , _worldEvents = id , _pressPlates = IM.empty diff --git a/src/Dodge/GameRoom.hs b/src/Dodge/GameRoom.hs index e2645cc20..df511f5a9 100644 --- a/src/Dodge/GameRoom.hs +++ b/src/Dodge/GameRoom.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE StrictData #-} {- | GameRooms contain information about given positions in the world -} module Dodge.GameRoom @@ -7,4 +8,6 @@ import Geometry data GameRoom = GameRoom { _grViewpoints :: [Point2] , _grBound :: [Point2] + , _grDir :: Float -- ^ gives direction of room + , _grName :: String } diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index b8cf790e7..c97472528 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -11,11 +11,14 @@ import Dodge.WorldEvent.Cloud import Dodge.SoundLogic import Dodge.SoundLogic.Synonyms import Geometry.Data +import Dodge.GameRoom +import Geometry import System.Random import qualified Data.Set as S import qualified Data.IntMap.Strict as IM import qualified Data.Map as M +import Data.List (sortOn) firstWorld :: IO World firstWorld = do @@ -37,7 +40,7 @@ initialWorld = defaultWorld , _floorItems = IM.empty , _randGen = mkStdGen 2 , _mousePos = V2 0 0 - , _testString = [] + , _testString = testStringInit , _yourID = 0 , _worldEvents = soundOncePos foamSprayFadeOutSound (V2 0 0) . foldr ((.) . makeStartCloudAt) id [V3 x y 5 | x <- [-5,-3..5] , y <- [-5,-3..5]] @@ -49,3 +52,11 @@ initialWorld = defaultWorld , _menuLayers = [TerminalMessage 300 rezText'] , _worldState = M.empty } +testStringInit :: World -> [String] +testStringInit w = (show . _crPos $ _creatures w IM.! 0) + : (map show . _grBound . last $ sortOn _grName grs) + ++ closeRooms + where + closeRooms = map _grName $ filter (pointInOrOnPolygon p . _grBound) grs + grs = _gameRooms w + p = _cameraViewFrom w diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 8fa5c6a93..b99c646c5 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -131,7 +131,9 @@ gameRoomsFromRooms = map f f rm = GameRoom { _grViewpoints = (map fst . foldl' (flip cutWalls) [] $ _rmPolys rm) ++ map fst (_rmLinks rm) - , _grBound = expandPolyByFixed 100 $ convexHullSafe $ concat $ _rmBound rm ++ _rmPolys rm + , _grBound = expandPolyByFixed 100 $ orderPolygon $ convexHullSafe $ concat $ _rmBound rm ++ _rmPolys rm + , _grDir = snd . last $ _rmLinks rm + , _grName = _rmName rm } floorsFromRooms :: [Room] -> [(Point3,Point3)] diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 0f4872a26..96d9cd60b 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -8,6 +8,7 @@ import Dodge.Base import Dodge.Base.Window import Dodge.Inventory import Dodge.Render.Connectors +import Dodge.Render.List import Picture import Geometry import Padding @@ -22,7 +23,7 @@ import SDL (MouseButton (..)) hudDrawings :: World -> Picture hudDrawings w = pictures [ winScale w . dShadCol white $ displayHP 0 w - , winScale w . translate (-390) 20 . scale 0.05 0.05 . dShadCol white $ text (_testString w) + , renderListAt (halfWidth w) 0 w $ map (,white) (_testString w w) , selectionText ] where @@ -31,9 +32,6 @@ hudDrawings w = pictures then drawLocations w else drawInventory w -winScale :: World -> Picture -> Picture -{-# INLINE winScale #-} -winScale w = scale (2 / getWindowX w) (2 / getWindowY w) drawInventory :: World -> Picture drawInventory w = displayInv 0 w `appendPic` subInventoryDisplay w @@ -100,7 +98,7 @@ pjTweakString pj = _pjDisplayParam pj $ _pjIntParam pj displayMidList :: World -> [String] -> String -> Picture displayMidList w strs s = invHead w s - `appendPic` renderListAt 150 (-60) (map (,white) strs) w + `appendPic` renderListAt 150 (-60) w (map (,white) strs) invHead :: World -> String -> Picture invHead w s = winScale w . translate (-130) (halfHeight w - 40) . dShadCol white . scale 0.4 0.4 $ text s @@ -116,9 +114,6 @@ renderItemMapAt tx ty scols w = --renderPairListAt tx ty scols w = -- concatMapPic (winScale w) $ map (uncurry $ listPairAt tx ty w) scols -renderListAt :: Float -> Float -> [(String,Color)] -> World -> Picture -renderListAt tx ty scols w = - concatMapPic (winScale w) $ zipWith (listPairAt tx ty w) [0..] scols displayInv :: Int -> World -> Picture displayInv n w = renderItemMapAt 0 0 items w @@ -130,15 +125,15 @@ displayInv n w = renderItemMapAt 0 0 items w --itemStringCol itm = (_itInvDisplay itm itm, _itInvColor itm) drawLocations :: World -> Picture -drawLocations wrld = pictures $ - renderListAt 0 0 locs wrld - : zipWith bConnect (displayListEndCoords wrld locTexts) locPoss - ++ mapOverlay wrld - ++ [mainListCursor white iPos wrld] +drawLocations w = pictures $ + renderListAt 0 0 w locs + : zipWith bConnect (displayListEndCoords w locTexts) locPoss + ++ mapOverlay w + ++ [mainListCursor white iPos w] where - iPos = _selLocation wrld - locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ wrld - locPoss = map (cartePosToScreen wrld . ($ wrld) . fst) . IM.elems . _seenLocations $ wrld + iPos = _selLocation w + locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w + locPoss = map (cartePosToScreen w . ($ w) . fst) . IM.elems . _seenLocations $ w locTexts = map fst locs displayListEndCoords :: World -> [String] -> [Point2] @@ -169,7 +164,7 @@ mapWall w wl = closeObjectTexts :: World -> Picture closeObjectTexts w = pictures $ renderListAt pushout (negate 20 * fromIntegral invPos) - (map colAndText $ _closeActiveObjects w) w + w (map colAndText $ _closeActiveObjects w) : maybeToList maybeLine where colAndText (Left x) = ( _itName $ _flIt x, _itInvColor $ _flIt x) @@ -193,12 +188,6 @@ closeObjectTexts w = pictures $ let p = V2 (textWidth + 15 + pushout - halfWidth w) ( halfHeight w - 20* (fromIntegral invPos +1) + 2.5) return . winScale w . color col $ lConnect p itScreenPos -{- | Colour picture and add black drop shadow. -} -dShadCol :: Color -> Picture -> Picture -dShadCol c p = pictures - [ color black $ translate 1.2 (-1.2) p - , color c p - ] mainListCursor :: Color -> Int -> World -> Picture mainListCursor c = openCursorAt 120 c 5 0 @@ -229,19 +218,6 @@ listItemAt' xoff yoff w yint item = winScale w . translate (xoff + 15 - halfWidt -- -> Picture --{-# INLINE listItemAt #-} --listItemAt xoff yoff w yint = listPairAt xoff yoff w yint . itemStringCol -listPairAt - :: Float -- ^ x offset - -> Float -- ^ y offset - -> World - -> Int -- ^ y offset (discrete) - -> (String,Color) -- ^ The text item - -> Picture -{-# INLINE listPairAt #-} -listPairAt xoff yoff w yint (s,col) - = translate (xoff + 15 - halfWidth w) (yoff + halfHeight w - (20 * (fromIntegral yint+1))) - . scale 0.1 0.1 - . dShadCol col - $ text s openCursorAt :: Float -- ^ Width diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs new file mode 100644 index 000000000..75e1a3e37 --- /dev/null +++ b/src/Dodge/Render/List.hs @@ -0,0 +1,32 @@ +module Dodge.Render.List + where +import Dodge.Data +import Dodge.Base.Window +import Picture + +renderListAt :: Float -> Float -> World -> [(String,Color)] -> Picture +renderListAt tx ty w = + concatMapPic (winScale w) . zipWith (listPairAt tx ty w) [0..] + +listPairAt + :: Float -- ^ x offset + -> Float -- ^ y offset + -> World + -> Int -- ^ y offset (discrete) + -> (String,Color) -- ^ The text item + -> Picture +{-# INLINE listPairAt #-} +listPairAt xoff yoff w yint (s,col) + = translate (xoff + 15 - halfWidth w) (yoff + halfHeight w - (20 * (fromIntegral yint+1))) + . scale 0.1 0.1 + . dShadCol col + $ text s +{- | Colour picture and add black drop shadow. -} +dShadCol :: Color -> Picture -> Picture +dShadCol c p = pictures + [ color black $ translate 1.2 (-1.2) p + , color c p + ] +winScale :: World -> Picture -> Picture +{-# INLINE winScale #-} +winScale w = scale (2 / getWindowX w) (2 / getWindowY w) diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 56c9535be..ff58334b0 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TupleSections #-} module Dodge.Render.Picture where import Dodge.Data @@ -7,7 +8,9 @@ import Dodge.Base.Zone import Dodge.Picture import Dodge.Picture.Layer import Dodge.Render.HUD +--import Dodge.Render.List import Dodge.Render.MenuScreen +--import Dodge.GameRoom --import Dodge.Debug import Geometry --import Geometry.Zone @@ -60,6 +63,7 @@ customMouseCursor w = testPic :: World -> Picture testPic _ = blank + --setLayer 1 $ renderListAt 50 0 w $ map ((,white) . _grName) $ _gameRooms w -- [ setDepth (-1) . translate 0 0.8 -- . scale 0.001 0.001 . text . show $ _crMvDir $ you w diff --git a/src/Dodge/Room/Data.hs b/src/Dodge/Room/Data.hs index e60b0001c..3047b8ded 100644 --- a/src/Dodge/Room/Data.hs +++ b/src/Dodge/Room/Data.hs @@ -8,6 +8,7 @@ module Dodge.Room.Data , rmPS , rmBound , rmFloor + , rmName ) where import Dodge.LevelGen.Data --import Geometry @@ -27,9 +28,10 @@ assigning no bounds will allow rooms to overlap. data Room = Room { _rmPolys :: [ [Point2] ] , _rmLinks :: [(Point2,Float)] - , _rmPath :: [(Point2, Point2)] - , _rmPS :: [Placement] - , _rmBound :: [ [Point2] ] - , _rmFloor :: [Tile] + , _rmPath :: [(Point2, Point2)] + , _rmPS :: [Placement] + , _rmBound :: [ [Point2] ] + , _rmFloor :: [Tile] + , _rmName :: String } makeLenses ''Room diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 1969063af..774009d17 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -48,6 +48,7 @@ twinSlowDoorRoom drID w h x = defaultRoom (over worldState (M.insert (DoorNumOpen drID) True)) ] , _rmBound = ps + , _rmName = "twinSlowDoorRoom" } where ps = diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 1794dab2d..e6a0543dd 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -14,18 +14,18 @@ import Dodge.Base.Collide import Dodge.Config.KeyConfig import Dodge.Item.Attachment.Data import Geometry -import Geometry.ConvexPoly +--import Geometry.ConvexPoly import Dodge.GameRoom -import qualified Data.List.NonEmpty as NEL +--import qualified Data.List.NonEmpty as NEL import Control.Lens --import Control.Applicative import Data.Maybe import qualified Data.Set as S import qualified Data.IntMap.Strict as IM import qualified SDL -import Data.Monoid -import Data.Semigroup +--import Data.Monoid +--import Data.Semigroup import qualified Control.Foldl as L {- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers; update where your avatar's view is from. -} @@ -164,49 +164,46 @@ autoZoomCam w = over cameraZoom changeZoom w theScopeZoom = fromMaybe 1 $ yourItem w ^? itAttachment . scopeZoom farWallDist' :: Point2 -> World -> Float -farWallDist' p w = (winFac /) $ fromMaybe 800 $ L.fold L.maximum vdists +farWallDist' p w = (winFac /) $ fromMaybe maxViewDistance $ L.fold L.maximum vdists where hw = halfWidth w hh = halfHeight w winFac = min hw hh - vdists = map (flip (collideDirectionIndirect 800 p) wos) + vdists = map (flip (collideDirectionIndirect maxViewDistance p) wos) vps vps = concatMap _grViewpoints grs grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w) wos = wallsOnScreen w - - --- | Find the furthest viewable distance from a given point in the world -farWallDist :: Point2 -> World -> Float ---{-# INLINE farWallDist #-} -farWallDist cpos w - = getMin - . uncurry (<>) - $ bimap (toScale hw) (toScale hh) - $ sconcat - $ NEL.map distsMaybeTo viewTestValues - where - wos = wallsOnScreen w - camRot = _cameraRot w - hw = halfWidth w - hh = halfHeight w - toScale x = Min . (x /) . (+ 50) . maybe maxViewDistance getMax . getAp - distsMaybeTo x = (valueAtWidth x,valueAtHeight x) - valueAtHeight h = cpiv (cpos +.+ x) <> cpiv (cpos -.- x) - where - x = rotateV camRot $ V2 maxViewDistance h - cpiv p = Ap $ Max . horSize <$> collidePointIndirect cpos p wos - horSize = abs . dotV rv . (-.- cpos) - rv = rotateV camRot (V2 1 0) - valueAtWidth h = cpih (cpos +.+ x) <> cpih (cpos -.- x) - where - x = rotateV camRot $ V2 h maxViewDistance - cpih p = Ap $ Max . verSize <$> collidePointIndirect cpos p wos - verSize = abs . dotV rh . (-.- cpos) - rh = rotateV camRot (V2 0 1) - -viewTestValues :: NEL.NonEmpty Float -viewTestValues = NEL.fromList [-maxViewDistance,negate $ 0.75*maxViewDistance..maxViewDistance] +---- | Find the furthest viewable distance from a given point in the world +--farWallDist :: Point2 -> World -> Float +----{-# INLINE farWallDist #-} +--farWallDist cpos w +-- = getMin +-- . uncurry (<>) +-- $ bimap (toScale hw) (toScale hh) +-- $ sconcat +-- $ NEL.map distsMaybeTo viewTestValues +-- where +-- wos = wallsOnScreen w +-- camRot = _cameraRot w +-- hw = halfWidth w +-- hh = halfHeight w +-- toScale x = Min . (x /) . (+ 50) . maybe maxViewDistance getMax . getAp +-- distsMaybeTo x = (valueAtWidth x,valueAtHeight x) +-- valueAtHeight h = cpiv (cpos +.+ x) <> cpiv (cpos -.- x) +-- where +-- x = rotateV camRot $ V2 maxViewDistance h +-- cpiv p = Ap $ Max . horSize <$> collidePointIndirect cpos p wos +-- horSize = abs . dotV rv . (-.- cpos) +-- rv = rotateV camRot (V2 1 0) +-- valueAtWidth h = cpih (cpos +.+ x) <> cpih (cpos -.- x) +-- where +-- x = rotateV camRot $ V2 h maxViewDistance +-- cpih p = Ap $ Max . verSize <$> collidePointIndirect cpos p wos +-- verSize = abs . dotV rh . (-.- cpos) +-- rh = rotateV camRot (V2 0 1) +--viewTestValues :: NEL.NonEmpty Float +--viewTestValues = NEL.fromList [-maxViewDistance,negate $ 0.75*maxViewDistance..maxViewDistance] maxViewDistance :: Float maxViewDistance = 800 diff --git a/src/Geometry.hs b/src/Geometry.hs index 925ab028b..08e838be1 100644 --- a/src/Geometry.hs +++ b/src/Geometry.hs @@ -133,7 +133,7 @@ convexHull :: [Point2] -> [Point2] convexHull (x:y:z:xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b,a)) (x:y:z:xs) convexHull _ = error "Tried to create the convex hull of two or fewer points" -- | Creates the convex hull of a set of points. --- Need to verify whether or not this is ordered +-- it appears that the output may NOT be ordered convexHullSafe :: [Point2] -> [Point2] convexHullSafe (x:y:z:xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b,a)) (x:y:z:xs) convexHullSafe _ = []