worldturtle 0.1.0.0 → 0.1.1.0

raw patch · 8 files changed

+183/−78 lines, 8 filesdep +matrixPVP ok

version bump matches the API change (PVP)

Dependencies added: matrix

API changes (from Hackage documentation)

Files

• ChangeLog.md +10/−0
• Graphics/WorldTurtle.hs +7/−3
• Graphics/WorldTurtle/Color.hs +57/−0
• Graphics/WorldTurtle/Commands.hs +79/−46
• Graphics/WorldTurtle/Internal/Coords.hs +10/−15
• Graphics/WorldTurtle/Internal/Sequence.hs +9/−9
• Graphics/WorldTurtle/Internal/Turtle.hs +3/−0
• worldturtle.cabal +8/−5

@@ -1,5 +1,15 @@ # Changelog for turtle-haskell
 
+## v0.1.1
+
+* Added `sleep` function.
+* Added `rotationSpeed` function.
+* Added the `shiftHue` color function.
+* Fixed bugs in circle rendering when going in a clockwise direction.
+* Fixed the bounds and potential recursion pitfall in internal normalization
+  functions.
+* If rotation left 270 degrees will not turn right 90 degrees and vice versa.
+
 ## v0.1.0
 
 Initial release.

@@ -10,6 +10,10 @@ "Graphics.WorldTurtle" is a module for writing and rendering turtle graphics
 in Haskell.
 
+Take a look at the
+     [examples](https://github.com/FortOyer/worldturtle-haskell#examples) on
+Github!
+
 -}
 module Graphics.WorldTurtle
      ( 
@@ -23,17 +27,17 @@      -- * Further documentation
      , module Graphics.WorldTurtle.Commands
      , module Graphics.WorldTurtle.Shapes
-     , module Graphics.Gloss.Data.Color
+     , module Graphics.WorldTurtle.Color
      ) where
 
 import Control.Applicative ((<|>))
 
-import Graphics.Gloss.Data.Color
 import Graphics.Gloss.Data.Display (Display (..))
 import qualified Graphics.Gloss.Data.ViewState as G
 import qualified Graphics.Gloss.Data.ViewPort as G
 import qualified Graphics.Gloss.Interface.Pure.Game as G
 
+import Graphics.WorldTurtle.Color
 import Graphics.WorldTurtle.Commands
 import Graphics.WorldTurtle.Internal.Sequence (renderTurtle)
 import Graphics.WorldTurtle.Internal.Commands (TurtleCommand, seqT)
@@ -151,5 +155,5 @@    >>> a <|> b
    a
 
-   when @a@ is not `Control.Monad.mzero`.
+   when /a/ is not `Control.Monad.mzero`.
 -}

@@ -0,0 +1,57 @@+{-|
+Module      : Graphics.WorldTurtle.Color
+Description : Color functions
+Copyright   : (c) Archibald Neil MacDonald, 2020
+License     : BSD3
+Maintainer  : FortOyer@hotmail.co.uk
+Stability   : experimental
+Portability : POSIX
+
+This module is a collection of color manipulation commands!
+
+-}
+module Graphics.WorldTurtle.Color
+  ( module Graphics.Gloss.Data.Color
+  , shiftHue
+  ) where
+
+import Data.Matrix
+
+import Graphics.Gloss.Data.Color
+
+-- | Rotates a given color's hue between [0, 360) degrees.
+shiftHue :: Float -- ^ Degrees to change hue.
+         -> Color -- ^ Color to shift.
+         -> Color -- ^ Resultant color with hue shifted.
+shiftHue d c = let hMatrix = hueMatrix d
+                   (r, g, b, a) = rgbaOfColor c
+                   cMatrix = fromList 1 3 [r, g, b]
+                   cMatrix' = cMatrix * hMatrix
+                   [r', g', b'] = toList cMatrix'
+                   in makeColor r' g' b' a
+
+-- Haskell form of solution posted here:
+-- https://stackoverflow.com/questions/8507885/shift-hue-of-an-rgb-color
+hueMatrix :: Float -> Matrix Float
+hueMatrix degrees = matrix 3 3 (flip calcForIndex degrees)
+
+calcForIndex :: (Int, Int) -> Float -> Float
+calcForIndex (1, 1) = diag_
+calcForIndex (1, 2) = perm1_
+calcForIndex (1, 3) = perm2_ 
+calcForIndex (2, 1) = perm2_ 
+calcForIndex (2, 2) = diag_
+calcForIndex (2, 3) = perm1_
+calcForIndex (3, 1) = perm1_
+calcForIndex (3, 2) = perm2_ 
+calcForIndex (3, 3) = diag_
+calcForIndex _      = error $ "We only work with 3x3 matrices!"
+
+diag_ :: Float -> Float
+diag_ d = cos d + 1/3 * (1.0 - cos d)
+
+perm1_ :: Float -> Float
+perm1_ d = 1/3 * (1 - cos d) - sqrt (1/3) * sin d
+
+perm2_ :: Float -> Float
+perm2_ d = 1/3 * (1 - cos d) + sqrt (1/3) * sin d

@@ -9,12 +9,13 @@ Stability   : experimental
 Portability : POSIX
 
-This module is a collection of all the commands used to manipulate a turtle!
+This module contains all commands used to create, move and 
+manipulate a turtle.
 
 -}
 module Graphics.WorldTurtle.Commands
   (
-  -- * Setting up a turtle.
+  -- * Creating a turtle.
     Turtle
   , makeTurtle
   , makeTurtle'
@@ -34,18 +35,20 @@   , home
   , setHeading
   , setSpeed
+  , setRotationSpeed
   -- * Styling commands.
   , stamp
   , representation
-  -- * Tell turtle's state.
+  -- * Query turtle's state.
   , position
   , heading
   , speed
+  , rotationSpeed
   , penColor
   , penDown
   , penSize
   , visible
-  -- * Drawing state.
+  -- * Set rendering state.
   , setPenColor
   , setPenDown
   , setPenSize
@@ -53,6 +56,7 @@   , setVisible
   -- * Canvas commands.
   , clear
+  , sleep
   -- * Common constants
   , east
   , north
@@ -88,7 +92,7 @@       forward 90 t
    @
 
-The default turtle starts at position (0, 0) and is orientated @North@.
+The default turtle starts at position (0, 0) and is orientated `north`.
 
 -}
 makeTurtle :: TurtleCommand Turtle
