wraparound 0.0.1.1 → 0.0.2

raw patch · 3 files changed

+183/−100 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/WrapAround.hs +145/−78
• wrap-around-example.hs +37/−21
• wraparound.cabal +1/−1

@@ -29,15 +29,27 @@   <https://frigidcode.com/donate/> -} module Data.WrapAround ( WrapMap()+                       , WM                        , wrapmap+                       , wm                        , WrapPoint()+                       , WP                        , wrappoint+                       , wp                        , addPoints+                       , add                        , addPoints'+                       , add'                        , distance                        , subtractPoints+                       , diff+                       , subtractPoints'+                       , diff'                        , toCoords+                       , coords+                       , vec                        , vectorRelation+                       , relation                        -- , windowView                        -- , WrapWindow(..)                        ) where@@ -49,14 +61,22 @@                        }   deriving (Show) +type WM = WrapMap++circleRadians = 2 * pi++radius = (/ circleRadians)+ -- |Generates a 'WrapMap'.-wrapmap :: Double   -- ^ Width+wm, wrapmap :: Double   -- ^ Width         -> Double   -- ^ Height         -> WrapMap-wrapmap width height = WrapMap { radiusR = height / (2 * pi)-                               , radiusr = width / (2 * pi)-                               }+wrapmap w h = WrapMap { radiusR = radius h +                      , radiusr = radius w+                      } +wm = wrapmap+ -- |A representation of a point location that allows for wrapping in the -- vertical or horizontal direction. data WrapPoint = WrapPoint { angler :: Double -- radians around tube center@@ -64,104 +84,152 @@                            }   deriving (Show) +type WP = WrapPoint+ -- |Generates a 'WrapPoint'.-wrappoint :: WrapMap           -- ^ Corresponding WrapMap structure+wp, wrappoint :: WrapMap           -- ^ Corresponding WrapMap structure           -> (Double, Double)  -- ^ x, y coordinates           -> WrapPoint-wrappoint wmap (x, y)-  = let angleR' = fixAngle (y / radiusR wmap) in -    let angler' = fixAngle (x / radiusr wmap) in-    WrapPoint { angleR = angleR', angler = angler' }+wrappoint wmap (x, y) =+  WrapPoint { angleR = fixAngle (y / radiusR wmap)+            , angler = fixAngle (x / radiusr wmap)+            } --- |Converts a WrapPoint to x, y coordinates. Generally you will only will only--- want to use this function for informational purposes, for example, to print--- out the x, y coordinates or to feed the coordinates to a graphics display--- function. If you convert a WrapPoint to x, y coordinates so that you can--- perform calculations with the coordinates, you must handle the wrapping math--- yourself and you are doing the work the module is supposed to do for you.-toCoords :: WrapMap          -- ^ Corresponding WrapMap structure+wp = wrappoint++-- |Converts a 'WrapPoint' to coordinates.+coords,toCoords,vec :: WrapMap          -- ^ Corresponding WrapMap structure          -> WrapPoint        -- ^ WrapPoint to be converted          -> (Double, Double)-toCoords WrapMap { radiusR = mRadiusR, radiusr = mRadiusr }-         WrapPoint { angleR = pAngleR, angler = pAngler }-  = (pAngler * mRadiusr, pAngleR * mRadiusR)+toCoords WrapMap { radiusR = rR, radiusr = rr }+         WrapPoint { angleR = aR, angler = ar }+  = (ar * rr, aR * rR) +coords = toCoords++vec = toCoords+ -- |Adds two WrapPoints together (vector style).-addPoints :: WrapPoint  -- ^ The first WrapPoint in the operation-          -> WrapPoint  -- ^ The WrapPoint to be added to the first WrapPoint-          -> WrapPoint-addPoints wp1 wp2-  = let angleR' = fixAngle (angleR wp1 + angleR wp2) in-    let angler' = fixAngle (angler wp1 + angler wp2) in-    WrapPoint { angleR = angleR', angler = angler' }+add,addPoints+  :: WrapPoint  -- ^ The first WrapPoint in the operation+  -> WrapPoint  -- ^ The WrapPoint to be added to the first WrapPoint+  -> WrapPoint+addPoints a b =+  WrapPoint { angleR = fixAngle (angleRSum a b)+            , angler = fixAngle (anglerSum a b)+            } +add = addPoints++angleRSum a b = angleR a + angleR b+anglerSum a b = angler a + angler b+ -- |Adds a WrapPoint and a pair of x, y coordinates (vector style).-addPoints' :: WrapMap           -- ^ The corresponding WrapMap structure-           -> WrapPoint         -- ^ The WrapPoint in the operation-           -> (Double, Double)  -- ^ The x, y coordinates to be added to the WrapPoint-           -> WrapPoint-addPoints' wmap wp1 (x, y)-  = let wp2 = wrappoint wmap (x, y) in-    let angleR' = fixAngle (angleR wp1 + angleR wp2) in-    let angler' = fixAngle (angler wp1 + angler wp2) in-    WrapPoint { angleR = angleR', angler = angler' }+add', addPoints'+  :: WrapMap           -- ^ The corresponding WrapMap structure+  -> WrapPoint         -- ^ The WrapPoint in the operation+  -> (Double, Double)  -- ^ The x, y coordinates to be added to the WrapPoint+  -> WrapPoint+addPoints' w a v+  = let b = wp w v in+    WrapPoint { angleR = fixAngle (angleRSum a b)+              , angler = fixAngle (anglerSum a b)+              } +add' = addPoints'++angleRDiff a b = angleR a - angleR b+anglerDiff a b = angleR a - angler b+ -- |Subtracts a WrapPoint from a WrapPoint (vector style).-subtractPoints :: WrapPoint  -- ^ The first WrapPoint in the operation-               -> WrapPoint  -- ^ The WrapPoint to be subtracted from the first WrapPoint-               -> WrapPoint-subtractPoints wp1 wp2-  = let angleR' = fixAngle (angleR wp1 - angleR wp2) in-    let angler' = fixAngle (angler wp1 - angler wp2) in-    WrapPoint { angleR = angleR', angler = angler' }+diff, subtractPoints+  :: WrapPoint  -- ^ The first WrapPoint in the operation+  -> WrapPoint  -- ^ The WrapPoint to be subtracted from the first WrapPoint+  -> WrapPoint+subtractPoints a b =+  WrapPoint { angleR = fixAngle (angleRDiff a b)+            , angler = fixAngle (anglerDiff a b)+            } +diff = subtractPoints++negV (x,y) = (-x,-y)++-- |Subtracts coordinates from a WrapPoint (vector style).+diff', subtractPoints'+  :: WrapMap           -- ^ The corresponding WrapMap structure+  -> WrapPoint         -- ^ The WrapPoint in the operation+  -> (Double, Double)  -- ^ The x, y coordinates to be added to the WrapPoint+  -> WrapPoint+subtractPoints' a b c = addPoints' a b (negV c)++diff' = subtractPoints'++join f a = f a a++sqr = join (*)++distrib f g a b = g (f a) (f b)++sumSquares = distrib sqr (+)++hypotenuse a b = sqrt (sumSquares a b)+ -- |Finds the distance between two WrapPoints. distance :: WrapMap    -- ^ The corresponding WrapMap structure          -> WrapPoint  -- ^ The first WrapPoint          -> WrapPoint  -- ^ The second WrapPoint          -> Double-distance wmap wp1 wp2-  = let (dX, dY) = vectorRelation wmap wp1 wp2 in-     sqrt (dX**2 + dY**2)+distance w a b+  = let (x, y) = vectorRelation w a b in+    hypotenuse x y -fixAngle :: Double -> Double-fixAngle radians-  = let q = radians / (2 * pi) in-    let angle = radians - fromIntegral (truncate q) * (2 * pi) in-    if angle < 0 then 2 * pi + angle-                 else angle+isPos = (>= 0)+isNeg = not . isPos +fixAngle r+  = let q = r / circleRadians in+    let a = r - fromIntegral (truncate q) * circleRadians in+    if isNeg a then circleRadians + a+               else a++absDiff a b = abs (a - b)++spinCCW = (+ circleRadians)+spinCW = flip (-) circleRadians+ -- |Returns the relationship between two WrapPoints as a pair of x, y -- coordinates (a vector).-vectorRelation :: WrapMap          -- ^ The corresponding WrapMap structure-               -> WrapPoint        -- ^ The first WrapPoint-               -> WrapPoint        -- ^ The second WrapPoint-               -> (Double, Double)-vectorRelation WrapMap { radiusR = mRadiusR, radiusr = mRadiusr }-               WrapPoint { angleR = p1angleR, angler = p1angler }-               WrapPoint { angleR = p2angleR, angler = p2angler }-  = let dXa = abs (p2angler - p1angler) in-    let dYa = abs (p2angleR - p1angleR) in-    let dXb = if p1angler < p2angler-                then abs ((p1angler + 2 * pi) - p2angler)-                else abs ((p1angler - 2 * pi) - p2angler) in-    let dYb = if p1angleR < p2angleR-                then abs ((p1angleR + 2 * pi) - p2angleR)-                else abs ((p1angleR - 2 * pi) - p2angleR) in+relation, vectorRelation+  :: WrapMap          -- ^ The corresponding WrapMap structure+  -> WrapPoint        -- ^ The first WrapPoint+  -> WrapPoint        -- ^ The second WrapPoint+  -> (Double, Double)+vectorRelation WrapMap { radiusR = rR, radiusr = rr }+               WrapPoint { angleR = aR1, angler = ar1 }+               WrapPoint { angleR = aR2, angler = ar2 }+  = let dXa = absDiff ar2 ar1 in+    let dYa = absDiff aR2 aR1 in+    let dXb = if ar1 < ar2+                then abs (spinCCW ar1 - ar2)+                else abs (spinCW ar1 - ar2) in+    let dYb = if aR1 < aR2+                then abs (spinCCW aR1 - aR2)+                else abs (spinCW aR1 - aR2) in     let dX = if dXa <= dXb-                then p2angler - p1angler-                else if p1angler <= p2angler-                        then (p2angler - 2 * pi) - p1angler-                        else (p2angler + 2 * pi) - p1angler in+                then ar2 - ar1+                else if ar1 <= ar2+                        then spinCW ar2 - ar1+                        else spinCCW ar2 - ar1 in     let dY = if dYa <= dYb-                then p2angleR - p1angleR-                else if p1angleR <= p2angleR-                     then (p2angleR - 2 * pi) - p1angleR-                     else (p2angleR + 2 * pi) - p1angleR in-    let dX' = dX * mRadiusr in-    let dY' = dY * mRadiusR in-    (dX', dY')+                then aR2 - aR1+                else if aR1 <= aR2+                     then spinCW aR2 - aR1+                     else spinCCW aR2 - aR1 in+    (dX * rr, dY * rR) +relation = vectorRelation+ -- Maybe add these someday after I find them useful  -- data WrapWindow = WrapWindow { tlCorner :: (Double, Double)@@ -180,4 +248,3 @@ --     let vx' = vx in --     let vy' = (-vy) in --     (vx' + fst (tlCorner window), vy' + snd (tlCorner window))-

