diff --git a/src/Diagrams/TwoD/Path/Turtle/Internal.hs b/src/Diagrams/TwoD/Path/Turtle/Internal.hs index 74290a8..c5cd5e0 100644 --- a/src/Diagrams/TwoD/Path/Turtle/Internal.hs +++ b/src/Diagrams/TwoD/Path/Turtle/Internal.hs @@ -1,12 +1,20 @@ -{-# LANGUAGE FlexibleContexts #-} --- | A module consisting of core types and functions to represent and operate on +{-# LANGUAGE FlexibleContexts, TypeSynonymInstances, FlexibleInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : Diagrams.TwoD.Path.Turtle +-- Copyright : (c) 2011 Michael Sloan +-- License : BSD-style (see LICENSE) +-- Maintainer : Michael Sloan , Deepak Jois +-- Authors : Michael Sloan , Deepak Jois +-- +-- A module consisting of core types and functions to represent and operate on -- a \"turtle\". -- -- More info about turtle graphics: -- -- --- The underlying graphics primitives are provided by the diagrams library --- +----------------------------------------------------------------------------- + module Diagrams.TwoD.Path.Turtle.Internal ( -- * Turtle data types and accessors @@ -45,7 +53,7 @@ data PenStyle = PenStyle data TurtlePath = TurtlePath { penStyle :: PenStyle -- ^ Style , turtleTrail :: (P2, Trail R2) -- ^ Path - } + } deriving Show -- | Core turtle data type. A turtle needs to keep track of its current -- position, like its position, heading etc., and all the paths that it has @@ -70,7 +78,7 @@ data Turtle = Turtle -- | List of paths along with style information, traversed by the turtle -- previously , paths :: [TurtlePath] - } + } deriving Show -- | Default pen style, with @penWidth@ set to 1.0 and @penColor@ set to black defaultPenStyle :: PenStyle diff --git a/tests/Diagrams/TwoD/Path/Turtle/Tests.hs b/tests/Diagrams/TwoD/Path/Turtle/Tests.hs index c3d8085..02a043f 100644 --- a/tests/Diagrams/TwoD/Path/Turtle/Tests.hs +++ b/tests/Diagrams/TwoD/Path/Turtle/Tests.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ViewPatterns #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Diagrams.TwoD.Path.Turtle.Tests ( tests ) where @@ -12,8 +13,7 @@ import Test.QuickCheck import Diagrams.Prelude import Diagrams.TwoD.Path.Turtle.Internal -import Debug.Trace - +tests :: [Test] tests = [ testProperty "Moves forward correctly" movesForward , testProperty "Moves backward correctly" movesBackward @@ -27,25 +27,29 @@ tests = movesForward :: Turtle -> Property movesForward t = isPenDown t ==> - round diffPos == round x -- position is set correctly - && round lenCurrTrail == round x -- most recent trail has the right length + diffPos == round x -- position is set correctly + && lenCurrTrail == round x -- most recent trail has the right length where x = 2.0 t' = t # forward x - diffPos = magnitude $ penPos t' .-. penPos t - lenCurrTrail = flip arcLength 0.0001 . head . trailSegments . snd . currTrail $ t' + diffPos :: Int + diffPos = round $ magnitude $ penPos t' .-. penPos t + lenCurrTrail :: Int + lenCurrTrail = round $ flip arcLength 0.0001 . head . trailSegments . snd . currTrail $ t' -- | The turtle moves forward by the right distance movesBackward :: Turtle -> Property movesBackward t = isPenDown t ==> - round diffPos == round x -- position is set correctly - && round lenCurrTrail == round x -- most recent trail has the right length + diffPos == round x -- position is set correctly + && lenCurrTrail == round x -- most recent trail has the right length where x = 2.0 t' = t # backward x - diffPos = magnitude $ penPos t' .-. penPos t - lenCurrTrail = flip arcLength 0.0001 . head . trailSegments . snd . currTrail $ t' + diffPos :: Int + diffPos = round $ magnitude $ penPos t' .-. penPos t + lenCurrTrail :: Int + lenCurrTrail = round $ flip arcLength 0.0001 . head . trailSegments . snd . currTrail $ t' -- | The turtle moves forward and backward by the same distance and returns to -- the same position @@ -104,10 +108,6 @@ trailEmptyWhenPenUp t = isPenDown t ==> trailIsEmpty t' = t # penUp # forward 4 # backward 3 trailIsEmpty = null . trailSegments . snd . currTrail $ t' -instance Show Turtle where - show t@(Turtle a b c _ _ _) = show (a,b,c) - - -- | Arbitrary instance for the Turtle type. instance Arbitrary Turtle where arbitrary = @@ -137,6 +137,7 @@ instance Arbitrary PenStyle where 1 -> return $ PenStyle penWidth_ black 2 -> return $ PenStyle penWidth_ blue 3 -> return $ PenStyle penWidth_ brown + _ -> error "Should not get here" -- | Arbitrary instance of Segment --