Add aggressive light culling

appDodge/Main.hs

@@ -94,7 +94,7 @@ doSideEffects u = do
         (_pictureShaders $ _renderData preData)
         (setDepth (-1)
             . translate (-0.5) (-0.8) . scale 0.0005 0.0005
-            . text $ "ms/frame " ++ show (endTicks - lastFrameTicks)
+            $ fpsText (endTicks - lastFrameTicks)
         )
     return $ u' 
         & preloadData . frameTimer .~ endTicks
@@ -102,6 +102,15 @@ doSideEffects u = do
         & uvWorld . toPlaySounds  .~ M.empty
         & uvWorld . sideEffects   .~ return
 
+fpsText :: (Show a, Ord a, Num a) => a -> Picture
+fpsText x = color col $ text $ "ms/frame " ++ show x
+  where
+    col | x < 22 = blue
+        | x < 30 = green
+        | x < 40 = yellow
+        | x < 50 = orange
+        | otherwise = red
+
 doPreload :: IO PreloadData
 doPreload = do
     rData   <- preloadRender

src/Dodge/Base.hs

@@ -233,6 +233,12 @@ collidePointWalls p1 p2
   where
     findPoint (x,y) p = fromMaybe p $ intersectSegSeg p1 p x y
 
+collidePointWallsFilter :: (Wall -> Bool) -> Point2 -> Point2 -> IM.IntMap Wall -> Point2
+collidePointWallsFilter t p1 p2 
+    = foldr findPoint p2 . fmap _wlLine . IM.filter t
+  where
+    findPoint (x,y) p = fromMaybe p $ intersectSegSeg p1 p x y
+
 -- | Looks for first collision of a circle with walls.
 -- If found, gives point and reflection velocity, reflection damped in normal.
 -- note that the "intersection" point is the center of the circle flush against the wall

src/Dodge/Base/Window.hs

@@ -48,7 +48,7 @@ halfWidth w = _windowX w / 2
 halfHeight w = _windowY w / 2
 -- | A box of the size of the screen in screen centered coordinates
 screenBox :: Configuration -> [Point2]
-screenBox w = rectNSEW hh (-hh) hw (-hw)
+screenBox w = reverse $ rectNSWE hh (-hh) (-hw) hw
   where
     hw = halfWidth w
     hh = halfHeight w

src/Dodge/CullBox.hs

@@ -0,0 +1,23 @@
+module Dodge.CullBox 
+    (cullBox
+    ) where
+import Dodge.Data
+import Dodge.GameRoom
+import Dodge.Base
+import Dodge.Zone
+import Geometry
+import Dodge.Update.Camera
+import Shape
+
+import Data.Maybe (mapMaybe)
+
+cullBox :: Configuration -> World -> [Point2]
+--cullBox cfig w = farWallPoints cp w
+cullBox cfig w' = let (n,s,e,w) = farWallDistDirection (_cameraCenter w') cfig w'
+    in map ((+.+ _cameraCenter w') . rotateV (_cameraRot w') ) $ rectNSWE n (negate s) (negate w) e
+--    --mapMaybe (fmap (fst . _wlLine . snd) . f) $ screenPolygon cfig w
+--  where
+--    grs = filter (pointInOrOnPolygon cp . _grBound) (_gameRooms w)
+--    cp = _cameraCenter w
+--    f p = collidePointWallsWall cp p $ wallsAlongLine cp p w
+--

src/Dodge/Debug.hs

@@ -47,7 +47,7 @@ pjTimerF time i = props . ix i . pjUpdate .~ (\_ -> pjTimerF (time - 1) i)
 drawDDA :: IM.IntMap IS.IntSet -> Picture
 drawDDA = setLayer BloomLayer . color (withAlpha 0.5 green) . IM.foldlWithKey' f blank
   where
-    f pic x' ys' = concatMapPic (\y -> polygon (rectNSEW (y+50) y (x+50) x)) ys `appendPic` pic
+    f pic x' ys' = concatMapPic (\y -> polygon (reverse $ rectNSWE (y+50) y x (x+50))) ys `appendPic` pic
       where
         x = 50 * fromIntegral x'
         ys = map ((50 *) . fromIntegral) $ IS.toList ys'

