light (empty) → 0.1.0.0

raw patch · 6 files changed

+194/−0 lines, 6 filesdep +basedep +containersdep +gjk2dsetup-changed

Dependencies added: base, containers, gjk2d, lens, light, linear, mtl

Files

LICENSE +30/−0
README.md +9/−0
Setup.hs +2/−0
light.cabal +41/−0
src/Physics/Light.hs +84/−0
test/Spec.hs +28/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Suzumiya (c) 2017++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 Suzumiya nor the names of other+      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+OWNER 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 @@+# light++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/light.svg)](https://hackage.haskell.org/package/light)+[![Dependencies](https://img.shields.io/hackage-deps/v/light.svg)](http://packdeps.haskellers.com/feed?needle=light)

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ light.cabal view

@@ -0,0 +1,41 @@+name:                light+version:             0.1.0.0+synopsis:            a simple physics engine+description:         A simple physics engine(dynamics only) with collision dection+homepage:            https://github.com/suzumiyasmith/light#readme+license:             BSD3+license-file:        LICENSE+author:              Suzumiya+maintainer:          suzumiyasmith@gmail.com+copyright:           Copyright: (c) 2017 Suzumiya+category:            Physics+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Physics.Light+  build-depends:       base >= 4.7 && < 5+                     , linear >= 1.20 && < 2+                     , gjk2d >= 0.1 && < 1+                     , containers >= 0.5 && < 1+                     , lens >= 4 && < 5+                     , mtl >= 2.2 && < 3+  default-language:    Haskell2010++test-suite light-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , light+                     , linear+                     , lens+                     , containers+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/suzumiyasmith/light

+ src/Physics/Light.hs view

@@ -0,0 +1,84 @@+{-# LANGUAGE TemplateHaskell #-}++module Physics.Light where++import GJK++import Control.Arrow+import Control.Lens+import Control.Monad.Writer.Lazy+import Data.Fixed+import Data.Function+import qualified Data.IntMap.Lazy as IM+import Data.List+import Linear++data Object2D = Object2D+  { _position :: V3 Double+  , _velocity :: V3 Double+  , _acceleration :: V3 Double+  , _shape :: [Convex]+  }++makeLenses ''Object2D++instance Show Object2D where+  show o = show (o ^. position, o ^. velocity, o ^. acceleration)++type PhysicsWorld = (IM.IntMap Object2D, Int)++newPhysicsWorld :: PhysicsWorld+newPhysicsWorld = (IM.empty, 0)++addObject :: Object2D -> PhysicsWorld -> PhysicsWorld+addObject o (w, fresh) = (IM.insert fresh o w, fresh + 1)++addObjects :: [Object2D] -> PhysicsWorld -> PhysicsWorld+addObjects (o:os) w = addObjects os $ addObject o w+addObjects [] w = w++update :: Double -> PhysicsWorld -> PhysicsWorld+update dt = first (fmap w)+  where+    w :: Object2D -> Object2D+    w o = o+      & position %~ (+ o ^. velocity ^* dt)+      & velocity %~ (+ o ^. acceleration ^* dt)+      & position .  _z %~ (`mod'` (2 * pi))++detectCollision :: PhysicsWorld -> [(Int, Int)]+detectCollision (w, _) =+  execWriter $ IM.traverseWithKey (\k o -> tell $ fmap ((,) k) (detect w k o)) w++detect :: IM.IntMap Object2D -> Int -> Object2D -> [Int]+detect w k1 o1 =+  IM.keys $+  IM.filterWithKey (\k2 o2 -> k1 < k2 && (shapeCollide `on` realShape) o1 o2) w+  where+    realShape o =+      rotateConvex (o ^. position ^. _z) . moveConvex (o ^. position ^. _xy) <$>+      o ^. shape++shapeCollide :: [Convex] -> [Convex] -> Bool+shapeCollide v1 v2 = and $ convexIntersect <$> v1 <*> v2++ellipse :: Double -> Double -> Convex+ellipse a b = Convex $ \d -> V2 (a * cos d) (b * sin d)++circle :: Double -> Convex+circle r = ellipse r r++polygon :: [V2 Double] -> Convex+polygon vs = Convex $ \d -> maximumBy (compare `on` dot (angle d)) vs++moveConvex :: V2 Double -> Convex -> Convex+moveConvex p s = Convex $ \d -> p + support s d++rotateConvex :: Double -> Convex -> Convex+rotateConvex r s = Convex $ \d -> rotateMatrix2D r !* support s d++scaleConvex :: V2 Double -> Convex -> Convex+scaleConvex c s = Convex $ \d -> scaled c !* support s d++rotateMatrix2D :: Double -> V2 (V2 Double)+rotateMatrix2D r = V2 (V2 (cos r) (-sin r)) (V2 (sin r) (cos r))

+ test/Spec.hs view

@@ -0,0 +1,28 @@+import Control.Lens+import qualified Data.IntMap.Lazy as IM+import Linear+import Physics.Light++main :: IO ()+main = do+  print $ detectCollision <$> (updateTest <$> [1 .. 1000] <*> [testWorld1, testWorld2])++testShape1 = [circle 1, ellipse 0.5 3]++testShape2 = polygon $ V2 <$> [-1, 1] <*> [-1, 1]++o1 = Object2D 0 (V3 0 0 1) 0 testShape1++o2 = Object2D (V3 1.5 0 0) (V3 0 0 0) 0 [testShape2]++o3 = Object2D (V3 (-1.5) 0 0) (V3 0 0 0) 0 [testShape2]++o4 = Object2D (V3 (-1.5) 0 0) (V3 1 0 0) 0 [testShape2]++testWorld1 = newPhysicsWorld & addObjects [o1, o2, o3]+testWorld2 = newPhysicsWorld & addObjects [o1, o3, o4]+++updateTest :: Int -> PhysicsWorld -> PhysicsWorld+updateTest 0 w = w+updateTest n w = update 0.1 $ updateTest (n - 1) w