Tweak switch doors
This commit is contained in:
@@ -77,10 +77,11 @@ spaceAction w = if _carteDisplay w
|
||||
else
|
||||
case listToMaybe $ _closeActiveObjects w of
|
||||
Just (Left flit) -> pickUpItem' flit w
|
||||
Just (Right but) -> _btEvent but but w
|
||||
Just (Right but) -> updateTopCloseObject (_btID but) $ _btEvent but but w
|
||||
Nothing -> w
|
||||
where
|
||||
theLoc = fst (_seenLocations w IM.! _selLocation w) w
|
||||
updateTopCloseObject i w = w & closeActiveObjects %~ ( Right (_buttons w IM.! i) : ) . tail
|
||||
|
||||
pauseGame :: World -> World
|
||||
pauseGame w = w {_menuLayers = [PauseMenu]}
|
||||
|
||||
+23
-21
@@ -26,12 +26,13 @@ checkInvSlotsYou' it w = fmap fst $ find cond invListSelFirst
|
||||
|
||||
checkInvSlotsYou :: Item -> World -> Maybe Int
|
||||
checkInvSlotsYou it w = fmap fst $ find cond invListSelFirst
|
||||
where cond (_,NoItem) = True
|
||||
cond (_,it' ) = itNotFull it' && _itName it == _itName it'
|
||||
youCr = you w
|
||||
youSel = _crInvSel youCr
|
||||
invList = _crInv youCr
|
||||
invListSelFirst = (youSel , invList IM.! youSel) : IM.toList invList
|
||||
where
|
||||
cond (_,NoItem) = True
|
||||
cond (_,it' ) = itNotFull it' && _itName it == _itName it'
|
||||
youCr = you w
|
||||
youSel = _crInvSel youCr
|
||||
invList = _crInv youCr
|
||||
invListSelFirst = (youSel , invList IM.! youSel) : IM.toList invList
|
||||
|
||||
checkInvSlots :: Item -> IM.IntMap Item -> Maybe Int
|
||||
checkInvSlots it its = fmap fst $ find cond $ IM.toList its
|
||||
@@ -79,21 +80,22 @@ closestActiveObject w = listToMaybe $ sortBy (compare `on` dist ypos . pos) $ ac
|
||||
|
||||
updateCloseObjects :: World -> World
|
||||
updateCloseObjects w = w & closeActiveObjects .~ unionBy eTest oldCloseFiltered currentClose
|
||||
where filt = filter $ \obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w
|
||||
ypos = _crPos $ you w
|
||||
objs = map Left (IM.elems $ _floorItems w) ++ activeButtons
|
||||
activeButtons = map Right
|
||||
. filter ( (/=) BtNoLabel . _btState)
|
||||
. IM.elems
|
||||
$ _buttons w
|
||||
pos (Right x) = _btPos x
|
||||
pos (Left x) = _flItPos x
|
||||
eTest (Right x) (Right y) = _btID x == _btID y
|
||||
eTest (Left x) (Left y) = _flItID x == _flItID y
|
||||
eTest _ _ = False
|
||||
currentClose = filt objs
|
||||
oldClose = filt $ _closeActiveObjects w
|
||||
oldCloseFiltered = intersectBy eTest oldClose currentClose
|
||||
where
|
||||
filt = filter $ \obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w
|
||||
ypos = _crPos $ you w
|
||||
objs = map Left (IM.elems $ _floorItems w) ++ activeButtons
|
||||
activeButtons = map Right
|
||||
. filter ( (/=) BtNoLabel . _btState)
|
||||
. IM.elems
|
||||
$ _buttons w
|
||||
pos (Right x) = _btPos x
|
||||
pos (Left x) = _flItPos x
|
||||
eTest (Right x) (Right y) = _btID x == _btID y
|
||||
eTest (Left x) (Left y) = _flItID x == _flItID y
|
||||
eTest _ _ = False
|
||||
currentClose = filt objs
|
||||
oldClose = filt $ _closeActiveObjects w
|
||||
oldCloseFiltered = intersectBy eTest oldClose currentClose
|
||||
|
||||
closeObjScrollUp :: World -> World
|
||||
closeObjScrollUp = over closeActiveObjects rotU
|
||||
|
||||
@@ -39,14 +39,14 @@ makeSwitch c effOn effOff = Button
|
||||
, _btRot = 0
|
||||
, _btEvent = flipSwitch
|
||||
, _btID = 0
|
||||
, _btText = "Switch"
|
||||
, _btText = "SWITCH/"
|
||||
, _btState = BtOff
|
||||
}
|
||||
where
|
||||
flipSwitch b w = switchEffect b . soundOnce 1 $ w
|
||||
switchEffect b = case _btState b of
|
||||
BtOff -> effOn . over buttons (IM.adjust turnOn (_btID b))
|
||||
BtOn -> effOff . over buttons (IM.adjust turnOff (_btID b))
|
||||
BtOff -> effOn . over buttons (IM.adjust turnOn (_btID b))
|
||||
BtOn -> effOff . over buttons (IM.adjust turnOff (_btID b))
|
||||
offPict = onLayer WlLayer $ color c $ pictures [--translate (-8) 4 $ circleSolid 5
|
||||
polygon $ rectNSEW (-2) (-5) (-10) (10)
|
||||
,polygon [(-2,-5),(-10,4),(-6,4),(2,-5)]
|
||||
@@ -56,6 +56,14 @@ makeSwitch c effOn effOff = Button
|
||||
,polygon [(-2,-5), (6,4),( 10,4),(2,-5)]
|
||||
]
|
||||
turnOn :: Button -> Button
|
||||
turnOn bt = bt {_btState = BtOn, _btPict = onPict}
|
||||
turnOn bt = bt
|
||||
{ _btState = BtOn
|
||||
, _btPict = onPict
|
||||
, _btText = "SWITCH\\"
|
||||
}
|
||||
turnOff :: Button -> Button
|
||||
turnOff bt = bt {_btState = BtOff, _btPict = offPict}
|
||||
turnOff bt = bt
|
||||
{ _btState = BtOff
|
||||
, _btPict = offPict
|
||||
, _btText = "SWITCH/"
|
||||
}
|
||||
|
||||
@@ -67,45 +67,40 @@ triggerDoor c cond a b wls = IM.union wls $ IM.fromList $ zip is $ mkTriggerDoor
|
||||
|
||||
mkTriggerDoor :: Color -> (World -> Bool) -> Point2 -> Point2 -> [Int] -> [Wall]
|
||||
mkTriggerDoor c cond pl pr xs = addSound $ zipWith3 (triggerDoorPane c cond)
|
||||
xs
|
||||
[ [pld,hwd,hw,pl]
|
||||
, [hwd,hwu]
|
||||
, [hwu,plu,pl,hw]
|
||||
, [plu,pld]
|
||||
, [pru,hwu,hw,pr]
|
||||
, [hwu,hwd]
|
||||
, [hwd,prd,pr,hw]
|
||||
, [prd,pru]
|
||||
]
|
||||
[ [plld,pld,pl,pl]
|
||||
, [pld,plu]
|
||||
, [plu,pllu,pl,pl]
|
||||
, [pllu,plld]
|
||||
, [prru,pru,pr,pr]
|
||||
, [pru,prd]
|
||||
, [prd,prrd,pr,pr]
|
||||
, [prrd,prru]
|
||||
]
|
||||
where norm = 14 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
|
||||
hw = 0.5 *.* (pl +.+ pr)
|
||||
perp = 20 *.* normalizeV (pl -.- pr)
|
||||
--perp = pl -.- hw
|
||||
plu = pl +.+ norm
|
||||
pld = pl -.- norm
|
||||
pru = pr +.+ norm
|
||||
prd = pr -.- norm
|
||||
hwu = hw +.+ norm
|
||||
hwd = hw -.- norm
|
||||
pllu = plu +.+ perp
|
||||
plld = pld +.+ perp
|
||||
prru = pru -.- perp
|
||||
prrd = prd -.- perp
|
||||
addSound (x:xs) = f x : xs
|
||||
f wl = over doorMech g wl
|
||||
g dm w | dist wp pld > 2 && dist wp hwd > 2 = soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0
|
||||
xs
|
||||
(leftDoor ++ rightDoor)
|
||||
(map shiftLeft leftDoor ++ map shiftRight rightDoor)
|
||||
where
|
||||
leftDoor =
|
||||
[ [pld +.+ perp,hwd]
|
||||
, [hwd, hwu]
|
||||
, [hwu, plu +.+ perp]
|
||||
, [plu +.+ perp,pld +.+ perp]
|
||||
]
|
||||
rightDoor =
|
||||
[ [pru -.- perp,hwu]
|
||||
, [hwu, hwd]
|
||||
, [hwd, prd -.- perp]
|
||||
, [prd -.- perp,pru -.- perp]
|
||||
]
|
||||
shiftRight = map (+.+ (0.5 *.* (pr -.- pl)))
|
||||
shiftLeft = map (+.+ (0.5 *.* (pl -.- pr)))
|
||||
norm = 14 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
|
||||
hw = 0.5 *.* (pl +.+ pr)
|
||||
perp = 5 *.* normalizeV (pl -.- pr)
|
||||
plu = pl +.+ norm
|
||||
pld = pl -.- norm
|
||||
pru = pr +.+ norm
|
||||
prd = pr -.- norm
|
||||
hwu = hw +.+ norm
|
||||
hwd = hw -.- norm
|
||||
addSound (x:xs) = f x : xs
|
||||
f wl = over doorMech g wl
|
||||
g dm w | dist wp pld > 2 && dist wp hwd > 2
|
||||
= soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0
|
||||
$ dm w
|
||||
| otherwise = dm w
|
||||
where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1
|
||||
| otherwise = dm w
|
||||
where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1
|
||||
|
||||
triggerDoorPane :: Color -> (World -> Bool) -> Int -> [Point2] -> [Point2] -> Wall
|
||||
triggerDoorPane c cond n closedPos openPos = Door
|
||||
|
||||
+6
-6
@@ -66,20 +66,20 @@ airlockOneWay n = Room
|
||||
airlock :: Int -> Room
|
||||
airlock n = Room
|
||||
{ _rmPolys =
|
||||
[ rectNSWE 90 0 0 40
|
||||
, rectNSWE 60 30 (-40) 20
|
||||
[ rectNSWE 100 0 0 40
|
||||
, rectNSWE 65 35 (-40) 20
|
||||
]
|
||||
, _rmLinks = lnks
|
||||
, _rmPath = [((20,85),(20,45))
|
||||
,((20,45),(20, 5))
|
||||
]
|
||||
, _rmPS =
|
||||
[PS (0,15) 0 $ PutTriggerDoor col (not . cond) (1,0) (39,0)
|
||||
,PS (0,75) 0 $ PutTriggerDoor col (cond) (1,0) (39,0)
|
||||
,PS (35,45) (pi/2) $ PutButton $ makeSwitch col
|
||||
[PS (0,20) 0 $ PutTriggerDoor col (not . cond) (1,0) (39,0)
|
||||
,PS (0,80) 0 $ PutTriggerDoor col (cond) (1,0) (39,0)
|
||||
,PS (35,50) (pi/2) $ PutButton $ makeSwitch col
|
||||
(over worldState (M.insert (DoorNumOpen n) True))
|
||||
(over worldState (M.insert (DoorNumOpen n) False))
|
||||
,PS (-25, 45) 0 putLamp
|
||||
,PS (-25, 50) 0 putLamp
|
||||
]
|
||||
, _rmBound = rectNSWE 75 15 0 40
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user