diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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. diff --git a/Graphics/WorldTurtle.hs b/Graphics/WorldTurtle.hs --- a/Graphics/WorldTurtle.hs +++ b/Graphics/WorldTurtle.hs @@ -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`. -} diff --git a/Graphics/WorldTurtle/Color.hs b/Graphics/WorldTurtle/Color.hs new file mode 100644 --- /dev/null +++ b/Graphics/WorldTurtle/Color.hs @@ -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 diff --git a/Graphics/WorldTurtle/Commands.hs b/Graphics/WorldTurtle/Commands.hs --- a/Graphics/WorldTurtle/Commands.hs +++ b/Graphics/WorldTurtle/Commands.hs @@ -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 diff --git a/Graphics/WorldTurtle/Internal/Coords.hs b/Graphics/WorldTurtle/Internal/Coords.hs --- a/Graphics/WorldTurtle/Internal/Coords.hs +++ b/Graphics/WorldTurtle/Internal/Coords.hs @@ -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' diff --git a/Graphics/WorldTurtle/Internal/Sequence.hs b/Graphics/WorldTurtle/Internal/Sequence.hs --- a/Graphics/WorldTurtle/Internal/Sequence.hs +++ b/Graphics/WorldTurtle/Internal/Sequence.hs @@ -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 diff --git a/Graphics/WorldTurtle/Internal/Turtle.hs b/Graphics/WorldTurtle/Internal/Turtle.hs --- a/Graphics/WorldTurtle/Internal/Turtle.hs +++ b/Graphics/WorldTurtle/Internal/Turtle.hs @@ -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 diff --git a/worldturtle.cabal b/worldturtle.cabal --- a/worldturtle.cabal +++ b/worldturtle.cabal @@ -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: