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

Add flavour text, start smoke, support for different reload sounds

Browse Source
This commit is contained in:
justin
2021-06-22 14:42:23 +02:00
parent 52eaeead5d
commit 39218ed3b5
31 changed files with 128 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Foreground.hs
+11 -8
View File
@@ -69,8 +69,8 @@ girderZ w x y = setDepth (-0.1) $ color red $ pictures $
dia = rotateV (pi/4) n
ps' = map (\p -> intersectSegLine' xt yt p (p +.+ dia)) ps
ls = catMaybes $ zipWith (fmap . (,)) ps ps'
girderV :: Float -> Point2 -> Point2 -> Picture
girderV w x y = setDepth (-0.1) $ color red $ pictures $
girderV :: Color -> Float -> Point2 -> Point2 -> Picture
girderV col w x y = setDepth (-0.1) $ color col $ pictures $
[ thickLine [xt,yt] 3
, thickLine [xb,yb] 3
]
@@ -83,16 +83,19 @@ girderV w x y = setDepth (-0.1) $ color red $ pictures $
xt = x -.- n
yt = y -.- n
ps = divideLineExact (w*2) xb yb
(as,bs) = evenOddSplit ps
(as,_) = evenOddSplit ps
f a = map (\p -> intersectSegLine' xt yt p (p +.+ (rotateV a n)))
as' = catMaybes $ zipWith (fmap . (,)) as $ f (pi/4) as
bs' = catMaybes $ zipWith (fmap . (,)) as $ f (3*pi/4) as
girder :: Float -> Point2 -> Point2 -> Picture
girder w x y = setDepth (-0.1) $ color red $ pictures $
[ thickLine [xt,yt] 3
, thickLine [xb,yb] 3
girder :: Color -> Float -> Point2 -> Point2 -> Picture
girder col w x y = pictures $
[ setDepth (-0.1) $ color col $ pictures $
[ thickLine [xt,yt] 3
, thickLine [xb,yb] 3
]
++ map (flip thickLine 3 . flat2) ls
]
++ map (flip thickLine 3 . flat2) ls
++ map (\p -> verticalPipe 1.5 col p 0 (-0.1)) [xb,xt,yb,yt]
where
n = w *.* (normalizeV $ vNormal $ y -.- x)
xb = x +.+ n
src/Dodge/Room/Start.hs
+11 -9
View File
@@ -1,9 +1,11 @@
module Dodge.Room.Start
where
import Dodge.Room.Data
import Dodge.Room.Door
import Dodge.Room.Link
import Dodge.Room.Procedural
import Dodge.Room.Foreground
import Dodge.Layout.Tree.Polymorphic
import Dodge.LevelGen.Data
import Picture
--import Geometry
@@ -13,19 +15,19 @@ import Control.Monad.State
import Control.Lens
import System.Random
rezBox :: Room
rezBox = shiftRoomBy ((-20,-10),0) $ roomRect 40 20 1 1 & rmPS .~ []
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 50
----, 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 50
[ highPipe (0,h/2) (w, h/2)
, girderV 10 (0,3*h/4) (w, 3*h/4)
, girderV cola 10 (0,3*h/4) (w, 3*h/4)
, girder colb 5 (0,5*h/8) (w, 5*h/8)
]
pure . Right <$> randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h & rmPS %~ (fground :))
treeFromPost [Left rezBox, Left door] . Right <$> randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h & rmPS %~ (fground :))
where
cola = dark . dark . light . light $ light red
colb = dark . dark . light . light $ light blue