From 04ed034a3e2c5c162f7c636ff0374cb0111d0093 Mon Sep 17 00:00:00 2001 From: jgk Date: Wed, 16 Jun 2021 18:18:03 +0200 Subject: [PATCH] Add room foregrounds --- src/Dodge/Default/World.hs | 36 +++----------------------- src/Dodge/Layout/Tree/Annotate.hs | 6 ++--- src/Dodge/LevelGen.hs | 6 ++++- src/Dodge/LevelGen/Data.hs | 1 + src/Dodge/Room/Foreground.hs | 43 +++++++++++++++++++++++++++++++ src/Dodge/Room/Start.hs | 29 +++++++++++++++++++++ 6 files changed, 84 insertions(+), 37 deletions(-) create mode 100644 src/Dodge/Room/Foreground.hs create mode 100644 src/Dodge/Room/Start.hs diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index e85638313..562d3e9c2 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -7,11 +7,9 @@ import Dodge.Debug.Flag.Data import Dodge.Config.Data import Dodge.Config.KeyConfig import Dodge.Item.Data -import Picture -import Geometry +--import Picture +--import Geometry --import Picture.Texture -import Data.Tile -import Tile import System.Random import qualified Data.IntMap.Strict as IM @@ -39,23 +37,7 @@ defaultWorld = World , _wallsZone = IM.empty , _forceFields = IM.empty , _floorItems = IM.empty - , _floorTiles = tToRender $ Tile - { _tilePoly = rectNSWE 200 0 0 200 - , _tileCenter = (0,0) - , _tileX = (100,0) - , _tileY = (0,100) - , _tileZ = 16 - } --- let x = 200 --- y = 0.9 --- z = 16 --- r = 8 --- in tileToRender [(0,0,z),(r,0,z),(r,r,z),(0,r,z)] --- [(20,100 + 20,y) --- ,( x,100 + 20,y) --- ,( x,100 + x,y) --- ,(20,100 + x,y) --- ] + , _floorTiles = [] , _randGen = mkStdGen 2 , _mousePos = (0,0) , _testString = [] @@ -95,18 +77,8 @@ defaultWorld = World , _debugFlags = defaultDebugFlags , _inventoryMode = TopInventory , _lClickHammer = HammerUp - , _foregroundDecorations = - [ setDepth (-0.1) $ color orange $ pictures - [ polygon $ rectNSEW 50 40 140 (-20) - , translate 60 45 $ scale 0.5 1 $ thickArc 0 pi 75 10 - , translate (-20) 300 $ polygon $ rectNSEW 10 0 40 0 - ] - , setDepth (-0.2) $ rotate 0.75 $ pictures - $ map f [5,25,45,65] - ] + , _foregroundDecorations = [] } - where - f x = polygon $ rectNSEW (x - 20) (x-22) 500 0 defaultDebugFlags :: DebugFlags defaultDebugFlags = DebugFlags { _noClip = False diff --git a/src/Dodge/Layout/Tree/Annotate.hs b/src/Dodge/Layout/Tree/Annotate.hs index a9445b009..7de924bce 100644 --- a/src/Dodge/Layout/Tree/Annotate.hs +++ b/src/Dodge/Layout/Tree/Annotate.hs @@ -16,6 +16,7 @@ import Dodge.Room.Treasure import Dodge.Room.Link import Dodge.Room.Data import Dodge.Room.Airlock +import Dodge.Room.Start import Dodge.Room import Dodge.Room.Teleport @@ -80,10 +81,7 @@ annoToRoomTree [FirstWeapon] = do blockedC <- longBlockedCorridor join $ takeOne $ return (appendEitherTree branchWP [blockedC]) : replicate 5 weaponRoom annoToRoomTree [EndRoom] = fmap (pure . Right) (telRoomLev 1) -annoToRoomTree [StartRoom] = do - w <- state $ randomR (100,400) - h <- state $ randomR (200,400) - pure . Right <$> randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h) +annoToRoomTree [StartRoom] = startRoom annoToRoomTree (SpecificRoom rt:_) = rt annoToRoomTree (BossAno cr : _) = do br <- bossRoom cr diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index cb5362ccf..6ce6dbe94 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -81,6 +81,7 @@ placeSpot ps w = case _psType ps of PutDoubleDoor col f a b -> putDoubleDoor col f (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w PutAutoDoor a b -> addAutoDoor (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w PutBlock (hp:hps) col ps' -> putBlock (map (shiftPointBy (p,rot)) ps') hp col False hps w + PutBlock _ _ _ -> error "messed up block placement somehow" PutBtDoor c bp f a b -> addButtonDoor c (shiftPointBy (p,rot) bp) (f + rot) (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w PutSwitchDoor c bp f a b -> addSwitchDoor c (shiftPointBy (p,rot) bp) (f + rot) @@ -91,7 +92,10 @@ placeSpot ps w = case _psType ps of where (q:qs) = map (shiftPointBy (p,rot)) ps' rmCrossPaths w' = foldr (uncurry removePathsCrossing) w' $ zip (q:qs) (qs++[q]) - _ -> w + PutForeground pic -> w & foregroundDecorations %~ (uncurry translate p (rotate rot pic) :) + PutNothing -> w + PutID _ -> w + --_ -> w where p = _psPos ps rot = _psRot ps diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 2d3f63d48..a15d54725 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -22,6 +22,7 @@ data PSType = PutCrit {_unPutCrit :: Creature} | PutBtDoor Color Point2 Float Point2 Point2 | PutSwitchDoor Color Point2 Float Point2 Point2 | RandPS (State StdGen PSType) + | PutForeground Picture | PutNothing | PutID { _putID :: Int} data PlacementSpot = PS diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs new file mode 100644 index 000000000..955073729 --- /dev/null +++ b/src/Dodge/Room/Foreground.hs @@ -0,0 +1,43 @@ +module Dodge.Room.Foreground + where +import Picture +import Geometry +import Geometry.Data + +import Data.List +import Data.Maybe + +highDiagonalMesh + :: Point2 + -> Point2 + -> Float -- ^ width + -> Float -- ^ vertical distance between lines + -> Picture +highDiagonalMesh pa pb w d = setDepth (-0.2) $ pictures $ + (map (flip thickLine 1 . flat2) $ diagonalLinesRect pb pa w d (pi/4)) + ++ + (map (flip thickLine 1 . flat2) $ diagonalLinesRect pa pc h d (3* pi/4)) + where + pc = pa +.+ w *.* normalizeV (vNormal (pb -.- pa)) + h = dist pa pb + +diagonalLinesRect + :: Point2 + -> Point2 + -> Float -- ^ width + -> Float -- ^ vertical distance between lines + -> Float + -> [(Point2,Point2)] +diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints + where + xVec = negate w *.* vNormal (normalizeV $ pb -.- pa) + diVec = rotateV ang xVec + pax = pa +.+ xVec + pbx = pb +.+ xVec + lhsPoints = divideLine d (pa -.- yN) (pb +.+ yN) + findDiPoint p = head . sortOn (dist p) $ catMaybes + [intersectLineLine' p (p +.+ diVec) pax pbx + ,intersectSegLine' pa pax p (p +.+ diVec) + ,intersectSegLine' pb pbx p (p +.+ diVec) + ] + yN = d * 0.5 *.* (normalizeV $ pa -.- pb) diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs new file mode 100644 index 000000000..5c8e066af --- /dev/null +++ b/src/Dodge/Room/Start.hs @@ -0,0 +1,29 @@ +module Dodge.Room.Start + where +import Dodge.Room.Data +import Dodge.Room.Link +import Dodge.Room.Procedural +import Dodge.Room.Foreground +import Dodge.LevelGen.Data +import Picture +--import Geometry + +import Data.Tree +import Control.Monad.State +import Control.Lens +import System.Random + +startRoom :: RandomGen g => State g (Tree (Either Room Room)) +startRoom = do + w <- state $ randomR (100,400) + h <- state $ randomR (200,400) + let fground = sPS (0,0) 0 $ PutForeground $ pictures + [ highDiagonalMesh (0,0) (0,h) w 25 + --, setDepth (-0.1) $ color orange $ pictures + -- [ polygon $ rectNSEW 50 40 140 (-20) + -- , translate 60 45 $ scale 0.5 1 $ thickArc 0 pi 75 10 + -- , translate (-20) 300 $ polygon $ rectNSEW 10 0 40 0 + -- ] + , highDiagonalMesh (w,0) (0,0) h 25 + ] + pure . Right <$> randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h & rmPS %~ (fground :))