line-drawing (empty) → 0.1.0.0
raw patch · 7 files changed
+196/−0 lines, 7 filesdep +basedep +hspecsetup-changed
Dependencies added: base, hspec
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- changes.txt +5/−0
- line-drawing.cabal +39/−0
- src/Line/Draw.hs +86/−0
- test/Line/DrawSpec.hs +33/−0
- test/Test.hs +1/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ changes.txt view
@@ -0,0 +1,5 @@+0.1.0.0+-------++- Released Tue 11 Jun 2019 20:35:43 CEST.+- Added Bresenham's algorithm.
+ line-drawing.cabal view
@@ -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/
+ src/Line/Draw.hs view
@@ -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'))+
+ test/Line/DrawSpec.hs view
@@ -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)]+
+ test/Test.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}