new method which makes a planar graph between random points

.gitignore

@@ -1,4 +1,4 @@
 .stack-work/*
 dist/*
-*.svg
 /dist-newstyle/
+/cabal.project.local

README.md

@@ -1,46 +1,16 @@
 # image-triangles
 ### examples
-![example1Orig](sierra.jpg)
+![Sierra mountians original](examples/sierra.jpg)
-![example1result](sierraResult.png)
+![Sierra mountians post-filter](examples/sierra-result.svg)
-![example2Orig](art.png)
+![Dog original](examples/luna.jpeg)
-![example2Result](artResult.png)
+![Dog post-filter](examples/luna-result.svg)
 
-### to build:
+### to run:
 
-make sure you have nix installed
+install [cabal & ghc](https://www.haskell.org/ghcup/) if you don't have them.
-```
-curl https://nixos.org/nix/install | sh
-```
 
 ```
-nix-build
+cabal update
-
+# change input file name in Main.hs line 95-ish
+cabal run image-triangles -- -o output.svg --height 1000 --width 1000
 ```
-run with
-```
-./result/bin/image-triangles -o output.svg
-```
-
-### to develop on:
-```
-cabal --enable-nix build
-```
-or
-```
-echo "nix: True" >> ~/.cabal/config
-cabal build
-```
-
-#### run with
-```
-./dist/build/image-triangles/image-triangles -o output.svg
-```
-
-### todo
-- [x] Confirm diagrams is rendering triangles in the correct places.
-- [x] Cache transformations to the colors library
-- [x] Hip has a map transformation. It also depends on the colours library, does it use it?
-- [x] In addition, hip has interfaces to arrays that support operations like map
-- [x] Check that hip colors are srgb
-- [ ] Think about opacity. What if everything was completely opaque? What should we do with areas that aren’t 100% covered at the end?
-- [ ] The diagram needs a final bounding box that's the size of the picture that it comes from.

image-triangles.cabal

@@ -80,8 +80,9 @@ executable image-triangles
                      , diagrams-svg
                      , parallel
                      , repa
+                     , linear
                      , vector
-                     , scotty
+                     , containers
 
 
   -- Directories containing source files.
@@ -89,8 +90,10 @@ executable image-triangles
 
   -- Base language which the package is written in.
   default-language:    Haskell2010
-  ghc-options: -threaded
+  ghc-options:
-               -rtsopts
+                -- "-fprof-auto"
---               -prof
+                -threaded
+               "-with-rtsopts= -N"
+              -- -prof
 --               -fexternal-interpreter
 --               import Servant.Client

src/Main.hs

@@ -1,6 +1,7 @@
 module Main where
 
 import qualified Triangles as Tri
+import GHC.Generics
 import qualified Render    as Ren
 import Graphics.Image as Img hiding (map, zipWith)
 import System.Random
@@ -15,20 +16,24 @@ import qualified Graphics.Image.Interface as Int
 import qualified Data.Vector.Unboxed as Vec
 import qualified Debug.Trace as DT
 import qualified System.Environment as Env
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Triangles (getTriangleAverageRGB)
+import qualified Data.Colour.SRGB as CL
 
 data Options = Options {
-                    numTriangles :: Int,
+                    numPoints :: Int,
                     gen :: Maybe StdGen
                }
 
--- modify this to your liking
+-- -- modify this to your liking
 defaultOpts  = Options {
-                    numTriangles = 5000,
+                    numPoints = 10,
                     gen = Nothing
                   }
 
 genList :: StdGen -> [StdGen]
-genList = map snd . iterate (split . fst) . split 
+genList = map snd . iterate (split . fst) . split
 
 -- CL.rgb might be the wrong fn...
 tosRGB' :: (Ord b, Floating b) => Pixel G.RGB b -> CL.Colour b
@@ -36,43 +41,58 @@ tosRGB' (G.PixelRGB r g b) = CL.rgb r g b
 
 convImage = Vec.map tosRGB' . Int.toVector
 
--- progress goes from 0 to 1 the farther we get along the process
+-- -- progress goes from 0 to 1 the farther we get along the process
--- note, 0 represents the topmost triangle
+-- -- note, 0 represents the topmost triangle
-renderTri :: Vec.Vector (Colour Double) -> (Int, Int) -> StdGen -> Double -> QDiagram SVG V2 Double Any
+-- renderTri :: Vec.Vector (Colour Double) -> (Int, Int) -> StdGen -> Double -> QDiagram SVG V2 Double Any
-renderTri image dimensions gen progress = Ren.makeTriangle (Ren.toPointList dimensions triangle) color opacity'
+-- renderTri image dimensions gen progress = Ren.makeTriangle (Ren.toPointList dimensions triangle) color opacity'
-    where
+--     where
 
-        triangle = Tri.getRandomTriangle image dimensions (Just area) gen
+--         triangle = Tri.getRandomTriangle image dimensions (Just area) gen
-        
-        color = Tri.getTriangleAverageRGB image triangle dimensions
-        
-        -- the following should be considered triangle shaders
-        -- modify them to your liking, their outputs are expected to be in [0, 1]
-        -- TODO: move these into a separate module
-        -- opacity' = 0.4
-        opacity' =  0.3 +  ((1 - progress) * 0.5)
-        
-        area = max ((progress ** 2) * 0.2) 0.02
 
+--         color = Tri.getTriangleAverageRGB image triangle dimensions
 
-genImage :: String -> IO (Diagram B)
+--         -- the following should be considered triangle shaders
+--         -- modify them to your liking, their outputs are expected to be in [0, 1]
+--         -- TODO: move these into a separate module
+--         -- opacity' = 0.4
+--         opacity' =  0.3 +  ((1 - progress) * 0.5)
+
+--         area = max ((progress ** 2) * 0.2) 0.02
+
+corners :: [(Double, Double)]
+corners = (,) <$> [0, 1] <*> [0, 1]
+
+scalePointToImage :: (Int, Int) -> Point V2 Double -> Point V2 Int
+scalePointToImage (ymax, xmax) p = round <$> (p2 (fromIntegral xmax, fromIntegral ymax) * p)
+
+-- derive Generic (RGB Double)
+
+-- genImage :: String -> IO (Diagram B)
+genImage :: FilePath -> IO (QDiagram SVG V2 Double Any)
 genImage name = do
-    let (Options {numTriangles = numTriangles, gen = gen'}) = defaultOpts
+    let (Options {..}) = defaultOpts
-    gen'' <- case gen' of
+    gen' <- maybe getStdGen pure gen
-                        Nothing -> getStdGen
+    print gen'
-                        Just a  -> return a
     image <- Img.readImageRGB VU name
     let img' = convImage image
     let dimensions = (rows image, cols image)
-    print gen''
+    let triangles =  S.toList . Tri.findTriangles . Tri.toPlanarGraph . take 1000 . map p2 $ corners ++ Tri.randomPoints gen'
-    let progressList =  withStrategy (parListChunk 500 rdeepseq) . map (/ (fromIntegral numTriangles)) $ [0.0 .. (fromIntegral numTriangles)]
+    let triColors =  map (getTriangleAverageRGB img' dimensions . S.map (scalePointToImage dimensions)) $ triangles
-    return $ center . reflectY . mconcat $ zipWith (renderTri img' dimensions) (genList gen'') progressList
+    pure $ reflectY . mconcat $ withStrategy (parListChunk 1000 rseq) $ zipWith Ren.placeTri triangles triColors
+
+    -- let progressList =  withStrategy (parListChunk 500 rdeepseq) . map (/ (fromIntegral numTriangles)) $ [0.0 .. (fromIntegral numTriangles)]
+    -- return $ center . reflectY . mconcat $ zipWith (renderTri img' dimensions) (genList gen'') progressList
+
+
+
 
 main :: IO ()
 main = do
   gen <- getStdGen
-  let diagram = mconcat . map Ren.toLine . Tri.toPlanarGraph . take 40 $ [(0,0), (3000,0), (0, 3000), (3000, 3000)] ++ Tri.randomPoints (3000, 3000) gen
+  -- let diagram :: (QDiagram SVG V2 Double Any) = mconcat . map (strokeLocTrail . uncurry Tri.toLocatedTrail) . Tri.toPlanarGraph . take 40 . map p2 $ corners ++ Tri.randomPoints gen
   -- let diagram = mconcat . map Ren.toLine . Tri.toPlanarGraph $ [(0,0), (1,2), (0,1), (1,0)]
+  -- let diagram :: (QDiagram SVG V2 Double Any) = mconcat . map Ren.placeTri . S.toList . Tri.findTriangles . Tri.toPlanarGraph . take 15 . map p2 $ corners ++ Tri.randomPoints gen
+  diagram <- genImage "sierra.jpg"
   mainWith diagram
 
 -- cmdArgs <- Env.getArgs

src/Render.hs

@@ -6,14 +6,17 @@ 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 -> Double -> Diagram SVG
 makeTriangle verts col opacity_ = fromVertices verts
     # mapLoc closeLine
     # strokeLocLoop 
+    # lc col
     # fc col
-    # lw 0
+    # lw 0.5
     # opacity opacity_
 
 
@@ -24,14 +27,15 @@ tupleFromIntegral (cols, rows) (a, b) = (fromIntegral b, fromIntegral a)
 divv :: Int -> Int -> Double
 a `divv` b = (fromIntegral a) / (fromIntegral b)
 
-toPointList :: (Int, Int) -> Tri.Triangle -> [Point V2 Double]
+-- toPointList :: (Int, Int) -> Tri.Triangle -> [Point V2 Double]
-toPointList dims (a, b, c) = map (p2 . tupleFromIntegral dims) [a, b, c]
+-- toPointList dims (a, b, c) = map (p2 . tupleFromIntegral dims) [a, b, c]
 
-toLine :: Tri.Line -> Diagram SVG
+-- toLine :: Tri.Line -> Diagram SVG
-toLine line = lw thin $ moveTo startPoint . strokeLine $ startPoint ~~ endPoint
+-- toLine line = lw thin $ moveTo startPoint . strokeLine $ startPoint ~~ endPoint
-  where
+--   where
-    startPoint = p2 (fromIntegral $  Tri.startX line, fromIntegral $ Tri.yAt line (Tri.startX line))
+--     startPoint = p2 (fromIntegral $  Tri.startX line, fromIntegral $ Tri.yAt line (Tri.startX line))
-    endPoint = p2 (fromIntegral $  Tri.endX line, fromIntegral $ Tri.yAt line (Tri.endX line))
+--     endPoint = p2 (fromIntegral $  Tri.endX line, fromIntegral $ Tri.yAt line (Tri.endX line))
 
 
 -- renderTriangle = makeTriangle (map p2 [(0.0,0.0), (0.1,0.1), (0.2,0.2)]) blue
+placeTri tri col = makeTriangle (S.toList tri) col 1.0

src/Triangles.hs

@@ -20,11 +20,17 @@ import Data.List
 import Data.Maybe
 import qualified Data.Vector.Unboxed as Vec
 import Data.Fixed
-import Data.Vector.Unboxed.Deriving 
+import Data.Vector.Unboxed.Deriving
+import Diagrams.TwoD
+import Diagrams.Prelude
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Control.Arrow
+-- import qualified Linear.Affine as L
 type Image_ = Vec.Vector Pixel_
 type Pixel_ = Colour Double
-type Point = (Int, Int)
+-- type Point = (Double, Double)
-type Triangle = (Point, Point, Point)
+-- type Triangle = (Point, Point, Point)
 
 toSRGBTuple :: Pixel_ -> (Double, Double, Double)
 toSRGBTuple = srgb' . C.toRGB
@@ -40,173 +46,209 @@ derivingUnbox "Pixel_"
     [| fromSRGBTuple |]
 
 
-randomPoints :: (Int, Int) -> StdGen -> [(Int, Int)]
+randomPoints :: StdGen -> [(Double, Double)]
-randomPoints (height, width) = randomRs ((0,0), (height, width))
+randomPoints = randomRs ((0,0), (1, 1))
 
-toPlanarGraph :: [Point] -> [Line]
+-- toPlanarGraph :: [Point P2 Double] -> [(Point P2 Double, Point P2 Double)]
-toPlanarGraph points = makePlanar . map (uncurry makeLine) . sortOn (uncurry distance)
+-- toPlanarGraph :: [P2 Double] -> [Located (Path V2 Double)]
-                     $ concatMap (\x -> map (,x) points) points
+-- toPlanarGraph :: (V a ~ V2, TrailLike a) => [Point V2 (N a)] -> [(Point P2 Double, Point P2 Double)]
+toPlanarGraph :: (Floating b, Ord b) => [Point V2 b] -> [(Point V2 b, Point V2 b)]
+toPlanarGraph points = -- map (uncurry toLocatedTrail) .
+  removeIntersections . sortOn (uncurry distanceA) . filter (uncurry (/=)) $ (,) <$> points <*> points
   where
-    makePlanar :: [Line] -> [Line]
-    makePlanar = foldl addIfPlanar []
 
-    addIfPlanar lines candidate = if any (intersects candidate) lines then lines else candidate : lines
+    removeIntersections = foldl' addIfNoIntersection []
 
-distance :: Point -> Point -> Double
+    addIfNoIntersection xs x = if all (noIntersection x) xs then (x:xs) else xs
-distance (x0, y0) (x1, y1) = sqrt $ (fromIntegral (x0 - x1) ** 2) + (fromIntegral (y0 - y1) ** 2)
 
-sharesCoords :: Triangle -> Bool
+    noIntersection l1 l2 = (==) sharedEndPoint . length $ intersectPointsT (uncurry toLocatedTrail l1) (uncurry toLocatedTrail l2)
-sharesCoords ((x1, y1), (x2, y2), (x3, y3)) = ((/= 3) . length . nub $ [x1, x2, x3])
+      where
-                                           || ((/= 3) . length . nub $ [y1, y2, y3])
+        sharedEndPoint = (-) 4 . length . nub $ [fst l1, snd l1, fst l2, snd l2]
 
-intersects :: Line -> Line -> Bool
+toLocatedTrail :: TrailLike a => Point (V a) (N a) -> Point (V a) (N a) -> Located a
-intersects l1 l2 = case xIntersect of
+toLocatedTrail p1 p2 = fromVertices [p1, p2] `at` p1
-  Just x -> (x > (fromIntegral . startX $ l1) && x < (fromIntegral . endX $ l1)) &&
+
-            (x > (fromIntegral . startX $ l2) && x < (fromIntegral . endX $ l2))
+
-  Nothing -> False
+findTriangles :: Ord b => [(b, b)] -> S.Set (S.Set b)
+findTriangles edges = S.unions . S.map threeCyclesOf . M.keysSet $ adjacencyMap
   where
-    xIntersect = if m l2 == m l1 || isVertical l1 || isVertical l2 then Nothing else Just $ (b l1 - b l2) / (m l2 - m l1)
 
-isVertical :: Line -> Bool
+    threeCyclesOf node = S.unions
-isVertical (Line {..}) = m > 2000.0
+      . S.map (\x -> S.map (\y ->  S.fromList [node, x, y]) $ S.delete node . S.intersection originalNodeNeighbors . (M.!) adjacencyMap $ x) $ originalNodeNeighbors
+      where
+        originalNodeNeighbors = fromMaybe S.empty (adjacencyMap M.!? node)
 
-shoelace :: [Point] -> Double 
+    adjacencyMap = M.fromListWith S.union . map (second S.singleton) $ (edges ++ edgesReversed)
-shoelace pts = halve . sum $ zipWith (*) (zipWith (+) xs' xs) (zipWith (-) ys' ys)
+    edgesReversed = map (\(a, b) -> (b, a)) edges
-    where
-        showme =  zipWith (*) (zipWith (+) xs' xs) (zipWith (-) ys' ys)
-        xs = map snd pts
-        ys = map fst pts
-        ys' = tail . cycle $ xs
-        xs' = tail . cycle $ ys
-        halve b =  (fromIntegral b) / 2.0
 
-shoelace' :: [Point] -> Double 
+pointsInTriangle tri = []
-shoelace' [(y1, x1), (y2, x2), (y3, x3)] =  abs $ (* 0.5) . fromIntegral $ x1*y2 + x2*y3 + x3*y1 - x2*y1 - x3*y2 - x1*y3
+  where
+    [fst, snd, thrd] = S.toList tri
 
-area :: Triangle -> Double
-area (p1, p2, p3) = shoelace' [p1, p2, p3]
-    where
-        swapForCounterClockwise [a, b, c] = if snd a < snd b
-                                               then [a, b, c]
-                                               else [b, a, c]
-        ccArea [(x1, y1), (x2, y2), (x3, y3)] = 
-            (fromIntegral (x1 * y2 + x2 * y3 + x3 * y1
-                         - x1 * y3 - x2 * y1 - x3 - y2)) / 2.0
 
-getRandomPixel :: StdGen -> (Int, Int) -> (Int, Int)
+  --   makePlanar :: [Line] -> [Line]
-getRandomPixel gen (rows, cols) =
+  --   makePlanar = foldl addIfPlanar []
-    ( getCoord gen  . pred $ rows
-    , getCoord gen' . pred $ cols)
-    where
-        getCoord :: StdGen -> Int -> Int
-        getCoord gen = fst . (flip randomR) gen . (0,)
 
-        gen' = snd . next $ gen
+  --   addIfPlanar lines candidate = if any (intersects candidate) lines then lines else candidate : lines
 
-first3 :: [a] -> (a, a, a)
+-- distance :: Point -> Point -> Double
-first3 (a : b : c : _) = (a, b, c)
+-- distance (x0, y0) (x1, y1) = sqrt $ (fromIntegral (x0 - x1) ** 2) + (fromIntegral (y0 - y1) ** 2)
+
+-- -- sharesCoords :: Triangle -> Bool
+-- -- sharesCoords ((x1, y1), (x2, y2), (x3, y3)) = ((/= 3) . length . nub $ [x1, x2, x3])
+-- --                                            || ((/= 3) . length . nub $ [y1, y2, y3])
+
+-- intersects :: Line -> Line -> Bool
+-- intersects l1 l2 = case xIntersect of
+--   Just x -> (x > (fromIntegral . startX $ l1) && x < (fromIntegral . endX $ l1)) &&
+--             (x > (fromIntegral . startX $ l2) && x < (fromIntegral . endX $ l2))
+--   Nothing -> False
+--   where
+--     xIntersect = if m l2 == m l1 || isVertical l1 || isVertical l2 then Nothing else Just $ (b l1 - b l2) / (m l2 - m l1)
+
+-- isVertical :: Line -> Bool
+-- isVertical (Line {..}) = m > 2000.0
+
+-- shoelace :: [Point] -> Double
+-- shoelace pts = halve . sum $ zipWith (*) (zipWith (+) xs' xs) (zipWith (-) ys' ys)
+--     where
+--         showme =  zipWith (*) (zipWith (+) xs' xs) (zipWith (-) ys' ys)
+--         xs = map snd pts
+--         ys = map fst pts
+--         ys' = tail . cycle $ xs
+--         xs' = tail . cycle $ ys
+--         halve b =  (fromIntegral b) / 2.0
+
+-- shoelace' :: [Point] -> Double
+-- shoelace' [(y1, x1), (y2, x2), (y3, x3)] =  abs $ (* 0.5) . fromIntegral $ x1*y2 + x2*y3 + x3*y1 - x2*y1 - x3*y2 - x1*y3
+
+-- area :: Triangle -> Double
+-- area (p1, p2, p3) = shoelace' [p1, p2, p3]
+--     where
+--         swapForCounterClockwise [a, b, c] = if snd a < snd b
+--                                                then [a, b, c]
+--                                                else [b, a, c]
+--         ccArea [(x1, y1), (x2, y2), (x3, y3)] =
+--             (fromIntegral (x1 * y2 + x2 * y3 + x3 * y1
+--                          - x1 * y3 - x2 * y1 - x3 - y2)) / 2.0
+
+-- getRandomPixel :: StdGen -> (Int, Int) -> (Int, Int)
+-- getRandomPixel gen (rows, cols) =
+--     ( getCoord gen  . pred $ rows
+--     , getCoord gen' . pred $ cols)
+--     where
+--         getCoord :: StdGen -> Int -> Int
+--         getCoord gen = fst . (flip randomR) gen . (0,)
+
+--         gen' = snd . next $ gen
+
+-- first3 :: [a] -> (a, a, a)
+-- first3 (a : b : c : _) = (a, b, c)
 
 -- colorComp :: Image_ -> (Int, Int) -> (Int, Int)
 -- colorComp img p1 p2 = comp ( p1)
 
-getP2 :: Image_ -> StdGen -> (Int, Int) -> Double -> (Int, Int)
+-- getP2 :: Image_ -> StdGen -> (Int, Int) -> Double -> (Int, Int)
-getP2 image gen (x0, y0) r' = (x0 + x, y0 + y)
+-- getP2 image gen (x0, y0) r' = (x0 + x, y0 + y)
-    where 
+--     where
-        r = max 2.0 r' 
+--         r = max 2.0 r'
-        phi = fst . randomR (0.0, pi * 2) $ gen
+--         phi = fst . randomR (0.0, pi * 2) $ gen
-        phi' = map (\x -> (x + phi) `mod'` (2 * pi)) [0, pi / 2, pi, 3 * pi / 2]
+--         phi' = map (\x -> (x + phi) `mod'` (2 * pi)) [0, pi / 2, pi, 3 * pi / 2]
-        x = round $ r * cos phi
+--         x = round $ r * cos phi
-        y = round $ r * sin phi
+--         y = round $ r * sin phi
 
 
-getRandomTriangle :: Image_ -> (Int, Int) -> Maybe Double -> StdGen -> Triangle
+-- getRandomTriangle :: Image_ -> (Int, Int) -> Maybe Double -> StdGen -> Triangle
-getRandomTriangle image dims area gen = (p1, p2, p3)
+-- getRandomTriangle image dims area gen = (p1, p2, p3)
+--     where
+--         p1 : p2' : _ = map (\x -> getRandomPixel x dims) genList
+
+--         p2 = case area of
+--                Nothing -> p2'
+--                Just a -> getP2 image gen1 p1 $ a * (fromIntegral $ (uncurry min) dims)
+
+
+--         gen0 : gen1 : genList = tail . iterate (snd . next) $ gen
+
+--         p3 = getThirdPoint p1 p2 gen0 (pi / 10.0)
+
+-- angleIntersect :: (Point, Double) -> (Point, Double) -> Point
+-- angleIntersect ((y1, x1), angle1) ((y2, x2), angle2) = (round y3, round x3)
+--     where
+--         m1 :: Double
+--         m1 = tan angle1
+--         m2 :: Double
+--         m2 = tan angle2
+
+--         x3 = (b1 - b2) / (m2 - m1)
+--         y3 = (m1 * x3) + b1
+--         y3' = (m2 * x3) + b2
+
+--         b1 :: Double
+--         b1 = (fromIntegral y1) - (m1 * (fromIntegral x1))
+--         b2 :: Double
+--         b2 = (fromIntegral y2) - (m2 * (fromIntegral x2))
+
+-- getThirdPoint :: Point -> Point -> StdGen -> Double -> Point
+-- getThirdPoint p1 p2 gen tolerance = angleIntersect (p1, p1From2 + p1Angle) (p2, p2From1 - p2Angle)
+--     where
+
+--         showMe = [p1Angle, p2Angle, p3Angle]
+
+--         p2From1 :: Double
+--         p2From1 = angle p2 p1
+
+--         p1From2 :: Double
+--         p1From2 = angle p1 p2
+
+--         p3Angle :: Double
+--         p3Angle = fst $ randomR (thirdpi - tolerance, thirdpi + tolerance) gen
+
+--         thirdpi :: Double
+--         thirdpi = pi / 3.0
+
+--         p2Angle :: Double
+--         p2Angle = fst $ randomR (thirdpi - tolerance, p2Max) (snd . next $ gen)
+
+--         p2Max :: Double
+--         p2Max = {-min (pi - p3Angle - (thirdpi - tolerance))-} (thirdpi + tolerance)
+
+--         p1Angle :: Double
+--         p1Angle = pi - p3Angle - p2Angle
+
+-- angle :: Point -> Point -> Double
+-- angle (y, x) (fromy, fromx) = atan2 y' x'
+--     where
+--         y' = fromIntegral $ y - fromy
+--         x' = fromIntegral $ x - fromx
+
+-- getPointsInTriangle :: Image_ -> S.Set (Point V2 Int) -> [Point V2 Int]
+getPointsInTriangle :: p -> S.Set (P2 Int) -> [(Int, Int)]
+getPointsInTriangle image pts = S.toList . S.unions . map S.fromList $ [
+                                (ptsBtween (makeLine p1 p3) (makeLine p1 p2)),
+                                (ptsBtween (makeLine p1 p3) (makeLine p2 p3)),
+                                (ptsBtween (makeLine p1 p2) (makeLine p2 p3))]
     where
-        p1 : p2' : _ = map (\x -> getRandomPixel x dims) genList
+        [p1, p2, p3] = sortOn fst . map (\(y, x) -> (x,y)) . map unp2 . S.toList $ pts
 
-        p2 = case area of 
+        -- p1 = sortedPoints !! 0
-               Nothing -> p2'
+        -- p2 = sortedPoints !! 1
-               Just a -> getP2 image gen1 p1 $ a * (fromIntegral $ (uncurry min) dims)
+        -- p3 = sortedPoints !! 2
 
-
+blendEqually colors = C.affineCombo (zip (repeat fraction) colors) $ C.black
-        gen0 : gen1 : genList = tail . iterate (snd . next) $ gen
-
-        p3 = getThirdPoint p1 p2 gen0 (pi / 10.0)
-
-angleIntersect :: (Point, Double) -> (Point, Double) -> Point
-angleIntersect ((y1, x1), angle1) ((y2, x2), angle2) = (round y3, round x3)
-    where
-        m1 :: Double
-        m1 = tan angle1
-        m2 :: Double
-        m2 = tan angle2
-
-        x3 = (b1 - b2) / (m2 - m1)
-        y3 = (m1 * x3) + b1
-        y3' = (m2 * x3) + b2
-        
-        b1 :: Double
-        b1 = (fromIntegral y1) - (m1 * (fromIntegral x1))
-        b2 :: Double
-        b2 = (fromIntegral y2) - (m2 * (fromIntegral x2))
-
-getThirdPoint :: Point -> Point -> StdGen -> Double -> Point
-getThirdPoint p1 p2 gen tolerance = angleIntersect (p1, p1From2 + p1Angle) (p2, p2From1 - p2Angle)
-    where
-
-        showMe = [p1Angle, p2Angle, p3Angle]
-
-        p2From1 :: Double
-        p2From1 = angle p2 p1
-        
-        p1From2 :: Double
-        p1From2 = angle p1 p2
-
-        p3Angle :: Double
-        p3Angle = fst $ randomR (thirdpi - tolerance, thirdpi + tolerance) gen
-
-        thirdpi :: Double
-        thirdpi = pi / 3.0
-
-        p2Angle :: Double
-        p2Angle = fst $ randomR (thirdpi - tolerance, p2Max) (snd . next $ gen)
-
-        p2Max :: Double
-        p2Max = {-min (pi - p3Angle - (thirdpi - tolerance))-} (thirdpi + tolerance)
-
-        p1Angle :: Double
-        p1Angle = pi - p3Angle - p2Angle
-
-angle :: Point -> Point -> Double
-angle (y, x) (fromy, fromx) = atan2 y' x'
-    where
-        y' = fromIntegral $ y - fromy
-        x' = fromIntegral $ x - fromx
-    
-getPointsInTriangle :: Image_ -> Triangle -> [Point]
-getPointsInTriangle image (p1', p2', p3') = (ptsBtween (makeLineUnsafe p1 p3) (makeLineUnsafe p1 p2)) ++
-                                            (ptsBtween (makeLineUnsafe p1 p3) (makeLineUnsafe p2 p3))
-    where
-        sortedPoints = sortOn snd [p1', p2', p3']
-
-        p1 = sortedPoints !! 0
-        p2 = sortedPoints !! 1
-        p3 = sortedPoints !! 2
-
-blendEqually colors = C.affineCombo (zip (repeat fraction) colors) $ C.black 
     where
         fraction = 1.0 / (fromIntegral . length $ colors)
 
-getTriangleAverageRGB :: Image_ -> Triangle -> (Int, Int) -> C.Colour Double
+getTriangleAverageRGB :: Image_ -> (Int, Int)-> S.Set (P2 Int)  -> C.Colour Double
-getTriangleAverageRGB image triangle (y', x') = blendEqually $  pixels
+getTriangleAverageRGB image (y', x') triangle = blendEqually pixels
     where
 
         pixels :: [Pixel_]
         pixels = catMaybes . map index' $ points
 
-        points :: [Point]
+        points :: [(Int, Int)]
         points = getPointsInTriangle image triangle
-        
+
         -- I got so upset that I put this function in here instead of in general scope that I went to bed for the night.
         index' :: (Int, Int) -> Maybe Pixel_
         index' (y, x)
@@ -216,7 +258,7 @@ getTriangleAverageRGB image triangle (y', x') = blendEqually $  pixels
             | x < 0   = Nothing
             | otherwise = image Vec.!? ((y * x') + x)
 
-ptsBtween :: Line -> Line -> [Point]
+ptsBtween :: LineMXB -> LineMXB -> [(Int, Int)]
 ptsBtween l1 l2 = concatMap rasterLine . noSingletons $ [startingX .. endingX]
     where
         startingX = max (startX l1) (startX l2)
@@ -227,28 +269,18 @@ ptsBtween l1 l2 = concatMap rasterLine . noSingletons $ [startingX .. endingX]
 noSingletons :: [a] -> [a]
 noSingletons [x] = []
 noSingletons l   = l
-        
+
 range' :: Int -> Int -> [Int]
 range' a b = [(min a b) .. (max a b)]
 
-yAt :: Line -> Int -> Int
+yAt :: LineMXB -> Int -> Int
-yAt (Line {m = m, b = b}) x = round $ (m * (fromIntegral x)) + b
+yAt (LineMXB {m = m, b = b}) x = round $ (m * (fromIntegral x)) + b
 
--- y = mx + b
+-- -- y = mx + b
--- y - mx = b
+-- -- y - mx = b
 
-makeLineUnsafe :: Point -> Point -> Line
+makeLine :: (Int, Int) -> (Int, Int) -> LineMXB
-makeLineUnsafe (y1, x1) (y2, x2) = Line {
+makeLine (y1, x1) (y2, x2) = LineMXB {
-    m = slope,
-    b = (fromIntegral y1) - (slope * (fromIntegral x1)),
-    startX = x1,
-    endX = x2
-                                  }
-    where
-        slope = (fromIntegral $ y1 - y2) / (fromIntegral $ x1 - x2)
-
-makeLine :: Point -> Point -> Line
-makeLine (y1, x1) (y2, x2) = Line {
     m = slope,
     b = (fromIntegral y1) - (slope * (fromIntegral x1)),
     startX = min x1 x2,
@@ -259,7 +291,7 @@ makeLine (y1, x1) (y2, x2) = Line {
         then (fromIntegral $ y1 - y2) % (fromIntegral $ x1 - x2)
         else fromIntegral . ceiling $ ((10.0 :: Double) ** 100.0)
 
-data Line = Line
+data LineMXB = LineMXB
     {
         m :: Rational,
         b :: Rational,
@@ -267,15 +299,15 @@ data Line = Line
         endX :: Int
     } deriving (Show, Ord, Eq)
 
-isPointInTriangle :: Triangle -> Point -> Bool
+-- isPointInTriangle :: Triangle -> Point -> Bool
-isPointInTriangle (v1, v2, v3) pt = not (has_neg && has_pos)
+-- isPointInTriangle (v1, v2, v3) pt = not (has_neg && has_pos)
-    where
+--     where
-        d1 = sign pt v1 v2
+--         d1 = sign pt v1 v2
-        d2 = sign pt v2 v3
+--         d2 = sign pt v2 v3
-        d3 = sign pt v3 v1
+--         d3 = sign pt v3 v1
 
-        has_neg = (d1 < 0) || (d2 < 0) || (d3 < 0)
+--         has_neg = (d1 < 0) || (d2 < 0) || (d3 < 0)
-        has_pos = (d1 > 0) || (d2 > 0) || (d3 > 0)
+--         has_pos = (d1 > 0) || (d2 > 0) || (d3 > 0)
 
-        sign :: Point -> Point -> Point -> Int
+--         sign :: Point -> Point -> Point -> Int
-        sign p1 p2 p3 = (fst p1 - fst p3) * (snd p2 - snd p3) - (fst p2 - fst p3) * (snd p1 - snd p3)
+--         sign p1 p2 p3 = (fst p1 - fst p3) * (snd p2 - snd p3) - (fst p2 - fst p3) * (snd p1 - snd p3)