diagrams-rubiks-cube 0.2.0.1 → 0.3.0.0

raw patch · 6 files changed

+124/−64 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• LICENSE +1/−1
• README.md +4/−0
• diagrams-rubiks-cube.cabal +3/−3
• src/Diagrams/RubiksCube/Draw.hs +90/−55
• src/Diagrams/RubiksCube/Model.hs +18/−5

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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 @@ -- -- <<diagrams/src_Diagrams_RubiksCube_Draw_drawSideDia.svg#diagram=drawSideDia&height=150&width=200>> 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 =

@@ -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