remove never-used source files (CircumCircle & Render)

src/CircumCircle.hs

@@ -1,65 +0,0 @@
-module CircumCircle where
-import Diagrams.Prelude
-import Triangles
-import qualified Data.Set as S
-import qualified Data.List as L
-import Diagrams.TwoD
-import Diagrams.Direction
-import qualified Data.Colour.Names as CN
-import Diagrams.Backend.SVG
-import GHC.Generics
-import Data.Maybe
-
-data Circle n = Circle {
-  loc :: P2 n,
-  radius :: n
-                     }
-
-placeCircle :: Colour Double -> Circle Double -> Diagram B
-placeCircle col (Circle{..}) = circle radius # translate (loc .-. origin) # lw 0 # fc col
-
--- placeCircle (Circle{loc = loc, radius = rad}) = circle rad $ fc blue -- # opacity .25
-
-circumCircle :: (Ord a, Floating a) => S.Set (P2 a) -> Maybe (Circle a)
-circumCircle pts = circumCircleFromLoc <$> loc
-  where
-    circumCircleFromLoc loc' = Circle loc' (magnitude $ p1 .-. loc')
-
-    loc = listToMaybe $ intersectPointsT (mapLoc (fromOffsets. L.singleton . (^* circumfrence) . fromDir) bisectP1P2)
-                                         (mapLoc (fromOffsets. L.singleton . (^* circumfrence) . fromDir) bisectP2P3)
-
-    bisectP1P2 = bisect p1 p2
-
-    bisectP2P3 = bisect p2 p3
-
-    [p1, p2, p3] = L.sortOn (snd . unp2) . S.toList $ pts
-
-    circumfrence = sum . map magnitude $ [(p2 .-. p1), (p2 .-. p3), (p1 .-. p3)]
-
-
--- circumDebug :: (Ord a, Floating a) => S.Set (P2 a) -> Maybe (Circle a)
-circumDebug pts = (bisectP1P2, bisectP2P3)
-  where
-    circumCircleFromLoc loc' = Circle loc' (magnitude $ p1 .-. loc')
-
-    loc = listToMaybe $ intersectPointsT (mapLoc (fromOffsets. L.singleton . fromDir) bisectP1P2) (mapLoc (fromOffsets. L.singleton . fromDir) bisectP1P2)
-
-    bisectP1P2 = bisect p1 p2
-
-    bisectP2P3 = bisect p2 p3
-
-    [p1, p2, p3] = L.sortOn (snd . unp2) . S.toList $ pts
-
-    circumfrence = 400
-
-
-magnitude :: Floating a => V2 a -> a
-magnitude v = sqrt (x * x + y * y)
-  where
-    (x, y) = unr2 v
-
--- assumes x of p1 is smaller than x of p2
-bisect :: Floating n => Point V2 n -> Point V2 n -> Located (Direction V2 n)
-bisect p1 p2 = at (rotateBy (1 / 4) $ dir bisectVec) (p1 .+^ bisectVec)
-  where
-    bisectVec = (p2 .-. p1) ^/ 2

src/Main.hs

@@ -28,7 +28,6 @@ import Graphics.Image as Img hiding (map, zipWith)
 import qualified Graphics.Image.ColorSpace as G
 import qualified Graphics.Image.Interface as Int
 import Options.Generic
-import qualified Render as Ren
 import qualified System.Environment as Env
 import System.Random
 import System.Random.Internal
@@ -79,7 +78,8 @@ genImage' image gen cornerCount =
       . fromVertices
       $ shape
 
-  widthHeightRatio = (fromIntegral $ fst dimensions) / ((fromIntegral $ snd dimensions) :: Double)
+  widthHeightRatio :: Double
+  widthHeightRatio = (fromIntegral . fst $ dimensions) / (fromIntegral . snd $ dimensions)
 
   img' = convImage image
   dimensions = Img.dims image

src/Render.hs

@@ -1,29 +0,0 @@
-module Render where
-
-import Diagrams.TrailLike
-
-
-import qualified Triangles as Tri
-import Diagrams.Prelude
-import Diagrams.Backend.SVG.CmdLine
-import qualified Data.Set as S
-import qualified Data.Colour.Names as CN
-
-
--- makeTriangle :: [Point V2 Double] -> Colour Double -> Diagram SVG
--- makeTriangle :: (base-4.16.4.0:Data.Typeable.Internal.Typeable n, RealFloat n,
---  Renderable (Path V2 n) b) =>
--- [Point V2 n] -> Colour Double -> QDiagram b V2 n Any
-makeTriangle verts col = fromVertices verts
-    # mapLoc closeLine
-    # strokeLocLoop 
-    # lc col
-    # fc col
-    # lw 1.0
-
-
--- tupleFromIntegral :: (Int, Int) -> (Int, Int) -> (Double, Double)
-tupleFromIntegral (cols, rows) (a, b) = (fromIntegral b, fromIntegral a)
-
--- renderTriangle = makeTriangle (map p2 [(0.0,0.0), (0.1,0.1), (0.2,0.2)]) blue
-placeTri tri = makeTriangle (S.toList tri)

src/Triangles.hs

@@ -46,21 +46,24 @@ derivingUnbox
   [|toSRGBTuple|]
   [|fromSRGBTuple|]
 
+borderSize = 0.05
+
 -- from -0.05 to 1.05 so there aren't missing/elongated triangles at the edges
 randomPoints :: StdGen -> [(Double, Double)]
 randomPoints = map (bimap toZeroToOneTuple toZeroToOneTuple) . randomRs ((0 :: Word, 0 :: Word), (maxBound, maxBound))
  where
   toZeroToOneTuple :: Word -> Double
-  toZeroToOneTuple x = ((fromIntegral x / (fromIntegral (maxBound :: Word))) * 1.2) - 0.1
+  toZeroToOneTuple x = ((fromIntegral x / (fromIntegral (maxBound :: Word))) * (1 + (2 * borderSize))) - borderSize
 
 combinations :: (Ord b, Floating b, NFData b) => [P2 b] -> [(P2 b, P2 b)]
 combinations xs =
   sortOn (abs . uncurry distanceA)
-    . S.toList
+    . S.toList -- deduplicate
     . S.fromList
     . filter (uncurry (/=))
-    . sortOn (abs . uncurry distanceA)
-    . concatMap (\(x : xs) -> map (x,) xs)
+    . concat
+    . withStrategy (parListChunk 50 rdeepseq)
+    . map (\(x : xs) -> take 15 . sortOn (abs . uncurry distanceA) . map (x,) $ xs)
     . init
     . tails
     $ xs
@@ -70,6 +73,7 @@ combinations xs =
 toPlanarGraph :: forall n. (NFData n, Floating n, Ord n) => [P2 n] -> [(Point V2 n, Point V2 n)]
 toPlanarGraph points =
   removeIntersections
+    . sortOn (abs . uncurry distanceA)
     . combinations
     $ points
  where
@@ -116,7 +120,7 @@ voroniDiagramCorners center midpoints =
 
   tangentTrail midpoint = fromVertices [midpoint .-^ tangentVec, midpoint .+^ tangentVec]
    where
-    -- implicitly uses the unit vector as an infinitely long vector
+    -- implicitly uses the unit vector * 8 as an infinitely long vector
     tangentVec =
       scale 8
         . fromDirection
@@ -165,7 +169,7 @@ getPointsInTriangle image pts =
     , ptsBtween (makeLine p1 p2) (makeLine p2 p3)
     ]
  where
-  [p1, p2, p3] = sortOn fst . map (\(y, x) -> (x, y)) . map unp2 . S.toList $ pts
+  [p1, p2, p3] = sortOn fst . map unp2 . S.toList $ pts
 
 blendEqually colors = C.affineCombo (zip (repeat fraction) colors) $ C.blue
  where
@@ -197,7 +201,7 @@ getColorsInTriangle image (x', y') triangle = pixels
   points = getPointsInTriangle image triangle
 
   index' :: (Int, Int) -> Maybe Pixel_
-  index' (y, x)
+  index' (x, y)
     | y >= y' = Nothing
     | x >= x' = Nothing
     | y < 0 = Nothing
@@ -213,7 +217,7 @@ ptsBtween l1 l2 = concatMap rasterLine . noSingletons $ [startingX .. endingX]
   startingX = max (startX l1) (startX l2)
   endingX = min (endX l1) (endX l2)
 
-  rasterLine x = map (\y -> (y, x)) $ range' (yAt l1 x) (yAt l2 x)
+  rasterLine x = map (x,) $ range' (yAt l1 x) (yAt l2 x)
 
 noSingletons :: [a] -> [a]
 noSingletons [x] = []
@@ -226,7 +230,7 @@ yAt :: LineMXB -> Int -> Int
 yAt (LineMXB{m = m, b = b}) x = round $ (m * (fromIntegral x)) + b
 
 makeLine :: (Int, Int) -> (Int, Int) -> LineMXB
-makeLine (y1, x1) (y2, x2) =
+makeLine (x1, y1) (x2, y2) =
   LineMXB
     { m = slope
     , b = (fromIntegral y1) - (slope * (fromIntegral x1))