src/Dodge/Default.hs

@@ -209,8 +209,8 @@ defaultDrawButton col bt =
     )
   where
     buttonGeometry
-        | _btState bt == BtOff = rectNSEW 10 (-1) width (-width) 
+        | _btState bt == BtOff = reverse $ rectNSWE 10 (-1) (-width) width
-        | otherwise = rectNSEW 2 (-1) width (-width)
+        | otherwise = reverse $ rectNSWE 2 (-1) (-width) width
     width = 8
 defaultTerminal :: Terminal
 defaultTerminal = Terminal 

src/Dodge/Item/Equipment.hs

@@ -215,7 +215,7 @@ effectOnOffHeld f f' = ItInvEffectID
 jetPack :: Item
 jetPack = defaultEquipment
     { _itEquipPict = \_ _ -> (,) emptySH $ setDepth 20
-        $ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ]
+        $ pictures [color yellow $ polygon $ reverse $ rectNSWE 5 (-5) (-11) (-3) ]
     , _itEffect = NoItEffect
     , _itID = Nothing
     }   & itUse . eqEq . eqSite .~ GoesOnBack

src/Dodge/Item/Weapon/BulletGun/Clip.hs

@@ -11,7 +11,8 @@ makeSingleClipAt p it = case it ^? itConsumption . laLoaded of
     _ -> translateSH p $ upperPrismPoly 1 $ square 1.5
 
 makeTinClipAt :: Float -> Point3 -> Item -> Shape
-makeTinClipAt r p it = translateSH p . overPosSH (rotate3z r) $ upperPrismPoly 1 $ rectNSEW 0 (-y) (-2) 2
+makeTinClipAt r p it = translateSH p . overPosSH (rotate3z r) $ upperPrismPoly 1 $ reverse 
+    $ rectNSWE 0 (-y) (-2) 2
   where
     y = fromIntegral y' * 0.3
     y' = fromMaybe 0 $ it ^? itConsumption . laLoaded

src/Dodge/Item/Weapon/BulletGuns.hs

@@ -136,7 +136,7 @@ bangCone = defaultGun
             ,_muzPos    = 15
             }
         , _dimSPic = const $ noPic $ colorSH cyan $ upperPrismPoly 3 (rectXH 5 2)
-            <> upperPrismPoly 6 (rectNSEW 4 (-4) 15 5)
+            <> upperPrismPoly 6 (reverse $ rectNSWE 4 (-4) 5 15)
         }
     }
     & itType . iyBase .~ BANGCONE
@@ -163,7 +163,7 @@ blunderbuss = bangCone
             ,_muzPos    = 30
             }
         , _dimSPic = const $ noPic $ colorSH cyan $ upperPrismPoly 3 (rectXH 20 2)
-            <> upperPrismPoly 6 (rectNSEW 4 (-4) 30 20)
+            <> upperPrismPoly 6 (reverse $ rectNSWE 4 (-4) 20 30)
         }
     }
     & itConsumption . laMax .~ 25

src/Dodge/LevelGen/Switch.hs

