diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # Change Log +## 0.3.0.0 - 2017-12-09 + +- Remove artefacts caused by square line joins +- Proper arrow scaling +- Shorter arrows for back layer moves +- Make arrow colour configurable +- Nicer default colours + ## 0.2.0.1 - 2016-10-27 - Updated upper bounds diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2015 Tim Baumann +Copyright (c) 2015-2017 Tim Baumann Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -16,6 +16,8 @@ See the docs on [Hackage][hackage-url]. +For an example, take a look at this [beginner's manual for solving the Rubik's Cube][solving-manual-pdf] and its [source code][solving-manual-source]. + [travis-image]: https://travis-ci.org/timjb/diagrams-rubiks-cube.svg?branch=master [travis-url]: https://travis-ci.org/timjb/diagrams-rubiks-cube [moves-image]: https://cdn.rawgit.com/timjb/diagrams-rubiks-cube/master/diagrams/src_Diagrams_RubiksCube_Draw_drawMovesExample.svg @@ -25,3 +27,5 @@ [hackage-deps-url]: http://packdeps.haskellers.com/feed?needle=diagrams-rubiks-cube [codeclimate-url]: https://codeclimate.com/github/timjb/diagrams-rubiks-cube [codeclimate-image]: https://codeclimate.com/github/timjb/diagrams-rubiks-cube/badges/gpa.svg +[solving-manual-pdf]: http://timbaumann.info/mathezirkel-kurs/rubiks-wuerfel-workshop/anleitung.pdf +[solving-manual-source]: https://github.com/timjb/mathezirkel-kurs/blob/gh-pages/rubiks-wuerfel-workshop/anleitung.tex diff --git a/diagrams-rubiks-cube.cabal b/diagrams-rubiks-cube.cabal --- a/diagrams-rubiks-cube.cabal +++ b/diagrams-rubiks-cube.cabal @@ -1,5 +1,5 @@ name: diagrams-rubiks-cube -version: 0.2.0.1 +version: 0.3.0.0 synopsis: Library for drawing the Rubik's Cube. description: Includes a facets model of the Rubik's Cube and a 'diagrams'-based renderer. homepage: https://github.com/timjb/rubiks-cube @@ -7,12 +7,12 @@ license-file: LICENSE author: Tim Baumann maintainer: tim@timbaumann.info -copyright: 2015-2016 Tim Baumann +copyright: 2015-2017 Tim Baumann category: Graphics build-type: Simple extra-source-files: README.md, CHANGELOG.md, diagrams/*.svg extra-doc-files: diagrams/*.svg -cabal-version: >= 1.10 +cabal-version: >= 1.18 source-repository head type: git diff --git a/src/Diagrams/RubiksCube/Draw.hs b/src/Diagrams/RubiksCube/Draw.hs --- a/src/Diagrams/RubiksCube/Draw.hs +++ b/src/Diagrams/RubiksCube/Draw.hs @@ -13,7 +13,7 @@ , Offsets (..), offsetX, offsetY , drawRubiksCube , drawMove - , MovesSettings (..), moveSep, showStart, showEnd, offsets + , MovesSettings (..), moveSep, showStart, showEnd, offsets, arrowColour , drawMoves, drawMovesBackward ) where @@ -24,10 +24,12 @@ import Diagrams.Prelude hiding (center, cube) import Diagrams.TwoD.Arrow (arrowFromLocatedTrail') import Diagrams.Trail (trailPoints) -import Data.List (sortBy, mapAccumL) -import Data.Function (on) import qualified Diagrams.Prelude as P +import Data.Function (on) +import Data.List (sortBy, mapAccumL) +import Data.Typeable (Typeable) + type RubiksCubeBackend n b = (Renderable (Path V2 n) b, TypeableFloat n, N b ~ n, V b ~ V2) -- > {-# LANGUAGE FlexibleContexts, TypeFamilies #-} @@ -40,12 +42,13 @@ solvedRubiksCube :: RubiksCube (Colour Double) solvedRubiksCube = RubiksCube (Cube f b l r u d) where - f = pure orange - b = pure red + -- colours from http://clrs.cc/ + f = pure (sRGB24 255 133 27) -- orange + b = pure (sRGB24 255 65 54) -- red l = pure white - r = pure yellow - u = pure green - d = pure blue + r = pure (sRGB24 255 220 0) -- yellow + u = pure (sRGB24 61 153 112) -- olive + d = pure (sRGB24 0 116 217) -- blue -- > {-# LANGUAGE FlexibleContexts, TypeFamilies #-} -- > import Diagrams.RubiksCube @@ -61,10 +64,10 @@ -- -- <> drawSide - :: RubiksCubeBackend n b + :: (RubiksCubeBackend n b, Color c) => V2 n -- ^ dx -> V2 n -- ^ dy - -> Side (Colour Double) + -> Side c -> Diagram b drawSide (dx :: V2 n) dy side = mconcat $ do (y, row) <- count rows @@ -76,17 +79,22 @@ pos :: Int -> Int -> Point V2 n pos x y = P $ fromIntegral x *^ dx ^+^ fromIntegral y *^ dy drawField - :: (Renderable (Path V2 n) b, N b ~ n, V b ~ V2) - => Int -> Int -> Colour Double -> Diagram b + :: (Renderable (Path V2 n) b, N b ~ n, V b ~ V2, Color c) + => Int -> Int -> c -> Diagram b drawField x y color = fromVertices [pos x y, pos (x+1) y, pos (x+1) (y+1), pos x (y+1), pos x y] - # mapLoc closeTrail # trailLike # fc color + # mapLoc closeTrail + # trailLike + # lineColor (sRGB24 30 30 30) + # fillColor color + # lineCap LineCapRound + # lineJoin LineJoinRound -- | Draw the folding pattern of the cube. The front side is at the center of -- the pattern. drawFoldingPattern - :: RubiksCubeBackend n b - => RubiksCube (Colour Double) + :: (RubiksCubeBackend n b, Color c) + => RubiksCube c -> Diagram b drawFoldingPattern c' = let c = c' ^. cube @@ -140,9 +148,9 @@ -- > let c = solvedRubiksCube ^. undoMoves [R,U,R',U'] -- > in drawRubiksCube with c drawRubiksCube - :: RubiksCubeBackend n b + :: (RubiksCubeBackend n b, Color c) => Offsets n - -> RubiksCube (Colour Double) + -> RubiksCube c -> Diagram b drawRubiksCube (Offsets dx dy) c' = position $ [ f ] ++ @@ -166,52 +174,70 @@ u = (p2 (0,3), drawSide' dx' dz' upSide) d = (p2 (3*dx, 3*dy), drawSide' dx' (-dz') downSide) +moveArrowOptions :: (Num n, RealFloat n, Fractional n, Typeable n) => ArrowOpts n +moveArrowOptions = + with + & shaftStyle %~ lw (local 0.35) + & headLength .~ local 0.6 + & tailLength .~ local 0.6 + & arrowHead .~ tri + & arrowTail .~ lineTail + moveArrow :: RubiksCubeBackend n b - => Bool -> [P2 n] -> Diagram b -moveArrow rev points = - lc red $ arrowFromLocatedTrail' opts $ fromVertices $ + => Bool + -> Colour Double + -> [P2 n] + -> Diagram b +moveArrow rev arrColour points = + lc arrColour $ arrowFromLocatedTrail' moveArrowOptions $ fromVertices $ if rev then reverse points else points - where opts = with & shaftStyle %~ lw ultraThick - & headLength .~ veryLarge - & tailLength .~ veryLarge - & arrowTail .~ lineTail drawMoveU, drawMoveD, drawMoveL, drawMoveR, drawMoveF, drawMoveB - :: RubiksCubeBackend n b + :: (RubiksCubeBackend n b, Color c) => Bool -- ^ invert + -> Colour Double -> Offsets n - -> RubiksCube (Colour Double) + -> RubiksCube c -> Diagram b -drawMoveU rev off c = - atop (moveArrow rev [p2 (2.8, 2.5), p2 (0.2, 2.5)]) +drawMoveU rev arrColour off c = + atop (moveArrow rev arrColour [p2 (2.8, 2.5), p2 (0.2, 2.5)]) (drawRubiksCube off c) -drawMoveD rev (Offsets dx dy) c = - atop (moveArrow rev [p2 (0.2, 0.5), p2 (2.8, 0.5)]) +drawMoveD rev arrColour (Offsets dx dy) c = + atop (moveArrow rev arrColour [p2 (0.2, 0.5), p2 (2.8, 0.5)]) (drawRubiksCube (Offsets dx (-dy)) c) -drawMoveL rev off c = - atop (moveArrow rev [p2 (0.5, 2.8), p2 (0.5, 0.2)]) +drawMoveL rev arrColour off c = + atop (moveArrow rev arrColour [p2 (0.5, 2.8), p2 (0.5, 0.2)]) (drawRubiksCube off c) -drawMoveR rev off c = - atop (moveArrow rev [p2 (2.5, 0.2), p2 (2.5, 2.8)]) +drawMoveR rev arrColour off c = + atop (moveArrow rev arrColour [p2 (2.5, 0.2), p2 (2.5, 2.8)]) (drawRubiksCube off c) -drawMoveF rev off c = - arr (opts & arrowShaft .~ quarterTurn') (p2 (1.5, 2.6)) (p2 (2.5, 1.3)) +drawMoveF True arrColour off c = + arr (p2 (0.5, 1.2)) (p2 (1.3, 2.5)) `atop` - arr (opts & arrowShaft .~ quarterTurn') (p2 (1.5, 0.4)) (p2 (0.5, 1.7)) + arr (p2 (2.5, 1.8)) (p2 (1.7, 0.5)) `atop` - drawRubiksCube off c + drawRubiksCube off c where - quarterTurn' = arc xDir (1/4 @@ turn) # (if rev then id else reverseTrail) - opts = with & shaftStyle %~ lw ultraThick & headLength .~ veryLarge - arr opts' s e = (if rev then arrowBetween' opts' e s else arrowBetween' opts' s e) - # lc red -drawMoveB rev off@(Offsets dx dy) c = - moveArrow rev (trailPoints arrowTrail) + arrOpts = moveArrowOptions & arrowShaft .~ quarterTurn' & arrowTail .~ noTail + quarterTurn' = arc xDir (0.25 @@ turn) + arr s e = arrowBetween' arrOpts e s # lc arrColour +drawMoveF False arrColour off c = + arr (p2 (1.7, 2.5)) (p2 (2.5, 1.2)) `atop` - drawRubiksCube off c - where backOff = p2 (3.3 + 3 * dx, 0.2 + 3 * dy) - arrowOffsets = [(0 ^& 3.1), ((-3.1) ^& 0)] + arr (p2 (1.3, 0.5)) (p2 (0.5, 1.8)) + `atop` + drawRubiksCube off c + where + arrOpts = moveArrowOptions & arrowShaft .~ quarterTurn' & arrowTail .~ noTail + quarterTurn' = arc xDir (-0.25 @@ turn) + arr s e = arrowBetween' arrOpts s e # lc arrColour +drawMoveB rev arrColour off@(Offsets dx dy) c = + moveArrow rev arrColour (trailPoints arrowTrail) + `atop` + drawRubiksCube off c + where backOff = p2 (3.3 + 3 * dx, 1.2 + 3 * dy) + arrowOffsets = [(0 ^& 2.1), ((-2.1) ^& 0)] arrowTrail = P.at (fromOffsets arrowOffsets) backOff -- | Draw the Rubik's cube in parallel perspective with an arrow indicating the @@ -226,10 +252,11 @@ -- > let c = solvedRubiksCube ^. undoMoves [L,U,L',U'] -- > in drawMove L with c drawMove - :: RubiksCubeBackend n b + :: (RubiksCubeBackend n b, Color c) => Move + -> Colour Double -> Offsets n - -> RubiksCube (Colour Double) + -> RubiksCube c -> Diagram b drawMove U = drawMoveU False drawMove U' = drawMoveU True @@ -249,12 +276,20 @@ , _showStart :: Bool -- ^ show the start configuration? , _showEnd :: Bool -- ^ show the end configuration? , _offsets :: Offsets n + , _arrowColour :: Colour Double } deriving (Eq, Show, Read) makeLenses ''MovesSettings instance Fractional n => Default (MovesSettings n) where - def = MovesSettings 1.75 False True def + def = + MovesSettings + { _moveSep = 1.75 + , _showStart = False + , _showEnd = True + , _offsets = def + , _arrowColour = sRGB24 0 31 63 + } -- | Draws a sequence of moves. -- @@ -269,9 +304,9 @@ -- > settings = with & showStart .~ True -- > in drawMoves settings startPos moves drawMoves - :: RubiksCubeBackend n b + :: (RubiksCubeBackend n b, Color c) => MovesSettings n - -> RubiksCube (Colour Double) -- ^ the start configuration + -> RubiksCube c -- ^ the start configuration -> [Move] -> Diagram b drawMoves settings c moves = @@ -284,7 +319,7 @@ pos i = p2 (fromIntegral i * (3 + settings ^. moveSep), 0) iter (i, c') m = let c'' = c' ^. move m - in ((i+1, c''), (pos i, drawMove m off c')) + in ((i+1, c''), (pos i, drawMove m (settings ^. arrowColour) off c')) -- | Like 'drawMoves', but takes the end configuration instead of the start -- configuration. The previous example can be simplified with this: @@ -297,9 +332,9 @@ -- > settings = with & showStart .~ True -- > in drawMovesBackward settings endPos moves drawMovesBackward - :: RubiksCubeBackend n b + :: (RubiksCubeBackend n b, Color c) => MovesSettings n - -> RubiksCube (Colour Double) -- ^ the end configuration + -> RubiksCube c -- ^ the end configuration -> [Move] -> Diagram b drawMovesBackward settings c moves = diff --git a/src/Diagrams/RubiksCube/Model.hs b/src/Diagrams/RubiksCube/Model.hs --- a/src/Diagrams/RubiksCube/Model.hs +++ b/src/Diagrams/RubiksCube/Model.hs @@ -1,11 +1,13 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module Diagrams.RubiksCube.Model ( @@ -73,7 +75,9 @@ three = FinS two -- | A list of fixed length 3. -data Vec3 a = Vec3 a a a deriving (Show, Eq, Functor, Foldable, Traversable) +data Vec3 a + = Vec3 a a a + deriving (Show, Eq, Functor, Foldable, Traversable) instance Applicative Vec3 where pure v = Vec3 v v v @@ -95,6 +99,15 @@ FinS FinZ -> b FinS (FinS FinZ) -> c _ -> error "index@Vec3: cannot happen" + +instance Field1 (Vec3 a) (Vec3 a) a a where + _1 f (Vec3 a b c) = (\a' -> Vec3 a' b c) <$> f a + +instance Field2 (Vec3 a) (Vec3 a) a a where + _2 f (Vec3 a b c) = (\b' -> Vec3 a b' c) <$> f b + +instance Field3 (Vec3 a) (Vec3 a) a a where + _3 f (Vec3 a b c) = (\c' -> Vec3 a b c') <$> f c -- | A variant of 'inside' that works for insideRep