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

Tweak switch doors

Browse Source
This commit is contained in:
justin
2021-04-22 17:10:53 +02:00
parent 6c65515381
commit fdac382c61
5 changed files with 77 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Event/Keyboard.hs
+2 -1
View File
@@ -77,10 +77,11 @@ spaceAction w = if _carteDisplay w
else else
case listToMaybe $ _closeActiveObjects w of case listToMaybe $ _closeActiveObjects w of
Just (Left flit) -> pickUpItem' flit w 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 Nothing -> w
where where
theLoc = fst (_seenLocations w IM.! _selLocation w) w theLoc = fst (_seenLocations w IM.! _selLocation w) w
updateTopCloseObject i w = w & closeActiveObjects %~ ( Right (_buttons w IM.! i) : ) . tail
pauseGame :: World -> World pauseGame :: World -> World
pauseGame w = w {_menuLayers = [PauseMenu]} pauseGame w = w {_menuLayers = [PauseMenu]}
src/Dodge/Inventory.hs
+23 -21
View File
@@ -26,12 +26,13 @@ checkInvSlotsYou' it w = fmap fst $ find cond invListSelFirst
checkInvSlotsYou :: Item -> World -> Maybe Int checkInvSlotsYou :: Item -> World -> Maybe Int
checkInvSlotsYou it w = fmap fst $ find cond invListSelFirst checkInvSlotsYou it w = fmap fst $ find cond invListSelFirst
where cond (_,NoItem) = True where
cond (_,it' ) = itNotFull it' && _itName it == _itName it' cond (_,NoItem) = True
youCr = you w cond (_,it' ) = itNotFull it' && _itName it == _itName it'
youSel = _crInvSel youCr youCr = you w
invList = _crInv youCr youSel = _crInvSel youCr
invListSelFirst = (youSel , invList IM.! youSel) : IM.toList invList invList = _crInv youCr
invListSelFirst = (youSel , invList IM.! youSel) : IM.toList invList
checkInvSlots :: Item -> IM.IntMap Item -> Maybe Int checkInvSlots :: Item -> IM.IntMap Item -> Maybe Int
checkInvSlots it its = fmap fst $ find cond $ IM.toList its 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 :: World -> World
updateCloseObjects w = w & closeActiveObjects .~ unionBy eTest oldCloseFiltered currentClose updateCloseObjects w = w & closeActiveObjects .~ unionBy eTest oldCloseFiltered currentClose
where filt = filter $ \obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w where
ypos = _crPos $ you w filt = filter $ \obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w
objs = map Left (IM.elems $ _floorItems w) ++ activeButtons ypos = _crPos $ you w
activeButtons = map Right objs = map Left (IM.elems $ _floorItems w) ++ activeButtons
. filter ( (/=) BtNoLabel . _btState) activeButtons = map Right
. IM.elems . filter ( (/=) BtNoLabel . _btState)
$ _buttons w . IM.elems
pos (Right x) = _btPos x $ _buttons w
pos (Left x) = _flItPos x pos (Right x) = _btPos x
eTest (Right x) (Right y) = _btID x == _btID y pos (Left x) = _flItPos x
eTest (Left x) (Left y) = _flItID x == _flItID y eTest (Right x) (Right y) = _btID x == _btID y
eTest _ _ = False eTest (Left x) (Left y) = _flItID x == _flItID y
currentClose = filt objs eTest _ _ = False
oldClose = filt $ _closeActiveObjects w currentClose = filt objs
oldCloseFiltered = intersectBy eTest oldClose currentClose oldClose = filt $ _closeActiveObjects w
oldCloseFiltered = intersectBy eTest oldClose currentClose
closeObjScrollUp :: World -> World closeObjScrollUp :: World -> World
closeObjScrollUp = over closeActiveObjects rotU closeObjScrollUp = over closeActiveObjects rotU
src/Dodge/LevelGen/Switch.hs
+13 -5
View File
@@ -39,14 +39,14 @@ makeSwitch c effOn effOff = Button
, _btRot = 0 , _btRot = 0
, _btEvent = flipSwitch , _btEvent = flipSwitch
, _btID = 0 , _btID = 0
, _btText = "Switch" , _btText = "SWITCH/"
, _btState = BtOff , _btState = BtOff
} }
where where
flipSwitch b w = switchEffect b . soundOnce 1 $ w flipSwitch b w = switchEffect b . soundOnce 1 $ w
switchEffect b = case _btState b of switchEffect b = case _btState b of
BtOff -> effOn . over buttons (IM.adjust turnOn (_btID b)) BtOff -> effOn . over buttons (IM.adjust turnOn (_btID b))
BtOn -> effOff . over buttons (IM.adjust turnOff (_btID b)) BtOn -> effOff . over buttons (IM.adjust turnOff (_btID b))
offPict = onLayer WlLayer $ color c $ pictures [--translate (-8) 4 $ circleSolid 5 offPict = onLayer WlLayer $ color c $ pictures [--translate (-8) 4 $ circleSolid 5
polygon $ rectNSEW (-2) (-5) (-10) (10) polygon $ rectNSEW (-2) (-5) (-10) (10)
,polygon [(-2,-5),(-10,4),(-6,4),(2,-5)] ,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)] ,polygon [(-2,-5), (6,4),( 10,4),(2,-5)]
] ]
turnOn :: Button -> Button turnOn :: Button -> Button
turnOn bt = bt {_btState = BtOn, _btPict = onPict} turnOn bt = bt
{ _btState = BtOn
, _btPict = onPict
, _btText = "SWITCH\\"
}
turnOff :: Button -> Button turnOff :: Button -> Button
turnOff bt = bt {_btState = BtOff, _btPict = offPict} turnOff bt = bt
{ _btState = BtOff
, _btPict = offPict
, _btText = "SWITCH/"
}
src/Dodge/LevelGen/TriggerDoor.hs
+33 -38
View File
@@ -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 :: Color -> (World -> Bool) -> Point2 -> Point2 -> [Int] -> [Wall]
mkTriggerDoor c cond pl pr xs = addSound $ zipWith3 (triggerDoorPane c cond) mkTriggerDoor c cond pl pr xs = addSound $ zipWith3 (triggerDoorPane c cond)
xs xs
[ [pld,hwd,hw,pl] (leftDoor ++ rightDoor)
, [hwd,hwu] (map shiftLeft leftDoor ++ map shiftRight rightDoor)
, [hwu,plu,pl,hw] where
, [plu,pld] leftDoor =
, [pru,hwu,hw,pr] [ [pld +.+ perp,hwd]
, [hwu,hwd] , [hwd, hwu]
, [hwd,prd,pr,hw] , [hwu, plu +.+ perp]
, [prd,pru] , [plu +.+ perp,pld +.+ perp]
] ]
[ [plld,pld,pl,pl] rightDoor =
, [pld,plu] [ [pru -.- perp,hwu]
, [plu,pllu,pl,pl] , [hwu, hwd]
, [pllu,plld] , [hwd, prd -.- perp]
, [prru,pru,pr,pr] , [prd -.- perp,pru -.- perp]
, [pru,prd] ]
, [prd,prrd,pr,pr] shiftRight = map (+.+ (0.5 *.* (pr -.- pl)))
, [prrd,prru] shiftLeft = map (+.+ (0.5 *.* (pl -.- pr)))
] norm = 14 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
where norm = 14 *.* errorNormalizeV 49 ( vNormal (pr -.- pl)) hw = 0.5 *.* (pl +.+ pr)
hw = 0.5 *.* (pl +.+ pr) perp = 5 *.* normalizeV (pl -.- pr)
perp = 20 *.* normalizeV (pl -.- pr) plu = pl +.+ norm
--perp = pl -.- hw pld = pl -.- norm
plu = pl +.+ norm pru = pr +.+ norm
pld = pl -.- norm prd = pr -.- norm
pru = pr +.+ norm hwu = hw +.+ norm
prd = pr -.- norm hwd = hw -.- norm
hwu = hw +.+ norm addSound (x:xs) = f x : xs
hwd = hw -.- norm f wl = over doorMech g wl
pllu = plu +.+ perp g dm w | dist wp pld > 2 && dist wp hwd > 2
plld = pld +.+ perp = soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0
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
$ dm w $ dm w
| otherwise = dm w | otherwise = dm w
where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1 where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1
triggerDoorPane :: Color -> (World -> Bool) -> Int -> [Point2] -> [Point2] -> Wall triggerDoorPane :: Color -> (World -> Bool) -> Int -> [Point2] -> [Point2] -> Wall
triggerDoorPane c cond n closedPos openPos = Door triggerDoorPane c cond n closedPos openPos = Door
src/Dodge/Room.hs
+6 -6
View File
@@ -66,20 +66,20 @@ airlockOneWay n = Room
airlock :: Int -> Room airlock :: Int -> Room
airlock n = Room airlock n = Room
{ _rmPolys = { _rmPolys =
[ rectNSWE 90 0 0 40 [ rectNSWE 100 0 0 40
, rectNSWE 60 30 (-40) 20 , rectNSWE 65 35 (-40) 20
] ]
, _rmLinks = lnks , _rmLinks = lnks
, _rmPath = [((20,85),(20,45)) , _rmPath = [((20,85),(20,45))
,((20,45),(20, 5)) ,((20,45),(20, 5))
] ]
, _rmPS = , _rmPS =
[PS (0,15) 0 $ PutTriggerDoor col (not . cond) (1,0) (39,0) [PS (0,20) 0 $ PutTriggerDoor col (not . cond) (1,0) (39,0)
,PS (0,75) 0 $ PutTriggerDoor col (cond) (1,0) (39,0) ,PS (0,80) 0 $ PutTriggerDoor col (cond) (1,0) (39,0)
,PS (35,45) (pi/2) $ PutButton $ makeSwitch col ,PS (35,50) (pi/2) $ PutButton $ makeSwitch col
(over worldState (M.insert (DoorNumOpen n) True)) (over worldState (M.insert (DoorNumOpen n) True))
(over worldState (M.insert (DoorNumOpen n) False)) (over worldState (M.insert (DoorNumOpen n) False))
,PS (-25, 45) 0 putLamp ,PS (-25, 50) 0 putLamp
] ]
, _rmBound = rectNSWE 75 15 0 40 , _rmBound = rectNSWE 75 15 0 40
} }