Move unused functions

src/Dodge/Debug/Picture.hs

@@ -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