@@ -131,16 +135,6 @@ bk :: Float -> Turtle -> TurtleCommand ()
 bk = backward
 
--- | Turn a turtle right by the given degrees amount.
-right :: Float -- ^ Rotation amount to apply to turtle.
-      -> Turtle -- ^ The turtle to rotate.
-      -> TurtleCommand ()
-right !r = left (-r)
-
--- | Shorthand for `right`.
-rt :: Float -> Turtle -> TurtleCommand ()
-rt = right
-
 calculateNewPointF_ :: P.Point -- ^ Starting point
                     -> Float -- ^ Distance
                     -> Float -- ^ Heading in degrees.
@@ -179,24 +173,40 @@       -> TurtleCommand ()
 stamp turtle = TurtleCommand $ tData_ turtle >>= addPicture . T.drawTurtle 
 
+-- | Turn a turtle right by the given degrees amount.
+right :: Float -- ^ Rotation amount to apply to turtle.
+      -> Turtle -- ^ The turtle to rotate.
+      -> TurtleCommand ()
+right = rotateTo_ True
+
+-- | Shorthand for `right`.
+rt :: Float -> Turtle -> TurtleCommand ()
+rt = right
+
 -- | Turn a turtle left by the given degrees amount.
 left :: Float -- ^ Rotation amount to apply to turtle.
      -> Turtle -- ^ The turtle to rotate.
      -> TurtleCommand ()
-left !r turtle = TurtleCommand $ do
-    t <- tData_ turtle
-    let r' = P.normalizeDirection r
-    animate' (P.degToRad r') (t ^. T.speed) $ \q -> do
-      let !h = t ^. T.heading
-      --let q' = if r > 0 then q else -q
-      let !newHeading = P.normalizeHeading $ h + q * r'
-      --  Get new heading via percentage
-      turtLens_ turtle . T.heading .= newHeading
+left = rotateTo_ False
 
 -- | Shorthand for `left`.
 lt :: Float -> Turtle -> TurtleCommand ()
 lt = left
 
+rotateTo_ :: Bool -- ^ Bias decides in which direction rotation happens.
+          -> Float -- ^ Amount to rotate by
+          -> Turtle -- Turtle to modify.
+          -> TurtleCommand ()
+rotateTo_  rightBias !r turtle = TurtleCommand $ do
+    t <- tData_ turtle
+    let r' = P.normalizeHeading r
+    animate' (P.degToRad r') (t ^. T.rotationSpeed) $ \q -> do
+      let !h = t ^. T.heading
+      let !newHeading = P.normalizeHeading $ if rightBias then h - q * r'
+                                                          else h + q * r'
+      --  Get new heading via percentage
+      turtLens_ turtle . T.heading .= newHeading
+
 -- | Draws an arc starting from a given starting point on the edge of the
 --   circle.
 drawCircle_ :: P.Point -- ^ Point on edge of circle to start from
