Move unused functions
This commit is contained in:
@@ -0,0 +1,68 @@
|
||||
module Dodge.Debug.Picture where
|
||||
import Dodge.Data
|
||||
import Dodge.Base.Window
|
||||
import Geometry
|
||||
import Picture
|
||||
|
||||
import Data.Maybe
|
||||
--import Color
|
||||
|
||||
printPoint :: Point2 -> Picture
|
||||
printPoint p = color white $ uncurryV translate p $ pictures [circle 3 ,scale 0.05 0.05 $ text (show p)]
|
||||
|
||||
printRotPoint :: Float -> Point2 -> Picture
|
||||
printRotPoint r p = color white
|
||||
. uncurryV translate p
|
||||
$ pictures [circle 3 , rotate (negate r) $ scale 0.1 0.1 $ text (show p)]
|
||||
|
||||
outsideScreenPolygon :: World -> [Point2]
|
||||
outsideScreenPolygon w = [tr,tl,bl,br]
|
||||
where
|
||||
scRot = rotateV (_cameraRot w)
|
||||
scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p
|
||||
| otherwise = error "Trying to set screen zoom to zero"
|
||||
scTran p = p +.+ _cameraCenter w
|
||||
tr = scTran $ scRot $ scZoom $ V2 ( 3*halfWidth w ) ( 3* halfHeight w)
|
||||
tl = scTran $ scRot $ scZoom $ V2 (- (3*halfWidth w)) ( 3* halfHeight w)
|
||||
br = scTran $ scRot $ scZoom $ V2 ( 3*halfWidth w ) (- (3* halfHeight w))
|
||||
bl = scTran $ scRot $ scZoom $ V2 (- (3*halfWidth w)) (- (3* halfHeight w))
|
||||
|
||||
-- cannot only test if walls are on screen, but also if they are on the cone
|
||||
-- towards the center of sight
|
||||
lineOnScreenCone :: World -> Point2 -> Point2 -> Bool
|
||||
lineOnScreenCone w p1 p2 = pointInPolygon p1 sp
|
||||
|| pointInPolygon p2 sp
|
||||
|| any (isJust . uncurry (intersectSegSeg p1 p2)) sps
|
||||
where
|
||||
sp' = screenPolygon w
|
||||
vp = _cameraViewFrom w
|
||||
sp | pointInPolygon vp sp' = sp'
|
||||
| otherwise = orderPolygon (_cameraViewFrom w : sp')
|
||||
sps = zip sp (tail sp ++ [head sp])
|
||||
|
||||
|
||||
drawWallFace :: World -> Wall -> Picture
|
||||
drawWallFace w wall
|
||||
| isRHS sightFrom x y || _wlIsSeeThrough wall = blank
|
||||
| otherwise = setDepth (-1) . color (withAlpha 0 black) . polygon $ points
|
||||
where
|
||||
(x,y) = _wlLine wall
|
||||
points = extendConeToScreenEdge w sightFrom (x,y)
|
||||
sightFrom = _cameraViewFrom w
|
||||
|
||||
extendConeToScreenEdge :: World -> Point2 -> (Point2,Point2) -> [Point2]
|
||||
extendConeToScreenEdge w c (x,y) = orderPolygon $ wallScreenIntersect ++ [x,y] ++ borderPs ++ cornerPs
|
||||
where
|
||||
borderPs = mapMaybe (intersectLinefromScreen w c) [x,y]
|
||||
cornerPs = filter (pointIsInCone c (x,y)) $ screenPolygon w
|
||||
wallScreenIntersect = mapMaybe (uncurry $ intersectSegSeg y ((2*.*y) -.- x))
|
||||
. makeLoopPairs $ screenPolygon w
|
||||
|
||||
-- the following assumes that the point a is inside the screen
|
||||
-- it still works otherwise, but it might intersect two points:
|
||||
-- it is not obvious which will be returned
|
||||
intersectLinefromScreen :: World -> Point2 -> Point2 -> Maybe Point2
|
||||
intersectLinefromScreen w a b = listToMaybe
|
||||
. mapMaybe (\(x,y) -> intersectSegLineFrom' x y b (b +.+ b -.- a))
|
||||
. makeLoopPairs
|
||||
$ screenPolygon w
|
||||
@@ -0,0 +1,88 @@
|
||||
module Dodge.LevelGen.StaticWalls.Deprecated
|
||||
where
|
||||
import Geometry
|
||||
--import Geometry.ConvexPoly
|
||||
--import FoldableHelp
|
||||
import Dodge.LevelGen.StaticWalls
|
||||
|
||||
import Data.List.Extra
|
||||
import Data.Maybe
|
||||
-- the following is (while typing) a duplicate
|
||||
type WallP = (Point2,Point2)
|
||||
-- | Test whether lines are near parallel.
|
||||
-- Assumes non-zero length lines.
|
||||
nearParallel :: WallP -> WallP -> Bool
|
||||
nearParallel (a,b) (x,y)
|
||||
= dotV (a -.- b) (vNormal (x -.- y)) < 0.01
|
||||
-- | Test for near collinearity.
|
||||
-- Assumes non-zero length lines.
|
||||
nearCollinear :: WallP -> WallP -> Bool
|
||||
nearCollinear (a,b) (x,y)
|
||||
| a /= x = nearParallel (a,b) (x,y) && nearParallel (a,b) (a,x)
|
||||
| otherwise = nearParallel (a,b) (x,y) && nearParallel (a,b) (a,y)
|
||||
|
||||
-- | Given a specific wall and list of walls, checks that the number of walls leaving the
|
||||
-- first point is the same as the number of walls entering the first point of
|
||||
-- the specific wall.
|
||||
-- On success returns Nothing, on failure returns Just the specific wall and the
|
||||
-- list of walls leaving the first point.
|
||||
checkWallLeft :: WallP -> [WallP] -> Maybe (WallP,[WallP])
|
||||
checkWallLeft (x,y) wls
|
||||
| length ins == length outs = Nothing
|
||||
| otherwise = Just ((x,y), outs)
|
||||
where
|
||||
ins = filter (\(a,_) -> a == x) wls
|
||||
outs = filter (\(_,b) -> b == x) wls
|
||||
-- | Cut out a polygon from a set of walls, and check for errors in the
|
||||
-- created walls.
|
||||
-- Give error if created walls are not consistent.
|
||||
cutWalls'' :: [Point2] -> [WallP] -> [WallP]
|
||||
cutWalls'' ps wls = case mapMaybe (`checkWallRight` newWalls) newWalls of
|
||||
[] -> newWalls
|
||||
errs -> error $ "during level generation function cutWalls: when cutting poly:\n" ++ show ps
|
||||
++ "\nRight corner errors:\n"
|
||||
++ unlines (map show errs)
|
||||
++ "\nLeft corner errors:\n"
|
||||
++ unlines (map show errsL)
|
||||
++ "\nWalls before cut:\n"
|
||||
++ unlines (map show wls)
|
||||
++ "\nWalls after cut:\n"
|
||||
++ unlines (map show newWalls)
|
||||
where
|
||||
newWalls = cutPoly ps wls
|
||||
errsL = mapMaybe (`checkWallLeft` newWalls) newWalls
|
||||
-- | Given a specific wall and list of walls, checks that the number of walls leaving the
|
||||
-- second point is the same as the number of walls entering the second point of
|
||||
-- the specific wall.
|
||||
-- On success returns Nothing, on failure returns Just the specific wall and the
|
||||
-- list of walls leaving the second point.
|
||||
checkWallRight :: WallP -> [WallP] -> Maybe (WallP,[WallP])
|
||||
checkWallRight (x,y) wls
|
||||
| length ins == length outs = Nothing
|
||||
| otherwise = Just ((x,y), outs)
|
||||
where
|
||||
ins = filter (\(_,b) -> b == y) wls
|
||||
outs = filter (\(a,_) -> a == y) wls
|
||||
-- | Given a list of points and a point, returns the point if none in the list
|
||||
-- is close to the point.
|
||||
pointIfNotClose :: [Point2] -> Point2 -> Maybe Point2
|
||||
pointIfNotClose ps p = case findClosePoint ps p of
|
||||
Nothing -> Just p
|
||||
_ -> Nothing
|
||||
-- | Given a list of points and a point, returns a point in the list if any is close
|
||||
-- to the point.
|
||||
findClosePoint :: [Point2] -> Point2 -> Maybe Point2
|
||||
findClosePoint ps p = find (\q -> dist p q < 5) ps
|
||||
-----------------------DEBUG CODE:
|
||||
-- | Given a polygon and list of walls, finds walls inside the polygon.
|
||||
findWallsInPolygon :: [Point2] -> [WallP] -> [WallP]
|
||||
findWallsInPolygon ps = filter cond
|
||||
where
|
||||
cond wall = pointInOrOnPolygon (0.5 *.* uncurry (+.+) wall) ps
|
||||
|
||||
expandToSquare :: (Point2,Point2) -> [(Point2,Point2)]
|
||||
expandToSquare (a,b) = [(a,b),(b,c),(c,d),(d,a)]
|
||||
where
|
||||
v = a -.- b
|
||||
c = b +.+ vNormal v
|
||||
d = a +.+ vNormal v
|
||||
Reference in New Issue
Block a user