mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-14 09:32:22 +00:00
803 lines
82 KiB
HTML
803 lines
82 KiB
HTML
<html>
|
|
<head>
|
|
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
|
|
<style type="text/css">
|
|
span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
|
|
span.nottickedoff { background: yellow}
|
|
span.istickedoff { background: white }
|
|
span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
|
|
span.tickonlytrue { margin: -1px; border: 1px solid #60de51; background: #60de51 }
|
|
span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
|
|
span.decl { font-weight: bold }
|
|
span.spaces { background: white }
|
|
</style>
|
|
</head>
|
|
<body>
|
|
<pre>
|
|
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
|
|
</pre>
|
|
<pre>
|
|
<span class="lineno"> 1 </span>{-# LANGUAGE BangPatterns #-}
|
|
<span class="lineno"> 2 </span>{-# LANGUAGE ConstraintKinds #-}
|
|
<span class="lineno"> 3 </span>{-# OPTIONS_HADDOCK hide #-}
|
|
<span class="lineno"> 4 </span>module Reanimate.Math.Polygon
|
|
<span class="lineno"> 5 </span> ( APolygon(..)
|
|
<span class="lineno"> 6 </span> , Polygon
|
|
<span class="lineno"> 7 </span> , FPolygon
|
|
<span class="lineno"> 8 </span> , P
|
|
<span class="lineno"> 9 </span> , mkPolygon -- :: (Fractional a, Ord a) => V.Vector (V2 a) -> APolygon a
|
|
<span class="lineno"> 10 </span> , mkPolygonFromRing -- :: (Fractional a, Ord a) => Ring a -> APolygon a
|
|
<span class="lineno"> 11 </span> , castPolygon -- :: (Real a, Fractional b, Ord a) => APolygon a -> APolygon b
|
|
<span class="lineno"> 12 </span> , pParent -- :: Polygon -> Int -> Int -> Int
|
|
<span class="lineno"> 13 </span> , pSetOffset -- :: APolygon a -> Int -> APolygon a
|
|
<span class="lineno"> 14 </span> , pAdjustOffset -- :: APolygon a -> Int -> APolygon a
|
|
<span class="lineno"> 15 </span> , pSize -- :: APolygon a -> Int
|
|
<span class="lineno"> 16 </span> , pNull -- :: APolygon a -> Bool
|
|
<span class="lineno"> 17 </span> , pNext -- :: APolygon a -> Int -> Int
|
|
<span class="lineno"> 18 </span> , pPrev -- :: APolygon a -> Int -> Int
|
|
<span class="lineno"> 19 </span> , pIsSimple -- :: Polygon -> Bool
|
|
<span class="lineno"> 20 </span> , pIsConvex -- :: Polygon -> Bool
|
|
<span class="lineno"> 21 </span> , pIsCCW -- :: Polygon -> Bool
|
|
<span class="lineno"> 22 </span> , pScale -- :: Rational -> Polygon -> Polygon
|
|
<span class="lineno"> 23 </span> , pAtCentroid -- :: Polygon -> Polygon
|
|
<span class="lineno"> 24 </span> , pAtCenter -- :: Polygon -> Polygon
|
|
<span class="lineno"> 25 </span> , pTranslate -- :: V2 Rational -> Polygon -> Polygon
|
|
<span class="lineno"> 26 </span> , pCenter -- :: Polygon -> V2 Rational
|
|
<span class="lineno"> 27 </span> , pBoundingBox -- :: Polygon -> (Rational, Rational, Rational, Rational)
|
|
<span class="lineno"> 28 </span> , pIsInside -- :: Polygon -> V2 Rational -> Bool
|
|
<span class="lineno"> 29 </span> , pAccess -- :: APolygon a -> Int -> V2 a
|
|
<span class="lineno"> 30 </span> , pMkWinding -- :: Int -> Polygon
|
|
<span class="lineno"> 31 </span> , pDeoverlap -- :: Polygon -> Polygon
|
|
<span class="lineno"> 32 </span> , pCycles -- :: Polygon -> [Polygon]
|
|
<span class="lineno"> 33 </span> , pCycle -- :: (Real a, Fractional a, Ord a) => APolygon a -> Double -> APolygon a
|
|
<span class="lineno"> 34 </span> , pCentroid -- :: Polygon -> V2 Rational
|
|
<span class="lineno"> 35 </span> , pMapEdges -- :: (V2 Rational -> V2 Rational -> a) -> Polygon -> V.Vector a
|
|
<span class="lineno"> 36 </span> , pArea -- :: Polygon -> Rational
|
|
<span class="lineno"> 37 </span> , pCircumference -- :: (Real a, Fractional a) => APolygon a -> a
|
|
<span class="lineno"> 38 </span> , pCircumference' -- :: (Real a, Fractional a) => APolygon a -> Double
|
|
<span class="lineno"> 39 </span> , pAddPoints -- :: Int -> Polygon -> Polygon
|
|
<span class="lineno"> 40 </span> , pAddPointsRestricted -- :: [Int] -> Int -> Polygon -> Polygon
|
|
<span class="lineno"> 41 </span> , pAddPointsBetween -- :: (Fractional a, Ord a, Real a) => (Int, Int) -> Int -> APolygon a -> APolygon a
|
|
<span class="lineno"> 42 </span> , pRayIntersect -- :: Polygon -> (Int, Int) -> (Int,Int) -> Maybe (V2 Rational)
|
|
<span class="lineno"> 43 </span> , pOverlap -- :: Polygon -> Polygon -> Polygon
|
|
<span class="lineno"> 44 </span> , pCuts -- :: Polygon -> [(Polygon,Polygon)]
|
|
<span class="lineno"> 45 </span> , pCutEqual -- :: Polygon -> (Polygon, Polygon)
|
|
<span class="lineno"> 46 </span> -- * Triangulation
|
|
<span class="lineno"> 47 </span> , isValidTriangulation -- :: Polygon -> Triangulation -> Bool
|
|
<span class="lineno"> 48 </span> , triangulationsToPolygons -- :: Polygon -> Triangulation -> [Polygon]
|
|
<span class="lineno"> 49 </span> -- * Single-Source-Shortest-Path
|
|
<span class="lineno"> 50 </span> , ssspVisibility -- :: Polygon -> Polygon
|
|
<span class="lineno"> 51 </span> , ssspWindows -- :: Polygon -> [(V2 Rational, V2 Rational)]
|
|
<span class="lineno"> 52 </span> -- * Built-in shapes for testing
|
|
<span class="lineno"> 53 </span> , triangle -- :: Polygon
|
|
<span class="lineno"> 54 </span> , triangle' -- :: [P]
|
|
<span class="lineno"> 55 </span> , shape1 -- :: Polygon
|
|
<span class="lineno"> 56 </span> , shape2 -- :: Polygon
|
|
<span class="lineno"> 57 </span> , shape3 -- :: Polygon
|
|
<span class="lineno"> 58 </span> , shape4 -- :: Polygon
|
|
<span class="lineno"> 59 </span> , shape5 -- :: Polygon
|
|
<span class="lineno"> 60 </span> , shape6 -- :: Polygon
|
|
<span class="lineno"> 61 </span> , shape7 -- :: Polygon
|
|
<span class="lineno"> 62 </span> , shape8 -- :: Polygon
|
|
<span class="lineno"> 63 </span> , shape9 -- :: Polygon
|
|
<span class="lineno"> 64 </span> , shape10 -- :: Polygon
|
|
<span class="lineno"> 65 </span> , shape11 -- :: Polygon
|
|
<span class="lineno"> 66 </span> , shape12 -- :: Polygon
|
|
<span class="lineno"> 67 </span> , shape13 -- :: Polygon
|
|
<span class="lineno"> 68 </span> , shape14 -- :: Polygon
|
|
<span class="lineno"> 69 </span> , shape15 -- :: Polygon
|
|
<span class="lineno"> 70 </span> , shape16 -- :: Polygon
|
|
<span class="lineno"> 71 </span> , shape17 -- :: Polygon
|
|
<span class="lineno"> 72 </span> , shape18 -- :: Polygon
|
|
<span class="lineno"> 73 </span> , shape19 -- :: Polygon
|
|
<span class="lineno"> 74 </span> , shape20 -- :: Polygon
|
|
<span class="lineno"> 75 </span> , shape21 -- :: Polygon
|
|
<span class="lineno"> 76 </span> , shape22 -- :: Polygon
|
|
<span class="lineno"> 77 </span> , shape23 -- :: Polygon
|
|
<span class="lineno"> 78 </span> , concave -- :: Polygon
|
|
<span class="lineno"> 79 </span> -- * Internals
|
|
<span class="lineno"> 80 </span> , pRing -- :: APolygon a -> Ring a
|
|
<span class="lineno"> 81 </span> , pUnsafeMap -- :: (Ring a -> Ring a) -> APolygon a -> APolygon a
|
|
<span class="lineno"> 82 </span> , pCopy -- :: Polygon -> Polygon
|
|
<span class="lineno"> 83 </span> , pGenerate -- :: [(Double, Double)] -> Polygon
|
|
<span class="lineno"> 84 </span> , pUnGenerate -- :: Polygon -> [(Double, Double)]
|
|
<span class="lineno"> 85 </span> , Epsilon
|
|
<span class="lineno"> 86 </span> ) where
|
|
<span class="lineno"> 87 </span>
|
|
<span class="lineno"> 88 </span>-- import Control.Exception
|
|
<span class="lineno"> 89 </span>import Data.Hashable
|
|
<span class="lineno"> 90 </span>import Data.List (intersect, maximumBy, sort, sortOn,
|
|
<span class="lineno"> 91 </span> tails)
|
|
<span class="lineno"> 92 </span>import Data.Maybe
|
|
<span class="lineno"> 93 </span>import Data.Ratio
|
|
<span class="lineno"> 94 </span>import Data.Serialize
|
|
<span class="lineno"> 95 </span>import Data.Vector (Vector)
|
|
<span class="lineno"> 96 </span>import qualified Data.Vector as V
|
|
<span class="lineno"> 97 </span>import Linear.V2
|
|
<span class="lineno"> 98 </span>import Linear.Vector
|
|
<span class="lineno"> 99 </span>import Reanimate.Math.Common
|
|
<span class="lineno"> 100 </span>-- import Reanimate.Math.EarClip
|
|
<span class="lineno"> 101 </span>import Reanimate.Math.SSSP
|
|
<span class="lineno"> 102 </span>import Reanimate.Math.Triangulate
|
|
<span class="lineno"> 103 </span>
|
|
<span class="lineno"> 104 </span>-- import Debug.Trace
|
|
<span class="lineno"> 105 </span>
|
|
<span class="lineno"> 106 </span>-- Generate random polygons, options:
|
|
<span class="lineno"> 107 </span>-- 1. put corners around a circle. Vary the radius.
|
|
<span class="lineno"> 108 </span>-- 2. close a hilbert curve
|
|
<span class="lineno"> 109 </span>type FPolygon = APolygon Double
|
|
<span class="lineno"> 110 </span>-- Optimize representation?
|
|
<span class="lineno"> 111 </span>-- Polygon = (Vector XNumerator, Vector XDenominator
|
|
<span class="lineno"> 112 </span>-- ,Vector YNumerator, Vector YDenominator)
|
|
<span class="lineno"> 113 </span>data APolygon a = Polygon
|
|
<span class="lineno"> 114 </span> { <span class="istickedoff"><span class="decl"><span class="istickedoff">polygonPoints</span></span></span> :: Vector (V2 a)
|
|
<span class="lineno"> 115 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">polygonOffset</span></span></span> :: Int
|
|
<span class="lineno"> 116 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">polygonTriangulation</span></span></span> :: Triangulation
|
|
<span class="lineno"> 117 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">polygonSSSP</span></span></span> :: Vector SSSP
|
|
<span class="lineno"> 118 </span> }
|
|
<span class="lineno"> 119 </span>type Polygon = APolygon Rational
|
|
<span class="lineno"> 120 </span>type P = V2 Double
|
|
<span class="lineno"> 121 </span>
|
|
<span class="lineno"> 122 </span>instance Show a => Show (APolygon a) where
|
|
<span class="lineno"> 123 </span> <span class="decl"><span class="nottickedoff">show = show . V.toList . polygonPoints</span></span>
|
|
<span class="lineno"> 124 </span>
|
|
<span class="lineno"> 125 </span>instance Hashable a => Hashable (APolygon a) where
|
|
<span class="lineno"> 126 </span> <span class="decl"><span class="nottickedoff">hashWithSalt s p = V.foldl' hashWithSalt s (polygonPoints p)</span></span>
|
|
<span class="lineno"> 127 </span>
|
|
<span class="lineno"> 128 </span>instance (PolyCtx a, Serialize a) => Serialize (APolygon a) where
|
|
<span class="lineno"> 129 </span> <span class="decl"><span class="nottickedoff">put = put . V.toList . polygonPoints</span></span>
|
|
<span class="lineno"> 130 </span> <span class="decl"><span class="nottickedoff">get = mkPolygon . V.fromList <$> get</span></span>
|
|
<span class="lineno"> 131 </span>
|
|
<span class="lineno"> 132 </span>pRing :: APolygon a -> Ring a
|
|
<span class="lineno"> 133 </span><span class="decl"><span class="nottickedoff">pRing = ringPack . polygonPoints</span></span>
|
|
<span class="lineno"> 134 </span>
|
|
<span class="lineno"> 135 </span>type PolyCtx a = (Real a, Fractional a, Epsilon a)
|
|
<span class="lineno"> 136 </span>
|
|
<span class="lineno"> 137 </span>mkPolygon :: PolyCtx a => V.Vector (V2 a) -> APolygon a
|
|
<span class="lineno"> 138 </span><span class="decl"><span class="istickedoff">mkPolygon points = Polygon</span>
|
|
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="istickedoff">{ polygonPoints = points</span>
|
|
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="istickedoff">, polygonOffset = <span class="nottickedoff">0</span></span>
|
|
<span class="lineno"> 141 </span><span class="spaces"> </span><span class="istickedoff">, polygonTriangulation = <span class="nottickedoff">trig</span></span>
|
|
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="istickedoff">, polygonSSSP = <span class="nottickedoff">V.generate n $ \i -> sssp ring (dual i trig)</span></span>
|
|
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="istickedoff">}</span>
|
|
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
|
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">n = length points</span></span>
|
|
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">ring = ringPack points</span></span>
|
|
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">trig = triangulate ring</span></span></span>
|
|
<span class="lineno"> 148 </span> -- earClip ring
|
|
<span class="lineno"> 149 </span>
|
|
<span class="lineno"> 150 </span>castPolygon :: (PolyCtx a, PolyCtx b) => APolygon a -> APolygon b
|
|
<span class="lineno"> 151 </span><span class="decl"><span class="nottickedoff">castPolygon = mkPolygon . V.map (fmap realToFrac) . polygonPoints</span></span>
|
|
<span class="lineno"> 152 </span>
|
|
<span class="lineno"> 153 </span>mkPolygonFromRing :: PolyCtx a => Ring a -> APolygon a
|
|
<span class="lineno"> 154 </span><span class="decl"><span class="nottickedoff">mkPolygonFromRing = mkPolygon . ringUnpack</span></span>
|
|
<span class="lineno"> 155 </span>
|
|
<span class="lineno"> 156 </span>pUnsafeMap :: (Ring a -> Ring a) -> APolygon a -> APolygon a
|
|
<span class="lineno"> 157 </span><span class="decl"><span class="nottickedoff">pUnsafeMap fn p = p{ polygonPoints = ringUnpack (fn (pRing p)) }</span></span>
|
|
<span class="lineno"> 158 </span>
|
|
<span class="lineno"> 159 </span>-- pParent p i j = shortest-path parent from j to i
|
|
<span class="lineno"> 160 </span>pParent :: APolygon a -> Int -> Int -> Int
|
|
<span class="lineno"> 161 </span><span class="decl"><span class="nottickedoff">pParent p i j =</span>
|
|
<span class="lineno"> 162 </span><span class="spaces"> </span><span class="nottickedoff">(sTree V.! mod (j + polygonOffset p) n - polygonOffset p) `mod` n</span>
|
|
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="nottickedoff">sTree = polygonSSSP p V.! mod (i + polygonOffset p) n</span>
|
|
<span class="lineno"> 165 </span><span class="spaces"> </span><span class="nottickedoff">n = pSize p</span></span>
|
|
<span class="lineno"> 166 </span>
|
|
<span class="lineno"> 167 </span>pCopy :: Polygon -> Polygon
|
|
<span class="lineno"> 168 </span><span class="decl"><span class="nottickedoff">pCopy p = mkPolygon $ V.generate (pSize p) $ pAccess p</span></span>
|
|
<span class="lineno"> 169 </span>
|
|
<span class="lineno"> 170 </span>pSetOffset :: APolygon a -> Int -> APolygon a
|
|
<span class="lineno"> 171 </span><span class="decl"><span class="nottickedoff">pSetOffset p offset =</span>
|
|
<span class="lineno"> 172 </span><span class="spaces"> </span><span class="nottickedoff">p { polygonOffset = offset `mod` pSize p }</span></span>
|
|
<span class="lineno"> 173 </span>
|
|
<span class="lineno"> 174 </span>pAdjustOffset :: APolygon a -> Int -> APolygon a
|
|
<span class="lineno"> 175 </span><span class="decl"><span class="nottickedoff">pAdjustOffset p offset =</span>
|
|
<span class="lineno"> 176 </span><span class="spaces"> </span><span class="nottickedoff">p { polygonOffset = (polygonOffset p + offset) `mod` pSize p }</span></span>
|
|
<span class="lineno"> 177 </span>
|
|
<span class="lineno"> 178 </span>{-# INLINE pSize #-}
|
|
<span class="lineno"> 179 </span>pSize :: APolygon a -> Int
|
|
<span class="lineno"> 180 </span><span class="decl"><span class="istickedoff">pSize = length . polygonPoints</span></span>
|
|
<span class="lineno"> 181 </span>
|
|
<span class="lineno"> 182 </span>pNull :: APolygon a -> Bool
|
|
<span class="lineno"> 183 </span><span class="decl"><span class="istickedoff">pNull = V.null . polygonPoints</span></span>
|
|
<span class="lineno"> 184 </span>
|
|
<span class="lineno"> 185 </span>pNext :: APolygon a -> Int -> Int
|
|
<span class="lineno"> 186 </span><span class="decl"><span class="nottickedoff">pNext p i = (i+1) `mod` pSize p</span></span>
|
|
<span class="lineno"> 187 </span>
|
|
<span class="lineno"> 188 </span>pPrev :: APolygon a -> Int -> Int
|
|
<span class="lineno"> 189 </span><span class="decl"><span class="nottickedoff">pPrev p i = (i-1) `mod` pSize p</span></span>
|
|
<span class="lineno"> 190 </span>
|
|
<span class="lineno"> 191 </span>-- When is a polygon valid/simple?
|
|
<span class="lineno"> 192 </span>-- It is counter-clockwise.
|
|
<span class="lineno"> 193 </span>-- No edges intersect.
|
|
<span class="lineno"> 194 </span>-- O(n^2)
|
|
<span class="lineno"> 195 </span>-- 'checkEdge' takes 90% of the time.
|
|
<span class="lineno"> 196 </span>pIsSimple :: Polygon -> Bool
|
|
<span class="lineno"> 197 </span><span class="decl"><span class="nottickedoff">pIsSimple p | pSize p < 3 = False</span>
|
|
<span class="lineno"> 198 </span><span class="spaces"></span><span class="nottickedoff">pIsSimple p = pIsCCW p && noDups && checkEdge 0 2</span>
|
|
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 200 </span><span class="spaces"> </span><span class="nottickedoff">noDups = checkForDups (sort (V.toList (polygonPoints p)))</span>
|
|
<span class="lineno"> 201 </span><span class="spaces"> </span><span class="nottickedoff">checkForDups (x:y:xs)</span>
|
|
<span class="lineno"> 202 </span><span class="spaces"> </span><span class="nottickedoff">= x /= y && checkForDups (y:xs)</span>
|
|
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="nottickedoff">checkForDups _ = True</span>
|
|
<span class="lineno"> 204 </span><span class="spaces"> </span><span class="nottickedoff">len = pSize p</span>
|
|
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="nottickedoff">-- check i,i+1 against j,j+1</span>
|
|
<span class="lineno"> 206 </span><span class="spaces"> </span><span class="nottickedoff">-- j > i+1</span>
|
|
<span class="lineno"> 207 </span><span class="spaces"> </span><span class="nottickedoff">checkEdge i j</span>
|
|
<span class="lineno"> 208 </span><span class="spaces"> </span><span class="nottickedoff">| j >= len = (i > len-3) || checkEdge (i+1) (i+3)</span>
|
|
<span class="lineno"> 209 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise =</span>
|
|
<span class="lineno"> 210 </span><span class="spaces"> </span><span class="nottickedoff">case lineIntersect (pAccess p i, pAccess p $ i+1)</span>
|
|
<span class="lineno"> 211 </span><span class="spaces"> </span><span class="nottickedoff">(pAccess p j, pAccess p $ j+1) of</span>
|
|
<span class="lineno"> 212 </span><span class="spaces"> </span><span class="nottickedoff">Just u | u /= pAccess p i -> False</span>
|
|
<span class="lineno"> 213 </span><span class="spaces"> </span><span class="nottickedoff">_nothing -> checkEdge i (j+1)</span></span>
|
|
<span class="lineno"> 214 </span>
|
|
<span class="lineno"> 215 </span>pScale :: Rational -> Polygon -> Polygon
|
|
<span class="lineno"> 216 </span><span class="decl"><span class="nottickedoff">pScale s = pUnsafeMap (ringMap (^* s))</span></span>
|
|
<span class="lineno"> 217 </span>
|
|
<span class="lineno"> 218 </span>pAtCentroid :: Polygon -> Polygon
|
|
<span class="lineno"> 219 </span><span class="decl"><span class="nottickedoff">pAtCentroid p = pTranslate (negate c) p</span>
|
|
<span class="lineno"> 220 </span><span class="spaces"> </span><span class="nottickedoff">where c = pCentroid p ^/ 2</span></span>
|
|
<span class="lineno"> 221 </span>
|
|
<span class="lineno"> 222 </span>pAtCenter :: Polygon -> Polygon
|
|
<span class="lineno"> 223 </span><span class="decl"><span class="nottickedoff">pAtCenter p = pTranslate (negate $ pCenter p) p</span></span>
|
|
<span class="lineno"> 224 </span>
|
|
<span class="lineno"> 225 </span>pTranslate :: V2 Rational -> Polygon -> Polygon
|
|
<span class="lineno"> 226 </span><span class="decl"><span class="nottickedoff">pTranslate v = pUnsafeMap (ringMap (+v))</span></span>
|
|
<span class="lineno"> 227 </span>
|
|
<span class="lineno"> 228 </span>pCenter :: Polygon -> V2 Rational
|
|
<span class="lineno"> 229 </span><span class="decl"><span class="nottickedoff">pCenter p = V2 (x+w/2) (y+h/2)</span>
|
|
<span class="lineno"> 230 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 231 </span><span class="spaces"> </span><span class="nottickedoff">(x,y,w,h) = pBoundingBox p</span></span>
|
|
<span class="lineno"> 232 </span>
|
|
<span class="lineno"> 233 </span>-- Returns (min-x, min-y, width, height)
|
|
<span class="lineno"> 234 </span>pBoundingBox :: Polygon -> (Rational, Rational, Rational, Rational)
|
|
<span class="lineno"> 235 </span><span class="decl"><span class="nottickedoff">pBoundingBox = \p -></span>
|
|
<span class="lineno"> 236 </span><span class="spaces"> </span><span class="nottickedoff">let V2 x y = pAccess p 0 in</span>
|
|
<span class="lineno"> 237 </span><span class="spaces"> </span><span class="nottickedoff">case V.foldl' worker (x, y, 0, 0) (polygonPoints p) of</span>
|
|
<span class="lineno"> 238 </span><span class="spaces"> </span><span class="nottickedoff">(xMin, yMin, xMax, yMax) -></span>
|
|
<span class="lineno"> 239 </span><span class="spaces"> </span><span class="nottickedoff">(xMin, yMin, xMax-xMin, yMax-yMin)</span>
|
|
<span class="lineno"> 240 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 241 </span><span class="spaces"> </span><span class="nottickedoff">worker (xMin,yMin,xMax,yMax) (V2 thisX thisY) =</span>
|
|
<span class="lineno"> 242 </span><span class="spaces"> </span><span class="nottickedoff">(min xMin thisX, min yMin thisY</span>
|
|
<span class="lineno"> 243 </span><span class="spaces"> </span><span class="nottickedoff">,max xMax thisX, max yMax thisY)</span></span>
|
|
<span class="lineno"> 244 </span>
|
|
<span class="lineno"> 245 </span>-- Place n points on a circle, use one parameter to slide the points back and forth.
|
|
<span class="lineno"> 246 </span>-- Use second parameter to move points closer to center circle.
|
|
<span class="lineno"> 247 </span>pGenerate :: [(Double, Double)] -> Polygon
|
|
<span class="lineno"> 248 </span><span class="decl"><span class="nottickedoff">pGenerate points</span>
|
|
<span class="lineno"> 249 </span><span class="spaces"> </span><span class="nottickedoff">| len < 4 = error "pGenerate: require at least four points"</span>
|
|
<span class="lineno"> 250 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 251 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 (realToFrac $ cos ang * rMod)</span>
|
|
<span class="lineno"> 252 </span><span class="spaces"> </span><span class="nottickedoff">(realToFrac $ sin ang * rMod)</span>
|
|
<span class="lineno"> 253 </span><span class="spaces"> </span><span class="nottickedoff">| (i,(angMod,rMod)) <- zip [0..] points</span>
|
|
<span class="lineno"> 254 </span><span class="spaces"> </span><span class="nottickedoff">, let minAngle = tau / len * i - pi</span>
|
|
<span class="lineno"> 255 </span><span class="spaces"> </span><span class="nottickedoff">maxAngle = tau / len * (i+1) - pi</span>
|
|
<span class="lineno"> 256 </span><span class="spaces"> </span><span class="nottickedoff">ang = minAngle + (maxAngle-minAngle)*angMod</span>
|
|
<span class="lineno"> 257 </span><span class="spaces"> </span><span class="nottickedoff">]</span>
|
|
<span class="lineno"> 258 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 259 </span><span class="spaces"> </span><span class="nottickedoff">tau = 2*pi</span>
|
|
<span class="lineno"> 260 </span><span class="spaces"> </span><span class="nottickedoff">len = fromIntegral (length points)</span></span>
|
|
<span class="lineno"> 261 </span>
|
|
<span class="lineno"> 262 </span>pUnGenerate :: Polygon -> [(Double, Double)]
|
|
<span class="lineno"> 263 </span><span class="decl"><span class="nottickedoff">pUnGenerate p =</span>
|
|
<span class="lineno"> 264 </span><span class="spaces"> </span><span class="nottickedoff">[ worker i (fmap realToFrac e)</span>
|
|
<span class="lineno"> 265 </span><span class="spaces"> </span><span class="nottickedoff">| (i,e) <- zip [0..] (V.toList $ polygonPoints p) ]</span>
|
|
<span class="lineno"> 266 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 267 </span><span class="spaces"> </span><span class="nottickedoff">len = fromIntegral (pSize p)</span>
|
|
<span class="lineno"> 268 </span><span class="spaces"> </span><span class="nottickedoff">worker i (V2 x y) =</span>
|
|
<span class="lineno"> 269 </span><span class="spaces"> </span><span class="nottickedoff">let ang = atan2 y x</span>
|
|
<span class="lineno"> 270 </span><span class="spaces"> </span><span class="nottickedoff">minAngle = tau / len * i - pi</span>
|
|
<span class="lineno"> 271 </span><span class="spaces"> </span><span class="nottickedoff">maxAngle = tau / len * (i+1) - pi</span>
|
|
<span class="lineno"> 272 </span><span class="spaces"> </span><span class="nottickedoff">in ((ang-minAngle)/(maxAngle-minAngle), sqrt (x*x+y*y))</span>
|
|
<span class="lineno"> 273 </span><span class="spaces"> </span><span class="nottickedoff">tau = 2*pi</span></span>
|
|
<span class="lineno"> 274 </span>
|
|
<span class="lineno"> 275 </span>-- When is a triangulation valid?
|
|
<span class="lineno"> 276 </span>-- Intersection: No internal edges intersect.
|
|
<span class="lineno"> 277 </span>-- Completeness: All edge neighbours share a single internal edge.
|
|
<span class="lineno"> 278 </span>isValidTriangulation :: Polygon -> Triangulation -> Bool
|
|
<span class="lineno"> 279 </span><span class="decl"><span class="nottickedoff">isValidTriangulation p t = isComplete && intersectionFree</span>
|
|
<span class="lineno"> 280 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 281 </span><span class="spaces"> </span><span class="nottickedoff">o = polygonOffset p</span>
|
|
<span class="lineno"> 282 </span><span class="spaces"> </span><span class="nottickedoff">isComplete = all isProper [0 .. pSize p-1]</span>
|
|
<span class="lineno"> 283 </span><span class="spaces"> </span><span class="nottickedoff">isProper i =</span>
|
|
<span class="lineno"> 284 </span><span class="spaces"> </span><span class="nottickedoff">let j = pNext p i in</span>
|
|
<span class="lineno"> 285 </span><span class="spaces"> </span><span class="nottickedoff">length ((pPrev p i : (t V.! i)) `intersect` (pNext p j : t V.! j)) == 1</span>
|
|
<span class="lineno"> 286 </span><span class="spaces"> </span><span class="nottickedoff">intersectionFree = and</span>
|
|
<span class="lineno"> 287 </span><span class="spaces"> </span><span class="nottickedoff">[ case lineIntersect (pAccess p (a-o), pAccess p (b-o)) (pAccess p (c-o), pAccess p (d-o)) of</span>
|
|
<span class="lineno"> 288 </span><span class="spaces"> </span><span class="nottickedoff">Nothing -> True</span>
|
|
<span class="lineno"> 289 </span><span class="spaces"> </span><span class="nottickedoff">Just u -> u == pAccess p (a-o) || u == pAccess p (b-o) ||</span>
|
|
<span class="lineno"> 290 </span><span class="spaces"> </span><span class="nottickedoff">u == pAccess p (c-o) || u == pAccess p (d-o)</span>
|
|
<span class="lineno"> 291 </span><span class="spaces"> </span><span class="nottickedoff">| ((a,b),(c,d)) <- edgePairs ]</span>
|
|
<span class="lineno"> 292 </span><span class="spaces"> </span><span class="nottickedoff">edgePairs = [ (e1, e2) | (e1, rest) <- zip edges (drop 1 $ tails edges), e2 <- rest]</span>
|
|
<span class="lineno"> 293 </span><span class="spaces"> </span><span class="nottickedoff">edges =</span>
|
|
<span class="lineno"> 294 </span><span class="spaces"> </span><span class="nottickedoff">[ (n, i)</span>
|
|
<span class="lineno"> 295 </span><span class="spaces"> </span><span class="nottickedoff">| (n, lst) <- zip [0..] (V.toList t)</span>
|
|
<span class="lineno"> 296 </span><span class="spaces"> </span><span class="nottickedoff">, i <- lst</span>
|
|
<span class="lineno"> 297 </span><span class="spaces"> </span><span class="nottickedoff">, n < i</span>
|
|
<span class="lineno"> 298 </span><span class="spaces"> </span><span class="nottickedoff">]</span></span>
|
|
<span class="lineno"> 299 </span>
|
|
<span class="lineno"> 300 </span>triangulationsToPolygons :: Polygon -> Triangulation -> [Polygon]
|
|
<span class="lineno"> 301 </span><span class="decl"><span class="nottickedoff">triangulationsToPolygons p t =</span>
|
|
<span class="lineno"> 302 </span><span class="spaces"> </span><span class="nottickedoff">[ mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 303 </span><span class="spaces"> </span><span class="nottickedoff">[ pAccess p g, pAccess p i, pAccess p j ]</span>
|
|
<span class="lineno"> 304 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [0 .. pSize p-1]</span>
|
|
<span class="lineno"> 305 </span><span class="spaces"> </span><span class="nottickedoff">, let js = filter (i<) $ t V.! i</span>
|
|
<span class="lineno"> 306 </span><span class="spaces"> </span><span class="nottickedoff">, (g, j) <- zip (i-1:js) js</span>
|
|
<span class="lineno"> 307 </span><span class="spaces"> </span><span class="nottickedoff">]</span></span>
|
|
<span class="lineno"> 308 </span>
|
|
<span class="lineno"> 309 </span>pIsInside :: Polygon -> V2 Rational -> Bool
|
|
<span class="lineno"> 310 </span><span class="decl"><span class="nottickedoff">pIsInside p point = or</span>
|
|
<span class="lineno"> 311 </span><span class="spaces"> </span><span class="nottickedoff">[ isInside (rawAccess g) (rawAccess i) (rawAccess j) point</span>
|
|
<span class="lineno"> 312 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [0 .. pSize p-1]</span>
|
|
<span class="lineno"> 313 </span><span class="spaces"> </span><span class="nottickedoff">, let js = filter (i<) $ polygonTriangulation p V.! i</span>
|
|
<span class="lineno"> 314 </span><span class="spaces"> </span><span class="nottickedoff">, (g, j) <- zip (i-1:js) js</span>
|
|
<span class="lineno"> 315 </span><span class="spaces"> </span><span class="nottickedoff">]</span>
|
|
<span class="lineno"> 316 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 317 </span><span class="spaces"> </span><span class="nottickedoff">rawAccess x = polygonPoints p V.! x</span></span>
|
|
<span class="lineno"> 318 </span>
|
|
<span class="lineno"> 319 </span>-- reducePolygons :: Int -> [Polygon] -> [Polygon]
|
|
<span class="lineno"> 320 </span>-- reducePolygons n ps
|
|
<span class="lineno"> 321 </span>-- | length ps <= n = ps
|
|
<span class="lineno"> 322 </span>-- | otherwise =
|
|
<span class="lineno"> 323 </span>-- let p = findSmallest ps
|
|
<span class="lineno"> 324 </span>-- es = edges p
|
|
<span class="lineno"> 325 </span>-- e = findSmallest es
|
|
<span class="lineno"> 326 </span>-- in reducePolygons n (merge p e : delete p (delete e ps))
|
|
<span class="lineno"> 327 </span>-- where
|
|
<span class="lineno"> 328 </span>-- findSmallest = minimumBy (comparing area2X)
|
|
<span class="lineno"> 329 </span>-- shareEdge p1 p2 =
|
|
<span class="lineno"> 330 </span>
|
|
<span class="lineno"> 331 </span>{-# INLINE pAccess #-}
|
|
<span class="lineno"> 332 </span>pAccess :: APolygon a -> Int -> V2 a
|
|
<span class="lineno"> 333 </span><span class="decl"><span class="nottickedoff">pAccess p i = -- polygonPoints p V.! ((polygonOffset p + i) `mod` pSize p)</span>
|
|
<span class="lineno"> 334 </span><span class="spaces"> </span><span class="nottickedoff">polygonPoints p `V.unsafeIndex` ((polygonOffset p + i) `mod` pSize p)</span></span>
|
|
<span class="lineno"> 335 </span>
|
|
<span class="lineno"> 336 </span>triangle :: Polygon
|
|
<span class="lineno"> 337 </span><span class="decl"><span class="nottickedoff">triangle = mkPolygon $ V.fromList [V2 1 1, V2 0 0, V2 2 0]</span></span>
|
|
<span class="lineno"> 338 </span>
|
|
<span class="lineno"> 339 </span>triangle' :: [P]
|
|
<span class="lineno"> 340 </span><span class="decl"><span class="nottickedoff">triangle' = reverse [V2 1 1, V2 0 0, V2 2 0]</span></span>
|
|
<span class="lineno"> 341 </span>
|
|
<span class="lineno"> 342 </span>shape1 :: Polygon
|
|
<span class="lineno"> 343 </span><span class="decl"><span class="nottickedoff">shape1 = mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 344 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 2 0</span>
|
|
<span class="lineno"> 345 </span><span class="spaces"> </span><span class="nottickedoff">, V2 2 1, V2 2 2, V2 2 3, V2 2 4, V2 2 5, V2 2 6</span>
|
|
<span class="lineno"> 346 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 1, V2 0 1 ]</span></span>
|
|
<span class="lineno"> 347 </span>
|
|
<span class="lineno"> 348 </span>shape2 :: Polygon
|
|
<span class="lineno"> 349 </span><span class="decl"><span class="nottickedoff">shape2 = mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 350 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 1 0, V2 1 1, V2 2 1, V2 2 (-1), V2 0 (-1), V2 0 (-2)</span>
|
|
<span class="lineno"> 351 </span><span class="spaces"> </span><span class="nottickedoff">, V2 3 (-2), V2 3 2, V2 0 2]</span></span>
|
|
<span class="lineno"> 352 </span>
|
|
<span class="lineno"> 353 </span>shape3 :: Polygon
|
|
<span class="lineno"> 354 </span><span class="decl"><span class="nottickedoff">shape3 = mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 355 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 1 0, V2 1 1, V2 2 1, V2 2 2, V2 0 2]</span></span>
|
|
<span class="lineno"> 356 </span>
|
|
<span class="lineno"> 357 </span>shape4 :: Polygon
|
|
<span class="lineno"> 358 </span><span class="decl"><span class="nottickedoff">shape4 = mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 359 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 1 0, V2 1 1, V2 2 1, V2 2 (-1), V2 3 (-1),V2 3 2, V2 0 2]</span></span>
|
|
<span class="lineno"> 360 </span>
|
|
<span class="lineno"> 361 </span>shape5 :: Polygon
|
|
<span class="lineno"> 362 </span><span class="decl"><span class="nottickedoff">shape5 = pCycles shape4 !! 2</span></span>
|
|
<span class="lineno"> 363 </span>
|
|
<span class="lineno"> 364 </span>-- square
|
|
<span class="lineno"> 365 </span>shape6 :: Polygon
|
|
<span class="lineno"> 366 </span><span class="decl"><span class="nottickedoff">shape6 = mkPolygon $ V.fromList [ V2 0 0, V2 1 0, V2 1 1, V2 0 1 ]</span></span>
|
|
<span class="lineno"> 367 </span>
|
|
<span class="lineno"> 368 </span>shape7 :: Polygon
|
|
<span class="lineno"> 369 </span><span class="decl"><span class="nottickedoff">shape7 = pScale 6 $ mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 370 </span><span class="spaces"> </span><span class="nottickedoff">[V2 ((-1567171105775771) % 144115188075855872) ((-7758063241391039) % 1152921504606846976)</span>
|
|
<span class="lineno"> 371 </span><span class="spaces"> </span><span class="nottickedoff">,V2 ((-2711114907999263) % 18014398509481984) ((-3561889280168807) % 18014398509481984)</span>
|
|
<span class="lineno"> 372 </span><span class="spaces"> </span><span class="nottickedoff">,V2 ((-6897139157863177) % 72057594037927936) ((-1632144794297397) % 4503599627370496)</span>
|
|
<span class="lineno"> 373 </span><span class="spaces"> </span><span class="nottickedoff">,V2 (5592137945106423 % 36028797018963968) ((-71351641856107) % 281474976710656)</span>
|
|
<span class="lineno"> 374 </span><span class="spaces"> </span><span class="nottickedoff">,V2 (2568147525079071 % 4503599627370496) ((-4312925637247687) % 18014398509481984)</span>
|
|
<span class="lineno"> 375 </span><span class="spaces"> </span><span class="nottickedoff">,V2 (1291079014395023 % 2251799813685248) (321513444515769 % 2251799813685248)</span>
|
|
<span class="lineno"> 376 </span><span class="spaces"> </span><span class="nottickedoff">,V2 (2071709221627247 % 4503599627370496) (4019115966736491 % 9007199254740992)</span>
|
|
<span class="lineno"> 377 </span><span class="spaces"> </span><span class="nottickedoff">,V2 ((-1589087869859839) % 144115188075855872) (4904023654354179 % 9007199254740992)</span>
|
|
<span class="lineno"> 378 </span><span class="spaces"> </span><span class="nottickedoff">,V2 ((-2328090886101149) % 36028797018963968) (2587887893460759 % 36028797018963968)</span>
|
|
<span class="lineno"> 379 </span><span class="spaces"> </span><span class="nottickedoff">,V2 ((-7990199074159871) % 18014398509481984) (1301850651537745 % 4503599627370496)]</span></span>
|
|
<span class="lineno"> 380 </span>
|
|
<span class="lineno"> 381 </span>shape8 :: Polygon
|
|
<span class="lineno"> 382 </span><span class="decl"><span class="nottickedoff">shape8 = pScale 10 $ pGenerate</span>
|
|
<span class="lineno"> 383 </span><span class="spaces"> </span><span class="nottickedoff">[(0.36,0.4),(0.7,1.8e-2),(0.7,0.2),(0.1,0.4),(0.2,0.2),(0.7,0.1),(0.4,8.0e-2)]</span></span>
|
|
<span class="lineno"> 384 </span>
|
|
<span class="lineno"> 385 </span>shape9 :: Polygon
|
|
<span class="lineno"> 386 </span><span class="decl"><span class="nottickedoff">shape9 = pScale 5 $ pGenerate</span>
|
|
<span class="lineno"> 387 </span><span class="spaces"> </span><span class="nottickedoff">[(0.5,0.2),(0.7,0.6),(0.4,0.3),(0.1,0.7),(0.3,1.0e-2),(0.5,0.3),(0.2,0.8),(0.1,0.8),(0.7,6.0e-2),(0.1,0.6)]</span></span>
|
|
<span class="lineno"> 388 </span>
|
|
<span class="lineno"> 389 </span>shape10 :: Polygon
|
|
<span class="lineno"> 390 </span><span class="decl"><span class="nottickedoff">shape10 = pGenerate</span>
|
|
<span class="lineno"> 391 </span><span class="spaces"> </span><span class="nottickedoff">[(0.4,0.7),(0.2,0.2),(0.3,0.9),(5.0e-2,0.1),(0.7,1.0e-2),(0.7,0.9),(0.2,0.1),(0.5,6.0e-2),(0.6,9.0e-2)]</span></span>
|
|
<span class="lineno"> 392 </span>
|
|
<span class="lineno"> 393 </span>shape11 :: Polygon
|
|
<span class="lineno"> 394 </span><span class="decl"><span class="nottickedoff">shape11 = pGenerate</span>
|
|
<span class="lineno"> 395 </span><span class="spaces"> </span><span class="nottickedoff">[(0.1,0.8),(0.7,0.6),(0.7,0.4),(0.3,0.5),(0.8,0.9),(0.8,6.0e-2),(1.0e-2,4.0e-2),(0.8,0.1)]</span></span>
|
|
<span class="lineno"> 396 </span>
|
|
<span class="lineno"> 397 </span>shape12 :: Polygon
|
|
<span class="lineno"> 398 </span><span class="decl"><span class="nottickedoff">shape12 = mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 399 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 0.5 1.5, V2 2 2, V2 (-2) 2, V2 (-0.5) 1.5 ]</span></span>
|
|
<span class="lineno"> 400 </span>
|
|
<span class="lineno"> 401 </span>-- F shape
|
|
<span class="lineno"> 402 </span>shape13 :: Polygon
|
|
<span class="lineno"> 403 </span><span class="decl"><span class="nottickedoff">shape13 = pCycles (mkPolygon $ V.reverse (V.fromList</span>
|
|
<span class="lineno"> 404 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 0 2</span>
|
|
<span class="lineno"> 405 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 2, V2 1 1.7, V2 0.3 1.7, V2 0.3 1</span>
|
|
<span class="lineno"> 406 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 1, V2 1 0.7</span>
|
|
<span class="lineno"> 407 </span><span class="spaces"> </span><span class="nottickedoff">, V2 0.3 0.7, V2 0.3 0 ])) !! 7</span></span>
|
|
<span class="lineno"> 408 </span>
|
|
<span class="lineno"> 409 </span>-- E shape
|
|
<span class="lineno"> 410 </span>shape14 :: Polygon
|
|
<span class="lineno"> 411 </span><span class="decl"><span class="nottickedoff">shape14 = pCycles (mkPolygon $ V.reverse $ V.fromList</span>
|
|
<span class="lineno"> 412 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 0 2 -- up</span>
|
|
<span class="lineno"> 413 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 2, V2 1 1.7, V2 0.3 1.7, V2 0.3 1 -- first prong</span>
|
|
<span class="lineno"> 414 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 1, V2 1 0.7, V2 0.3 0.7, V2 0.3 0.3 -- second prong</span>
|
|
<span class="lineno"> 415 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 0.3, V2 1 0 -- last prong</span>
|
|
<span class="lineno"> 416 </span><span class="spaces"> </span><span class="nottickedoff">]) !! 9</span></span>
|
|
<span class="lineno"> 417 </span>
|
|
<span class="lineno"> 418 </span>--
|
|
<span class="lineno"> 419 </span>shape15 :: Polygon
|
|
<span class="lineno"> 420 </span><span class="decl"><span class="nottickedoff">shape15 = mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 421 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 2 0</span>
|
|
<span class="lineno"> 422 </span><span class="spaces"> </span><span class="nottickedoff">, V2 2 2, V2 1 2</span>
|
|
<span class="lineno"> 423 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 1, V2 0 1]</span></span>
|
|
<span class="lineno"> 424 </span>
|
|
<span class="lineno"> 425 </span>shape16 :: Polygon
|
|
<span class="lineno"> 426 </span><span class="decl"><span class="nottickedoff">shape16 = mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 427 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 2 0</span>
|
|
<span class="lineno"> 428 </span><span class="spaces"> </span><span class="nottickedoff">, V2 2 1, V2 1 1</span>
|
|
<span class="lineno"> 429 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 2, V2 0 2]</span></span>
|
|
<span class="lineno"> 430 </span>
|
|
<span class="lineno"> 431 </span>shape17 :: Polygon
|
|
<span class="lineno"> 432 </span><span class="decl"><span class="nottickedoff">shape17 = mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 433 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 2 0, V2 2 1</span>
|
|
<span class="lineno"> 434 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 1, V2 1 2</span>
|
|
<span class="lineno"> 435 </span><span class="spaces"> </span><span class="nottickedoff">, V2 0 2, V2 0 1, V2 0 0 ]</span></span>
|
|
<span class="lineno"> 436 </span>
|
|
<span class="lineno"> 437 </span>shape18 :: Polygon
|
|
<span class="lineno"> 438 </span><span class="decl"><span class="nottickedoff">shape18 = mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 439 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 2 0, V2 2 1, V2 2 2</span>
|
|
<span class="lineno"> 440 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 2, V2 1 1</span>
|
|
<span class="lineno"> 441 </span><span class="spaces"> </span><span class="nottickedoff">, V2 0 1, V2 0 0 ]</span></span>
|
|
<span class="lineno"> 442 </span>
|
|
<span class="lineno"> 443 </span>shape19 :: Polygon
|
|
<span class="lineno"> 444 </span><span class="decl"><span class="nottickedoff">shape19 = mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 445 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 (-3) (-3), V2 0 (-1)</span>
|
|
<span class="lineno"> 446 </span><span class="spaces"> </span><span class="nottickedoff">, V2 3 (-3), V2 1 0</span>
|
|
<span class="lineno"> 447 </span><span class="spaces"> </span><span class="nottickedoff">, V2 3 3, V2 0 1</span>
|
|
<span class="lineno"> 448 </span><span class="spaces"> </span><span class="nottickedoff">, V2 (-3) 3, V2 (-1) 0 ]</span></span>
|
|
<span class="lineno"> 449 </span>
|
|
<span class="lineno"> 450 </span>shape20 :: Polygon
|
|
<span class="lineno"> 451 </span><span class="decl"><span class="nottickedoff">shape20 = mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 452 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 (-3) (-3)</span>
|
|
<span class="lineno"> 453 </span><span class="spaces"> </span><span class="nottickedoff">, V2 0 (-1)</span>
|
|
<span class="lineno"> 454 </span><span class="spaces"> </span><span class="nottickedoff">, V2 3 (-3)</span>
|
|
<span class="lineno"> 455 </span><span class="spaces"> </span><span class="nottickedoff">, V2 5 0</span>
|
|
<span class="lineno"> 456 </span><span class="spaces"> </span><span class="nottickedoff">, V2 2.5 (-2)</span>
|
|
<span class="lineno"> 457 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 0</span>
|
|
<span class="lineno"> 458 </span><span class="spaces"> </span><span class="nottickedoff">, V2 3 3</span>
|
|
<span class="lineno"> 459 </span><span class="spaces"> </span><span class="nottickedoff">, V2 0 1</span>
|
|
<span class="lineno"> 460 </span><span class="spaces"> </span><span class="nottickedoff">, V2 (-3) 3</span>
|
|
<span class="lineno"> 461 </span><span class="spaces"> </span><span class="nottickedoff">, V2 (-1) 0 ]</span></span>
|
|
<span class="lineno"> 462 </span>
|
|
<span class="lineno"> 463 </span>shape21 :: Polygon
|
|
<span class="lineno"> 464 </span><span class="decl"><span class="nottickedoff">shape21 = mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 465 </span><span class="spaces"> </span><span class="nottickedoff">[V2 0.0 0.0,V2 1.0 0.0,V2 1.0 1.0,V2 2.0 1.0,V2 2.0 (-1.0),V2 3.0 (-1.0)</span>
|
|
<span class="lineno"> 466 </span><span class="spaces"> </span><span class="nottickedoff">,V2 3.0 2.0,V2 0.0 2.0]</span></span>
|
|
<span class="lineno"> 467 </span>
|
|
<span class="lineno"> 468 </span>shape22 :: Polygon
|
|
<span class="lineno"> 469 </span><span class="decl"><span class="nottickedoff">shape22 = pScale 2 $ mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 470 </span><span class="spaces"> </span><span class="nottickedoff">[V2 (-0.17) (-0.08)</span>
|
|
<span class="lineno"> 471 </span><span class="spaces"> </span><span class="nottickedoff">,V2 (-0.34) (-0.21)</span>
|
|
<span class="lineno"> 472 </span><span class="spaces"> </span><span class="nottickedoff">,V2 0.0 0.0</span>
|
|
<span class="lineno"> 473 </span><span class="spaces"> </span><span class="nottickedoff">,V2 (-0.10) 0.60</span>
|
|
<span class="lineno"> 474 </span><span class="spaces"> </span><span class="nottickedoff">,V2 (-0.14) 0.19</span>
|
|
<span class="lineno"> 475 </span><span class="spaces"> </span><span class="nottickedoff">,V2 (-0.05) 0.03</span>
|
|
<span class="lineno"> 476 </span><span class="spaces"> </span><span class="nottickedoff">]</span></span>
|
|
<span class="lineno"> 477 </span>
|
|
<span class="lineno"> 478 </span>shape23 :: Polygon
|
|
<span class="lineno"> 479 </span><span class="decl"><span class="nottickedoff">shape23 = mkPolygon $ V.fromList</span>
|
|
<span class="lineno"> 480 </span><span class="spaces"> </span><span class="nottickedoff">[ V2 0 0, V2 4 0</span>
|
|
<span class="lineno"> 481 </span><span class="spaces"> </span><span class="nottickedoff">, V2 4 3, V2 2 3</span>
|
|
<span class="lineno"> 482 </span><span class="spaces"> </span><span class="nottickedoff">, V2 2 2, V2 3 2</span>
|
|
<span class="lineno"> 483 </span><span class="spaces"> </span><span class="nottickedoff">, V2 3 1, V2 1 1</span>
|
|
<span class="lineno"> 484 </span><span class="spaces"> </span><span class="nottickedoff">, V2 1 2, V2 2 2</span>
|
|
<span class="lineno"> 485 </span><span class="spaces"> </span><span class="nottickedoff">, V2 2 3, V2 0 3 ]</span></span>
|
|
<span class="lineno"> 486 </span>
|
|
<span class="lineno"> 487 </span>concave :: Polygon
|
|
<span class="lineno"> 488 </span><span class="decl"><span class="nottickedoff">concave = mkPolygon $</span>
|
|
<span class="lineno"> 489 </span><span class="spaces"> </span><span class="nottickedoff">V.fromList [V2 0 0, V2 2 0, V2 2 2, V2 1 1, V2 0 2]</span></span>
|
|
<span class="lineno"> 490 </span>
|
|
<span class="lineno"> 491 </span>pMkWinding :: Int -> Polygon
|
|
<span class="lineno"> 492 </span><span class="decl"><span class="nottickedoff">pMkWinding n | n < 1 = error "Polygon must have at least one winding."</span>
|
|
<span class="lineno"> 493 </span><span class="spaces"></span><span class="nottickedoff">pMkWinding n = mkPolygon $</span>
|
|
<span class="lineno"> 494 </span><span class="spaces"> </span><span class="nottickedoff">V.fromList $ p0 : p1 : walkTo p1 1 n (V2 1 0) ++ reverse (walkTo p0 1 (n+2) (V2 (-1) 0))</span>
|
|
<span class="lineno"> 495 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 496 </span><span class="spaces"> </span><span class="nottickedoff">p0 = V2 0 0</span>
|
|
<span class="lineno"> 497 </span><span class="spaces"> </span><span class="nottickedoff">p1 = V2 0 1</span>
|
|
<span class="lineno"> 498 </span><span class="spaces"> </span><span class="nottickedoff">walkTo at a b dir</span>
|
|
<span class="lineno"> 499 </span><span class="spaces"> </span><span class="nottickedoff">| a == b = []</span>
|
|
<span class="lineno"> 500 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise =</span>
|
|
<span class="lineno"> 501 </span><span class="spaces"> </span><span class="nottickedoff">let newAt = at + (dir ^* toRational a)</span>
|
|
<span class="lineno"> 502 </span><span class="spaces"> </span><span class="nottickedoff">in newAt : walkTo newAt (a+1) b (rot dir)</span>
|
|
<span class="lineno"> 503 </span><span class="spaces"> </span><span class="nottickedoff">rot (V2 x y) =</span>
|
|
<span class="lineno"> 504 </span><span class="spaces"> </span><span class="nottickedoff">V2 y (-x)</span></span>
|
|
<span class="lineno"> 505 </span>
|
|
<span class="lineno"> 506 </span>pDeoverlap :: Polygon -> Polygon
|
|
<span class="lineno"> 507 </span><span class="decl"><span class="nottickedoff">pDeoverlap p = mkPolygon arr</span>
|
|
<span class="lineno"> 508 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 509 </span><span class="spaces"> </span><span class="nottickedoff">arr = V.generate (pSize p) worker</span>
|
|
<span class="lineno"> 510 </span><span class="spaces"> </span><span class="nottickedoff">worker 0 = pAccess p 0</span>
|
|
<span class="lineno"> 511 </span><span class="spaces"> </span><span class="nottickedoff">worker n =</span>
|
|
<span class="lineno"> 512 </span><span class="spaces"> </span><span class="nottickedoff">if length (V.elemIndices (pAccess p n) (polygonPoints p)) /= 1</span>
|
|
<span class="lineno"> 513 </span><span class="spaces"> </span><span class="nottickedoff">then</span>
|
|
<span class="lineno"> 514 </span><span class="spaces"> </span><span class="nottickedoff">let prev = arr V.! (n-1)</span>
|
|
<span class="lineno"> 515 </span><span class="spaces"> </span><span class="nottickedoff">this = pAccess p n</span>
|
|
<span class="lineno"> 516 </span><span class="spaces"> </span><span class="nottickedoff">in lerp 0.99999 this prev</span>
|
|
<span class="lineno"> 517 </span><span class="spaces"> </span><span class="nottickedoff">else pAccess p n</span></span>
|
|
<span class="lineno"> 518 </span>
|
|
<span class="lineno"> 519 </span>pCycles :: APolygon a -> [APolygon a]
|
|
<span class="lineno"> 520 </span><span class="decl"><span class="nottickedoff">pCycles p = map (pAdjustOffset p) [0 .. pSize p-1]</span></span>
|
|
<span class="lineno"> 521 </span>
|
|
<span class="lineno"> 522 </span>pCycle :: PolyCtx a => APolygon a -> Double -> APolygon a
|
|
<span class="lineno"> 523 </span><span class="decl"><span class="nottickedoff">pCycle p 0 = p</span>
|
|
<span class="lineno"> 524 </span><span class="spaces"></span><span class="nottickedoff">pCycle p t = mkPolygon $ worker 0 0</span>
|
|
<span class="lineno"> 525 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 526 </span><span class="spaces"> </span><span class="nottickedoff">worker acc i</span>
|
|
<span class="lineno"> 527 </span><span class="spaces"> </span><span class="nottickedoff">| segment + acc > limit =</span>
|
|
<span class="lineno"> 528 </span><span class="spaces"> </span><span class="nottickedoff">V.singleton (lerp (realToFrac $ (segment + acc - limit)/segment) x y) <></span>
|
|
<span class="lineno"> 529 </span><span class="spaces"> </span><span class="nottickedoff">-- V.drop (i+1) (polygonPoints p) <></span>
|
|
<span class="lineno"> 530 </span><span class="spaces"> </span><span class="nottickedoff">V.fromList (map (pAccess p) [i+1..pSize p-1]) <></span>
|
|
<span class="lineno"> 531 </span><span class="spaces"> </span><span class="nottickedoff">V.fromList (map (pAccess p) [0 .. i])</span>
|
|
<span class="lineno"> 532 </span><span class="spaces"> </span><span class="nottickedoff">-- V.take (i+1) (polygonPoints p)</span>
|
|
<span class="lineno"> 533 </span><span class="spaces"> </span><span class="nottickedoff">| i == pSize p-1 = V.fromList (map (pAccess p) [0 .. pSize p-1])</span>
|
|
<span class="lineno"> 534 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = worker (acc+segment) (i+1)</span>
|
|
<span class="lineno"> 535 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 536 </span><span class="spaces"> </span><span class="nottickedoff">x = pAccess p i</span>
|
|
<span class="lineno"> 537 </span><span class="spaces"> </span><span class="nottickedoff">y = pAccess p $ i+1</span>
|
|
<span class="lineno"> 538 </span><span class="spaces"> </span><span class="nottickedoff">segment = distance' x y</span>
|
|
<span class="lineno"> 539 </span><span class="spaces"> </span><span class="nottickedoff">len = pCircumference' p</span>
|
|
<span class="lineno"> 540 </span><span class="spaces"> </span><span class="nottickedoff">limit = t * len</span></span>
|
|
<span class="lineno"> 541 </span>
|
|
<span class="lineno"> 542 </span>pCentroid :: Fractional a => APolygon a -> V2 a
|
|
<span class="lineno"> 543 </span><span class="decl"><span class="nottickedoff">pCentroid p = V2 cx cy</span>
|
|
<span class="lineno"> 544 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 545 </span><span class="spaces"> </span><span class="nottickedoff">a = pArea p</span>
|
|
<span class="lineno"> 546 </span><span class="spaces"> </span><span class="nottickedoff">cx = recip (6*a) * V.sum (pMapEdges fnX p)</span>
|
|
<span class="lineno"> 547 </span><span class="spaces"> </span><span class="nottickedoff">cy = recip (6*a) * V.sum (pMapEdges fnY p)</span>
|
|
<span class="lineno"> 548 </span><span class="spaces"> </span><span class="nottickedoff">fnX (V2 x y) (V2 x' y') = (x+x')*(x*y' - x'*y)</span>
|
|
<span class="lineno"> 549 </span><span class="spaces"> </span><span class="nottickedoff">fnY (V2 x y) (V2 x' y') = (y+y')*(x*y' - x'*y)</span></span>
|
|
<span class="lineno"> 550 </span>
|
|
<span class="lineno"> 551 </span>{-# INLINE pMapEdges #-}
|
|
<span class="lineno"> 552 </span>pMapEdges :: (V2 a -> V2 a -> b) -> APolygon a -> V.Vector b
|
|
<span class="lineno"> 553 </span><span class="decl"><span class="istickedoff">pMapEdges fn p = V.generate n $ \i -></span>
|
|
<span class="lineno"> 554 </span><span class="spaces"> </span><span class="istickedoff">if i == n-1</span>
|
|
<span class="lineno"> 555 </span><span class="spaces"> </span><span class="istickedoff">then fn (arr `V.unsafeIndex` i) (arr `V.unsafeIndex` 0)</span>
|
|
<span class="lineno"> 556 </span><span class="spaces"> </span><span class="istickedoff">else fn (arr `V.unsafeIndex` i) (arr `V.unsafeIndex` (i+1))</span>
|
|
<span class="lineno"> 557 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
|
<span class="lineno"> 558 </span><span class="spaces"> </span><span class="istickedoff">n = pSize p</span>
|
|
<span class="lineno"> 559 </span><span class="spaces"> </span><span class="istickedoff">arr = polygonPoints p</span></span>
|
|
<span class="lineno"> 560 </span>
|
|
<span class="lineno"> 561 </span>{-# SPECIALIZE pArea :: APolygon Double -> Double #-}
|
|
<span class="lineno"> 562 </span>{-# SPECIALIZE pArea :: APolygon Rational -> Rational #-}
|
|
<span class="lineno"> 563 </span>pArea :: (Fractional a) => APolygon a -> a
|
|
<span class="lineno"> 564 </span><span class="decl"><span class="nottickedoff">pArea p =</span>
|
|
<span class="lineno"> 565 </span><span class="spaces"> </span><span class="nottickedoff">-- 0.5 * V.sum (pMapEdges (\(V2 x y) (V2 x' y') -> x*y' - x'*y) p)</span>
|
|
<span class="lineno"> 566 </span><span class="spaces"> </span><span class="nottickedoff">0.5 * worker 0 0</span>
|
|
<span class="lineno"> 567 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 568 </span><span class="spaces"> </span><span class="nottickedoff">fn (V2 x y) (V2 x' y') = x*y' - x'*y</span>
|
|
<span class="lineno"> 569 </span><span class="spaces"> </span><span class="nottickedoff">arr = polygonPoints p</span>
|
|
<span class="lineno"> 570 </span><span class="spaces"> </span><span class="nottickedoff">worker !acc i</span>
|
|
<span class="lineno"> 571 </span><span class="spaces"> </span><span class="nottickedoff">| i == pSize p - 1 = acc + fn (arr `V.unsafeIndex` i) (arr `V.unsafeIndex` 0)</span>
|
|
<span class="lineno"> 572 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise =</span>
|
|
<span class="lineno"> 573 </span><span class="spaces"> </span><span class="nottickedoff">worker (acc + fn (arr `V.unsafeIndex` i) (arr `V.unsafeIndex` (i+1))) (i+1)</span></span>
|
|
<span class="lineno"> 574 </span>
|
|
<span class="lineno"> 575 </span>pCircumference :: (Real a, Fractional a) => APolygon a -> a
|
|
<span class="lineno"> 576 </span><span class="decl"><span class="nottickedoff">pCircumference p = sum</span>
|
|
<span class="lineno"> 577 </span><span class="spaces"> </span><span class="nottickedoff">[ approxDist (pAccess p i) (pAccess p $ i+1)</span>
|
|
<span class="lineno"> 578 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [0 .. pSize p-1]]</span></span>
|
|
<span class="lineno"> 579 </span>
|
|
<span class="lineno"> 580 </span>pCircumference' :: (Real a, Fractional a) => APolygon a -> Double
|
|
<span class="lineno"> 581 </span><span class="decl"><span class="nottickedoff">pCircumference' p = sum</span>
|
|
<span class="lineno"> 582 </span><span class="spaces"> </span><span class="nottickedoff">[ distance' (pAccess p i) (pAccess p $ i+1)</span>
|
|
<span class="lineno"> 583 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [0 .. pSize p-1]]</span></span>
|
|
<span class="lineno"> 584 </span>
|
|
<span class="lineno"> 585 </span>
|
|
<span class="lineno"> 586 </span>-- Add points by splitting the longest lines in half repeatedly.
|
|
<span class="lineno"> 587 </span>pAddPoints :: PolyCtx a => Int -> APolygon a -> APolygon a
|
|
<span class="lineno"> 588 </span><span class="decl"><span class="istickedoff">pAddPoints = pAddPointsRestricted <span class="nottickedoff">[]</span></span></span>
|
|
<span class="lineno"> 589 </span>
|
|
<span class="lineno"> 590 </span>pAddPointsRestricted :: PolyCtx a => [(V2 a, V2 a)] -> Int -> APolygon a -> APolygon a
|
|
<span class="lineno"> 591 </span><span class="decl"><span class="istickedoff">pAddPointsRestricted _immutableEdges n p | <span class="tickonlytrue">n <= 0</span> = p</span>
|
|
<span class="lineno"> 592 </span><span class="spaces"></span><span class="istickedoff">pAddPointsRestricted immutableEdges n p = <span class="nottickedoff">pAddPointsRestricted immutableEdges (n-1) $</span></span>
|
|
<span class="lineno"> 593 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">mkPolygon $ V.fromList $ concatMap worker [0 .. pSize p-1]</span></span>
|
|
<span class="lineno"> 594 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
|
<span class="lineno"> 595 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">isImmutable idx =</span></span>
|
|
<span class="lineno"> 596 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(pAccess p idx, pAccess p $ idx+1) `elem` immutableEdges ||</span></span>
|
|
<span class="lineno"> 597 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(pAccess p $ idx+1, pAccess p idx) `elem` immutableEdges</span></span>
|
|
<span class="lineno"> 598 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">worker idx</span></span>
|
|
<span class="lineno"> 599 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">| idx == longestEdge && not (isImmutable idx) =</span></span>
|
|
<span class="lineno"> 600 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[pAccess p idx, pMiddlePoint p idx]</span></span>
|
|
<span class="lineno"> 601 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">| otherwise = [pAccess p idx]</span></span>
|
|
<span class="lineno"> 602 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">longestEdge = maximumBy cmpLength [0 .. pSize p-1]</span></span>
|
|
<span class="lineno"> 603 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">cmpLength a _ | isImmutable a = LT</span></span>
|
|
<span class="lineno"> 604 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">cmpLength _ b | isImmutable b = GT</span></span>
|
|
<span class="lineno"> 605 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">cmpLength a b =</span></span>
|
|
<span class="lineno"> 606 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">distSquared (pAccess p a) (pAccess p $ a+1) `compare`</span></span>
|
|
<span class="lineno"> 607 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">distSquared (pAccess p b) (pAccess p $ b+1)</span></span></span>
|
|
<span class="lineno"> 608 </span>
|
|
<span class="lineno"> 609 </span>pMiddlePoint :: PolyCtx a => APolygon a -> Int -> V2 a
|
|
<span class="lineno"> 610 </span><span class="decl"><span class="nottickedoff">pMiddlePoint p idx</span>
|
|
<span class="lineno"> 611 </span><span class="spaces"> </span><span class="nottickedoff">= lerp 0.5 (pAccess p $ idx+1) (pAccess p idx)</span></span>
|
|
<span class="lineno"> 612 </span>
|
|
<span class="lineno"> 613 </span>pAddPointsBetween :: PolyCtx a => (Int, Int) -> Int -> APolygon a -> APolygon a
|
|
<span class="lineno"> 614 </span><span class="decl"><span class="nottickedoff">pAddPointsBetween _ n p | n <= 0 = p</span>
|
|
<span class="lineno"> 615 </span><span class="spaces"></span><span class="nottickedoff">pAddPointsBetween (i,l) n p = pAddPointsBetween (i,l+1) (n-1) $</span>
|
|
<span class="lineno"> 616 </span><span class="spaces"> </span><span class="nottickedoff">mkPolygon $ V.fromList $ concatMap worker [0 .. pSize p-1]</span>
|
|
<span class="lineno"> 617 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 618 </span><span class="spaces"> </span><span class="nottickedoff">worker idx</span>
|
|
<span class="lineno"> 619 </span><span class="spaces"> </span><span class="nottickedoff">| idx == longestEdge =</span>
|
|
<span class="lineno"> 620 </span><span class="spaces"> </span><span class="nottickedoff">[pAccess p idx, pMiddlePoint p idx]</span>
|
|
<span class="lineno"> 621 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = [pAccess p idx]</span>
|
|
<span class="lineno"> 622 </span><span class="spaces"> </span><span class="nottickedoff">longestEdge = maximumBy cmpLength [i .. i+l-1]</span>
|
|
<span class="lineno"> 623 </span><span class="spaces"> </span><span class="nottickedoff">cmpLength a b =</span>
|
|
<span class="lineno"> 624 </span><span class="spaces"> </span><span class="nottickedoff">distSquared (pAccess p a) (pAccess p $ a+1) `compare`</span>
|
|
<span class="lineno"> 625 </span><span class="spaces"> </span><span class="nottickedoff">distSquared (pAccess p b) (pAccess p $ b+1)</span></span>
|
|
<span class="lineno"> 626 </span>
|
|
<span class="lineno"> 627 </span>-- addPoints :: Int -> Polygon -> Polygon
|
|
<span class="lineno"> 628 </span>-- addPoints n p = mkPolygon $ V.fromList $ worker n 0 (map (pAccess p) [0..s])
|
|
<span class="lineno"> 629 </span>-- where
|
|
<span class="lineno"> 630 </span>-- worker 0 _ rest = init rest
|
|
<span class="lineno"> 631 </span>-- worker i acc (x:y:xs) =
|
|
<span class="lineno"> 632 </span>-- let xy = approxDist x y in
|
|
<span class="lineno"> 633 </span>-- if acc + xy > limit
|
|
<span class="lineno"> 634 </span>-- then x : worker (i-1) 0 (lerp ((limit-acc)/xy) y x : y:xs)
|
|
<span class="lineno"> 635 </span>-- else x : worker i (acc+xy) (y:xs)
|
|
<span class="lineno"> 636 </span>-- worker _ _ [_] = []
|
|
<span class="lineno"> 637 </span>-- worker _ _ _ = error "addPoints: invalid polygon"
|
|
<span class="lineno"> 638 </span>-- s = pSize p
|
|
<span class="lineno"> 639 </span>-- len = polygonLength p
|
|
<span class="lineno"> 640 </span>-- limit = len / fromIntegral (n+1)
|
|
<span class="lineno"> 641 </span>
|
|
<span class="lineno"> 642 </span>pIsConvex :: Polygon -> Bool
|
|
<span class="lineno"> 643 </span><span class="decl"><span class="nottickedoff">pIsConvex p = and</span>
|
|
<span class="lineno"> 644 </span><span class="spaces"> </span><span class="nottickedoff">[ area2X (pAccess p i) (pAccess p j) (pAccess p k) > 0</span>
|
|
<span class="lineno"> 645 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [0..n-1]</span>
|
|
<span class="lineno"> 646 </span><span class="spaces"> </span><span class="nottickedoff">, j <- [i+1..n-1]</span>
|
|
<span class="lineno"> 647 </span><span class="spaces"> </span><span class="nottickedoff">, k <- [j+1..n-1]</span>
|
|
<span class="lineno"> 648 </span><span class="spaces"> </span><span class="nottickedoff">]</span>
|
|
<span class="lineno"> 649 </span><span class="spaces"> </span><span class="nottickedoff">where n = pSize p</span></span>
|
|
<span class="lineno"> 650 </span>
|
|
<span class="lineno"> 651 </span>pIsCCW :: Polygon -> Bool
|
|
<span class="lineno"> 652 </span><span class="decl"><span class="istickedoff">pIsCCW p | <span class="tickonlyfalse">pNull p</span> = <span class="nottickedoff">False</span></span>
|
|
<span class="lineno"> 653 </span><span class="spaces"></span><span class="istickedoff">pIsCCW p = V.sum (pMapEdges fn p) < 0</span>
|
|
<span class="lineno"> 654 </span><span class="spaces"> </span><span class="istickedoff">where</span>
|
|
<span class="lineno"> 655 </span><span class="spaces"> </span><span class="istickedoff">fn (V2 x1 y1) (V2 x2 y2) = (x2-x1)*(y2+y1)</span></span>
|
|
<span class="lineno"> 656 </span>
|
|
<span class="lineno"> 657 </span>{-# INLINE pRayIntersect #-}
|
|
<span class="lineno"> 658 </span>pRayIntersect :: PolyCtx a => APolygon a -> (Int, Int) -> (Int,Int) -> Maybe (V2 a)
|
|
<span class="lineno"> 659 </span><span class="decl"><span class="nottickedoff">pRayIntersect p (a,b) (c,d) =</span>
|
|
<span class="lineno"> 660 </span><span class="spaces"> </span><span class="nottickedoff">rayIntersect (pAccess p a, pAccess p b) (pAccess p c, pAccess p d)</span></span>
|
|
<span class="lineno"> 661 </span>
|
|
<span class="lineno"> 662 </span>pCuts :: (Real a, Fractional a, Epsilon a) => APolygon a -> [(APolygon a,APolygon a)]
|
|
<span class="lineno"> 663 </span><span class="decl"><span class="nottickedoff">pCuts p =</span>
|
|
<span class="lineno"> 664 </span><span class="spaces"> </span><span class="nottickedoff">[ pCutAt (pAdjustOffset p i) (j-i)</span>
|
|
<span class="lineno"> 665 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [0 .. pSize p-1 ]</span>
|
|
<span class="lineno"> 666 </span><span class="spaces"> </span><span class="nottickedoff">, j <- [i+2 .. pSize p-1 ]</span>
|
|
<span class="lineno"> 667 </span><span class="spaces"> </span><span class="nottickedoff">, (j+1) `mod` pSize p /= i</span>
|
|
<span class="lineno"> 668 </span><span class="spaces"> </span><span class="nottickedoff">, pParent p i j == i ]</span></span>
|
|
<span class="lineno"> 669 </span>
|
|
<span class="lineno"> 670 </span>pCutEqual :: PolyCtx a => APolygon a -> (APolygon a, APolygon a)
|
|
<span class="lineno"> 671 </span><span class="decl"><span class="nottickedoff">pCutEqual p =</span>
|
|
<span class="lineno"> 672 </span><span class="spaces"> </span><span class="nottickedoff">fromMaybe (p,p) $ listToMaybe $ sortOn f $ pCuts p</span>
|
|
<span class="lineno"> 673 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 674 </span><span class="spaces"> </span><span class="nottickedoff">f (a,b) = abs (pArea a - pArea b)</span></span>
|
|
<span class="lineno"> 675 </span>
|
|
<span class="lineno"> 676 </span>-- FIXME: This should be more efficient
|
|
<span class="lineno"> 677 </span>pCutAt :: PolyCtx a => APolygon a -> Int -> (APolygon a, APolygon a)
|
|
<span class="lineno"> 678 </span><span class="decl"><span class="nottickedoff">pCutAt p i = (mkPolygon $ V.fromList left, mkPolygon $ V.fromList right)</span>
|
|
<span class="lineno"> 679 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 680 </span><span class="spaces"> </span><span class="nottickedoff">n = pSize p</span>
|
|
<span class="lineno"> 681 </span><span class="spaces"> </span><span class="nottickedoff">left = map (pAccess p) [0 .. i]</span>
|
|
<span class="lineno"> 682 </span><span class="spaces"> </span><span class="nottickedoff">right = map (pAccess p) (0:[i..n-1])</span></span>
|
|
<span class="lineno"> 683 </span>
|
|
<span class="lineno"> 684 </span>pOverlap :: PolyCtx a => APolygon a -> APolygon a -> APolygon a
|
|
<span class="lineno"> 685 </span><span class="decl"><span class="nottickedoff">pOverlap a b = mkPolygon $ V.fromList $ clearDups $ concatMap edgeIntersect [0 .. pSize a-1]</span>
|
|
<span class="lineno"> 686 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 687 </span><span class="spaces"> </span><span class="nottickedoff">clearDups (x:y:xs)</span>
|
|
<span class="lineno"> 688 </span><span class="spaces"> </span><span class="nottickedoff">| x == y = clearDups (y:xs)</span>
|
|
<span class="lineno"> 689 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = x : clearDups (y:xs)</span>
|
|
<span class="lineno"> 690 </span><span class="spaces"> </span><span class="nottickedoff">clearDups xs = xs</span>
|
|
<span class="lineno"> 691 </span><span class="spaces"> </span><span class="nottickedoff">edgeIntersect edge =</span>
|
|
<span class="lineno"> 692 </span><span class="spaces"> </span><span class="nottickedoff">sortOn (distSquared (pAccess a edge)) $ catMaybes</span>
|
|
<span class="lineno"> 693 </span><span class="spaces"> </span><span class="nottickedoff">[ lineIntersect (aP, aP') (bP, bP')</span>
|
|
<span class="lineno"> 694 </span><span class="spaces"> </span><span class="nottickedoff">| i <- [0 .. pSize b-1]</span>
|
|
<span class="lineno"> 695 </span><span class="spaces"> </span><span class="nottickedoff">, let aP = pAccess a edge</span>
|
|
<span class="lineno"> 696 </span><span class="spaces"> </span><span class="nottickedoff">aP' = pAccess a (edge+1)</span>
|
|
<span class="lineno"> 697 </span><span class="spaces"> </span><span class="nottickedoff">bP = pAccess b i</span>
|
|
<span class="lineno"> 698 </span><span class="spaces"> </span><span class="nottickedoff">bP' = pAccess b (i+1)</span>
|
|
<span class="lineno"> 699 </span><span class="spaces"> </span><span class="nottickedoff">]</span></span>
|
|
<span class="lineno"> 700 </span>
|
|
<span class="lineno"> 701 </span>---------------------------------------------------------
|
|
<span class="lineno"> 702 </span>-- SSSP visibility and SSSP windows
|
|
<span class="lineno"> 703 </span>
|
|
<span class="lineno"> 704 </span>ssspVisibility :: PolyCtx a => APolygon a -> APolygon a
|
|
<span class="lineno"> 705 </span><span class="decl"><span class="nottickedoff">ssspVisibility p = mkPolygon $</span>
|
|
<span class="lineno"> 706 </span><span class="spaces"> </span><span class="nottickedoff">V.fromList $ clearDups $ go [0 .. pSize p-1] -- ([root..pSize p-1] ++ [0 .. root-1])</span>
|
|
<span class="lineno"> 707 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 708 </span><span class="spaces"> </span><span class="nottickedoff">clearDups (x:y:xs)</span>
|
|
<span class="lineno"> 709 </span><span class="spaces"> </span><span class="nottickedoff">| x == y = clearDups (y:xs)</span>
|
|
<span class="lineno"> 710 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = x : clearDups (y:xs)</span>
|
|
<span class="lineno"> 711 </span><span class="spaces"> </span><span class="nottickedoff">clearDups xs = xs</span>
|
|
<span class="lineno"> 712 </span><span class="spaces"> </span><span class="nottickedoff">obstructedBy n =</span>
|
|
<span class="lineno"> 713 </span><span class="spaces"> </span><span class="nottickedoff">case pParent p 0 n of</span>
|
|
<span class="lineno"> 714 </span><span class="spaces"> </span><span class="nottickedoff">0 -> n</span>
|
|
<span class="lineno"> 715 </span><span class="spaces"> </span><span class="nottickedoff">i -> obstructedBy i</span>
|
|
<span class="lineno"> 716 </span><span class="spaces"> </span><span class="nottickedoff">go [] = []</span>
|
|
<span class="lineno"> 717 </span><span class="spaces"> </span><span class="nottickedoff">go [x] = [pAccess p x]</span>
|
|
<span class="lineno"> 718 </span><span class="spaces"> </span><span class="nottickedoff">go (x:y:xs) =</span>
|
|
<span class="lineno"> 719 </span><span class="spaces"> </span><span class="nottickedoff">let xO = obstructedBy x</span>
|
|
<span class="lineno"> 720 </span><span class="spaces"> </span><span class="nottickedoff">yO = obstructedBy y</span>
|
|
<span class="lineno"> 721 </span><span class="spaces"> </span><span class="nottickedoff">in case () of</span>
|
|
<span class="lineno"> 722 </span><span class="spaces"> </span><span class="nottickedoff">()</span>
|
|
<span class="lineno"> 723 </span><span class="spaces"> </span><span class="nottickedoff">-- Both ends are visible.</span>
|
|
<span class="lineno"> 724 </span><span class="spaces"> </span><span class="nottickedoff">| xO == x && yO == y -> pAccess p x : go (y:xs)</span>
|
|
<span class="lineno"> 725 </span><span class="spaces"> </span><span class="nottickedoff">-- X is visible, x to intersect (0,yO) (x,y)</span>
|
|
<span class="lineno"> 726 </span><span class="spaces"> </span><span class="nottickedoff">| xO == x -></span>
|
|
<span class="lineno"> 727 </span><span class="spaces"> </span><span class="nottickedoff">pAccess p x : fromMaybe (pAccess p y) (pRayIntersect p (0,yO) (x,y)) : go (y:xs)</span>
|
|
<span class="lineno"> 728 </span><span class="spaces"> </span><span class="nottickedoff">-- Y is visible</span>
|
|
<span class="lineno"> 729 </span><span class="spaces"> </span><span class="nottickedoff">| yO == y -> fromMaybe (pAccess p x) (pRayIntersect p (0,xO) (x,y)) : pAccess p y : go (y:xs)</span>
|
|
<span class="lineno"> 730 </span><span class="spaces"> </span><span class="nottickedoff">-- Neither is visible and they've obstructed by the same point</span>
|
|
<span class="lineno"> 731 </span><span class="spaces"> </span><span class="nottickedoff">-- so the entire edge is hidden.</span>
|
|
<span class="lineno"> 732 </span><span class="spaces"> </span><span class="nottickedoff">| xO == yO -> go (y:xs)</span>
|
|
<span class="lineno"> 733 </span><span class="spaces"> </span><span class="nottickedoff">-- Neither is visible. Cast shadow from obstruction points to</span>
|
|
<span class="lineno"> 734 </span><span class="spaces"> </span><span class="nottickedoff">-- find if a subsection of the edge is visible.</span>
|
|
<span class="lineno"> 735 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise -></span>
|
|
<span class="lineno"> 736 </span><span class="spaces"> </span><span class="nottickedoff">let a = fromMaybe (error "a") (pRayIntersect p (0,xO) (x,y))</span>
|
|
<span class="lineno"> 737 </span><span class="spaces"> </span><span class="nottickedoff">b = fromMaybe (error "b") (pRayIntersect p (0,yO) (x,y))</span>
|
|
<span class="lineno"> 738 </span><span class="spaces"> </span><span class="nottickedoff">in if a /= b</span>
|
|
<span class="lineno"> 739 </span><span class="spaces"> </span><span class="nottickedoff">then a : b : go (y:xs)</span>
|
|
<span class="lineno"> 740 </span><span class="spaces"> </span><span class="nottickedoff">else go (y:xs)</span></span>
|
|
<span class="lineno"> 741 </span>
|
|
<span class="lineno"> 742 </span>ssspWindows :: Polygon -> [(V2 Rational, V2 Rational)]
|
|
<span class="lineno"> 743 </span><span class="decl"><span class="nottickedoff">ssspWindows p = clearDups $ go (pAccess p 0) [0..pSize p-1]</span>
|
|
<span class="lineno"> 744 </span><span class="spaces"> </span><span class="nottickedoff">where</span>
|
|
<span class="lineno"> 745 </span><span class="spaces"> </span><span class="nottickedoff">clearDups (x:y:xs)</span>
|
|
<span class="lineno"> 746 </span><span class="spaces"> </span><span class="nottickedoff">| x == y = clearDups (y:xs)</span>
|
|
<span class="lineno"> 747 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = x : clearDups (y:xs)</span>
|
|
<span class="lineno"> 748 </span><span class="spaces"> </span><span class="nottickedoff">clearDups xs = xs</span>
|
|
<span class="lineno"> 749 </span><span class="spaces"> </span><span class="nottickedoff">obstructedBy n =</span>
|
|
<span class="lineno"> 750 </span><span class="spaces"> </span><span class="nottickedoff">case pParent p 0 n of</span>
|
|
<span class="lineno"> 751 </span><span class="spaces"> </span><span class="nottickedoff">0 -> n</span>
|
|
<span class="lineno"> 752 </span><span class="spaces"> </span><span class="nottickedoff">i -> obstructedBy i</span>
|
|
<span class="lineno"> 753 </span><span class="spaces"> </span><span class="nottickedoff">go _ [] = []</span>
|
|
<span class="lineno"> 754 </span><span class="spaces"> </span><span class="nottickedoff">go _ [_] = []</span>
|
|
<span class="lineno"> 755 </span><span class="spaces"> </span><span class="nottickedoff">go l (x:y:xs) =</span>
|
|
<span class="lineno"> 756 </span><span class="spaces"> </span><span class="nottickedoff">let xO = obstructedBy x</span>
|
|
<span class="lineno"> 757 </span><span class="spaces"> </span><span class="nottickedoff">yO = obstructedBy y</span>
|
|
<span class="lineno"> 758 </span><span class="spaces"> </span><span class="nottickedoff">in case () of</span>
|
|
<span class="lineno"> 759 </span><span class="spaces"> </span><span class="nottickedoff">()</span>
|
|
<span class="lineno"> 760 </span><span class="spaces"> </span><span class="nottickedoff">-- Both ends are visible.</span>
|
|
<span class="lineno"> 761 </span><span class="spaces"> </span><span class="nottickedoff">| xO == x && yO == y -> go (pAccess p x) (y:xs)</span>
|
|
<span class="lineno"> 762 </span><span class="spaces"> </span><span class="nottickedoff">-- X is visible, x to intersect (0,yO) (x,y)</span>
|
|
<span class="lineno"> 763 </span><span class="spaces"> </span><span class="nottickedoff">| xO == x -></span>
|
|
<span class="lineno"> 764 </span><span class="spaces"> </span><span class="nottickedoff">go (fromMaybe (pAccess p y) (pRayIntersect p (0,yO) (x,y))) (y:xs)</span>
|
|
<span class="lineno"> 765 </span><span class="spaces"> </span><span class="nottickedoff">-- Y is visible</span>
|
|
<span class="lineno"> 766 </span><span class="spaces"> </span><span class="nottickedoff">| yO == y -></span>
|
|
<span class="lineno"> 767 </span><span class="spaces"> </span><span class="nottickedoff">let newL = fromMaybe (pAccess p x) (pRayIntersect p (0,xO) (x,y)) in</span>
|
|
<span class="lineno"> 768 </span><span class="spaces"> </span><span class="nottickedoff">(l, newL) :</span>
|
|
<span class="lineno"> 769 </span><span class="spaces"> </span><span class="nottickedoff">go newL (y:xs)</span>
|
|
<span class="lineno"> 770 </span><span class="spaces"> </span><span class="nottickedoff">-- Neither is visible and they've obstructed by the same point</span>
|
|
<span class="lineno"> 771 </span><span class="spaces"> </span><span class="nottickedoff">-- so the entire edge is hidden.</span>
|
|
<span class="lineno"> 772 </span><span class="spaces"> </span><span class="nottickedoff">| xO == yO -> go l (y:xs)</span>
|
|
<span class="lineno"> 773 </span><span class="spaces"> </span><span class="nottickedoff">-- Neither is visible. Cast shadow from obstruction points to</span>
|
|
<span class="lineno"> 774 </span><span class="spaces"> </span><span class="nottickedoff">-- find if a subsection of the edge is visible.</span>
|
|
<span class="lineno"> 775 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise -></span>
|
|
<span class="lineno"> 776 </span><span class="spaces"> </span><span class="nottickedoff">let a = fromMaybe (error "a") (pRayIntersect p (0,xO) (x,y))</span>
|
|
<span class="lineno"> 777 </span><span class="spaces"> </span><span class="nottickedoff">b = fromMaybe (error "b") (pRayIntersect p (0,yO) (x,y))</span>
|
|
<span class="lineno"> 778 </span><span class="spaces"> </span><span class="nottickedoff">in if a /= b</span>
|
|
<span class="lineno"> 779 </span><span class="spaces"> </span><span class="nottickedoff">then (l, a) : (b, pAccess p yO) : go (pAccess p yO) (y:xs)</span>
|
|
<span class="lineno"> 780 </span><span class="spaces"> </span><span class="nottickedoff">else go l (y:xs)</span></span>
|
|
|
|
</pre>
|
|
</body>
|
|
</html>
|