@@ -210,8 +220,8 @@  translate (fst p) (snd p) $ rotate (180 - startAngle)
                            $ translate (-radius) 0
                            $ color pColor
-                           $ rotate (if radius >= 0 then 0 else 180)
-                           $ thickArc 0 (endAngle) radius pSize
+                           $ scale (if radius >= 0 then 1 else -1) 1
+                           $ thickArc 0 (endAngle) (abs radius) pSize
 
 -- Calculates the next position of a turtle on a circle.
 calculateNewPointC_ :: P.Point -- ^ Point on edge of circle
@@ -220,14 +230,11 @@                     -> Float -- ^ Rotation amount about radius in degrees
                     -> P.Point -- ^ Resulting new point
 calculateNewPointC_ !p !radius !startAngle !angle = (px, py)
-  where !px = fst p - (radius * (cA - cS))
-        !py = snd p - (radius * (sA - sS))
+  where !px = fst p - (radius * (cos a - cos s))
+        !py = snd p - (radius * (sin a - sin s))
         !s = P.degToRad startAngle
-        !a = P.degToRad $ angle + startAngle
-        !cS = cos s
-        !sS = sin s
-        !cA = cos a
-        !sA = sin a
+        !a = P.degToRad $ if radius >= 0 then startAngle + angle
+                                         else startAngle - angle
 
 -- | Draw an arc with a given @radius@. The center is @radius@ units left of the
 --   @turtle@ if positive. Otherwise  @radius@ units right of the @turtle@ if 
@@ -244,7 +251,7 @@ circle !radius !r turtle = TurtleCommand $ do
   t <- tData_ turtle
   let !r' = P.normalizeHeading r
-  animate' (radius * P.degToRad r') (t ^. T.speed) $ \ q -> do
+  animate' (abs radius * P.degToRad r') (t ^. T.speed) $ \ q -> do
     let !startAngle = t ^. T.heading + 90
     let !p = t ^. T.position
     let !angle = r' * q
@@ -254,7 +261,10 @@ 
     -- Update the turtle with the new values.
     let ts = turtLens_ turtle
-    ts . T.heading .= (P.normalizeHeading $ startAngle - 90 + angle)
+    ts . T.heading .= P.normalizeHeading (if radius >= 0
+                                          then startAngle - 90 + angle
+                                          else startAngle - 90 - angle)
+    
 
     let !p' = calculateNewPointC_ p radius startAngle angle
     ts . T.position .= p'
@@ -277,6 +287,8 @@ -- | Warps the turtle to a new position.
 --   The turtle jumps to this new position with no animation. If the pen is down
 --   then a line is drawn.
+--   
+--   This does not affect the turtle's heading.
 goto :: P.Point -- ^ Position to warp to.
      -> Turtle -- ^ Turtle to modify.
      -> TurtleCommand ()
@@ -308,7 +320,7 @@ 
 -- | Sets the turtle's heading. See `heading`.
 setHeading :: Float -- ^ Heading to apply. 
-           -> Turtle -- ^ Turtle to set.
+           -> Turtle -- ^ Turtle to modify.
            -> TurtleCommand ()
 setHeading = setter_ T.heading
 
@@ -327,7 +339,7 @@ 
 -- | Returns whether the turtle's pen is down.
 --   When the turtle's pen is down it will draw a line when it moves.
---   The default value is @true@.
+--   The default value is @True@.
 penDown :: Turtle -- ^ Turtle to query.
          -> TurtleCommand Bool -- ^ True if pen is down, false if not.
 penDown = getter_ False T.penDown
@@ -353,9 +365,9 @@ setPenSize = setter_ T.penSize
 
 -- | Returns whether the turtle is visible.
---   The default value is @true@.
+--   The default value is @True@.
 visible :: Turtle -- ^ Turtle to query.
-        -> TurtleCommand Bool -- ^ True if turtle is visible,false if not.
+        -> TurtleCommand Bool -- ^ @True@ if turtle is visible, @False@ if not.
 visible = getter_ False T.visible
 
 -- | Sets the turtle's visibility.
@@ -365,13 +377,13 @@            -> TurtleCommand ()
 setVisible = setter_ T.visible
 
--- | Returns whether the turtle's current speed.
+-- | Returns the turtle's current speed.
 --   Speed is is @distance@ per second.
 --   A speed of 0 is equivalent to no animation being performed and instant 
