diff --git a/Data/WrapAround.hs b/Data/WrapAround.hs new file mode 100644 --- /dev/null +++ b/Data/WrapAround.hs @@ -0,0 +1,194 @@ +{-| + WrapAround is a convenience module which helps you perform calculations with + points that are supposed to exist on a 2-dimensional, finite, unbounded plane. + (Or infinite, bounded plane, depending on who you ask.) On such a plane, space + wraps around so that an object travelling vertically or horizontally eventually + comes back to the place where it started. This allows you to move objects + around on a seamless map. For example, in some video games when an object + crosses the bottom of the screen it reappears at the top. + + WrapAround represents the points and handles the common calculations properly + so you don't have to bother with the messy math and edge cases. This is done + with two data structures: a 'WrapMap', which stores information about the size + of the plane, and a 'WrapPoint', which stores information about the location of + the point. + + A WrapPoint is represented internally as a pair of angles, like in a torus. + The WrapMap and WrapPoint structures are kept separate because some WrapPoint + calculations can be performed without a WrapMap context. Functions typically + only need a WrapMap when a WrapPoint must be converted to actual x, y + coordinates or vice versa. You can perform calculations mixing WrapPoints that + were generated with different WrapMaps, but this generally yields meaningless + results. + + When you need the actual x, y coordinates, use the 'toCoords' conversion + function. + + If you are grateful for this software, I gladly accept donations! + + +-} +module Data.WrapAround ( WrapMap() + , wrapmap + , WrapPoint() + , wrappoint + , addPoints + , addPoints' + , distance + , subtractPoints + , toCoords + , vectorRelation + -- , windowView + -- , WrapWindow(..) + ) where + +-- |Contains the contextual information necessary to convert a WrapPoint to +-- coordinates and vice versa. +data WrapMap = WrapMap { radiusr :: Double -- radius from tube center + , radiusR :: Double -- radius from torus center + } + deriving (Show) + +-- |Generates a 'WrapMap'. +wrapmap :: Double -- ^ Width + -> Double -- ^ Height + -> WrapMap +wrapmap width height = WrapMap { radiusR = height / (2 * pi) + , radiusr = width / (2 * pi) + } + +-- |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 + , angleR :: Double -- radians around torus center + } + deriving (Show) + +-- |Generates a 'WrapPoint'. +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' } + +-- |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 + -> WrapPoint -- ^ WrapPoint to be converted + -> (Double, Double) +toCoords WrapMap { radiusR = mRadiusR, radiusr = mRadiusr } + WrapPoint { angleR = pAngleR, angler = pAngler } + = (pAngler * mRadiusr, pAngleR * mRadiusR) + +-- |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' } + +-- |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' } + +-- |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' } + +-- distance :: WrapMap -> WrapPoint -> WrapPoint -> Double +-- distance 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 +-- let dX = min dXa dXb in +-- let dY = min dYa dYb in +-- let dX' = dX * mRadiusr in +-- let dY' = dY * mRadiusR in +-- sqrt (dX'**2 + dY'**2) + + +-- |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) + +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 + +-- |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 + let dX = min dXa dXb in + let dY = min dYa dYb in + let dX' = dX * mRadiusr in + let dY' = dY * mRadiusR in + (dX', dY') + +-- Maybe add these someday after I find them useful + +-- data WrapWindow = WrapWindow { tlCorner :: (Double, Double) +-- , width :: Double +-- , height :: Double +-- , wrapMap :: WrapMap +-- } + +-- windowView :: WrapWindow -> WrapPoint -> WrapPoint -> (Double, Double) +-- windowView window centerpoint point +-- = let cornerPoint = addPoints' +-- (wrapMap window) +-- centerpoint +-- ((-width window) / 2.0, height window / 2.0) in +-- let (vx, vy) = vectorRelation (wrapMap window) cornerPoint point in +-- let vx' = vx in +-- let vy' = (-vy) in +-- (vx' + fst (tlCorner window), vy' + snd (tlCorner window)) + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2012, Christopher Howard + +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 Christopher Howard 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/wrap-around-example.hs b/wrap-around-example.hs new file mode 100644 --- /dev/null +++ b/wrap-around-example.hs @@ -0,0 +1,35 @@ +import Graphics.Gloss.Interface.Pure.Simulate +import GHC.Float +import Data.WrapAround + +dispmode = InWindow "WrapAround module test" (1024, 768) (0, 0) + +main = simulate dispmode (dim green) 10 model dispmodel stepfunc + +data Model = Model { particles :: [(WrapPoint, (Double, Double))] + , wrapMap :: WrapMap } + deriving (Show) + +wmap = wrapmap 200 300 + +model = Model { particles = [ (wrappoint wmap (10, 10), (10, 0)) + , (wrappoint wmap (30, 30), ((-5), (-5))) + ] + , Main.wrapMap = 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)) + +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 } + + diff --git a/wraparound.cabal b/wraparound.cabal new file mode 100644 --- /dev/null +++ b/wraparound.cabal @@ -0,0 +1,62 @@ +Name: wraparound + +-- 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 + +-- A short (one-line) description of the package. +Synopsis: Convenient handling of points on a seamless 2-dimensional plane + +-- A longer description of the package. +Description: + WrapAround helps you perform calculations involving points on a finite, + unbounded plane, in which objects that move across one edge of the map + appear on the other. Add points, calculate distance, and so forth + without worrying about the edge cases and frustrating math mistakes. + +-- URL for the project homepage or repository. +Homepage: http://frigidcode.com + +-- The license under which the package is released. +License: BSD3 + +-- The file containing the license text. +License-file: LICENSE + +-- The package author(s). +Author: Christopher Howard + +-- An email address to which users can send suggestions, bug reports, +-- and patches. +Maintainer: christopher.howard@frigidcode.com + +-- A copyright notice. +-- Copyright: + +Category: Data + +Build-type: Simple + +-- Extra files to be distributed with the package, such as examples or +-- a README. +Extra-source-files: wrap-around-example.hs + +-- Constraint on the version of Cabal needed to build this package. +Cabal-version: >=1.10 + +Library + -- Modules exported by the library. + Exposed-modules: Data.WrapAround + + -- Packages needed in order to build this package. + Build-depends: base >= 4 && < 5 + + Default-language: Haskell2010 + + -- Modules not exported by this package. + -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. + -- Build-tools: +