diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 44230b653..644a8b00d 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -21,6 +21,7 @@ import Geometry --import Geometry.Data import Geometry.Vector3D import Polyhedra +import Shape import Control.Lens import qualified Control.Foldl as L @@ -119,11 +120,10 @@ explosiveBarrel :: Creature explosiveBarrel = defaultInanimate { _crUpdate = updateExpBarrel , _crHP = 400 - , _crPict = picAtCrPos $ pictures - [ color red $ circleSolid 8 - , setDepth 0.049 . color (greyN 0.5) $ circleSolid 10 - , color orange $ circleSolid 10 - ] + , _crPict = shapeAtCrPos + . colorSH orange + . upperPrismPoly 20 + $ polyCirc 4 10 , _crState = defaultState {_crSpState = Barrel [] } diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 90a3a19c5..0f2b83423 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -6,6 +6,7 @@ module Dodge.Creature.Picture ( basicCrPict , circLine , picAtCrPos + , shapeAtCrPos , picAtCrPosNoRot ) where import Dodge.Data @@ -47,6 +48,12 @@ basicCrPict col cr w = (,) (basicCrShape col cr) $ pictures $ tr = uncurryV translate (_crPos cr) rotdir = rotate (_crDir cr) +shapeAtCrPos :: Shape -> Creature -> World -> SPic +shapeAtCrPos sh cr _ = + ( uncurryV translateSHf (_crPos cr) $ rotateSH (_crDir cr) sh + , mempty + ) + basicCrShape :: Color -- ^ Creature color -> Creature diff --git a/src/Dodge/Default/Room.hs b/src/Dodge/Default/Room.hs index fc52f8439..c65b7232a 100644 --- a/src/Dodge/Default/Room.hs +++ b/src/Dodge/Default/Room.hs @@ -13,4 +13,5 @@ defaultRoom = Room , _rmFloor = [] , _rmName = "defaultRoom" , _rmShift = (V2 0 0 , 0) + , _rmViewpoints = [] } diff --git a/src/Dodge/Item/Weapon/AutoGun.hs b/src/Dodge/Item/Weapon/AutoGun.hs index 5f422801c..1648077c3 100644 --- a/src/Dodge/Item/Weapon/AutoGun.hs +++ b/src/Dodge/Item/Weapon/AutoGun.hs @@ -66,7 +66,7 @@ autoGun = defaultAutoGun autoGunPic :: SPic autoGunPic = ( colorSH red $ prismPoly - (map (addZ 5) $ rectNESW 2 12 (-2) (-12)) + (map (addZ 5) $ rectNESW 2 12 (-2) (-8)) (map (addZ 0) $ rectNESW 4 12 (-4) (-12)) , mempty ) diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 0e23d68b5..6b6352947 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -25,6 +25,7 @@ import Tile import Polyhedra import Polyhedra.Data +import Data.List (nub) import Control.Monad.State import Control.Lens import System.Random @@ -120,9 +121,9 @@ gameRoomsFromRooms :: [Room] -> [GameRoom] gameRoomsFromRooms = map f where f rm = GameRoom - { _grViewpoints = map fst . foldl' (flip cutWalls) [] $ _rmPolys rm + { _grViewpoints = _rmViewpoints rm ++ (map fst . foldl' (flip cutWalls) [] $ _rmPolys rm) , _grViewpointsEx = map fst (_rmLinks rm) - , _grBound = expandPolyByFixed 100 $ orderPolygon $ convexHullSafe $ concat $ _rmBound rm ++ _rmPolys rm + , _grBound = expandPolyByFixed 100 . convexHullSafe . nub . concat $ _rmBound rm ++ _rmPolys rm , _grDir = snd . last $ _rmLinks rm , _grName = _rmName rm } diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 4dcef9419..faadb804f 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -124,7 +124,7 @@ placeProp pr p a w = (i, w & props %~ addProp) where i = IM.newKey $ _props w addProp prs = IM.insert i (f pr) prs - f = (pjRot +~ a) . (pjPos %~ ( (p +.+) . (rotateV a) )) . (pjID .~ i) + f = (pjRot +~ a) . (pjPos %~ ( (p +.+) . rotateV a )) . (pjID .~ i) placeBt :: Button @@ -136,7 +136,7 @@ placeBt bt p a w = (i , over buttons addBT w) where i = IM.newKey $ _buttons w addBT xs = IM.insert i (f bt) xs - f = (btRot +~ a) . (btPos %~ ( (p +.+) . (rotateV a) )) . (btID .~ i) + f = (btRot +~ a) . (btPos %~ ( (p +.+) . rotateV a )) . (btID .~ i) --addBT bts = IM.insert (IM.newKey bts) (bt {_btPos = p, _btRot = rot, _btID = IM.newKey bts}) bts {- Creates a floor item at a given point. Assigns an id correctly. -} diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 1056361f0..8d9aca99f 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -232,6 +232,7 @@ doDrawing pdata w = do activeTexture $= TextureUnit 1 zipWithM_ (>>) bindings $ map bindDrawDist rds activeTexture $= TextureUnit 0 + renderLayer 5 shadV layerCounts -- draw overlay depthFunc $= Just Always depthMask $= Disabled diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 922629741..cfb34f9e1 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -2,6 +2,8 @@ module Dodge.Render.Picture where import Dodge.Data +import Dodge.Update.Camera +import Dodge.GameRoom import Dodge.Base import Dodge.Base.Window import Dodge.Zone @@ -62,10 +64,11 @@ customMouseCursor w = $ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ] testPic :: World -> Picture -testPic _ = pictures - [ --- , fixedSizePicClampArrow 10 50 thepic (mouseWorldPos w) w - ] +testPic w = setLayer 5 $ color green (concatMap (polygonWire . _grBound) grs) + <> color yellow (concatMap (\q -> line [p,q]) $ farWallPoints p w) + where + p = _crPos $ you w + grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w) -- where -- thepic = setDepth 20 . color green . polygon $ rectNSEW 5 (-5) (-5) (5) --testPic _ = blank diff --git a/src/Dodge/Room/Data.hs b/src/Dodge/Room/Data.hs index 432b26115..207881dfd 100644 --- a/src/Dodge/Room/Data.hs +++ b/src/Dodge/Room/Data.hs @@ -25,5 +25,6 @@ data Room = Room , _rmFloor :: [Tile] , _rmName :: String , _rmShift :: (Point2, Float) + , _rmViewpoints :: [Point2] } makeLenses ''Room diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs index 6376300db..c21bea3ef 100644 --- a/src/Dodge/Room/Link.hs +++ b/src/Dodge/Room/Link.hs @@ -76,6 +76,7 @@ shiftRoomBy shift r = r . (tileZero %~ shiftPointBy shift ) . (tileX %~ shiftPointBy shift ) ) + & rmViewpoints %~ map (shiftPointBy shift) shiftLinkBy :: (Point2,Float) diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 2382d6227..7f7af4cfe 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -48,6 +48,7 @@ twinSlowDoorRoom w h x = defaultRoom ] , _rmBound = ps , _rmName = "twinSlowDoorRoom" + , _rmViewpoints = [V2 0 h] } where wlSpeed = 0.5 @@ -62,7 +63,7 @@ twinSlowDoorRoom w h x = defaultRoom [rectNSWE h 0 (-w) w ,rectNSWE 20 (-h) (negate x) x ] - cond' btid w' = (_btState $ _buttons w' IM.! btid) == BtOn + cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn col = dim $ dim $ bright red twinSlowDoorChasers diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 556f52698..9c863dcbf 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -4,6 +4,7 @@ Functions controlling the movement of the screen camera: and the position that the character sees from: '_cameraViewFrom'. -} module Dodge.Update.Camera ( updateCamera + , farWallPoints ) where import Dodge.Data @@ -176,6 +177,14 @@ farWallDist p w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w) wos = wallsOnScreen w +farWallPoints :: Point2 -> World -> [Point2] +farWallPoints p w = concatMap _grViewpoints grs ++ linkvps + where + grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w) + linkvps = map extend (concatMap _grViewpointsEx grs) + extend :: Point2 -> Point2 + extend outp = p +.+ maxViewDistance *.* safeNormalizeV (outp -.- p) + --farWallDist :: Point2 -> World -> Float --farWallDist p w = (winFac /) $ fromMaybe maxViewDistance -- $ L.fold (L.premap (dist p) L.maximum) vdists diff --git a/src/Geometry.hs b/src/Geometry.hs index 10c8189cc..ce99de928 100644 --- a/src/Geometry.hs +++ b/src/Geometry.hs @@ -121,6 +121,10 @@ orderPolygonAround orderPolygonAround _ [] = [] orderPolygonAround cen ps = sortOn (\p -> argV (p -.- cen)) ps +orderAroundFirstReverse :: [Point2] -> [Point2] +orderAroundFirstReverse [] = [] +orderAroundFirstReverse (a:as) = a : reverse (orderPolygonAround a as) + orderAroundFirst :: [Point2] -> [Point2] orderAroundFirst [] = [] orderAroundFirst (a:as) = a : orderPolygonAround a as @@ -141,8 +145,9 @@ 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. --- it appears that the output may NOT be ordered +-- assumes no repetition of points: try nubbing! convexHullSafe :: [Point2] -> [Point2] +--convexHullSafe (x:y:z:xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b,a)) (x:y:z:xs) convexHullSafe (x:y:z:xs) = grahamScan $ orderAroundFirst $ sortOn (\(V2 a b) -> (b,a)) (x:y:z:xs) convexHullSafe _ = [] diff --git a/src/Picture.hs b/src/Picture.hs index 7ee0f1baa..ae7f8426d 100644 --- a/src/Picture.hs +++ b/src/Picture.hs @@ -5,6 +5,7 @@ module Picture , module Color , blank , polygon + , polygonWire , polygonZ , polygonCol , poly3 @@ -56,6 +57,10 @@ blank :: Picture {-# INLINE blank #-} blank = [] +polygonWire :: [Point2] -> Picture +{-# INLINE polygonWire #-} +polygonWire ps = line (ps ++ [head ps]) + polygon :: [Point2] -> Picture {-# INLINE polygon #-} polygon ps = map f $ polyToTris ps