justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add room foregrounds

Browse Source
This commit is contained in:
jgk
2021-06-16 18:18:03 +02:00
parent 29902b6f22
commit 04ed034a3e
6 changed files with 84 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Default/World.hs
+4 -32
View File
@@ -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
src/Dodge/Layout/Tree/Annotate.hs
+2 -4
View File
@@ -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
src/Dodge/LevelGen.hs
+5 -1
View File
@@ -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
src/Dodge/LevelGen/Data.hs
+1
View File
@@ -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
src/Dodge/Room/Foreground.hs
+43
View File
@@ -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)
src/Dodge/Room/Start.hs
+29
View File
@@ -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 :))