diff --git a/diagrams-core.cabal b/diagrams-core.cabal index 32c6ef5..c41ef72 100644 --- a/diagrams-core.cabal +++ b/diagrams-core.cabal @@ -40,6 +40,7 @@ Library containers >= 0.4.2 && < 0.6, unordered-containers >= 0.2 && < 0.3, semigroups >= 0.8.4 && < 0.19, + numbered-semigroups >= 0.1 && < 0.2, monoid-extras >= 0.3 && < 0.5, dual-tree >= 0.2 && < 0.3, lens >= 4.0 && < 4.16, diff --git a/src/Diagrams/Core/Types.hs b/src/Diagrams/Core/Types.hs index 56b86ab..a064aa2 100644 --- a/src/Diagrams/Core/Types.hs +++ b/src/Diagrams/Core/Types.hs @@ -11,6 +11,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- We have some orphan Action instances here, but since Action is a multi-param @@ -132,13 +133,14 @@ module Diagrams.Core.Types import Control.Arrow (first, second, (***)) import Control.Lens (Lens', Prism', Rewrapped, Wrapped (..), iso, lens, over, - prism', view, (^.), _Wrapped, + prism', view, (^.), (.~), _Wrapped, _Wrapping) import Control.Monad (mplus) import Data.List (isSuffixOf) import qualified Data.Map as M import Data.Maybe (fromMaybe, listToMaybe) import Data.Semigroup +import Data.Semigroup.Numbered (SemigroupNo(..)) import qualified Data.Traversable as T import Data.Tree import Data.Typeable @@ -164,6 +166,10 @@ import Diagrams.Core.V import Linear.Affine import Linear.Metric import Linear.Vector +import Linear.V1 (R1, _x) +import Linear.V2 (R2, _y) +import Linear.V3 (R3, _z) +import Linear.V4 (R4, _w) -- XXX TODO: add lots of actual diagrams to illustrate the -- documentation! Haddock supports \<\\>. @@ -492,6 +498,23 @@ instance (Metric v, OrderedField n, Semigroup m) -- swap order so that primitives of d2 come first, i.e. will be -- rendered first, i.e. will be on the bottom. +-- | Lay out diagrams side-by-side. Cf. . +instance (Metric v, R1 v, OrderedField n, Semigroup m, Monoid m) + => SemigroupNo 0 (QDiagram b v n m) where + sappendN _ d₀ d₁ = d₀ <> juxtapose (_x.~1 $ zero) d₀ d₁ +-- | Stack diagrams vertically. Cf. . +instance (Metric v, R2 v, OrderedField n, Semigroup m, Monoid m) + => SemigroupNo 1 (QDiagram b v n m) where + sappendN _ d₀ d₁ = d₀ <> juxtapose (_y.~1 $ zero) d₀ d₁ +-- | Stack 3D-diagrams in z-direction. +instance (Metric v, R3 v, OrderedField n, Semigroup m, Monoid m) + => SemigroupNo 2 (QDiagram b v n m) where + sappendN _ d₀ d₁ = d₀ <> juxtapose (_z.~1 $ zero) d₀ d₁ +-- | Anybody in for a game of Brockian Ultra-Cricket? +instance (Metric v, R4 v, OrderedField n, Semigroup m, Monoid m) + => SemigroupNo 3 (QDiagram b v n m) where + sappendN _ d₀ d₁ = d₀ <> juxtapose (_w.~1 $ zero) d₀ d₁ + -- | A convenient synonym for 'mappend' on diagrams, designed to be -- used infix (to help remember which diagram goes on top of which -- when combining them, namely, the first on top of the second).