nek0/tracer
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

cyber entomology

Browse source
This commit is contained in:
nek0 2018-05-13 14:05:15 +02:00
parent 4a8826b256
commit c14c652360
1 changed files with 37 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

61
src/Test.hs
View file

@ -199,20 +199,29 @@ updateMap dt = do
let npos@(V2 nr nc) = pos' + fmap (* (4 * dt)) vel' let npos@(V2 nr nc) = pos' + fmap (* (4 * dt)) vel'
dpos@(V2 dpr dpc) = npos - pos' dpos@(V2 dpr dpc) = npos - pos'
len = sqrt (dpos `dot` dpos) len = sqrt (dpos `dot` dpos)
lll = Prelude.map (\i -> lll = (,)
let lrow = <$> (
[ (nr - (fromIntegral $ floor nr)) if dpr < 0
, (nr - (fromIntegral $ floor nr)) + (dpr / len) then [(floor dpr :: Int) .. 0]
.. else [0 .. (ceiling dpr :: Int)])
] <*> (
lcol = if dpc < 0
[ (nc - (fromIntegral $ floor nc)) then [(floor dpc :: Int) .. 0]
, (nc - (fromIntegral $ floor nc)) + (dpc / len) else [0 .. (ceiling dpc :: Int)])
.. -- lll = Prelude.map (\i ->
] -- let lrow =
in (fromIntegral (floor (lrow !! i)), fromIntegral (floor (lcol !! i))) -- [ (nr - (fromIntegral $ floor nr))
) -- , (nr - (fromIntegral $ floor nr)) + (dpr / len)
[ 0 .. floor len] -- ..
-- ]
-- lcol =
-- [ (nc - (fromIntegral $ floor nc))
-- , (nc - (fromIntegral $ floor nc)) + (dpc / len)
-- ..
-- ]
-- in (fromIntegral (floor (lrow !! i)), fromIntegral (floor (lcol !! i)))
-- )
-- [ 0 .. floor len]
ent = defEntity' ent = defEntity'
{ pos = Set $ pos' + dpos * Prelude.foldl { pos = Set $ pos' + dpos * Prelude.foldl
(\acc a -> let ret = checkBoundsCollision2 pos' npos dt acc a (\acc a -> let ret = checkBoundsCollision2 pos' npos dt acc a
@ -222,19 +231,16 @@ updateMap dt = do
concatMap concatMap
(\(dr, dc) -> (\(dr, dc) ->
let bs = fromMaybe [] (imgObstacle <$> (M.safeGet let bs = fromMaybe [] (imgObstacle <$> (M.safeGet
(floor (nr + dr)) (fromIntegral $ floor nr + dr)
(floor (nc + dc)) (fromIntegral $ floor nc + dc)
(imgMat (stateData ud)))) (imgMat (stateData ud))))
in Prelude.map (\(Boundaries (minr, minc) (maxr, maxc))-> in Prelude.map (\(Boundaries (minr, minc) (maxr, maxc))->
Boundaries Boundaries
(minr + dr, minc + dc) (minr + fromIntegral dr, minc + fromIntegral dc)
(maxr + dr, maxc + dc) (maxr + fromIntegral dr, maxc + fromIntegral dc)
) bs ) bs
) )
(A.log lll
A.Verbose
("paassing relative tiles: " ++ show lll ++ " " ++ show len)
lll)
) )
} }
return ent return ent
@ -367,9 +373,12 @@ checkBoundsCollision2
-> V2 Double -> V2 Double
checkBoundsCollision2 checkBoundsCollision2
pre@(V2 pr pc) next@(V2 nr nc) dt acc (Boundaries (minr, minc) (maxr, maxc)) pre@(V2 pr pc) next@(V2 nr nc) dt acc (Boundaries (minr, minc) (maxr, maxc))
| colltr < 0 && colltc < 0 = V2 0 0 -- | colltr < 0 && colltc < 0 = A.log A.Debug (show (colltr, colltc)) (V2 (colltr / dt) (colltc / dt))
| colltr < 0 && colltc >= 0 = (V2 0 1) * acc | (colltr < 0 && colltc < 0) || (inrow && incol) = A.log A.Debug ("both " ++ show (colltr, colltc)) (V2 0 0)
| colltc < 0 && colltr >= 0 = (V2 1 0) * acc -- | colltr < 0 && colltc >= dt = (V2 (colltr / dt) 1)
| colltr < 0 && incol = (A.log A.Debug ("row fixed " ++ show (colltr, colltc))(V2 0 1)) * acc
-- | colltc < 0 && colltc >= dt = (V2 1 (colltr / dt))
| colltc < 0 && inrow = (A.log A.Debug ("col fixed " ++ show (colltr, colltc))(V2 1 0)) * acc
| otherwise = acc | otherwise = acc
where where
vel@(V2 vr vc) = fmap (/ dt) (next - pre) vel@(V2 vr vc) = fmap (/ dt) (next - pre)
@ -381,3 +390,5 @@ checkBoundsCollision2
| vc > 0 = (((fromIntegral (floor nc :: Int)) + minc - 0.15) - nc) / vc | vc > 0 = (((fromIntegral (floor nc :: Int)) + minc - 0.15) - nc) / vc
| vc < 0 = (((fromIntegral (floor nc :: Int)) + maxc + 0.15) - nc) / vc | vc < 0 = (((fromIntegral (floor nc :: Int)) + maxc + 0.15) - nc) / vc
| otherwise = 0 | otherwise = 0
inrow = pr > minr && pr < maxr
incol = pc > minc && pc < maxc