Implement terminals
This commit is contained in:
@@ -34,7 +34,7 @@ cenLasTur :: Room
|
||||
cenLasTur = roomNgon 8 200 & rmPmnts .~
|
||||
[ putLasTurret 0.02
|
||||
, heightWallPS (resetPLUse $ rprBoolShift (const . isInLnk) (shiftInBy 100)) 30 covershape
|
||||
, mntLightLnkCond $ rpBool isInLnk
|
||||
, mntLightLnkCond $ rprBool $ const . isInLnk
|
||||
]
|
||||
where
|
||||
covershape = rectNSEW 10 (-10) 20 (-20)
|
||||
|
||||
@@ -117,7 +117,7 @@ addButtonSlowDoor x h rm = do
|
||||
Nothing
|
||||
getdoorpos drid w = let Just (a,b) = w ^? doors . ix drid . drPos
|
||||
in (b, argV (a-.-b))
|
||||
butPosCond = useRoomPosCond $ \rp -> isUnusedLnk rp && yV2 (_rpPos rp) < 0.5 * h
|
||||
butPosCond = useRoomPosCond $ \rp _ -> isUnusedLnk' rp && yV2 (_rpPos rp) < 0.5 * h
|
||||
--butPosCond _ = True -- y < h
|
||||
col = dim $ light red
|
||||
cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff
|
||||
|
||||
@@ -51,6 +51,7 @@ roomRect
|
||||
roomRect x y xn yn = defaultRoom
|
||||
{ _rmPolys = [rectNSWE y 0 0 x ]
|
||||
, _rmLinks = lnks
|
||||
, _rmName = "rect"
|
||||
, _rmPath = concatMap doublePair pth
|
||||
, _rmPos = map (roomposat RoomPosOnPath) posps
|
||||
++ map (roomposat RoomPosOffPath) interposps
|
||||
@@ -77,7 +78,7 @@ roomRect x y xn yn = defaultRoom
|
||||
++ m East FromSouth FromNorth elnks
|
||||
++ m West FromSouth FromNorth wlnks
|
||||
++ m South FromWest FromEast slnks
|
||||
m edge edgefrom1 edgefrom2 = zipWith (lnkBothAnd' (OnEdge edge) edgefrom1 edgefrom2) [0..]
|
||||
m edge edgefrom1 edgefrom2 = zipWith (lnkBothAnd (OnEdge edge) edgefrom1 edgefrom2) [0..]
|
||||
. zipCountDown
|
||||
pth = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
|
||||
posps = map (+.+ V2 20 20) $ gridPoints xd (xn+1) yd (yn+1)
|
||||
@@ -86,10 +87,10 @@ roomRect x y xn yn = defaultRoom
|
||||
zipCountDown :: [a] -> [(Int,a)]
|
||||
zipCountDown xs = zip [length xs - 1, length xs - 2 ..] xs
|
||||
|
||||
lnkBothAnd' :: RoomLinkType -> (Int -> RoomLinkType)
|
||||
lnkBothAnd :: RoomLinkType -> (Int -> RoomLinkType)
|
||||
-> (Int -> RoomLinkType)
|
||||
-> Int -> (Int,(Point2,Float)) -> RoomLink
|
||||
lnkBothAnd' rlt ltcon ltcon2 i (j,(p,a)) = RoomLink
|
||||
lnkBothAnd rlt ltcon ltcon2 i (j,(p,a)) = RoomLink
|
||||
{_rlType = S.fromList [OutLink,InLink,rlt,ltcon i,ltcon2 j]
|
||||
,_rlPos = p
|
||||
, _rlDir = a
|
||||
@@ -98,10 +99,13 @@ lnkBothAnd' rlt ltcon ltcon2 i (j,(p,a)) = RoomLink
|
||||
-- it is not clear to me that this works for very small rooms (but it does seem
|
||||
-- to do so)
|
||||
roomRectAutoLinks :: Float -> Float -> Room
|
||||
roomRectAutoLinks x y = (roomRect x y (f x) (f y)) {_rmPmnts = plmnts}
|
||||
roomRectAutoLinks x y = (roomRect x y (f x) (f y))
|
||||
{_rmPmnts = plmnts
|
||||
,_rmName = "autoRect"
|
||||
}
|
||||
where
|
||||
f z = max 1 $ (ceiling z - 40) `div` 60
|
||||
plmnts = [mntLightLnkCond $ resetPLUse $ rpBool isInLnk]
|
||||
plmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp]
|
||||
{- Combines two rooms into one room.
|
||||
- will have to work out exactly what to do with combining links
|
||||
Mostly involves concatenation. -}
|
||||
|
||||
@@ -185,9 +185,9 @@ roomOctogon = defaultRoom
|
||||
roomNgon :: Int -> Float -> Room
|
||||
roomNgon n x = defaultRoom
|
||||
{ _rmPolys = [poly]
|
||||
, _rmLinks = muout (init lnks) ++ muin[last lnks]
|
||||
, _rmLinks = map toBothLnk lnks -- muout (init lnks) ++ muin[last lnks]
|
||||
, _rmPath = [] -- TODO
|
||||
, _rmPmnts = [mntLightLnkCond $ resetPLUse $ rpBool isInLnk]
|
||||
, _rmPmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ const . isInLnk]
|
||||
, _rmBound = [poly]
|
||||
, _rmFloor = Tiled [makeTileFromPoly poly 9]
|
||||
, _rmName = show n ++ "gon"
|
||||
|
||||
@@ -1,13 +1,14 @@
|
||||
module Dodge.Room.SensorDoor where
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.PlacementSpot
|
||||
import Dodge.Placement.Instance.Terminal
|
||||
import Dodge.Data
|
||||
import Dodge.Tree
|
||||
--import Dodge.RoomLink
|
||||
import Dodge.Room.Door
|
||||
import Dodge.Room.Procedural
|
||||
import Dodge.Room.Room
|
||||
--import Dodge.Room.Corridor
|
||||
import Dodge.Room.Corridor
|
||||
import Dodge.Room.Link
|
||||
--import Dodge.Room.Procedural
|
||||
import Dodge.Room.Foreground
|
||||
@@ -22,11 +23,13 @@ import Geometry
|
||||
--import Padding
|
||||
import Color
|
||||
import Shape
|
||||
--import Lorem
|
||||
import LensHelp
|
||||
import Dodge.RandomHelp
|
||||
|
||||
--import qualified Data.Set as S
|
||||
import qualified Data.Set as S
|
||||
import Data.Maybe
|
||||
import Data.Char
|
||||
--import Data.Tree
|
||||
import Control.Monad.State
|
||||
import System.Random
|
||||
@@ -38,6 +41,16 @@ sensorRoom senseType n = do
|
||||
let doorroom = triggerDoorRoom n
|
||||
return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
|
||||
|
||||
sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g (SubCompTree Room)
|
||||
sensorRoomRunPast dt n = do
|
||||
t <- sensorRoom dt n
|
||||
return $ applyToSubforest [0] (++
|
||||
[treeFromPost [PassDown $ door & rmConnectsTo .~ S.member InLink
|
||||
& rmName .~ "test"
|
||||
] (UseLabel 0 corridor)]
|
||||
) t
|
||||
--[return $ UseLabel 0 $ door & rmConnectsTo .~ S.member InLink]
|
||||
|
||||
sensAboveDoor :: DamageType -> Float -> PlacementSpot -> Placement
|
||||
sensAboveDoor sensetype wth ps = extTrigLitPos
|
||||
(atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
|
||||
@@ -48,9 +61,35 @@ sensAboveDoor sensetype wth ps = extTrigLitPos
|
||||
|
||||
sensInsideDoor :: DamageType -> Int -> Room -> Room
|
||||
sensInsideDoor senseType outplid rm = rm
|
||||
& rmPmnts .:~ psPt atFstLnkOut
|
||||
(PutShape $ colorSH yellow $
|
||||
thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
|
||||
<> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
|
||||
<> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
|
||||
& rmName .++~ take 4 (show senseType)
|
||||
& rmPmnts .++~
|
||||
[ psPt atFstLnkOut
|
||||
(PutShape $ colorSH yellow $
|
||||
thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
|
||||
<> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
|
||||
<> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
|
||||
, putTerminal messagef
|
||||
& plGenPL . plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
|
||||
]
|
||||
& rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid]
|
||||
where
|
||||
mtoup = map toUpper
|
||||
horline = "-----------------"
|
||||
topflush = [replicate i ' ' ++ "*" | i <- [0,2 .. length horline -1]]
|
||||
messagef gp =
|
||||
let Just (pc,ds) = gp ^? sensorCoding . ix senseType
|
||||
themessage =
|
||||
topflush ++
|
||||
[horline
|
||||
,"SENSOR ATTRIBUTES"
|
||||
,horline
|
||||
,mtoup $ show senseType
|
||||
,"COLOR:"++ mtoup (show pc)
|
||||
,"SHAPE:"++ mtoup (reverse . drop 10 . reverse $ show ds)
|
||||
,horline
|
||||
]
|
||||
in TerminalParams
|
||||
{_termDisplayedLines = [] --zip (replicate 7 horline) (repeat white)
|
||||
,_termFutureLines = zip (repeat 0) $ zip themessage $ repeat white
|
||||
,_termMaxLines = 7
|
||||
}
|
||||
|
||||
@@ -41,8 +41,8 @@ tanksRoom crs its = do
|
||||
girderPosOrder <- shuffle [1 .. nwestlnks - 2]
|
||||
let plmnts =
|
||||
--ok, this has become complicated
|
||||
foldr1 setFallback [ twoRoomPoss (isUnusedLinkType (FromSouth i))
|
||||
(isUnusedLinkType (FromSouth i)) $ \ps1 ps2 ->
|
||||
foldr1 setFallback [ twoRoomPoss (const . isUnusedLinkType (FromSouth i))
|
||||
(const . isUnusedLinkType (FromSouth i)) $ \ps1 ps2 ->
|
||||
sps0 $ PutShape $ girderV 96 20 10 (_psPos ps1) (_psPos ps2)
|
||||
| i <- girderPosOrder]
|
||||
: map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its
|
||||
|
||||
Reference in New Issue
Block a user