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

Further strictifying

Browse Source
This commit is contained in:
jgk
2021-07-30 00:23:02 +02:00
parent bd8ef3f416
commit 2d8b27746c
33 changed files with 228 additions and 211 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Collide.hs
+3 -3
View File
@@ -141,14 +141,14 @@ pathToPointFireable i p w
canSeePointAll :: Int -> Point2 -> World -> Bool
canSeePointAll i targPos w
= all (flip (canSeePoint i) w . (\p -> targPos +.+ radius *.* p)) [(1,0),(0,1),(-1,0),(0,-1)]
= all (flip (canSeePoint i) w . (\p -> targPos +.+ radius *.* p)) $ map toV2 [(1,0),(0,1),(-1,0),(0,-1)]
where
cr = _creatures w IM.! i
radius = _crRad cr
canSeeAny :: Int -> Int -> World -> Bool
canSeeAny fromID toID w
= any (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p)) [(1,0),(0,1),(-1,0),(0,-1)]
= any (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p)) $ map toV2 [(1,0),(0,1),(-1,0),(0,-1)]
where
cr = _creatures w IM.! toID
cpos = _crPos cr
@@ -156,7 +156,7 @@ canSeeAny fromID toID w
canSeeAll :: Int -> Int -> World -> Bool
canSeeAll fromID toID w
= all (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p)) [(1,0),(0,1),(-1,0),(0,-1)]
= all (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p)) $ map toV2 [(1,0),(0,1),(-1,0),(0,-1)]
where
cr = _creatures w IM.! toID
cpos = _crPos cr
src/Dodge/Base/Window.hs
+4 -4
View File
@@ -12,10 +12,10 @@ screenPolygon w = [tr,tl,bl,br]
scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p
| otherwise = p
scTran p = p +.+ _cameraCenter w
tr = scTran $ scRot $ scZoom ( halfWidth w, halfHeight w)
tl = scTran $ scRot $ scZoom (-halfWidth w, halfHeight w)
br = scTran $ scRot $ scZoom ( halfWidth w,-halfHeight w)
bl = scTran $ scRot $ scZoom (-halfWidth w,-halfHeight w)
tr = scTran $ scRot $ scZoom (V2 ( halfWidth w) ( halfHeight w))
tl = scTran $ scRot $ scZoom (V2 (-halfWidth w) ( halfHeight w))
br = scTran $ scRot $ scZoom (V2 ( halfWidth w) (-halfHeight w))
bl = scTran $ scRot $ scZoom (V2 (-halfWidth w) (-halfHeight w))
halfWidth,halfHeight :: World -> Float
halfWidth w = getWindowX w / 2
src/Dodge/Base/Zone.hs
+8 -8
View File
@@ -19,12 +19,12 @@ floorHun :: Float -> Int
floorHun x = floor $ x / zoneSize
sizeZoneOfPoint :: Float -> Point2 -> (Int,Int)
sizeZoneOfPoint s (x,y) = (f x, f y)
sizeZoneOfPoint s (V2 x y) = (f x, f y)
where
f = floor . (/ s)
zoneOfPoint :: Point2 -> (Int,Int)
zoneOfPoint (x,y) = (floorHun x, floorHun y)
zoneOfPoint (V2 x y) = (floorHun x, floorHun y)
cloudZoneOfPoint :: Point2 -> (Int,Int)
cloudZoneOfPoint = sizeZoneOfPoint 20
@@ -33,19 +33,19 @@ crZoneOfPoint :: Point2 -> (Int,Int)
crZoneOfPoint = sizeZoneOfPoint 15
zoneNearPoint :: Point2 -> [(Int,Int)]
zoneNearPoint (x',y') = [(a,b) | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
zoneNearPoint (V2 x' y') = [(a,b) | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
where
x = floorHun x'
y = floorHun y'
zoneAroundPoint :: Point2 -> [(Int,Int)]
zoneAroundPoint (x',y') = [(a,b) | a<-[x-3..x+3] , b<-[y-3..y+3]]
zoneAroundPoint (V2 x' y') = [(a,b) | a<-[x-3..x+3] , b<-[y-3..y+3]]
where
x = floorHun x'
y = floorHun y'
zoneAroundPoint' :: Int -> Point2 -> IM.IntMap IS.IntSet
zoneAroundPoint' i (x',y') = IM.fromSet (const ys) xs
zoneAroundPoint' i (V2 x' y') = IM.fromSet (const ys) xs
where
x = floorHun x'
y = floorHun y'
@@ -65,10 +65,10 @@ bresx a b = digitalLine (x-1,y-1) (x'-1,y'-1)
(x',y') = zoneOfPoint b
zoneOfLine :: Point2 -> Point2 -> [(Int,Int)]
zoneOfLine (aa,ab) (ba,bb)
zoneOfLine (V2 aa ab) (V2 ba bb)
= nub
. concatMap f
$ digitalLine (zoneOfPoint (aa,ab)) (zoneOfPoint (ba,bb))
$ digitalLine (zoneOfPoint (V2 aa ab)) (zoneOfPoint (V2 ba bb))
where
f (x,y) = [(p,r) | p <-[x-1,x,x+1] , r<-[y-1,y,y+1]]
@@ -154,7 +154,7 @@ wallsNearZones is w -- = IM.unions [f b $ f a $ _wallsZone w | (a,b) <- is]
_ -> IM.empty
ixZone :: IM.IntMap (IM.IntMap a) -> Point2 -> a
ixZone z (x,y) = z IM.! floorHun x IM.! floorHun y
ixZone z (V2 x y) = z IM.! floorHun x IM.! floorHun y
ixNZ :: IM.IntMap (IM.IntMap a) -> Point2 -> [a]
ixNZ z p = lookLookups (zoneNearPoint p) z