Refactor item drawing

This commit is contained in:
2021-10-01 23:01:36 +01:00
parent 5f17841811
commit 8c1496e140
28 changed files with 248 additions and 185 deletions
+35 -51
View File
@@ -4,7 +4,9 @@ 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
import Dodge.Room.Foreground
import Dodge.Default.Room
import Dodge.Data
import Dodge.LevelGen.Data
@@ -13,7 +15,8 @@ import Dodge.RandomHelp
import Geometry
import Picture
import qualified Data.Map as M
import qualified Data.Map.Strict as M
import qualified Data.IntMap.Strict as IM
import System.Random
import Control.Monad.State
import Control.Lens
@@ -39,18 +42,14 @@ airlockOneWay n = defaultRoom
{- |
A passage with a switch that opens forward access while closing backwards access. -}
airlock
:: RandomGen g
=> Int -- ^ Door id
-> State g Room
airlock n = takeOne [airlock0 n,airlock90 n,airlockCrystal n]
airlock :: RandomGen g => State g Room
--airlock = takeOne [airlock0,airlock90,airlockCrystal]
airlock = takeOne [airlock0]
{- |
Straight airlock -}
airlock0
:: Int -- ^ Door id
-> Room
airlock0 n = defaultRoom
airlock0 :: Room
airlock0 = defaultRoom
{ _rmPolys =
[ rectNSWE 100 0 0 40
, rectNSWE 65 35 (-40) 20
@@ -60,12 +59,11 @@ airlock0 n = defaultRoom
,(V2 20 45,V2 20 5)
]
, _rmPS =
[sPS (V2 0 20) 0 $ PutDoubleDoor col (not . cond) (V2 1 0) (V2 39 0) 2
,sPS (V2 0 80) 0 $ PutDoubleDoor col cond (V2 1 0) (V2 39 0) 2
,sPS (V2 35 50) (pi/2) $ PutButton $ makeSwitch col red
(over worldState (M.insert (DoorNumOpen n) True))
(over worldState (M.insert (DoorNumOpen n) False))
,sPS (V2 (-25) 50) 0 putLamp
[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)
$ sPS (V2 0 80) 0 $ PutDoubleDoor col (cond' btid) (V2 1 0) (V2 39 0) 2
,mountedLightI 70 (V2 (-2) 30) (V2 (-2) 70)
,sps0 $ PutForeground $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
]
, _rmBound = [rectNSWE 75 15 0 40]
}
@@ -73,13 +71,12 @@ airlock0 n = defaultRoom
lnks = [(V2 20 95,0)
,(V2 20 5,pi)
]
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn
col = dim $ dim $ bright red
airlock90
:: Int -- ^ Door id
-> Room
airlock90 n = defaultRoom
:: Room
airlock90 = defaultRoom
{ _rmPolys =
[ rectNSWE 100 10 10 100
, rectNSWE 20 0 20 60
@@ -99,11 +96,9 @@ airlock90 n = defaultRoom
,(V2 40 0,V2 0 40)
]
, _rmPS =
[sPS (V2 5 5) 0 $ PutDoor col (not . cond) pss
,sPS (V2 120 120) (3* pi/4) $ PutButton $ makeSwitch col red
(over worldState (M.insert (DoorNumOpen n) True))
(over worldState (M.insert (DoorNumOpen n) False))
,sPS (V2 60 60) 0 putLamp
[ Placement (PS (V2 120 120) (3 * pi/4) (PutButton $ makeSwitch col red id id))
$ \btid -> jsps (V2 5 5) 0 $ PutDoor col (cond btid) pss
,mountedLightV (V2 20 20) (V3 70 70 50)
]
, _rmBound =
[map toV2 [ (10,10)
@@ -114,45 +109,34 @@ airlock90 n = defaultRoom
]]
}
where
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
--cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
col = dim $ dim $ bright red
pss = (V2 0 0 ,) <$> arcStepwise 3 (negate $ pi/2) (V2 0 0) (V2 0 55)
airlockCrystal
:: Int -- ^ Door id
-> Room
airlockCrystal n = defaultRoom
:: Room
airlockCrystal = defaultRoom
{ _rmPolys =
[ rectNSWE 140 0 0 40
, orderPolygon $ map toV2
[(39,20)
,(150,60)
,(150,80)
,(39,120)
]
, orderPolygon $ map toV2 [ (39,20) , (150,60) , (150,80) , (39,120) ]
]
, _rmLinks =
[(V2 20 130,0)
,(V2 20 0 ,pi)
]
, _rmPath =
[
]
, _rmLinks = [(V2 20 130,0) ,(V2 20 0 ,pi) ]
, _rmPath = [ ]
, _rmPS =
[sPS (V2 0 0) 0 $ PutDoor col (not . cond) pss
,sPS (V2 145 70) (pi/2) $ PutButton $ makeSwitch col red
(over worldState (M.insert (DoorNumOpen n) False))
(over worldState (M.insert (DoorNumOpen n) True))
,crystalLine (V2 0 70) (V2 40 70)
--,sPS (V2 20 40) 0 putLamp
--,sPS (V2 20 100) 0 putLamp
[ Placement (PS (V2 145 70) (pi/2) (PutButton $ makeSwitch col red id id))
$ \btid -> jsps0 $ PutDoor col (cond btid) pss
, crystalLine (V2 0 70) (V2 40 70)
, mountedLightV (V2 150 70) (V3 110 70 70)
]
, _rmBound =
[ ]
}
where
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
--cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
col = dim $ dim $ bright red
pss :: [(Point2,Point2)]
pss = reverse $ fmap ( (\x -> (V2 50 x,V2 50 (x+50)) ) . fromIntegral)
pss = reverse $ fmap ( (\x -> (V2 50 (x - 10),V2 50 (x+60)) ) . fromIntegral)
[20::Int,22..70]
+5 -7
View File
@@ -1,10 +1,11 @@
module Dodge.Room.Corridor
where
import Dodge.Room.Data
import Dodge.Room.Foreground
--import Dodge.Room.Foreground
import Dodge.Default.Room
import Dodge.LevelGen.Data
import Dodge.LightSources.Lamp
--import Dodge.LevelGen.Data
--import Dodge.LightSources.Lamp
import Dodge.LightSources.Fitting
import Geometry
import Tile
@@ -16,10 +17,7 @@ corridor = defaultRoom
{ _rmPolys = [poly]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
, _rmPS =
[sPS (V2 20 40) 0 $ PutLS (lightAt (V3 0 0 50) 0)
,sPS (V2 0 0) 0 $ PutForeground $ highPipe 55 (V2 0 40) (V2 40 40)
]
, _rmPS = [ mountedLightI 50 (V2 0 40) (V2 40 40) ]
, _rmBound = [ rectNSWE 50 30 0 40 ]
, _rmFloor = [makeTileFromPoly poly 2]
}
+2 -3
View File
@@ -16,7 +16,6 @@ import Dodge.RandomHelp
import Dodge.Creature.Inanimate
import Dodge.Creature
import Dodge.LightSources.Lamp
import Dodge.Placement
import Picture
import Geometry
@@ -42,8 +41,8 @@ twinSlowDoorRoom w h x = defaultRoom
, _rmPS =
[ Placement (PS (V2 0 (h-5)) pi $ PutButton $ makeSwitch col red id id)
$ \btid -> jsps0J (PutSingleDoor col (cond' btid) (V2 x 1) (V2 x h) wlSpeed)
$ place0 (PutSingleDoor col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed)
$ \did -> Just $ place0 (PutLS (colorLightAt (V3 0.75 0 0) (V3 0 (h-1) lampHeight) 0))
$ ps0 (PutSingleDoor col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed)
$ \did -> Just $ ps0 (PutLS (colorLightAt (V3 0.75 0 0) (V3 0 (h-1) lampHeight) 0))
$ \lsid -> jsps0 $ PutProp $ addColorChange lsid did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight
]
, _rmBound = ps
+4 -5
View File
@@ -29,11 +29,10 @@ centerVaultExplosiveExit
centerVaultExplosiveExit = do
cr <- takeOne [miniGunCrit, autoCrit]
let extraPS =
[sPS (V2 0 175) 0 $ PutCrit explosiveBarrel
,sPS (V2 5 195) 0 $ PutCrit explosiveBarrel
,sPS (V2 0 200) 0 $ PutCrit explosiveBarrel
,sPS (V2 (-4) 195) 0 $ PutCrit explosiveBarrel
[sPS (V2 0 110) 0 $ PutCrit explosiveBarrel
,sPS (V2 5 115) 0 $ PutCrit explosiveBarrel
,sPS (V2 0 120) 0 $ PutCrit explosiveBarrel
,sPS (V2 0 0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll)
]
r <- centerVaultRoom 200 200 50 <&> rmPS %~ (extraPS ++)
r <- centerVaultRoom 120 120 50 <&> rmPS %~ (extraPS ++)
randomiseLinksBy shuffleTail r <&> rmLinks %~ take 2
+10
View File
@@ -4,6 +4,7 @@ module Dodge.Room.Placement
import Dodge.Data
import Dodge.Default.Wall
import Dodge.LevelGen.Data
import Dodge.LevelGen.Switch
import Dodge.Room.Data
import Dodge.Creature.Inanimate
import Picture
@@ -11,6 +12,7 @@ import Geometry
import Data.List
import Control.Lens
import qualified Data.IntMap.Strict as IM
putColorLamp :: Point3 -> PSType
putColorLamp col = PutCrit (colorLamp col 90)
@@ -178,3 +180,11 @@ putBlockN a x b y = [ blockLine (V2 a b) (V2 a y)
, blockLine (V2 x b) (V2 a b)
, blockLine (V2 x y) (V2 x b)
]
switchDoor :: Point2 -> Float -> Point2 -> Point2 -> Color -> Placement
switchDoor btpos btrot dra drb col = Placement (PS btpos btrot $ PutButton $ makeSwitch col red id id)
$ \btid -> jsps0J (PutSingleDoor col (cond btid) dra drc 2)
$ sps0 (PutSingleDoor col (cond btid) drb drc 2)
where
drc = 0.5 *.* (dra +.+ drb)
cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
+8 -6
View File
@@ -15,7 +15,6 @@ import Dodge.Room.Data
import Dodge.Room.Placement
import Dodge.Room.Link
import Dodge.Room.Path
import Dodge.Placement
import Dodge.Default.Room
import Dodge.Item.Consumable
import Dodge.Item.Equipment
@@ -28,6 +27,7 @@ import Dodge.LightSources.Fitting
import Dodge.Creature
--import Dodge.Default
import Geometry
import Geometry.Vector3D
import Picture
import Data.Tile
@@ -235,12 +235,14 @@ centerVaultRoom w h d = do
,sps0 $ PutWall (rectNSEW ( d) (d - 30) (-d) (30 - d)) defaultWall
,sps0 $ PutWall (rectNSEW (-d) (30 - d) ( d) (d - 30)) defaultWall
,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
,sps0 $ PutForeground $ girder 55 10 10 (V2 (-w) (h/2)) (V2 w (h/2))
,sps0 $ PutForeground $ girder 55 10 10 (V2 (-w) (h/2)) (V2 w (h/2))
,mountedLight (V2 (-w) (h/2-20)) (V3 (20-w) (h/2-20) 70)
,mountedLight (V2 w (h/2-20)) (V3 (w-20) (h/2-20) 70)
,mountedLightV (V2 0 (d-20)) (V3 0 0 70)
-- ,sps0 $ PutForeground $ girder 55 10 10 (V2 (-w) (h/2)) (V2 w (h/2))
,sps0 $ PutForeground $ girder 70 10 10 (V2 (d-11) (-d)) (V2 (d-11) (-h))
-- ,mountedLight (V2 (-w) (h/2-20)) (V3 (20-w) (h/2-20) 70)
-- ,mountedLight (V2 w (h/2-20)) (V3 (w-20) (h/2-20) 70)
-- ,mountedLightV (V2 0 (d-20)) (V3 0 0 70)
]
++ map (\a -> mountedLightV (rotateV a $ V2 0 d) (rotate3z a $ V3 0 (d+30) 70))
[0,0.5*pi,pi,1.5*pi]
++ concat (map (\r -> map (shiftPSBy (V2 0 0,r)) $ theDoor)
[0,pi/2,pi,3*pi/2])
, _rmBound = [rectNSWE h (-h) (-w) w]
+5 -3
View File
@@ -13,6 +13,7 @@ import Dodge.LevelGen.Data
--import Dodge.RandomHelp
import Dodge.Creature
import Dodge.Layout.Tree.Polymorphic
import Dodge.LightSources.Fitting
import Data.Tree
import Control.Monad.State
@@ -71,8 +72,9 @@ longBlockedCorridor = do
blockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
blockedCorridor = do
r <- state $ randomR (0,pi)
let plmnts = [sPS (V2 20 40) r $ PutBlock [5,5,5] (V4 (150/256) ( 75/256) 0 ( 250/256))
let plmnts =
[sPS (V2 20 40) r $ PutBlock [5,5,5] (V4 (150/256) ( 75/256) 0 ( 250/256))
$ reverse $ rectNSWE 10 (-10) (-10) 10
,sPS (V2 20 15) 0 putLamp
]
,mountedLightI 55 (V2 0 15) (V2 40 15)
]
sequence $ treeFromPost [] $ return $ Right $ set rmPS plmnts corridor