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:
jgk
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/LevelGen/Switch.hs
+13 -5
View File
@@ -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/"
}
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 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