@@ -37,8 +37,9 @@ drawSwitch col1 col2 bt
     | otherwise = flick (negate (pi/4))
   where
     flick a = ( mconcat
-        [ colorSH col1 . upperPrismPoly 20 $ rectNSEW (-2) (-5) 10 (-10)
+        [ colorSH col1 . upperPrismPoly 20 $ reverse $ rectNSWE (-2) (-5) (-10) 10
-        , colorSH col2 . translateSH (V3 0 (-2) 20) . rotateSH a . upperPrismPoly 2 $ rectNSEW 10 0 2 (-2)
+        , colorSH col2 . translateSH (V3 0 (-2) 20) . rotateSH a . upperPrismPoly 2 $ reverse
+            $ rectNSWE 10 0 (-2) 2
         ]   
         , mempty)
 
@@ -48,8 +49,9 @@ drawSwitchWire col1 col2 bt
     | otherwise = flick (negate (pi/4))
   where
     flick a = ( mconcat
-        [ colorSH col1 . translateSHz 10 . upperPrismPoly 10 $ rectNSEW (-2) (-5) 10 (-10)
+        [ colorSH col1 . translateSHz 10 . upperPrismPoly 10 $ reverse $ rectNSWE (-2) (-5) (-10) 10
-        , colorSH col2 . translateSH (V3 0 (-2) 15) . rotateSH a . upperPrismPoly 2 $ rectNSEW 10 0 2 (-2)
+        , colorSH col2 . translateSH (V3 0 (-2) 15) . rotateSH a . upperPrismPoly 2 . reverse 
+            $ rectNSWE 10 0 (-2) 2
         ]   
         , mempty)
 

src/Dodge/Placement/Instance/LightSource/Cover.hs

@@ -53,10 +53,10 @@ drawLampCover h pr
     | not (_prToggle pr) = mempty
     | otherwise = ( translateSHz (h-2.5) . uncurryV translateSHf (_prPos pr)
         $ rotateSH (_pjRot pr) $ mconcat
-        [ translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 2    3 (-1)
+        [ translateSHz 1 . upperPrismPoly 1 . reverse $ rectNSWE 3 2    (-1) 3 
-        , translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2
+        , translateSHz 1 . upperPrismPoly 1 . reverse $ rectNSWE 3 (-1) 2    3 
-        , translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 2    3 (-1)
+        , translateSHz 2 . upperPrismPoly 1 . reverse $ rectNSWE 3 2    (-1) 3 
-        , translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2
+        , translateSHz 2 . upperPrismPoly 1 . reverse $ rectNSWE 3 (-1) 2    3 
         , upperPrismPoly 1 [V2 2 2,V2 (-1) 2,V2 2 (-1)]
         ]
         , mempty
@@ -66,8 +66,8 @@ drawDoubleLampCover :: Float -> Prop -> SPic
 drawDoubleLampCover h pr =
     ( translateSHz (h-2.5) . uncurryV translateSHf (_prPos pr) 
         $ rotateSH (_pjRot pr) $ mconcat
-        [ upperPrismPoly 5 $ rectNSEW 6 5       6 (-6)
+        [ upperPrismPoly 5 $ reverse $ rectNSWE 6 5       (-6) 6
-        , upperPrismPoly 5 $ rectNSEW (-5) (-6) 6 (-6)
+        , upperPrismPoly 5 $ reverse $ rectNSWE (-5) (-6) (-6) 6
         , upperPrismPoly 1 [V2 0 (-1),V2 6 5,V2 (-6) 5]
         , upperPrismPoly 1 [V2 0   1 ,V2 (-6) (-5),V2 6 (-5)]
         ]
@@ -79,7 +79,7 @@ drawVerticalLampCover h pr =
     ( translateSHz h . uncurryV translateSHf (_prPos pr) 
         $ rotateSHx (_pjRot pr) $ mconcat
         [ 
-        translateSHz (-3) . upperPrismPoly 1 $ rectNSEW 2 (-2) 5 (-5)
+        translateSHz (-3) . upperPrismPoly 1 $ reverse $ rectNSWE 2 (-2) (-5) 5
         ]
     , mempty
     )

src/Dodge/Placement/TopDecoration.hs

@@ -28,7 +28,7 @@ fourEmbossDecoration :: Float -> Float -> Float -> Color -> Color -> Shape
 fourEmbossDecoration w h z _ c = colorSH c $ foldMap f [(w,h),(-w,h),(w,-h),(-w,-h)]
   where
     f (a,b) = translateSH (V3 (a/2) (b/2) z) embossing
-    embossing = upperPrismPolyHalf 10 $ rectNSEW (h/2) (-h/2) (w/2) (-w/2)
+    embossing = upperPrismPolyHalf 10 $ reverse $ rectNSWE (h/2) (-h/2) (-w/2) (w/2)
 
 plusDecoration :: Float -> Float -> Float -> Color -> Color -> Shape
 plusDecoration w h z _ c = colorSH c $ thinHighBar z (V2 w 0) (V2 (-w) 0)

src/Dodge/Render.hs

@@ -39,7 +39,7 @@ doDrawing pdata u = do
         wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig)
         resFact             = resFactorNum $ cfig ^. graphics_resolution_factor
         (wallPointsCol,windowPoints,wallSPics) = wallsToDrawStreams cfig w
-        lightPoints             = lightsForGloom w
+        lightPoints             = lightsForGloom cfig w
         viewFroms@(V2 vfx vfy)  = _cameraViewFrom w
         viewFrom3d              = Vector3 vfx vfy 20
         shadV   = _pictureShaders pdata

src/Dodge/Render/HUD.hs

@@ -317,7 +317,7 @@ displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [
 
 
 mapOverlay :: Configuration -> World -> [Picture]
-mapOverlay cfig w = (color (withAlpha 0.5 black) . polygon $ rectNSEW 1 (-1) (-1) 1) : 
+mapOverlay cfig w = (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) : 
             (mapMaybe (mapWall cfig w) . IM.elems $ _walls w)
 
 mapWall :: Configuration -> World -> Wall -> Maybe Picture

src/Dodge/Render/Lights.hs

@@ -2,17 +2,24 @@ module Dodge.Render.Lights
     ( lightsForGloom
     ) where
 import Dodge.Data
+import Dodge.CullBox
 import Geometry
 
 import Data.Maybe
 import qualified Data.IntMap.Lazy as IM
 
-lightsForGloom :: World -> [(Point3,Float,Point3)]
+lightsForGloom :: Configuration -> World -> [(Point3,Float,Point3)]
-lightsForGloom w = mapMaybe getLS (IM.elems $ _lightSources w) ++ mapMaybe getTLS (_tempLightSources w)
+lightsForGloom cfig w = mapMaybe getLS (IM.elems $ _lightSources w) 
+    ++ mapMaybe getTLS (_tempLightSources w)
   where 
     getLS  = getlsparam . _lsParam
     getTLS = getlsparam . _tlsParam 
+    cbox = cullBox cfig w
     getlsparam ls
+        | not (pointInPolygon lpos cbox) = Nothing
         | dist (_cameraCenter w) (fst2 $ _lsPos ls) > _viewDistance w + _lsRad ls = Nothing
         | otherwise = Just ( _lsPos ls,  _lsRad ls^(2::Int) , _lsCol ls)
+      where
+        lpos = xyV3 $ _lsPos ls
+        rad  = _lsRad ls
     fst2 (V3 a b _) = V2 a b

src/Dodge/Render/ShapePicture.hs

@@ -2,6 +2,7 @@ module Dodge.Render.ShapePicture
     ( worldSPic
     ) where
 import Dodge.ShortShow
+import Dodge.CullBox
 import Dodge.Config.Data
 import Dodge.Render.InfoBox
 import Dodge.Debug.Picture
@@ -53,7 +54,7 @@ extraPics cfig w = pictures (_decorations w)
     <> concatMapPic (dbArg _bmDraw) (_positronBeams $ _beams w)
     <> concatMapPic (dbArg _bmDraw) (_electronBeams $ _beams w)
     <> concatMapPic (dbArg _lsPict) (_lightSources w)
-    <> testPic w
+    <> testPic cfig w
     <> _debugPicture w
     <> concatMapPic clDraw (_clouds w      )
     <> concatMapPic ppDraw (_pressPlates w )
@@ -65,8 +66,10 @@ extraPics cfig w = pictures (_decorations w)
     <> drawPathing cfig w
     <> drawCrInfo cfig w
 
-testPic :: World -> Picture
+testPic :: Configuration -> World -> Picture
-testPic _ = mempty
+testPic cfig w = setLayer DebugLayer $ color green $ line $ (x:xs) ++ [x]
+  where
+    (x:xs) = cullBox cfig w
 
 clDraw :: Cloud -> Picture
 clDraw c = translate3 (_clPos c) (_clPict c c)

src/Dodge/Room/Airlock.hs

@@ -78,7 +78,7 @@ airlockZ = defaultRoom
         [pContID (PS (V2 90 115) pi) (PutButton $ makeSwitch col red id id)
             $ \btid -> jspsJ (V2 0 60) 0 (PutDoor col (cond btid) outDoorps)
             $ sPS (V2 180 60) 0 (PutDoor col (cond btid) inDoorps)
-        , sps0 $ PutWall (rectNSEW 70 50 120 60) defaultWall
+        , sps0 $ PutWall (reverse $ rectNSWE 70 50 60 120) defaultWall
         , lighting
         ]
     , _rmBound = 

src/Dodge/Room/Corridor.hs

@@ -45,8 +45,8 @@ keyholeCorridor :: Room
 keyholeCorridor = corridor
     { _rmPath  = []
     , _rmPmnts = 
-        [ midWall $ rectNSEW top bot 0  15
+        [ midWall $ reverse $ rectNSWE top bot 15 0 
-        , midWall $ rectNSEW top bot 25 40]
+        , midWall $ reverse $ rectNSWE top bot 40 25]
     }
   where
     top = 65

src/Dodge/Room/LasTurret.hs

@@ -39,7 +39,7 @@ cenLasTur = roomNgon 8 200 & rmPmnts .~
     , mntLightLnkCond $ rprBool $ const . isInLnk
     ]
   where
-    covershape = rectNSEW 10 (-10) 20 (-20)
+    covershape = reverse $ rectNSWE 10 (-10) (-20) 20
 
 lightSensInsideDoor :: Int -> Room -> Room
 lightSensInsideDoor outplid rm = rm 
@@ -68,7 +68,7 @@ lightSensByDoor outplid rm = rm
         ]
     & rmOutPmnt .~ [OutPlacement (lasSensLightAboveDoor 20 (atFstLnkOutShiftBy sensorshift)) outplid]
   where
-    covershape = rectNSEW 10 (-10) 20 (-20)
+    covershape = reverse $ rectNSWE 10 (-10) (-20) 20
     sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a)
 
 keyCardRoomRunPast :: RandomGen g => Int -> Int -> State g (MetaTree Room String)
@@ -133,12 +133,12 @@ lasCenSensEdge n = do
 lasTunnel :: RandomGen g => Float -> State g Room
 lasTunnel y = do
     extraPlmnts <- takeOne
-        [   [ midWall (rectNSEW 115 90 0 60)
+        [   [ midWall (reverse $ rectNSWE 115 90 0     60)
-            , midWall (rectNSEW 65  40 (-40) 25)
+            , midWall (reverse $ rectNSWE 65  40 (-40) 25)
             ]
-        ,   [ midWall (rectNSEW 125 100 0 25)
+        ,   [ midWall (reverse $ rectNSWE 125 100 0 25)
-            , midWall (rectNSEW 80   40 (-40) 0)
+            , midWall (reverse $ rectNSWE 80   40 (-40) 0)
-            , midWall (rectNSEW 80   40 25 60)
+            , midWall (reverse $ rectNSWE 80   40 25 60)
             ]
         ]
     return  defaultRoom

src/Dodge/Room/LongDoor.hs

@@ -100,7 +100,7 @@ addButtonSlowDoor x h rm = do
         ["WARNING:"
         ,"LARGE BIOMASS DETECTED"
         ]
-    openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2)
+    openDoorBound = reverse $ rectNSWE (h + 5) (h - 5) (3*x/2) (-x/2)
     belowH y = (sndV2 . fst) y < h - 40
     aboveH y = (sndV2 . fst) y > h + 40
     amountedlight dr xoff = Just . moveLSThen (getdoorpos (fromJust $ _plMID dr)) 

src/Dodge/Room/Procedural.hs

@@ -249,10 +249,10 @@ centerVaultRoom w h d = return $ defaultRoom
         , inLink (V2 0   (-h)) pi ]
     , _rmPath   = []
     , _rmPmnts     = 
-        [sps0 $ PutWall (rectNSEW   d  (d - 30)   d  (d - 30)) defaultWall
+        [sps0 $ PutWall (reverse $ rectNSWE   d  (d - 30) (d - 30)   d ) defaultWall
-        ,sps0 $ PutWall (rectNSEW   d  (d - 30) (-d) (30 - d)) defaultWall
+        ,sps0 $ PutWall (reverse $ rectNSWE   d  (d - 30) (30 - d) (-d)) defaultWall
-        ,sps0 $ PutWall (rectNSEW (-d) (30 - d)   d  (d - 30)) defaultWall
+        ,sps0 $ PutWall (reverse $ rectNSWE (-d) (30 - d) (d - 30)   d ) defaultWall
-        ,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
+        ,sps0 $ PutWall (reverse $ rectNSWE (-d) (30 - d) (30 - d) (-d)) defaultWall
         ]
         ++ map (\a -> mntLS vShape (rotateV a $ V2 0  d) (rotate3z a $ V3 0 (d+30) 70))
             [0,0.5*pi,pi,1.5*pi]

src/Dodge/Room/Teleport.hs

@@ -35,7 +35,7 @@ telRoomLev _ = do
         , _ppID     = 0
         , _ppText   = "NEW LEVEL"
         }
-    ppFootprint = rectNSEW 20 (-20) 20 (-20)
+    ppFootprint = reverse $ rectNSWE 20 (-20) (-20) 20
     levelReset pp w
         | dist (_crPos $ you w) (_ppPos pp) < 20 = makeExplosionAt (_ppPos pp) w 
         | otherwise = w

src/Dodge/Update/Camera.hs

@@ -4,6 +4,7 @@ and the position that the character sees from: '_cameraViewFrom'.  -}
 module Dodge.Update.Camera 
     ( updateCamera
     , farWallPoints
+    , farWallDistDirection
     ) where
 import Dodge.Data
 import Dodge.Base
@@ -202,7 +203,17 @@ farWallDist p cfig w = (winFac /)
     grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
     wos = wallsOnScreen cfig w
     distFromEqmnt = foldr max 1 $ IM.mapMaybe (_eqViewDist . _eqEq. _itUse) $ getCrEquipment $ you w
-    
+
+farWallDistDirection :: Point2 -> Configuration -> World -> (Float,Float,Float,Float)
+--farWallDist p cfig w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps
+farWallDistDirection p cfig w = foldr m (0,0,0,0) $ map f vps
+  where
+    f q = g $ rotateV (negate $ _cameraRot w) $ collidePointWallsFilter wlIsOpaque p q wos -.- p
+    g (V2 x y) = (y, negate y, x, negate x)
+    m (a,b,c,d) (x,y,z,w') = (max a x, max b y, max c z, max d w')
+    vps = concatMap _grViewpoints grs ++ extendedViewPoints p grs
+    grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
+    wos = wallsOnScreen cfig w
 
 extendedViewPoints :: Point2 -> [GameRoom] -> [Point2]
 extendedViewPoints p grs = map extend 

src/Geometry/Polygon.hs

@@ -12,8 +12,8 @@ import qualified Control.Foldl as L
 rectNESW :: Float -> Float -> Float -> Float -> [Point2]
 rectNESW !a !b !c !d = [V2 b a,V2 b c,V2 d c,V2 d a]
 -- | Draw a clockwise rectangle based on maximal N S E W values.
-rectNSEW :: Float -> Float -> Float -> Float -> [Point2]
+--rectNSEW :: Float -> Float -> Float -> Float -> [Point2]
-rectNSEW !n !s !e !w = rectNESW n e s w
+--rectNSEW !n !s !e !w = rectNESW n e s w
 -- | Draw an anticlockwise rectangle based on maximal N S W E values.
 rectNSWE :: Float -> Float -> Float -> Float -> [Point2]
 rectNSWE !n !s !w !e = [V2 w n, V2 w s, V2 e s, V2 e n]

src/Geometry/Vector.hs

@@ -175,3 +175,7 @@ yV2 (V2 _ y) = y
 xyzV4 :: V4 a -> V3 a
 {-# INLINE xyzV4 #-}
 xyzV4 (V4 x y z _) = V3 x y z
+
+xyV3 :: V3 a -> V2 a
+{-# INLINE xyV3 #-}
+xyV3 (V3 x y _) = V2 x y

src/Picture.hs

@@ -55,6 +55,7 @@ polygonWire :: [Point2] -> Picture
 {-# INLINE polygonWire #-}
 polygonWire ps = line (ps ++ [head ps])
 
+-- need to check the winding!
 polygon :: [Point2] -> Picture
 {-# INLINE polygon #-}
 polygon = map f . polyToTris