packages feed

gjk2d (empty) → 0.1.0.0

raw patch · 6 files changed

+163/−0 lines, 6 filesdep +basedep +gjk2ddep +linearsetup-changed

Dependencies added: base, gjk2d, linear

Files

+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2017, suzumiyasmith+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++* Neither the name of the copyright holder nor the names of its+  contributors may be used to endorse or promote products derived from+  this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,9 @@+# gjk2d++for detailed usage see source in test module++[![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29)++### Releases+[![Hackage](https://img.shields.io/hackage/v/gjk2d.svg)](https://hackage.haskell.org/package/gjk2d)+[![Dependencies](https://img.shields.io/hackage-deps/v/gjk2d.svg)](http://packdeps.haskellers.com/feed?needle=gjk2d)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ gjk2d.cabal view
@@ -0,0 +1,36 @@+name:                gjk2d+version:             0.1.0.0+-- synopsis:+description:         Yet another 2D GJK collision dection algorithm with Linear+homepage:            https://github.com/suzumiyasmith/gjk2d#readme+license:             BSD3+license-file:        LICENSE+author:              Suzumiya+maintainer:          suzumiyasmith@gmail.com+copyright:           Copyright: (c) 2017 Suzumiya+category:            Graphics+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     GJK+  build-depends:       base >= 4.7 && < 5+                     , linear >= 1.20 && < 2+  ghc-options:         -Wall+  default-language:    Haskell2010++test-suite gjk2d-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , linear+                     , gjk2d+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/suzumiyasmith/gjk2d
+ src/GJK.hs view
@@ -0,0 +1,48 @@+module GJK where++import Linear++-- | Convex is represented by its supprot function+newtype Convex = Convex { support :: Double -> V2 Double }++-- | Minkowski Difference between 2 Convexes+minkowskiDifference :: Convex -> Convex -> Convex+minkowskiDifference a b = Convex $ (-) <$> support a <*> (support b . (+ pi))++-- | Compute angle of a vector+unAngle :: V2 Double -> Double+unAngle (V2 ax ay) =+  let alpha = asin $ ay / (ax * ax + ay * ay)+  in if ax < 0+       then pi - alpha+       else alpha++-- | Core Logic: Detect if origin point is contained inside a Convex+originInside :: Convex -> Bool+originInside s =+  if dot a b > 0+    then False+    else doSimplex (support s) a b+  where+    a = support s 0+    b = support s $ unAngle (-a)++-- | Simplex addition till nearZero+doSimplex :: (Double -> V2 Double) -> V2 Double -> V2 Double -> Bool+doSimplex s a b =+  nearZero (b - a) ||+  (if (axb > 0) /= (bxc > 0)+     then doSimplex s b c+     else (if (axc > 0) /= (cxb > 0)+             then doSimplex s a c+             else True))+  where+    c = s $ unAngle (b - a) + (if axb > 0 then pi / 2 else -pi / 2)+    axb = crossZ a b+    axc = crossZ a c+    bxc = crossZ b c+    cxb = -bxc++-- | If two Convex colliside+convexIntersect :: Convex -> Convex -> Bool+convexIntersect a b = originInside $ minkowskiDifference a b
+ test/Spec.hs view
@@ -0,0 +1,39 @@+import Data.Function+import Data.List+import GJK+import Linear++main :: IO ()+main = do+  let terr = V2 <$> [0.1,0.2 .. 10] <*> [0.1,0.2 .. 10]+  -- let polygons = (\v1 v2 v3 v4 -> [v1, v2, v3, v4]) <$> terr <*> terr <*> terr <*> terr+  let cirtest =+        (\cir1 cir2 ->+           ((cir1, cir2), convexIntersect (circle cir1) (circle cir2))) <$>+        terr <*>+        terr+  -- traverse (\s -> if snd s then print (fst s) else return ()) cirtest+  print $ length $ filter snd $ cirtest+  -- print $ convexIntersect (circle $ V2 0.2 7.2) (circle $ V2 0.1 9.1)+  print $+    (uncurry (convexIntersect `on` fromPolygon)) <$>+    [(poly1, poly2), (poly1, poly3), (poly2, poly3), (poly1, poly4)]+  print $ convexIntersect circle2 (fromPolygon poly3)+  print $ convexIntersect circle1 (fromPolygon poly3)++fromPolygon :: [V2 Double] -> Convex+fromPolygon vs = Convex $ \d -> maximumBy (compare `on` dot (angle d)) vs++poly1 = [V2 1 1, V2 1 0, V2 0 1, V2 0 0]++poly2 = fmap (+ 0.5) <$> [V2 1 1, V2 1 0, V2 0 1, V2 0 0]++poly3 = (+ 1) <$> [V2 1 1, V2 1 0, V2 0 1, V2 0 0]++poly4 = (+ 1.5) <$> [V2 1 1, V2 1 0, V2 0 1, V2 0 0]++circle1 = Convex $ \d -> angle d++circle2 = Convex $ \d -> angle d + V2 0.5 0++circle pos = Convex $ \d -> angle d + pos