Remove force fields, cleanup

src/Dodge/Render/Picture.hs

@@ -1,6 +1,10 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Render.Picture
-  where
+    ( worldPictures
+    , wallsAndWindows
+    , lightsForGloom
+    , fixedCoordPictures
+    ) where
 import Dodge.Data
 --import Dodge.Update.Camera
 --import Dodge.GameRoom
@@ -126,6 +130,15 @@ wallFloorsToDraw w = filter isVisible $ IM.elems $ wallsOnScreen w
         | wl ^? wlDraw == Just False = False
         | otherwise = onScreen wl
 
+lineOnScreen :: World -> Point2 -> Point2 -> Bool
+lineOnScreen w p1 p2 = pointInPolygon p1 sp 
+    || pointInPolygon p2 sp 
+    || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
+  where 
+    sp = screenPolygon w
+    sps = zip sp (tail sp ++ [head sp])
+
+
 drawWallFloor :: Wall -> Picture
 drawWallFloor wl = if _wlIsSeeThrough wl
     then setDepth 0.9 . color c $ polygon [x,x +.+ n2,y+.+n2, y]
@@ -139,77 +152,6 @@ errorNormalizeVDR :: Point2 -> Point2
 errorNormalizeVDR (V2 0 0) = error "problem with function: errorNormalizeVDR in DodgeRendering"
 errorNormalizeVDR p = normalizeV p
 
-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])
-
-
-lineOnScreen :: World -> Point2 -> Point2 -> Bool
-lineOnScreen w p1 p2 = pointInPolygon p1 sp 
-    || pointInPolygon p2 sp 
-    || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
-  where 
-    sp = screenPolygon w
-    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
-
--- 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
-
-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
-
-rectangleSolid :: Float -> Float -> Picture
-rectangleSolid x y = polygon $ map toV2 [(x,y),(x,-y),(-x,-y),(-x,y)]
-
 wallsAndWindows
     :: World
     -> ( [((Point2,Point2),Point4)]  ,[((Point2,Point2),Point4)] )
@@ -219,9 +161,6 @@ wallsAndWindows w
     f wl = (_wlLine wl, _wlColor wl)
     (wins,wls) = partition _wlIsSeeThrough . IM.elems . IM.filter _wlDraw $ wallsDoubleScreen w
 
-wallsToList :: [((Point2,Point2),Point4)] -> [Float]
-wallsToList = concatMap (\((V2 a b,V2 c d),V4 e f g h) -> [a,b,c,d,e,f,g,h])
-
 lightsForGloom :: World -> [(Point3,Float,Point3)]
 lightsForGloom w = mapMaybe getLS (IM.elems $ _lightSources w) ++ mapMaybe getTLS (_tempLightSources w)
   where