---   drawing.
+--   movement.
 -- The default value is @200@.
 speed :: Turtle -- ^ Turtle to query.
-      -> TurtleCommand Float
+      -> TurtleCommand Float -- ^ Speed of turtle.
 speed = getter_ 0 T.speed
 
 -- | Sets the turtle's speed.
@@ -381,12 +393,28 @@          -> TurtleCommand ()
 setSpeed = setter_ T.speed
 
--- | Gets the turtle's representation as a Gloss `Picture`.
+-- | Returns the turtle's current rotation speed.
+--   Rotation speed is is the speed in seconds it takes to do a full revolution.
+--   A speed of 0 is equivalent to no animation being performed and instant 
+--   rotation.
+-- The default value is @20@.
+rotationSpeed :: Turtle -- ^ Turtle to query.
+              -> TurtleCommand Float -- ^ Rotation speed of turtle.
+rotationSpeed = getter_ 0 T.rotationSpeed
+
+-- | Sets the turtle's rotation speed.
+--   See `rotationSpeed`.
+setRotationSpeed :: Float -- ^ New rotation speed.
+                 -> Turtle -- ^ Turtle to modify.
+                 -> TurtleCommand ()
+setRotationSpeed = setter_ T.rotationSpeed
+
+-- | Gets the turtle's representation as a `Picture`.
 representation :: Turtle -- ^ Turtle to query.
                -> TurtleCommand Picture
 representation = getter_ blank T.representation
 
-{- | Sets the turtle's representation to a Gloss `Picture`.
+{- | Sets the turtle's representation to a `Picture`.
    See `representation`.
    For example, to set the turtle as a red circle:
    
@@ -402,14 +430,19 @@       forward 90 t
    @
 -}
-setRepresentation :: Picture
-                  -> Turtle -- ^ Turtle to mutate.
+setRepresentation :: Picture -- ^ Picture to apply.
+                  -> Turtle -- ^ Turtle to modify.
                   -> TurtleCommand ()
 setRepresentation = setter_ T.representation
 
 -- | Clears all drawings form the canvas. Does not alter any turtle's state.
 clear :: TurtleCommand ()
 clear = TurtleCommand $ pics .= []
+
+-- | Sleep for a given amount of time in seconds. When sleeping no animation 
+--   runs. A negative value will be clamped to @0@.
+sleep :: Float -> TurtleCommand ()
+sleep = TurtleCommand . decrementSimTime . max 0
 
 -- | @90@ degrees.
 north :: Float

@@ -7,7 +7,6 @@   , module GAngle
   , lerp
   , normalizeHeading
-  , normalizeDirection
   ) where
 
 import Prelude hiding ((-), (+))
@@ -21,18 +20,14 @@ lerp :: Float -> Point -> Point -> Point
 lerp !l !a !b =  ((1 P.- l) `mulSV` a) + (l `mulSV` b)
 
--- | Return a valid heading value between (0, 360).
+-- | Return a valid heading value between (0, 360].
+--   We want 360 to be 360 (full rotation).
+--   We want 361 to be 1 (wraparound rotation).
+--   Special case: we want 0 to be 0 (no rotation). Though really 0 is equal to
+--   360 we will let this special case slide as it helps in our time elapsed 
+--   calculations.
 normalizeHeading :: Float -> Float
-normalizeHeading !f
-  | f < 0     = normalizeHeading (f P.+ r)
-  | f > r     = normalizeHeading (f P.- r)
-  | otherwise = f
-  where r = 360.0
-
--- | Return a valid heading value between (-180, 180).
-normalizeDirection :: Float -> Float
-normalizeDirection !f
-  | f < -r     = normalizeHeading (f P.+ r)
-  | f >  r     = normalizeHeading (f P.- r)
-  | otherwise = f
-  where r = 180.0+normalizeHeading 0 = 0
+normalizeHeading f = let (n, b) = properFraction f :: (Int, Float)
+                         f' = fromIntegral (n `rem` 360) P.+ b
+                      in if f' <= 0 then f' P.+ 360 else f'

@@ -177,8 +177,8 @@ --   This combination can only return if both A and B return. Compare to 
 --   `alternateSequence` which can return if one returns.
 combineSequence :: Semigroup a
-                => SequenceCommand b a -- ^ Sequence @a@ to run.
-                -> SequenceCommand b a -- ^ Sequence @b@ to run.
+                => SequenceCommand b a -- ^ Sequence /a/ to run.
+                -> SequenceCommand b a -- ^ Sequence /b/ to run.
                 -> SequenceCommand b a 
                     -- ^ New sequence of A and B in parallel.
 combineSequence a b = do