@@ -2,34 +2,50 @@ import GHC.Float import Data.WrapAround -dispmode = InWindow "WrapAround module test" (1024, 768) (0, 0)+dispmode = InWindow "WrapAround module test" (800, 600) (0, 0)  main = simulate dispmode (dim green) 10 model dispmodel stepfunc -data Model = Model { particles :: [(WrapPoint, (Double, Double))]-                   , wrapMap :: WrapMap }+data Model = Model { particles :: [(WP, (Double, Double))]+                   , wmap :: WM }   deriving (Show) -wmap = wrapmap 200 300--model = Model { particles = [ (wrappoint wmap (10, 10), (10, 0))-                            , (wrappoint wmap (30, 30), ((-5), (-5)))-                            ]-              , Main.wrapMap = wmap+model = let wmap' = wm 800 600 in+        let wrap (a, b) = (wp wmap' a, b) in+        Model { particles = map wrap [ ((60, 30), (10, 0))+                                     , ((110, 140), (0, 18))+                                     , ((90, 50), (-8, 14))+                                     ]+              , wmap = wmap'               } -dispmodel m = let ps = do (wp, _) <- particles m-                          let (px, py) = toCoords (Main.wrapMap m) wp in-                            [ Polygon [ (double2Float px, double2Float py)-                                      , (double2Float px + 10, double2Float py)-                                      , (double2Float px + 10, double2Float py + 10)-                                      , (double2Float px, double2Float py + 10)-                                      ] ] in-              Translate (-100.0) (-150.0) (Color green (Pictures ps))+appPair f (x, y) = (f x, f y) -stepfunc _ _ m = let map = Main.wrapMap m in-                 let nparticles = do (wp, (x, y)) <- particles m-                                     [ (addPoints' map wp (x, y), (x, y)) ] in-                 m { particles = nparticles }+downgrade a = appPair double2Float a++dispmodel m = let s = [ let (x, y) = downgrade (coords (wmap m) p) in+                          Polygon [ (x, y)+                                  , (x + 10, y)+                                  , (x + 10, y + 10)+                                  , (x, y + 10)+                                  ]+                      | (p, _) <- particles m+                      ] in+              Translate+                (-400) (-300)+                (Pictures [ (Color black+                             (Polygon [ (800, 600)+                                      , (0, 600)+                                      , (0, 0)+                                      , (800, 0)+                                      ]))+                          , (Color green+                              (Pictures s))+                          ])++stepfunc _ _ m = m { particles = [ (add' (wmap m) p v, v)+                                 | (p, v) <- particles m+                                 ]+                   }  

@@ -3,7 +3,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.0.1.1+Version:             0.0.2  -- A short (one-line) description of the package. Synopsis:            Convenient handling of points on a seamless 2-dimensional plane