summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorfffaaa <>2019-06-11 18:53:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-06-11 18:53:00 (GMT)
commitf03e9dbea07fe61ca05891463e907540ad6a7dc3 (patch)
treeb77e6f726668b40a30d646cf440f0bd88bf00059
version 0.1.0.0HEAD0.1.0.0master
-rw-r--r--LICENSE30
-rw-r--r--Setup.hs2
-rwxr-xr-xchanges.txt5
-rw-r--r--line-drawing.cabal39
-rw-r--r--src/Line/Draw.hs86
-rw-r--r--test/Line/DrawSpec.hs33
-rw-r--r--test/Test.hs1
7 files changed, 196 insertions, 0 deletions
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..e7a23c3
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2019, Francesco Ariis
+
+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 Francesco Ariis 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
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/changes.txt b/changes.txt
new file mode 100755
index 0000000..706f0e8
--- /dev/null
+++ b/changes.txt
@@ -0,0 +1,5 @@
+0.1.0.0
+-------
+
+- Released Tue 11 Jun 2019 20:35:43 CEST.
+- Added Bresenham's algorithm.
diff --git a/line-drawing.cabal b/line-drawing.cabal
new file mode 100644
index 0000000..1dafa11
--- /dev/null
+++ b/line-drawing.cabal
@@ -0,0 +1,39 @@
+cabal-version: >=1.10
+name: line-drawing
+version: 0.1.0.0
+synopsis: raster line drawing
+description: Line drawing algorithms to approximate a
+ line segment on discrete graphical media (raster).
+
+ Currently just Bresenham algorithm.
+bug-reports: fa-ml@ariis.it
+license: BSD3
+license-file: LICENSE
+author: Francesco Ariis
+maintainer: fa-ml@ariis.it
+copyright: © 2019 Francesco Ariis
+category: Graphics
+build-type: Simple
+extra-source-files: changes.txt
+
+library
+ exposed-modules: Line.Draw
+ build-depends: base == 4.*
+ hs-source-dirs: src
+ default-language: Haskell2010
+ ghc-options: -Wall
+
+test-suite test
+ default-language: Haskell2010
+ HS-Source-Dirs: test, src
+ main-is: Test.hs
+ build-depends: base == 4.*
+ , hspec == 2.7.*
+ other-modules: Line.Draw
+ Line.DrawSpec
+ type: exitcode-stdio-1.0
+ ghc-options: -Wall
+
+source-repository head
+ type: darcs
+ location: http://ariis.it/link/repos/line-drawing/
diff --git a/src/Line/Draw.hs b/src/Line/Draw.hs
new file mode 100644
index 0000000..dc34e30
--- /dev/null
+++ b/src/Line/Draw.hs
@@ -0,0 +1,86 @@
+--------------------------------------------------------------------------------
+-- |
+-- Module : Line.Draw
+-- Copyright : (C) 2019 Francesco Ariis
+-- License : BSD3 (see LICENSE file)
+--
+-- Maintainer : Francesco Ariis <fa-ml@ariis.it>
+-- Stability : provisional
+-- Portability : portable
+--
+-- Rasterisation of line segments on discrete graphical media
+-- (<https://en.wikipedia.org/wiki/Line_drawing_algorithm line drawing algorithm>).
+--
+-- Example:
+--
+-- @
+-- λ> bresenham (0, 0) (4, 2)
+-- [(0,0), (1,0), (2,1), (3,1), (4,2)]
+-- @
+--
+--------------------------------------------------------------------------------
+
+module Line.Draw (
+ Coords,
+ bresenham
+ )
+ where
+
+import qualified Data.List as L
+import qualified Data.Tuple as T
+
+type Coords = (Int, Int)
+type State = (Int, Int, Int)
+ -- curr x, curr y, treshold
+
+-- | Rasterising a line using
+-- <https://en.wikipedia.org/wiki/Bresenham%27s_line_algorithm Bresenham's algorithm>.
+bresenham :: Coords -> Coords -> [Coords]
+bresenham x@(x1, y1) y@(x2, y2)
+ | m1Check = bresenhamBase x y
+ | otherwise = let x' = T.swap x
+ y' = T.swap y
+ in map (T.swap) (bresenhamBase x' y')
+ where
+ m1Check :: Bool
+ m1Check = abs (x2 - x1) >= abs (y2 - y1)
+
+
+-----------------
+-- ANCILLARIES --
+-----------------
+
+bresenhamBase :: Coords -> Coords -> [Coords]
+bresenhamBase (x1, y1) (x2, y2) =
+ let -- first treshold
+ ti = 2 * ady - adx
+ in L.unfoldr f (x1, y1, ti)
+ where
+ -- slope
+ dx, dy, adx, ady :: Int
+ dx = x2 - x1
+ dy = y2 - y1
+ adx = abs dx
+ ady = abs dy
+
+ -- sign of increment
+ ix, iy :: Int -> Int
+ ix | dx > 0 = (+1)
+ | otherwise = (subtract 1)
+ iy | dy > 0 = (+1)
+ | otherwise = (subtract 1)
+
+ -- step function, takes (x, y, treshold)
+ f :: State -> Maybe (Coords, State)
+ f (cx, cy, t)
+ | abs cx > abs x2 = Nothing
+ | otherwise =
+ let cx' = ix cx
+
+ cy' | t > 0 = iy cy
+ | otherwise = cy
+
+ t' | t > 0 = t - 2 * adx + 2 * ady
+ | otherwise = t + 2 * ady
+ in Just ((cx, cy), (cx', cy', t'))
+
diff --git a/test/Line/DrawSpec.hs b/test/Line/DrawSpec.hs
new file mode 100644
index 0000000..e27bae8
--- /dev/null
+++ b/test/Line/DrawSpec.hs
@@ -0,0 +1,33 @@
+module Line.DrawSpec where
+
+import Line.Draw
+
+import Test.Hspec
+
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = do
+
+ describe "bresenham" $ do
+ it "rasterises a simple line" $
+ bresenham (0, 0) (4, 4) `shouldBe`
+ [(0,0), (1,1), (2,2), (3,3), (4,4)]
+ it "rasterises a line" $
+ bresenham (0, 0) (4, 2) `shouldBe`
+ [(0,0), (1,0), (2,1), (3,1), (4,2)]
+ it "rasterises a line, quadrant 2, m<1" $
+ bresenham (0, 0) (-4, 2) `shouldBe`
+ [(0,0), (-1,0), (-2,1), (-3,1), (-4,2)]
+ it "rasterises a line, quadrant 3, m<1" $
+ bresenham (0, 0) (-4, -2) `shouldBe`
+ [(0,0), (-1,0), (-2,-1), (-3,-1), (-4,-2)]
+ it "rasterises a line, quadrant 1, m>1" $
+ bresenham (0, 0) (2, 4) `shouldBe`
+ [(0,0), (0,1), (1,2), (1,3), (2,4)]
+ it "rasterises a line, quadrant 4, m>1" $
+ bresenham (0, 0) (2, -4) `shouldBe`
+ [(0,0), (0,-1), (1,-2), (1,-3), (2,-4)]
+
diff --git a/test/Test.hs b/test/Test.hs
new file mode 100644
index 0000000..a824f8c
--- /dev/null
+++ b/test/Test.hs
@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}