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

Partially working mounts on lerp doors

Browse Source
This commit is contained in:
justin
2025-10-22 11:03:46 +01:00
parent f8073381ee
commit af245fb5bf
10 changed files with 78 additions and 150 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block/Debris.hs
+3 -1
View File
@@ -7,6 +7,7 @@ module Dodge.Block.Debris (
makeDebrisDirected,
) where
import Dodge.ShiftPoint
import Color
import Data.Foldable
import qualified Data.IntSet as IS
@@ -24,7 +25,8 @@ import Shape
makeDoorDebris :: Door -> World -> World
makeDoorDebris dr w = w & makeDebris mt col p
where
p = uncurry midPoint (_drPos dr)
p2a = lerpP2A (dr ^. drZeroPos) (dr ^. drOnePos) (dr ^. drLerp)
p = centroid . fmap fst $ (dr ^. drFootPrint) & each . each %~ shiftPointBy p2a
(mt, col) = fromMaybe (Stone, greyN 0.5) $ do
wlids <- w ^? cWorld . lWorld . doors . ix (_drID dr) . drWallIDs
(wlid, _) <- IS.minView wlids
src/Dodge/Data/Door.hs
+3 -7
View File
@@ -18,8 +18,8 @@ import Dodge.Data.WorldEffect
import Geometry.Data
import qualified Data.IntMap.Strict as IM
data DoorStatus = DoorOpen | DoorClosed | DoorHalfway | DoorInt Int
deriving Eq
--data DoorStatus = DoorOpen | DoorClosed | DoorHalfway | DoorInt Int
-- deriving Eq
data PushSource
= PushesItself
@@ -30,12 +30,8 @@ data PushSource
data Door = Door
{ _drID :: Int
, _drWallIDs :: IS.IntSet
, _drStatus :: DoorStatus
, _drTrigger :: WdBl
, _drMech :: DrWdWd
, _drPos :: (Point2, Point2)
, _drOpenPos :: (Point2, Point2)
, _drClosePos :: (Point2, Point2)
, _drZeroPos :: (Point2,Float)
, _drOnePos :: (Point2,Float)
, _drLerp :: Float
@@ -51,6 +47,6 @@ data Door = Door
}
makeLenses ''Door
deriveJSON defaultOptions ''DoorStatus
--deriveJSON defaultOptions ''DoorStatus
deriveJSON defaultOptions ''PushSource
deriveJSON defaultOptions ''Door
src/Dodge/Default/Door.hs
+4 -4
View File
@@ -31,12 +31,12 @@ defaultDoor =
Door
{ _drID = 0
, _drWallIDs = mempty
, _drStatus = DoorClosed
-- , _drStatus = DoorClosed
, _drTrigger = WdBlConst False
, _drMech = DrWdId
, _drPos = (0, 0)
, _drOpenPos = (0, 0)
, _drClosePos = (0, 0)
-- , _drPos = (0, 0)
-- , _drOpenPos = (0, 0)
-- , _drClosePos = (0, 0)
, _drZeroPos = (0,0)
, _drOnePos = (0,0)
, _drLerp = 0
src/Dodge/DrWdWd.hs
+14 -32
View File
@@ -1,15 +1,13 @@
module Dodge.DrWdWd (doDrWdWd) where
import Dodge.Wall.Move
import Dodge.ShiftPoint
import Linear
import Data.IntMap.Merge.Strict
import Control.Lens
import Data.Maybe
import Dodge.Block.Debris
import Dodge.Data.World
import Dodge.ShiftPoint
import Dodge.SoundLogic
import Dodge.Wall.Move
import Dodge.WorldBool
import Geometry
doDrWdWd :: DrWdWd -> Door -> World -> World
doDrWdWd dww = case dww of
@@ -18,20 +16,15 @@ doDrWdWd dww = case dww of
DoorLerp -> doorLerp
doorLerp :: Door -> World -> World
doorLerp dr w = case newlerp of
Just x ->
w' x
-- & cWorld . lWorld . walls %~ merge dropMissing preserveMissing f
-- (wlposs x)
& moveUpdate
doorLerp dr w = fromMaybe w $ do
x <- newlerp
return $
f x
& playSound x
& cWorld . lWorld . doors . ix drid . drLerp .~ x
Nothing -> w
where
w' = ifoldl' (\i v p -> moveWallID i p v) w . wlposs
-- f = zipWithMatched $ \_ l wl -> wl & wlLine .~ l
(zp,za) = dr^. drZeroPos
(yp,ya) = dr^. drOnePos
p2a x = (zp + x *^ (yp - zp) , za + x * diffAngles ya za)
f = ifoldl' (flip . moveWallID) w . wlposs
p2a = lerpP2A (dr ^. drZeroPos) (dr ^. drOnePos)
wlposs x = (dr ^. drFootPrint) & each . each %~ shiftPointBy (p2a x)
clerp = dr ^. drLerp
newlerp
@@ -39,21 +32,10 @@ doorLerp dr w = case newlerp of
| clerp > 0 && not toOpen = Just . max 0 $ clerp - speed
| otherwise = Nothing
toOpen = doWdBl (_drTrigger dr) w
-- mvDir
-- | toOpen && _drStatus dr == DoorOpen = Nothing -- Not sure why necessary
-- | toOpen && dist dpos dop > 0.5 = Just $ vecBetweenSpeed speed dpos dop
-- | dist dpos dcp > 0.5 = Just $ vecBetweenSpeed speed dpos dcp
-- | otherwise = Nothing
speed = _drSpeed dr
drid = _drID dr
moveUpdate = playSound . setStatus
playSound
| _drPushedBy dr == PushesItself = soundContinue (WallSound drid) dpos slideDoorS (Just 1)
playSound x
| _drPushedBy dr == PushesItself =
soundContinue (WallSound drid) (fst $ p2a x) slideDoorS (Just 1)
| otherwise = id
dpos = snd $ _drPos dr
dop = snd $ _drOpenPos dr
dcp = snd $ _drClosePos dr
setStatus
| dist dpos dop < 1 = cWorld . lWorld . doors . ix drid . drStatus .~ DoorOpen
| dist dpos dcp < 1 = cWorld . lWorld . doors . ix drid . drStatus .~ DoorClosed
| otherwise = cWorld . lWorld . doors . ix drid . drStatus .~ DoorHalfway
-- dpos = snd $ _drPos dr
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
-10
View File
@@ -37,13 +37,8 @@ plDoor col eo cond l p1 p2 gw = (drid, over gwWorld addWalls $ gw & gwWorld . cW
defaultDoor
{ _drID = drid
, _drWallIDs = IS.fromList wlids
, _drStatus = DoorInt 0
, _drTrigger = cond
--, _drMech = DrWdMechanismStepwise nsteps wlids pss
, _drMech = DoorLerp
-- , _drPos = head pss
-- , _drOpenPos = head pss
-- , _drClosePos = last pss
, _drZeroPos = p1
, _drOnePos = p2
, _drLerp = 0
@@ -102,12 +97,7 @@ plSlideDoor dr wl eo shiftOffset a b gw =
dr
{ _drID = drid
, _drWallIDs = IS.fromList wlids
, _drStatus = DoorClosed
-- , _drMech = DoorMechanism
, _drMech = DoorLerp
, _drPos = (a, b)
, _drOpenPos = (shiftLeft a, shiftLeft b)
, _drClosePos = (a, b)
, _drZeroPos = (a, 0)
, _drOnePos = (shiftLeft a, 0)
, _drLerp = 0
src/Dodge/ShiftPoint.hs
+4
View File
@@ -3,6 +3,7 @@
module Dodge.ShiftPoint where
import Geometry
import Linear
shiftPointBy :: Point2A -> Point2 -> Point2
shiftPointBy (pos, rot) !p = pos +.+ rotateV rot p
@@ -10,6 +11,9 @@ shiftPointBy (pos, rot) !p = pos +.+ rotateV rot p
compP2A :: Point2A -> Point2A -> Point2A
compP2A (p1,r1) (p2,r2) = (p1 +.+ rotateV r1 p2, r1 + r2)
lerpP2A :: Point2A -> Point2A -> Float -> Point2A
lerpP2A (p1,a1) (p2,a2) x = (p1 + x *^ (p2 - p1), a1 + x * diffAngles a2 a1)
invShiftPointBy :: (Point2, Float) -> Point2 -> Point2
invShiftPointBy (p1, r) p2 = rotateV (- r) $ p2 -.- p1
src/Dodge/Wall/Move.hs
-31
View File
@@ -3,15 +3,9 @@
module Dodge.Wall.Move (
moveWallID,
moveWallIDUnsafe,
moveWall,
moveWallIDToward,
translateWallID,
mvPs,
) where
import Control.Lens
import Data.Maybe
import Dodge.Base
import Dodge.Data.World
import Dodge.Wall.Zone
import Geometry
@@ -33,28 +27,3 @@ moveWall wlid wl wlline w =
& insertWallInZones newwl
where
newwl = wl{_wlLine = wlline}
translateWallID :: Int -> Point2 -> World -> World
translateWallID wlid p w = fromMaybe w $ do
oldwl <- w ^? cWorld . lWorld . walls . ix wlid
let newwl = oldwl & wlLine . each +~ p
return $
w
& cWorld . lWorld . walls . ix wlid .~ newwl
& deleteWallFromZones oldwl
& insertWallInZones newwl
moveWallIDToward :: Int -> Float -> (Point2, Point2) -> World -> World
moveWallIDToward wlid speed ep w = moveWall wlid wl newwlline w
where
--wl = _walls (_cWorld w) IM.! wlid
wl = w ^?! cWorld . lWorld . walls . ix wlid
newwlline = mvPs speed ep (_wlLine wl)
mvP :: Float -> Point2 -> Point2 -> Point2
{-# INLINE mvP #-}
mvP !speed !ep !p = mvPointTowardAtSpeed speed ep p
mvPs :: Float -> (Point2, Point2) -> (Point2, Point2) -> (Point2, Point2)
{-# INLINE mvPs #-}
mvPs !speed (!ex, !ey) (!sx, !sy) = (mvP speed ex sx, mvP speed ey sy)
src/Dodge/WdP2f.hs
+3 -3
View File
@@ -1,15 +1,15 @@
{-# OPTIONS -Wno-incomplete-uni-patterns #-}
module Dodge.WdP2f (doWdP2f) where
import Dodge.ShiftPoint
import Control.Lens
import Dodge.Data.World
import Geometry.Data
import Geometry.Vector
-- # OPTIONS -Wno-incomplete-uni-patterns #-}
doWdP2f :: WdP2f -> World -> (Point2, Float)
doWdP2f x = case x of
WdP2f0 -> const (0, 0)
WdP2fDoorPosition drid -> \w ->
let Just (a, b) = w ^? cWorld . lWorld . doors . ix drid . drPos
in (b, argV (a -.- b))
let dr = w ^?! cWorld . lWorld . doors . ix drid
in lerpP2A (dr ^. drZeroPos) (dr ^. drOnePos) (dr ^. drLerp)
src/Dodge/WorldBool.hs
+2 -1
View File
@@ -13,7 +13,8 @@ doWdBl wb w = case wb of
WdTrig i -> fromMaybe False $ w ^? cWorld . lWorld . triggers . ix i
WdBlDoorMoving i -> fromMaybe False $ do
dr <- w ^? cWorld . lWorld . doors . ix i
return (DoorHalfway == _drStatus dr)
--return (DoorHalfway == _drStatus dr)
return (0 /= _drLerp dr && 1 /= _drLerp dr)
WdBlCrFilterNearPoint r p t -> any (crNearPoint r p) (IM.filter (doCrBl t) (w ^. cWorld . lWorld . creatures))
WdBlBtOn btid -> w ^?! cWorld . lWorld . buttons . ix btid . btEvent . btOn -- unsafe
WdBlNegate x -> not $ doWdBl x w