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

Cleanup

Browse Source
This commit is contained in:
justin
2021-10-19 13:14:52 +01:00
parent d46de1ca80
commit 9e9d2b5def
15 changed files with 71 additions and 122 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Airlock.hs
+8 -42
View File
@@ -1,8 +1,6 @@
{-# LANGUAGE TupleSections #-}
{-
Rooms that contain two doors and a switch alternating both. -}
module Dodge.Room.Airlock
where
{- Rooms that contain two doors and a switch alternating both. -}
module Dodge.Room.Airlock where
import Dodge.Room.Data
import Dodge.LightSources.Fitting
import Dodge.Room.Placement
@@ -15,49 +13,18 @@ import Dodge.RandomHelp
import Geometry
import Picture
import qualified Data.Map.Strict as M
import qualified Data.IntMap.Strict as IM
import System.Random
import Control.Monad.State
import Control.Lens
airlockOneWay :: Int -> Room
airlockOneWay n = defaultRoom
{ _rmPolys = [rectNSWE 90 0 0 40]
, _rmLinks = lnks
, _rmPath = []
, _rmPS = [sPS (V2 0 15) 0 $ PutDoubleDoor col (not . cond) (V2 0 0) (V2 0 40) 2
,sPS (V2 0 75) 0 $ PutDoubleDoor col cond (V2 0 0) (V2 0 40) 2
,sPS (V2 35 45) (pi/2) $ PutButton $ makeButton col (over worldState
(M.insert (DoorNumOpen n) True))
]
--, _rmBound = rectNSWE 90 30 (-30) 30
, _rmBound = [rectNSWE 75 15 0 40]
}
where lnks = [(V2 0 85,0)
,(V2 0 5,pi)
]
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
col = dim $ dim $ bright red
{- |
A passage with a switch that opens forward access while closing backwards access. -}
{- | A passage with a switch that opens forward access while closing backwards access. -}
airlock :: RandomGen g => State g Room
--airlock = takeOne [airlock0,airlock90,airlockCrystal]
airlock = takeOne [airlock0]
{- |
Straight airlock -}
airlock = takeOne [airlock0,airlock90,airlockCrystal]
{- | Straight airlock -}
airlock0 :: Room
airlock0 = defaultRoom
{ _rmPolys =
[ rectNSWE 100 0 0 40
, rectNSWE 65 35 (-40) 20
]
{ _rmPolys = [ rectNSWE 100 0 0 40 , rectNSWE 65 35 (-40) 20 ]
, _rmLinks = lnks
, _rmPath = [(V2 20 95,V2 20 45)
,(V2 20 45,V2 20 5)
]
, _rmPath = [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20 5) ]
, _rmPS =
[Placement (PS (V2 (-35) 50) (negate $ pi/2) $ PutButton $ makeSwitch col red id id)
$ \btid -> jspsJ (V2 0 20) 0 (PutDoubleDoor col (not . cond' btid) (V2 1 0) (V2 39 0) 2)
@@ -74,8 +41,7 @@ airlock0 = defaultRoom
cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn
col = dim $ dim $ bright red
airlock90
:: Room
airlock90 :: Room
airlock90 = defaultRoom
{ _rmPolys =
[ rectNSWE 100 10 10 100
src/Dodge/Room/Foreground.hs
+6 -3
View File
@@ -8,6 +8,7 @@ import Geometry
--import Geometry.Data
import Geometry.Vector3D
import Shape
import Quaternion
import Data.List
import Data.Maybe
@@ -133,9 +134,11 @@ robotArm = undefined
pipePP :: Float -> Point3 -> Point3 -> Shape
pipePP w a b = prismPoly
(map ((+.+.+ a) . addZ 0) $ polyCirc 4 w)
(map ((+.+.+ b) . addZ 0) $ polyCirc 4 w)
(map ((+.+.+ a) . rotateToZ z1 . addZ 0) $ polyCirc 4 w)
(map ((+.+.+ b) . rotateToZ z1 . addZ 0) $ polyCirc 4 w)
where
z1 = b -.-.- a
tankTopPipe :: Shape
tankTopPipe = colorSH orange $
upperPrismPoly 31 (polyCirc 4 20)
src/Dodge/Room/Furniture.hs
+5 -5
View File
@@ -8,9 +8,10 @@ import Dodge.Default.Wall
import Geometry
import Shape
import Color
--import Quaternion
roundTankTopRail :: Color -> Float -> Float -> Placement
roundTankTopRail col x y = shiftPlacement (V2 x y,0) $ ps0j
roundTank :: Color -> Float -> Float -> Placement
roundTank col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
upperPrismPoly 31 thecircle
<> foldMap toprail ( take 8 [0,pi/4..])
@@ -47,8 +48,8 @@ tankSquareCross = tankRectCross 20 20
tankRect :: Float -> Float -> Color -> Float -> Float -> Placement
tankRect w h col x y = shiftPlacement (V2 x y,0) $ ps0j
(PutForeground $ colorSH col $
upperPrismPoly 31 therect
(PutForeground $ colorSH col
$ upperPrismPoly 31 therect
<> foldMap f [(w',-w',h',h'),(w',-w',-h',-h'),(w',w',h',-h'),(-w',-w',h',-h')]
)
$ sps0 $ PutWall therect defaultWall {_wlDraw = False, _wlColor = col, _wlRotateTo = False}
@@ -77,7 +78,6 @@ tankRectEmboss w h col x y = shiftPlacement (V2 x y,0) $ ps0j
[V3 w h 31,V3 w (0.3*h) 41,V3 w (-0.3*h) 41,V3 w (-h) 31]
[V3 w' h 31,V3 w' (0.3*h) 41,V3 w' (-0.3*h) 41,V3 w' (-h) 31]
tankSquareEmboss :: Color -> Float -> Float -> Placement
tankSquareEmboss = tankRectEmboss 20 20
src/Dodge/Room/Start.hs
+6 -5
View File
@@ -11,6 +11,7 @@ import Dodge.LevelGen.Data
import Dodge.LightSources.Fitting
import Geometry.Data
import Color
import Shape
import Data.Tree
import Control.Monad.State
@@ -26,15 +27,15 @@ startRoom = do
w <- state $ randomR (100,400)
h <- state $ randomR (200,400)
let fground = sPS (V2 0 0) 0 $ PutForeground $
girderV 40 20 10 (V2 0 (h/2)) (V2 w (h/2))
-- <> highPipe 40 (V2 0 (h/2)) (V2 w (h/2))
-- <> highPipe 60 (V2 (w/3) 0 ) (V2 (w/3) h )
girderV 40 20 10 (V2 0 (h/2)) (V2 w (h/2))
treeFromPost [Left rezBox, Left door] . Right
<$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0)
$ roomRectAutoLinks w h & rmPS .~
$ roomRectAutoLinks w h & rmPS .~
[ fground
, mountedLightJ (V2 0 (h/3)) (V3 40 (h/3) 70)
, tankSquareEmboss4 (dim orange) 50 (h-60)
, tankSquareEmboss4 (dim orange) 50 50
, tankSquare (dim orange) 50 50
, tankSquare (dim orange) 50 120
, sps0 $ PutForeground $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
]
)
src/Dodge/Room/Teleport.hs
+3 -7
View File
@@ -1,15 +1,11 @@
{-
Specification of rooms that teleport (between levels).
-}
{- Specification of rooms that teleport (between levels). -}
module Dodge.Room.Teleport
where
import Dodge.Data
import Dodge.World.Trigger.Data
import Dodge.Base
import Dodge.Room.Data
import Dodge.Room.Procedural
import Dodge.Room.Placement
--import Dodge.Layout
import Dodge.LevelGen.Data
import Geometry
import Picture
@@ -42,6 +38,6 @@ telRoomLev i = do
}
ppFootprint = rectNSEW 20 (-20) 20 (-20)
levelReset pp w
| dist (_crPos $ you w) (_ppPos pp) < 20 = makeExplosionAt (_ppPos pp) $ startNewGame w
| dist (_crPos $ you w) (_ppPos pp) < 20 = makeExplosionAt (_ppPos pp) $
w & worldTriggers %~ S.insert (ResetLevel i)
| otherwise = w
startNewGame w = w & worldTriggers %~ S.insert (ResetLevel i)