@@ -191,12 +191,12 @@   let (Just !bVal') = bVal
   return $ aVal' <> bVal'
 
--- | Runs two items in sequence, returns the result of `a` if `a` passes,
---   otherwise returns the results of `b`. The implication of this is that only
+-- | Runs two items in sequence, returns the result of /a/ if /a/ passes,
+--   otherwise returns the results of /b/. The implication of this is that only
 --   the result of a will be returned while animating, and b when animation is
 --   finished.
-alternateSequence :: SequenceCommand b a -- ^ Sequence @a@ to run.
-                  -> SequenceCommand b a -- ^ Sequence @b@ to run.
+alternateSequence :: SequenceCommand b a -- ^ Sequence /a/ to run.
+                  -> SequenceCommand b a -- ^ Sequence /b/ to run.
                   -> SequenceCommand b a
 alternateSequence a b = do
   (!aVal, !bVal) <- runParallel a b
@@ -209,10 +209,10 @@     then let (Just !aVal') = aVal in return $! aVal'
     else let (Just !bVal') = bVal in return $! bVal'
 
--- | Given two sequences @a@ and @b@, instead of running them both as separate 
+-- | Given two sequences /a/ and /b/, instead of running them both as separate 
 --   animations, run them both in parallel!
-runParallel :: SequenceCommand c a -- ^ Sequence @a@ to run.
-            -> SequenceCommand c b -- ^ Sequence @b@ to run.
+runParallel :: SequenceCommand c a -- ^ Sequence /a/ to run.
+            -> SequenceCommand c b -- ^ Sequence /b/ to run.
             -> SequenceCommand c (AlmostVal a, AlmostVal b)
                -- ^ New sequence of A and B which returns both results.
 runParallel a b = do

@@ -10,6 +10,7 @@   , representation
   , penDown
   , speed
+  , rotationSpeed
   , Graphics.WorldTurtle.Internal.Turtle.scale
   , penColor
   , penSize
@@ -32,6 +33,7 @@     , _representation :: !Picture
     , _penDown :: !Bool
     , _speed :: !Float
+    , _rotationSpeed :: Float
     , _scale :: !Float
     , _penColor :: !Color
     , _penSize :: !Float
@@ -47,6 +49,7 @@     , _representation = turtleArrow black blue
     , _penDown = True
     , _speed = 200
+    , _rotationSpeed = 10
     , _scale = 1
     , _penColor = black
     , _penSize = 2

@@ -1,7 +1,7 @@ cabal-version: 2.0
 
 name:           worldturtle
-version:        0.1.0.0
+version:        0.1.1.0
 synopsis:       Turtle graphics.
 category:       teaching
 homepage:       https://github.com/FortOyer/worldturtle-haskell#readme
@@ -15,16 +15,17 @@ tested-with: GHC ==8.8.3 || ==8.10.3
 
 description: 
-  Have you ever heard of [Turtle Graphics](https://en.wikipedia.org//wiki//Turtle_graphics)?
+  Have you ever heard of [Turtle Graphics](https://en.wikipedia.org/wiki/Turtle_graphics)?
   .
-  No? Think of a @turtle@ as a cursor you can program to draw graphics! 
+  If not, then think of a @turtle@ as a cursor you can program to draw! 
   .
   Turtle graphics are a fantastic introduction to the world of
     programming and to the syntax of a new programming language.
   .
-  ![parallelcircles gif](docs/images/parallel_circles_animated_300.gif)
+  ![parallelcircles gif](https://hackage.haskell.org/package/worldturtle-0.1.1.0/docs/docs/images/parallel_circles_animated_300.gif)
   .
-  This module is a framework built on top of "Graphics.Gloss" to render turtles
+  This module is a framework built on top 
+  of [gloss](https://hackage.haskell.org/package/gloss) to render turtles
   programmed in Haskell as animations. This is primarily aimed as a 
   teaching tool to beginners - but also, it's cool to draw things!
   .
@@ -40,6 +41,7 @@ library
   exposed-modules:
       Graphics.WorldTurtle
+      Graphics.WorldTurtle.Color
       Graphics.WorldTurtle.Commands
       Graphics.WorldTurtle.Internal.Commands
       Graphics.WorldTurtle.Internal.Coords
@@ -51,6 +53,7 @@     , containers >=0.6.2 && < 0.7
     , gloss >=1.13.1 && < 1.14
     , lens >=4.18.1 && < 4.20
+    , matrix >= 0.3.6 && < 0.4
     , mtl >=2.2.2 && < 2.3
   default-language: Haskell2010
   ghc-options: