diagrams-core-1.5.1.1/0000755000000000000000000000000007346545000012563 5ustar0000000000000000diagrams-core-1.5.1.1/CHANGELOG.md0000644000000000000000000007256107346545000014407 0ustar0000000000000000## [v1.5.1.1](https://github.com/diagrams/diagrams-core/tree/v1.5.1.1) (2023-11-15) * Allow `base-4.19` and test on GHC 9.8 * Fix more warnings ## [v1.5.1](https://github.com/diagrams/diagrams-core/tree/v1.5.1) (2023-05-11) * Allow `base-4.18` and test on GHC 9.6 (thanks to @sergv) * Fix some warnings (thanks to @sergv) * Fix some documentation typos (thanks to @mchav) ## [v1.5.0.1-r1](https://github.com/diagrams/diagrams-core/tree/v1.5.0.1-r1) (2022-11-30) * Allow `linear-1.22` ## [v1.5.0.1](https://github.com/diagrams/diagrams-core/tree/v1.5.0.1) (2022-08-27) * Test with up to `base-4.17` and GHC 9.4 * Allow `lens-5.2` * Fix documentation for `atLeast` and `atMost` (thanks to Igor Moreno) ## [v1.5.0](https://github.com/diagrams/diagrams-core/tree/v1.5.0) (2021-05-13) * Updates for GHC 8.10 and 9.0 * Drop support for GHC < 8.4 * Remove deprecated `Option` type in favor of `Maybe`. This is a breaking API change. ## [v1.4.2-r1](https://github.com/diagrams/diagrams-core/tree/v1.4.2-r1) (2020-02-10) * Allow `lens-4.19` and `linear-1.21` ## [v1.4.2](https://github.com/diagrams/diagrams-core/tree/v1.4.2) (2019-10-19) * New `KeyVal` constructor for `Annotation` ([PR](https://github.com/diagrams/diagrams-core/pull/104)) * Updates for GHC 8.8 * Drop support for GHC 7.6 and 7.8 ## [v1.4.1.1](https://github.com/diagrams/diagrams-core/tree/v1.4.1.1) (2018-06-17) * Add some `ConstraintKinds` pragmas to allow compilation on GHC 7.8 and 7.6 ## [v1.4.1](https://github.com/diagrams/diagrams-core/tree/v1.4.1) (2018-04-10) * Allow `base-4.11` * Allow `lens-4.16` * Add `Semigroup` instance to build on GHC 8.4 ## v1.4.0.1 * Allow base-4.10 ## [v1.4](https://github.com/diagrams/diagrams-core/tree/v1.4) (2016-10-26) * **New features** - New `eachName` traversal, for traversing over parts of a `Name` that match a given type - More documentation explaining `HasOrigin` and `Transformable` instances for `Envelope` * **Dependency/version changes** - Allow `lens-4.15` - Many other upper bounds bumped; see minor release changelogs below. * **New instances** - `Transformable` instance for `Measured` - A bunch more instances for `Query` (`Distributive`, `Representable`, `Profunctor`, `Coseive`, `Closed`, `Costrong`, `Corepresentable`) * **API changes** - Move some `Query`-related functions to `diagrams-lib` (`sample`, `value`, `resetValue`, `clearValue`) - Remove some redundant constraints in type signatures (should not actually affect API) ## [v1.3.0.8](https://github.com/diagrams/diagrams-core/tree/v1.3.0.8) (2016-06-05) - allow `base-4.9` - build warning-free on GHC 8.0.1 ## [v1.3.0.7](https://github.com/diagrams/diagrams-core/tree/v1.3.0.7) (2016-05-01) - allow `lens-4.14` [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v1.3.0.6...v1.3.0.7) ## [v1.3.0.6](https://github.com/diagrams/diagrams-core/tree/v1.3.0.6) (2016-02-19) - allow `unordered-containers-0.2.*` [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v1.3.0.5...v1.3.0.6) ## [v1.3.0.5](https://github.com/diagrams/diagrams-core/tree/v1.3.0.5) (2016-01-14) - allow `unordered-containers-0.2.6` [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v1.3.0.4...v1.3.0.5) ## [v1.3.0.4](https://github.com/diagrams/diagrams-core/tree/v1.3.0.4) (2015-11-10) - allow `semigroups-0.18` [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v1.3.0.3...v1.3.0.4) ## [v1.3.0.3](https://github.com/diagrams/diagrams-core/tree/v1.3.0.3) (2015-09-17) - allow `lens-4.13` - allow `linear-1.20` - allow `semigroups-0.17` [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v1.3.0.2...v1.3.0.3) ## [v1.3.0.2](https://github.com/diagrams/diagrams-core/tree/v1.3.0.2) (2015-07-19) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v1.3.0.1...v1.3.0.2) ## [v1.3.0.1](https://github.com/diagrams/diagrams-core/tree/v1.3.0.1) (2015-05-26) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v1.3...v1.3.0.1) ## [v1.3](https://github.com/diagrams/diagrams-core/tree/v1.3) (2015-04-19) * **New features** - Update for ghc-7.10. - Switch from `vector-space` to `linear` for linear algebra. - `OpacityGroup` annotation for setting the opacity of diagrams as a group. Opacity groups can be applied with the `opacityGroup` or `groupOpacity` functions. - Added `atAttr`, `atMAttr` and `atTAttr` lenses onto the attributes of styles. - `InSpace` and `SameSpace` synonyms. - `size` function for computing the range of an enveloped object in the basis vectors. - "Grouping" for transparent things [\#21](https://github.com/diagrams/diagrams-core/issues/21) * **Dependency/version changes** - Allow `base-4.8` - Allow `lens-4.9` * **New instances** - `Show` instances for `Attribute` and `Style`. - `Each`, `Ixed` and `At` instances for and `Style`. * **API changes** - `Measure` has a new internal representation. `Local`, `Global`, `Normalized`, and `Output` have been renamed to `local`, `global`, `normalized` and `output` respectivly. `Measure` is now defined in `Diagrams.Core.Measure`. - `GTAttribute` has been removed. `MAttribute` now holds measured attributes and no longer requires a `Data` instance. - `V` is now a `* -> *` kind type family. - New type family `N` for the number type of an object, `Scalar` type family no longer exists. - `(|>)` has moved to `(.>>)` to make room for lens's snoc operator. - `Style`'s internal representation now uses a hashmap of the `TypeRep`. **Merged pull requests:** - Pre 1.3 [\#82](https://github.com/diagrams/diagrams-core/pull/82) ([cchalmers](https://github.com/cchalmers)) - update for GHC-7.10, -Wall [\#81](https://github.com/diagrams/diagrams-core/pull/81) ([bergey](https://github.com/bergey)) - Style lenses [\#80](https://github.com/diagrams/diagrams-core/pull/80) ([cchalmers](https://github.com/cchalmers)) - Add isReflection [\#79](https://github.com/diagrams/diagrams-core/pull/79) ([byorgey](https://github.com/byorgey)) - Linear update [\#77](https://github.com/diagrams/diagrams-core/pull/77) ([cchalmers](https://github.com/cchalmers)) - Bump lens upper version bounds [\#74](https://github.com/diagrams/diagrams-core/pull/74) ([RyanGlScott](https://github.com/RyanGlScott)) - Add Diagram B synonym for Diagram b v n [\#73](https://github.com/diagrams/diagrams-core/pull/73) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth)) - New stuff [\#72](https://github.com/diagrams/diagrams-core/pull/72) ([cchalmers](https://github.com/cchalmers)) - Linear [\#71](https://github.com/diagrams/diagrams-core/pull/71) ([cchalmers](https://github.com/cchalmers)) - Bump linear upper version bounds [\#75](https://github.com/diagrams/diagrams-core/pull/75) ([RyanGlScott](https://github.com/RyanGlScott)) - Change Measure back to not using Scalar v [\#65](https://github.com/diagrams/diagrams-core/pull/65) ([Mathnerd314](https://github.com/Mathnerd314)) - Remove gratuitous Data constraints [\#69](https://github.com/diagrams/diagrams-core/pull/69) ([Mathnerd314](https://github.com/Mathnerd314)) ## [v1.2.0.6](https://github.com/diagrams/diagrams-core/tree/v1.2.0.6) (2015-04-03) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v1.2.0.5...v1.2.0.6) **Closed issues:** - Please add support for recent versions of vector-space [\#78](https://github.com/diagrams/diagrams-core/issues/78) ## [v1.2.0.5](https://github.com/diagrams/diagrams-core/tree/v1.2.0.5) (2015-01-13) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v1.2.0.4...v1.2.0.5) ## [v1.2.0.4](https://github.com/diagrams/diagrams-core/tree/v1.2.0.4) (2014-12-04) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v1.2.0.3...v1.2.0.4) ## [v1.2.0.3](https://github.com/diagrams/diagrams-core/tree/v1.2.0.3) (2014-11-17) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v1.2.0.2...v1.2.0.3) ## [v1.2.0.2](https://github.com/diagrams/diagrams-core/tree/v1.2.0.2) (2014-08-22) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v1.2.0.1...v1.2.0.2) **Closed issues:** - Warn against GND for IsName [\#67](https://github.com/diagrams/diagrams-core/issues/67) ## [v1.2.0.1](https://github.com/diagrams/diagrams-core/tree/v1.2.0.1) (2014-06-04) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v1.2...v1.2.0.1) **Merged pull requests:** - Propogate transformations into the terms of Measure [\#66](https://github.com/diagrams/diagrams-core/pull/66) ([bergey](https://github.com/bergey)) ## [v1.2](https://github.com/diagrams/diagrams-core/tree/v1.2) (2014-06-02) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v1.1...v1.2) * **New features** - New function `matrixHomRep` to convert a transformation to a homogeneous matrix representation. - New function `dropTransl` to drop the translation component from a transformation. - A mini-DSL for Measures. - New `extent` function, used in `diameter`. - New `dimension` function to return the dimension of a vector space. - New `_relative` iso between points and vectors. - `avgScale` function (for computing the average scaling factor of a transformation) has been moved from `diagrams-lib` to `diagrams-core` and generalized to work over any vector space. * **Dependency/version changes** - Allow `semigroups-0.15` - Allow `lens-4.2` * **API changes** - Major refactoring which removes `freeze` (and hence `Split` transforms, etc.) and adds units of `Measure`. - Refactoring and simplification of the `Backend` class. - Remove `Multibackend`. - Remove `nullPrim`, `IsPrim` and simplify `RPrim` so that it does not carry a transformation. - Update `adjustDia` to return a transformation, not just a scale factor. Add `renderDiaT` which returns a transformation (for use by end users, e.g. to convert output coordinates back into local coordinates). **Implemented enhancements:** - Extracting things from Prim wrappers [\#42](https://github.com/diagrams/diagrams-core/issues/42) **Closed issues:** - Incomplete comment on Backend class [\#64](https://github.com/diagrams/diagrams-core/issues/64) - Please add support for Lens 4.x [\#56](https://github.com/diagrams/diagrams-core/issues/56) **Merged pull requests:** - A mini-DSL for Measures. [\#61](https://github.com/diagrams/diagrams-core/pull/61) ([byorgey](https://github.com/byorgey)) - Clean-slate redesign/simplification of `Backend` class [\#60](https://github.com/diagrams/diagrams-core/pull/60) ([byorgey](https://github.com/byorgey)) - Rework units [\#59](https://github.com/diagrams/diagrams-core/pull/59) ([byorgey](https://github.com/byorgey)) - Avg scale [\#58](https://github.com/diagrams/diagrams-core/pull/58) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth)) - Preliminary implementation of Measure [\#55](https://github.com/diagrams/diagrams-core/pull/55) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth)) - No mco [\#62](https://github.com/diagrams/diagrams-core/pull/62) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth)) ## [v1.1](https://github.com/diagrams/diagrams-core/tree/v1.1) (2014-03-09) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v1.0.0.1...v1.1) * **New features** - New `basis` function - New `determinant` function for computing the determinant of a `Transformation` - Add `Typeable` constraint on `Prim`s, making it possible to extract things back out of a `Prim` wrapper using `cast` - Raw `Trace`s now return a *sorted list* of intersections, instead of only the smallest. This is used to implement a new family of functions `rayTraceV`, `rayTraceP`, `maxRayTraceV`, `maxRayTraceP`, which work similarly to the parallel versions without `Ray`, but return the first intersection in the *positive* direction from the given point, rather than the smallest in absolute terms. - New `Annotation` type and corresponding `applyAnnotation` function, for attaching uninterpreted annotations at specific points in a diagram tree. Currently this is used for hyperlinks; more annotation types will be added in the future. * **Dependency/version changes** - Require `lens-4.0` - Allow `vector-space-points-0.2` * **Bug fixes** - Looking up a subdiagram by name now results in a diagram which still has that name (#43) **Closed issues:** - Named subdiagrams lose their names after being looked up [\#43](https://github.com/diagrams/diagrams-core/issues/43) **Merged pull requests:** - Hyperlinks [\#57](https://github.com/diagrams/diagrams-core/pull/57) ([tdox](https://github.com/tdox)) - Added `basis`, simplified `onBasis` [\#54](https://github.com/diagrams/diagrams-core/pull/54) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth)) - Determinants [\#53](https://github.com/diagrams/diagrams-core/pull/53) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth)) - Introduce Typeable constraint on Prims \(see \#42\) [\#52](https://github.com/diagrams/diagrams-core/pull/52) ([byorgey](https://github.com/byorgey)) - Update Wrapped instances for lens-4.0 [\#51](https://github.com/diagrams/diagrams-core/pull/51) ([bergey](https://github.com/bergey)) - return list of traces [\#48](https://github.com/diagrams/diagrams-core/pull/48) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth)) - Projections rebase [\#50](https://github.com/diagrams/diagrams-core/pull/50) ([bergey](https://github.com/bergey)) ## [v1.0.0.1](https://github.com/diagrams/diagrams-core/tree/v1.0.0.1) (2013-11-28) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v1.0...v1.0.0.1) ## [v1.0](https://github.com/diagrams/diagrams-core/tree/v1.0) (2013-11-25) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v0.7.0.1...v1.0) * **New features** * Delayed subtrees: instead of a primitive, one can now also have a delayed subtree at a leaf, containing a continuation which generates a `QDiagram` when given the accumulated d-annotation at that point in the tree. Useful for things which need to know the final transformation applied to them before deciding what diagram to generate. The prototypical use case is arrows: see https://github.com/diagrams/diagrams-lib/issues/112 . However, this may be useful for other things as well: for example, diagrams which scale normally until hitting some maximum or minimum size, at which point they refuse to scale any further (or more generally diagrams which scale as some non-linear function of the transformation applied to them). The only downside is that the u-annotation must be fixed ahead of time---doing otherwise requires a more general solution for constraint solving. * New function `lookupName` for doing a simple lookup of a named subdiagram * New module `Diagrams.Core.Compile`, containing a framework for compiling `QDiagrams` into a simpler tree type `RTree`, which may be used by backends for rendering. * **New instances** * `Qualifiable` instances for `(,)`, `(,,)`, `[]`, `Set`, `Map k`, and `(->) e`. * `(->) e` instance for `Juxtaposable` (thanks to Carlos Scheidegger) * **API changes** * Export `pointDiagram` function, which creates an otherwise empty diagram with a point (not empty) envelope * A bunch of stuff now uses machinery from the `lens` library. * `envelope`, `trace`, and `subMap` are now `Lens'`es * `Wrapped` instances for `Trace`, `TransInv`, `QDiagram`, `SubMap`, `Envelope`, `Style`, `Query`, and `Name` (replaces `Newtype` instances) * `Iso`s for `Query`, `Envelope`, `QDiagram`, `SubMap`, `TransInv` **Implemented enhancements:** - Tree structure in Backends [\#19](https://github.com/diagrams/diagrams-core/issues/19) **Merged pull requests:** - Delayed subtrees [\#47](https://github.com/diagrams/diagrams-core/pull/47) ([byorgey](https://github.com/byorgey)) - Trees for backends [\#46](https://github.com/diagrams/diagrams-core/pull/46) ([byorgey](https://github.com/byorgey)) - add b-\>a instance for Juxtaposable [\#45](https://github.com/diagrams/diagrams-core/pull/45) ([cscheid](https://github.com/cscheid)) - Lens [\#44](https://github.com/diagrams/diagrams-core/pull/44) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth)) ## [v0.7.0.1](https://github.com/diagrams/diagrams-core/tree/v0.7.0.1) (2013-09-27) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v0.7...v0.7.0.1) **Merged pull requests:** - Add lookupName function. [\#41](https://github.com/diagrams/diagrams-core/pull/41) ([cmears](https://github.com/cmears)) ## [v0.7](https://github.com/diagrams/diagrams-core/tree/v0.7) (2013-08-09) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v0.6.0.2...v0.7) * **New features** - new function `onBasis`, to extract the matrix equivalent of a `Transformation` - `SubMap`s are now `Deletable` - new function `localize` for hiding/deleting names from scope - new `IsPrim` class, containing `transformWithFreeze` function. This is primarily intended to support scale-invariant primitives (*e.g.* arrowheads) but may be useful for other stuff as well. The default implementation of `renderDia` now uses `transformWithFreeze`. - optimized `Transformable` instance for `TransInv` * **New instances** - `Eq`, `Ord`, `Enveloped`, `Traced`, and `Qualifiable` instances for `TransInv` - `Transformable` instance for functions, which acts by conjugation * **API changes** - `named` and `namePoint` have moved to the `diagrams-lib` package. * **Dependency/version changes** - allow `base-4.7` - upgrade to `monoid-extras-0.3` **Implemented enhancements:** - Function to extract matrix coefficients from a Transformation [\#22](https://github.com/diagrams/diagrams-core/issues/22) **Closed issues:** - Support for monoid-extras-0.3.0.0 [\#38](https://github.com/diagrams/diagrams-core/issues/38) **Merged pull requests:** - New IsPrim class for supporting ScaleInv [\#37](https://github.com/diagrams/diagrams-core/pull/37) ([byorgey](https://github.com/byorgey)) - onBasis gets the matrix equivalent of the Transformation [\#36](https://github.com/diagrams/diagrams-core/pull/36) ([bergey](https://github.com/bergey)) ## [v0.6.0.2](https://github.com/diagrams/diagrams-core/tree/v0.6.0.2) (2013-03-06) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v0.6.0.1...v0.6.0.2) **Fixed bugs:** - radius is wrong [\#35](https://github.com/diagrams/diagrams-core/issues/35) **Merged pull requests:** - make SubMaps deletable, and add a new function 'localize' for hiding/deleting names [\#34](https://github.com/diagrams/diagrams-core/pull/34) ([byorgey](https://github.com/byorgey)) ## [v0.6.0.1](https://github.com/diagrams/diagrams-core/tree/v0.6.0.1) (2013-01-07) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v0.6...v0.6.0.1) **Fixed bugs:** - "type instance V \(Point v\) = v" is not visible without explicit import. [\#17](https://github.com/diagrams/diagrams-core/issues/17) **Merged pull requests:** - Transformable instance for functions \(by conjugation\) [\#32](https://github.com/diagrams/diagrams-core/pull/32) ([conal](https://github.com/conal)) ## [v0.6](https://github.com/diagrams/diagrams-core/tree/v0.6) (2012-12-12) [Full Changelog](https://github.com/diagrams/diagrams-core/compare/v0.5...v0.6) * **New features** - Proper support for subdiagrams: previous versions of diagrams-core had a mechanism for associating names with a pair of a location and an envelope. Now, names are associated with actual subdiagrams (including their location and envelope, along with all the other information stored by a diagram). See [`Diagrams.Core.Types`](https://github.com/diagrams/diagrams-core/blob/27b275f45cad514caefcd3035e4e261f1b4adf6f/src/Diagrams/Core/Types.hs#L493). - Traces: in addition to an envelope, each diagram now stores a "trace", which is like an embedded raytracer: given any ray (represented by a base point and a vector), the trace computes the closest point of intersection with the diagram along the ray. This is useful for determining points on the boundary of a diagram, *e.g.* when drawing arrows between diagrams. See [`Diagrams.Core.Trace`](https://github.com/diagrams/diagrams-core/blob/2f8727fdfa60cdf46456a23f358c8a771b2cd90d/src/Diagrams/Core/Trace.hs). * **API changes** - The modules have all been renamed to be more consistent with the module naming scheme in the rest of the diagrams universe. In particular: `Graphics.Rendering.Diagrams` --> `Diagrams.Core` `Grahpics.Rendering.Diagrams.Core` --> `Diagrams.Core.Types` `Graphics.Rendering.Diagrams.*` --> `Diagrams.Core.*` - `Graphics.Rendering.Diagrams.UDTree` has been split out into a separate [`dual-tree`](http://hackage.haskell.org/package/dual%2Dtree) package (which has also been substantially rewritten). - `Graphics.Rendering.Diagrams.{Monoids,MList}` have been split out into a separate [`monoid-extras`](http://hackage.haskell.org/package/monoid%2Dextras) package. - The `names` function now returns a list of names and their associated locations, instead of the associated subdiagrams. In particular the output is suitable to be rendered to a `String` using `show`. - The new `subMap` function fills a similar role that `names` used to play, returning the entire mapping from names to subdiagrams. - New functions `envelope[VP]May` `envelopeV` and `envelopeP` return the zero vector and origin, respectively, when called on an empty envelope. However, sometimes it's useful to actually know whether the envelope was empty or not (the zero vector and the origin are legitimate outputs from non-empty envelopes). The new functions have their return type wrapped in `Maybe` for this purpose. - New functions `envelopeS` and `envelopeSMay` Like `envelope[VP](May)`, but returning a scalar multiple of the input vector. - The `Graphics.Rendering.Diagrams.Util` module has been removed, along with the `withLength` function. Calls to `withLength` can be replaced using `withLength s v = s *^ normalized v` - Add needed constraints `(InnerSpace v, OrderedField (Scalar v), Monoid' m)` to the type of the `renderDias` method in the `MultiBackend` class. - Generalized `Transformable` instances for pairs and tuples Previously, the components of the tuples were required to have the same type; but everything still works as long as they all share the same vector space. This is actually useful in practice: say, if we wanted to pair a diagram with a path and then apply the same transformation to both. * **Improvements** - More efficient implementation of `diameter` * **Dependency/version changes** - Tested with GHC 7.6.1 - allow `base-4.6` - allow `containers-0.5.*` - allow `MemoTrie-0.6.1` * **Bug fixes** - juxtaposeDefault now correctly handles empty envelopes (#37) `juxtaposeDefault` is now the identity on the second object if either one has an empty envelope. In particular this means that `mempty` is now an identity element for `beside` and friends. **Implemented enhancements:** - Turn R2 into D2 \(Generalize R2 to any numeric type\) [\#20](https://github.com/diagrams/diagrams-core/issues/20) - Terminology: rename "bounding function" -\> "envelope"; "boundary function" -\> "boundary" [\#16](https://github.com/diagrams/diagrams-core/issues/16) - Refactor: rename AnnDiagram to QDiagram [\#15](https://github.com/diagrams/diagrams-core/issues/15) - Combine \(point, bounds\) pairs stored in NameMap into a single "located bounding function" data structure [\#14](https://github.com/diagrams/diagrams-core/issues/14) - Remember more structure when building diagrams [\#12](https://github.com/diagrams/diagrams-core/issues/12) - Diagram-building service library + executable [\#7](https://github.com/diagrams/diagrams-core/issues/7) **Fixed bugs:** - setBounds is incorrect -- throws away bounds of subsequent diagrams too [\#13](https://github.com/diagrams/diagrams-core/issues/13) - Start developing test suites [\#10](https://github.com/diagrams/diagrams-core/issues/10) - Freezing does not appear to work with the SVG backend [\#9](https://github.com/diagrams/diagrams-core/issues/9) - Silent failure on other image types than .png [\#6](https://github.com/diagrams/diagrams-core/issues/6) - Tutorial contains links to old version of package [\#5](https://github.com/diagrams/diagrams-core/issues/5) - space is not left for empty diagram when using e.g. hcat' with {sep = ... } [\#3](https://github.com/diagrams/diagrams-core/issues/3) - Ellipse rotated incorrectly in test file with ellipse next to a square [\#2](https://github.com/diagrams/diagrams-core/issues/2) **Closed issues:** - Rename core modules to remove Graphics.Rendering prefix. [\#28](https://github.com/diagrams/diagrams-core/issues/28) - Improve haddock documentation [\#11](https://github.com/diagrams/diagrams-core/issues/11) - Improve description of Envelope in Haddock documentation [\#1](https://github.com/diagrams/diagrams-core/issues/1) **Merged pull requests:** - Add envelopeS / envelopeSMay for querying scalar displacements from envelopes [\#31](https://github.com/diagrams/diagrams-core/pull/31) ([mgsloan](https://github.com/mgsloan)) - Better definition for diameter [\#30](https://github.com/diagrams/diagrams-core/pull/30) ([mgsloan](https://github.com/mgsloan)) - Added needed constraints for MultiBackend. [\#29](https://github.com/diagrams/diagrams-core/pull/29) ([fryguybob](https://github.com/fryguybob)) - Rename `names` to `subMap`, and add new function `names` [\#26](https://github.com/diagrams/diagrams-core/pull/26) ([byorgey](https://github.com/byorgey)) - Fixes to work with rewritten dual-tree [\#25](https://github.com/diagrams/diagrams-core/pull/25) ([byorgey](https://github.com/byorgey)) - Fix for juxtaposeDefault to correctly handle empty envelopes [\#24](https://github.com/diagrams/diagrams-core/pull/24) ([byorgey](https://github.com/byorgey)) - dep bumps - fixes for GHC7.6 [\#23](https://github.com/diagrams/diagrams-core/pull/23) ([mgsloan](https://github.com/mgsloan)) ## [v0.5](https://github.com/diagrams/diagrams-core/tree/v0.5) (2012-03-09) * New features: - New `Juxtaposable` class - New `NullBackend` and `D` types, for conveniently giving a monomorphic type to diagrams when we don't care which one it is. - [\#27](http://code.google.com/p/diagrams/issues/detail?id=27): Change type of `adjustDia` to return a new options record (with an explicitly filled-in size) * New instances: - `Enveloped`, `HasOrigin`, `Juxtaposable`, `HasStyle`, and `Transformable` instances for `Set`s and tuples - `V Double = Double` - `Juxtaposable` and `Boundable` instances for `Map` * API changes - `AnnDiagram` renamed to `QDiagram` - [\#61](http://code.google.com/p/diagrams/issues/detail?id=61): terminology change from "bounds" to "envelope" + `boundary` -> `envelopeP` + "bounding region" -> "envelope" + `Bounds` -> `Envelope` + `Boundable` -> `Enveloped` + `getBounds` -> `getEnvelope` + *etc.* - Split out definition of `Point` into separate package ([`vector-space-points`](http://hackage.haskell.org/package/vector%2Dspace%2Dpoints)) - The `Point` constructor `P` is no longer exported from `Graphics.Rendering.Diagrams`. See the `Diagrams.TwoD.Types` module from `diagrams-lib` for new tools for working with abstract 2D points. If you really need the `P` constructor, import `Graphics.Rendering.Diagrams.Points`. - Name-related functions now return "located bounding functions" instead of pairs of points and bounds, to allow for future expansion. * Dependency/version changes: - `vector-space` 0.8 is now required. - Bump base upper bound to allow 4.5; now tested with GHC 7.4.1. * Bug fixes: - Bug fix related to empty envelopes 0.4: 23 October 2011 -------------------- * improved documentation * a few new instances (Newtype Point, Boundable Point) * new functions (value, clearValue, resetValue) for working with alternate query monoids 0.3: 18 June 2011 ----------------- * big overhaul of name maps: - allow arbitrary types as atomic names - carry along bounding functions as well as names in NameMaps - additional functions for querying information associated with names * fix for issue #34 (fix behavior of setBounds) * Transformable and HasOrigin instances for Transformations 0.2: 3 June 2011 ---------------- * bounding regions can now be overridden * new namePoint function for more flexibly assigning names to arbitrary points * add HasStyle, Boundable, and HasOrigin instances for lists * add a "trivial backend" * transformable attributes 0.1.1: 18 May 2011 ------------------ * link to new website 0.1: 17 May 2011 ---------------- * initial preview release \* *This Change Log was automatically generated by (and hand edited) [github_changelog_generator](https://github.com/skywinder/Github-Changelog-Generator)* diagrams-core-1.5.1.1/LICENSE0000644000000000000000000000421607346545000013573 0ustar0000000000000000Copyright (c) 2011-2015 diagrams-core team: Daniel Bergey Christopher Chalmers Tad Doxsee Conal Elliott Ben Gamari Allan Gardner Sam Griffin Niklas Haas Chris Mears Jeffrey Rosenbluth Carlos Scheidegger Ryan Scott Vilhelm Sjöberg Michael Sloan Scott Walck Ryan Yates Brent Yorgey All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Brent Yorgey nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diagrams-core-1.5.1.1/README.markdown0000644000000000000000000000060307346545000015263 0ustar0000000000000000[![Build Status](https://github.com/diagrams/diagrams-core/actions/workflows/haskell-ci.yml/badge.svg)](https://github.com/diagrams/diagrams-core/actions/workflows/haskell-ci.yml) The core modules defining the basic data structures and algorithms for [diagrams](http://projects.haskell.org/diagrams), a Haskell embedded domain-specific language for compositional, declarative drawing. diagrams-core-1.5.1.1/Setup.hs0000644000000000000000000000005607346545000014220 0ustar0000000000000000import Distribution.Simple main = defaultMain diagrams-core-1.5.1.1/diagrams-core.cabal0000644000000000000000000000557107346545000016274 0ustar0000000000000000Name: diagrams-core Version: 1.5.1.1 Synopsis: Core libraries for diagrams EDSL Description: The core modules underlying diagrams, an embedded domain-specific language for compositional, declarative drawing. Homepage: https://diagrams.github.io License: BSD3 License-file: LICENSE Author: Brent Yorgey Maintainer: diagrams-discuss@googlegroups.com Bug-reports: https://github.com/diagrams/diagrams-core/issues Category: Graphics Build-type: Simple Cabal-version: 1.18 Extra-source-files: diagrams/*.svg extra-doc-files: diagrams/*.svg, CHANGELOG.md, README.markdown Tested-with: GHC ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.7 || ==9.6.3 || ==9.8.1 Source-repository head type: git location: git://github.com/diagrams/diagrams-core.git Library Exposed-modules: Diagrams.Core, Diagrams.Core.Compile, Diagrams.Core.Envelope, Diagrams.Core.HasOrigin, Diagrams.Core.Juxtapose, Diagrams.Core.Names, Diagrams.Core.Points, Diagrams.Core.Query Diagrams.Core.Style, Diagrams.Core.Measure, Diagrams.Core.Trace, Diagrams.Core.Transform, Diagrams.Core.Types, Diagrams.Core.V Build-depends: base >= 4.11 && < 4.20, containers >= 0.4.2 && < 0.7, unordered-containers >= 0.2 && < 0.3, semigroups >= 0.8.4 && < 0.21, monoid-extras >= 0.6 && < 0.7, dual-tree >= 0.2 && < 0.3, lens >= 4.0 && < 5.3, linear >= 1.11.3 && < 1.23, adjunctions >= 4.0 && < 5.0, distributive >=0.2.2 && < 1.0, profunctors >= 5.0 && < 6.0, mtl >= 2.2 && < 2.4 hs-source-dirs: src Other-extensions: DeriveDataTypeable EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving MultiParamTypeClasses OverlappingInstances ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeOperators TypeSynonymInstances UndecidableInstances Default-language: Haskell2010 diagrams-core-1.5.1.1/diagrams/0000755000000000000000000000000007346545000014352 5ustar0000000000000000diagrams-core-1.5.1.1/diagrams/src_Diagrams_Core_Trace_maxRayTracePEx.svg0000644000000000000000000001607507346545000024505 0ustar0000000000000000diagrams-core-1.5.1.1/diagrams/src_Diagrams_Core_Trace_maxRayTraceVEx.svg0000644000000000000000000002251107346545000024503 0ustar0000000000000000diagrams-core-1.5.1.1/diagrams/src_Diagrams_Core_Trace_maxTracePEx.svg0000644000000000000000000001740507346545000024027 0ustar0000000000000000diagrams-core-1.5.1.1/diagrams/src_Diagrams_Core_Trace_maxTraceVEx.svg0000644000000000000000000002623307346545000024034 0ustar0000000000000000diagrams-core-1.5.1.1/diagrams/src_Diagrams_Core_Trace_rayTracePEx.svg0000644000000000000000000001607507346545000024037 0ustar0000000000000000diagrams-core-1.5.1.1/diagrams/src_Diagrams_Core_Trace_rayTraceVEx.svg0000644000000000000000000002251307346545000024037 0ustar0000000000000000diagrams-core-1.5.1.1/diagrams/src_Diagrams_Core_Trace_traceEx.svg0000644000000000000000000001030607346545000023232 0ustar0000000000000000diagrams-core-1.5.1.1/diagrams/src_Diagrams_Core_Trace_tracePEx.svg0000644000000000000000000001741007346545000023355 0ustar0000000000000000diagrams-core-1.5.1.1/diagrams/src_Diagrams_Core_Trace_traceVEx.svg0000644000000000000000000002625207346545000023367 0ustar0000000000000000diagrams-core-1.5.1.1/src/Diagrams/0000755000000000000000000000000007346545000015101 5ustar0000000000000000diagrams-core-1.5.1.1/src/Diagrams/Core.hs0000644000000000000000000001447707346545000016342 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Diagrams.Core -- Copyright : (c) 2011-2015 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- The core library of primitives forming the basis of an embedded -- domain-specific language for describing and rendering diagrams. -- Normal users of the diagrams library should almost never need to -- import anything from this package directly; instead, import modules -- (especially @Diagrams.Prelude@) from the diagrams-lib package, -- which re-exports most things of value to users. -- -- For most library code needing access to core internals, it should -- be sufficient to import this module, which simply re-exports useful -- functionality from other modules in the core library. Library -- writers needing finer-grained access or functionality may -- occasionally find it useful to directly import one of the -- constituent core modules. -- -- The diagrams library relies heavily on custom types and classes. Many -- of the relevant definitions are in the "Diagrams.Core.Types" module. -- Indeed the definition of the diagram type @QDiagram@ is contained in: -- 'Diagrams.Core.Types.QDiagram'. -- -- The best place to start when learning -- about diagrams\' types is the user manual: -- -- The following list shows which types are contained in each module of -- "Diagrams.Core". -- -- * "Diagrams.Core.Types" -- -- * @'Annotation'@, -- * @'UpAnnots' b v n m@, @'DownAnnots' v n@, -- * @'QDiaLeaf' b v n m@, @'Measure' n@, -- * @'Subdiagram' b v n m@, @'SubMap' b v n m@, -- * @'Prim' b v n@, @'Backend' b v n@, -- * @'DNode' b v n a@, @'DTree' b v n a@, -- * @'RNode' b v n a@, @'RTree' b v n a@, -- * @'NullBackend'@, @'Renderable' t b@, -- * @'D' v n@. -- -- * "Diagrams.Core.Envelope" -- -- * @'Envelope' v n@, @'Enveloped' a@, -- * @'OrderedField' s@. -- -- * "Diagrams.Core.Juxtapose" -- -- * @'Juxtaposable' a@. -- -- * "Diagrams.Core.Names" -- -- * @'AName'@, @'Name'@, @'IsName' a@, -- * @'Qualifiable' q@. -- -- * "Diagrams.Core.HasOrigin" -- -- * @'HasOrigin' t@. -- -- * "Diagrams.Core.Query" -- -- * @'Query' v n m@. -- -- * "Diagrams.Core.Style" -- -- * @'AttributeClass' a@, @'Attribute' v n@, -- * @'Style' v n@, @'HasStyle'@. -- -- * "Diagrams.Core.Trace" -- -- * @'SortedList' a@, -- * @'Trace' v n@, @'Traced' a@. -- -- * "Diagrams.Core.Transform" -- -- * @u ':-:' v@, @'HasLinearMap'@, @'HasBasis'@ -- * @'Transformation' v n@, @'Transformable' t@, -- * @'TransInv' t@. -- -- * "Diagrams.Core.V" -- -- * @'V' a@, -- * @'N' a@, -- * @'Vn' a@, -- * @'InSpace' v n a@, -- * @'SameSpace' a b@. ----------------------------------------------------------------------------- module Diagrams.Core ( -- * Associated vector spaces V, N, Vn, InSpace, SameSpace -- * Points , Point, origin, (*.) , relative -- * Transformations -- ** Utilities , basis , dimension , determinant , isReflection -- ** Invertible linear transformations , (:-:), (<->), linv, lapp -- ** General transformations , Transformation , inv, transp, transl , dropTransl , apply , papply , fromLinear -- ** Some specific transformations , translation, translate, moveTo, place , scaling, scale , avgScale -- ** The Transformable class , Transformable(..) -- ** Translational invariance , TransInv(TransInv) , eye -- * Names , AName , Name, IsName(..) , Qualifiable(..), (.>) , eachName -- ** Subdiagram maps , SubMap(..) , fromNames , rememberAs , lookupSub -- * Attributes and styles , AttributeClass , Attribute (..) , Style, HasStyle(..) , getAttr , atAttr, atMAttr, atTAttr , applyAttr, applyMAttr, applyTAttr -- * Envelopes , Envelope(..) , appEnvelope, onEnvelope, mkEnvelope , Enveloped(..) , envelopeVMay, envelopeV, envelopePMay, envelopeP , diameter, radius, size -- * Traces , Trace(Trace) , SortedList, mkSortedList, getSortedList , appTrace, mkTrace , Traced(..) , traceV, traceP , maxTraceV, maxTraceP , rayTraceV, rayTraceP , maxRayTraceV, maxRayTraceP -- * Things with local origins , HasOrigin(..), moveOriginBy -- * Juxtaposable things , Juxtaposable(..), juxtaposeDefault -- * Queries , Query(..) -- * Primitives , Prim(..) -- * Diagrams , QDiagram, Diagram, mkQD, pointDiagram , envelope, trace, subMap, names, query , nameSub , withName , withNameAll , withNames , localize , href , opacityGroup , groupOpacity , setEnvelope, setTrace , atop -- ** Subdiagrams , Subdiagram(..), mkSubdiagram , getSub, rawSub , location , subPoint -- ** Measurements , Measured , Measure , fromMeasured , output , local , global , normalized , scaleLocal , atLeast , atMost -- * Backends , Backend(..) , Renderable(..) , renderDia , renderDiaT -- ** The null backend , NullBackend, D -- * Convenience classes , HasLinearMap , HasBasis , OrderedField , TypeableFloat , Monoid' ) where import Diagrams.Core.Compile import Diagrams.Core.Envelope import Diagrams.Core.HasOrigin import Diagrams.Core.Juxtapose import Diagrams.Core.Measure import Diagrams.Core.Names import Diagrams.Core.Points import Diagrams.Core.Query import Diagrams.Core.Style import Diagrams.Core.Trace import Diagrams.Core.Transform import Diagrams.Core.Types import Diagrams.Core.V import Data.Monoid.WithSemigroup (Monoid') diagrams-core-1.5.1.1/src/Diagrams/Core/0000755000000000000000000000000007346545000015771 5ustar0000000000000000diagrams-core-1.5.1.1/src/Diagrams/Core/Compile.hs0000644000000000000000000001622707346545000017725 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Core.Compile -- Copyright : (c) 2013-2015 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- This module provides tools for compiling @QDiagrams@ into a more -- convenient and optimized tree form, suitable for use by backends. -- ----------------------------------------------------------------------------- module Diagrams.Core.Compile ( -- * Tools for backends RNode(..) , RTree , toRTree -- * Backend API , renderDia , renderDiaT -- * Internals , toDTree , fromDTree ) where import qualified Data.List.NonEmpty as NEL import Data.Maybe (fromMaybe) import Data.Monoid.Coproduct import Data.Monoid.MList import Data.Monoid.WithSemigroup (Monoid') import Data.Semigroup import Data.Tree import Data.Tree.DUAL import Data.Typeable import Diagrams.Core.Envelope (OrderedField, diameter) import Diagrams.Core.Style import Diagrams.Core.Transform import Diagrams.Core.Types import Linear.Metric hiding (qd) -- Typeable1 is a depreciated synonym in ghc > 707 #if __GLASGOW_HASKELL__ >= 707 #define Typeable1 Typeable #endif emptyDTree :: Tree (DNode b v n a) emptyDTree = Node DEmpty [] uncurry3 :: (a -> b -> c -> r) -> (a, b, c) -> r uncurry3 f (x, y, z) = f x y z -- | Convert a @QDiagram@ into a raw tree. toDTree :: (HasLinearMap v, Floating n, Typeable n) => n -> n -> QDiagram b v n m -> Maybe (DTree b v n Annotation) toDTree g n (QD qd) = foldDUAL -- Prims at the leaves. We ignore the accumulated d-annotations -- for prims (since we instead distribute them incrementally -- throughout the tree as they occur), or pass them to the -- continuation in the case of a delayed node. (\d -> withQDiaLeaf -- Prim: make a leaf node (\p -> Node (DPrim p) []) -- Delayed tree: pass the accumulated d-annotations to -- the continuation, convert the result to a DTree, and -- splice it in, adding a DDelay node to mark the point -- of the splice. (Node DDelay . (:[]) . fromMaybe emptyDTree . toDTree g n . ($ (d, g, n)) . uncurry3) ) -- u-only leaves --> empty DTree. We don't care about the -- u-annotations. emptyDTree -- a non-empty list of child trees. (\ts -> case NEL.toList ts of [t] -> t ts' -> Node DEmpty ts' ) -- Internal d-annotations. We untangle the interleaved -- transformations and style, and carefully place the style -- /above/ the transform in the tree (since by calling -- 'untangle' we have already performed the action of the -- transform on the style). (\d t -> case get d of Nothing -> t Just d' -> let (tr,sty) = untangle d' in Node (DStyle sty) [Node (DTransform tr) [t]] ) -- Internal a-annotations. (\a t -> Node (DAnnot a) [t]) qd -- | Convert a @DTree@ to an @RTree@ which can be used directly by backends. -- A @DTree@ includes nodes of type @DTransform (Transformation v)@; -- in the @RTree@ transform is pushed down until it reaches a primitive node. fromDTree :: forall b v n. (Floating n, HasLinearMap v) => DTree b v n Annotation -> RTree b v n Annotation fromDTree = fromDTree' mempty where fromDTree' :: Transformation v n -> DTree b v n Annotation -> RTree b v n Annotation -- We put the accumulated transformation (accTr) and the prim -- into an RPrim node. fromDTree' accTr (Node (DPrim p) _) = Node (RPrim (transform accTr p)) [] -- Styles are transformed then stored in their own node -- and accTr is push down the tree. fromDTree' accTr (Node (DStyle s) ts) = Node (RStyle (transform accTr s)) (fmap (fromDTree' accTr) ts) -- Transformations are accumulated and pushed down as well. fromDTree' accTr (Node (DTransform tr) ts) = Node REmpty (fmap (fromDTree' (accTr <> tr)) ts) fromDTree' accTr (Node (DAnnot a) ts) = Node (RAnnot a) (fmap (fromDTree' accTr) ts) -- Drop accumulated transformations upon encountering a DDelay -- node --- the tree unfolded beneath it already took into account -- any transformation at this point. fromDTree' _ (Node DDelay ts) = Node REmpty (fmap (fromDTree' mempty) ts) -- DEmpty nodes become REmpties, again accTr flows through. fromDTree' accTr (Node _ ts) = Node REmpty (fmap (fromDTree' accTr) ts) -- | Compile a @QDiagram@ into an 'RTree', rewriting styles with the -- given function along the way. Suitable for use by backends when -- implementing 'renderData'. The first argument is the -- transformation used to convert the diagram from local to output -- units. toRTree :: (HasLinearMap v, Metric v, Typeable n, OrderedField n, Monoid m, Semigroup m) => Transformation v n -> QDiagram b v n m -> RTree b v n Annotation toRTree globalToOutput d = (fmap . onRStyle) (unmeasureAttrs gToO nToO) . fromDTree . fromMaybe (Node DEmpty []) . toDTree gToO nToO $ d where gToO = avgScale globalToOutput -- Scaling factor from normalized units to output units: nth root -- of product of diameters along each basis direction. Note at -- this point the diagram has already had the globalToOutput -- transformation applied, so output = global = local units. nToO = product (map (`diameter` d) basis) ** (1 / fromIntegral (dimension d)) -- | Apply a style transformation on 'RStyle' nodes; the identity for -- other 'RNode's. onRStyle :: (Style v n -> Style v n) -> RNode b v n a -> RNode b v n a onRStyle f (RStyle s) = RStyle (f s) onRStyle _ n = n -------------------------------------------------- -- | Render a diagram, returning also the transformation which was -- used to convert the diagram from its (\"global\") coordinate -- system into the output coordinate system. The inverse of this -- transformation can be used, for example, to convert output/screen -- coordinates back into diagram coordinates. See also 'adjustDia'. renderDiaT :: (Backend b v n , HasLinearMap v, Metric v, Typeable n, OrderedField n, Monoid' m) => b -> Options b v n -> QDiagram b v n m -> (Transformation v n, Result b v n) renderDiaT b opts d = (g2o, renderRTree b opts' . toRTree g2o $ d') where (opts', g2o, d') = adjustDia b opts d -- | Render a diagram. renderDia :: (Backend b v n , HasLinearMap v, Metric v, Typeable n, OrderedField n, Monoid' m) => b -> Options b v n -> QDiagram b v n m -> Result b v n renderDia b opts d = snd (renderDiaT b opts d) diagrams-core-1.5.1.1/src/Diagrams/Core/Envelope.hs0000644000000000000000000003531607346545000020112 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Core.Envelope -- Copyright : (c) 2011 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- diagrams-core defines the core library of primitives forming the -- basis of an embedded domain-specific language for describing and -- rendering diagrams. -- -- The @Diagrams.Core.Envelope@ module defines a data type and type class for -- \"envelopes\", aka functional bounding regions. -- ----------------------------------------------------------------------------- module Diagrams.Core.Envelope ( -- * Envelopes Envelope(..) , appEnvelope , onEnvelope , mkEnvelope , pointEnvelope , Enveloped(..) -- * Utility functions , diameter , radius , extent , size , envelopeVMay , envelopeV , envelopePMay , envelopeP , envelopeSMay , envelopeS -- * Miscellaneous , OrderedField ) where #if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>)) #endif import Control.Lens (Rewrapped, Wrapped (..), iso, mapped, op, over, (&), (.~), _Wrapping') import Data.Functor.Rep import qualified Data.Map as M import Data.Maybe (fromMaybe) import Data.Semigroup import qualified Data.Set as S import Diagrams.Core.HasOrigin import Diagrams.Core.Points import Diagrams.Core.Transform import Diagrams.Core.V import Linear.Metric import Linear.Vector ------------------------------------------------------------ -- Envelopes --------------------------------------------- ------------------------------------------------------------ -- | Every diagram comes equipped with an /envelope/. What is an envelope? -- -- Consider first the idea of a /bounding box/. A bounding box -- expresses the distance to a bounding plane in every direction -- parallel to an axis. That is, a bounding box can be thought of -- as the intersection of a collection of half-planes, two -- perpendicular to each axis. -- -- More generally, the intersection of half-planes in /every/ -- direction would give a tight \"bounding region\", or convex hull. -- However, representing such a thing intensionally would be -- impossible; hence bounding boxes are often used as an -- approximation. -- -- An envelope is an /extensional/ representation of such a -- \"bounding region\". Instead of storing some sort of direct -- representation, we store a /function/ which takes a direction as -- input and gives a distance to a bounding half-plane as output. -- The important point is that envelopes can be composed, and -- transformed by any affine transformation. -- -- Formally, given a vector @v@, the envelope computes a scalar @s@ such -- that -- -- * for every point @u@ inside the diagram, -- if the projection of @(u - origin)@ onto @v@ is @s' *^ v@, then @s' <= s@. -- -- * @s@ is the smallest such scalar. -- -- There is also a special \"empty envelope\". -- -- The idea for envelopes came from -- Sebastian Setzer; see -- . See also Brent Yorgey, /Monoids: Theme and Variations/, published in the 2012 Haskell Symposium: ; video: . newtype Envelope v n = Envelope (Maybe (v n -> Max n)) instance Wrapped (Envelope v n) where type Unwrapped (Envelope v n) = Maybe (v n -> Max n) _Wrapped' = iso (\(Envelope e) -> e) Envelope instance Rewrapped (Envelope v n) (Envelope v' n') -- | \"Apply\" an envelope by turning it into a function. @Nothing@ -- is returned iff the envelope is empty. appEnvelope :: Envelope v n -> Maybe (v n -> n) appEnvelope (Envelope e) = (getMax .) <$> e -- | A convenient way to transform an envelope, by specifying a -- transformation on the underlying @v n -> n@ function. The empty -- envelope is unaffected. onEnvelope :: ((v n -> n) -> v n -> n) -> Envelope v n -> Envelope v n onEnvelope t = over (_Wrapping' Envelope . mapped) ((Max .) . t . (getMax .)) -- | Create an envelope from a @v n -> n@ function. mkEnvelope :: (v n -> n) -> Envelope v n mkEnvelope = Envelope . Just . (Max .) -- | Create a point envelope for the given point. A point envelope -- has distance zero to a bounding hyperplane in every direction. -- Note this is /not/ the same as the empty envelope. pointEnvelope :: (Fractional n, Metric v) => Point v n -> Envelope v n pointEnvelope p = moveTo p (mkEnvelope $ const 0) -- | Envelopes form a semigroup with pointwise maximum as composition. -- Hence, if @e1@ is the envelope for diagram @d1@, and -- @e2@ is the envelope for @d2@, then @e1 \`mappend\` e2@ -- is the envelope for @d1 \`atop\` d2@. deriving instance Ord n => Semigroup (Envelope v n) -- | The special empty envelope is the identity for the -- 'Monoid' instance. deriving instance Ord n => Monoid (Envelope v n) type instance V (Envelope v n) = v type instance N (Envelope v n) = n instance Show (Envelope v n) where show _ = "" ------------------------------------------------------------ -- Transforming envelopes -------------------------------- ------------------------------------------------------------ -- | The local origin of an envelope is the point with respect to -- which bounding queries are made, /i.e./ the point from which the -- input vectors are taken to originate. instance (Metric v, Fractional n) => HasOrigin (Envelope v n) where moveOriginTo (P u) = onEnvelope $ \oldEnv v -> oldEnv v - ((u ^/ (v `dot` v)) `dot` v) -- For a detailed explanation of this code, see note -- [Transforming Envelopes] below. instance (Metric v, Floating n) => Transformable (Envelope v n) where transform t = moveOriginTo (P . negated . transl $ t) . onEnvelope g where -- For a detailed explanation of this code, see note -- [Transforming Envelopes] below. g f v = f v' / (v' `dot` vi) where v' = signorm $ lapp (transp t) v vi = apply (inv t) v {- Note [Transforming Envelopes] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We are given an envelope for some object, and want to apply an affine transformation, such that the new envelope will be the envelope for the transformed object. The HasOrigin instance handles the translational component; the rest of the code in the Transformable instance handles the linear component. See <>. To implement moveOriginTo, we need to move the "base point" from which envelope queries are made. We are given the old envelope @oldEnv@ (a function from vectors to scalars), a vector @u@ from the old origin to the new origin, and a query vector @v@ which we imagine to emanate from the new origin. If we query the old envelope with v, it will find the correct perpendicular hyperplane, but the reported distance may be wrong (it will only be correct if the origin was moved in a direction perpendicular to v). The part that needs to be subtracted is just the projection of u onto v, which is given by (u.v)/(v.v) *^ v. In fact envelopes return not a distance or vector, but a scalar which is taken to be a multiple of the query vector, so the scalar we need to subtract is just (u.v)/(v.v). We now consider how to apply a linear transformation to an envelope. Recall that an envelope is a function that takes a vector and returns a scaling factor s such that scaling the vector by s will produce a vector to the minimum separating hyperplane. (So if given a unit vector as input, the output will be simply the distance to the minimum separating hyperplane.) We are given a linear transformation t and must produce a new envelope function. Given an input vector v, the "obvious" thing to do is to transform v back into the original coordinate system using the inverse of t, apply the original envelope, and then adjust the resulting scalar according to how much the transformation scales v. However, this does not work, since linear transformations do not preserve angles. Thus, in particular, given the query vector v and the perpendicular separating hyperplane H which we wish to find, t^-1 v and t^-1 H are not necessarily perpendicular anymore. So if we query the envelope with t^-1 v we will get information about the distance to some separating hyperplane, which when mapped forward through t will no longer be perpendicular to v. However, it turns out that if v and w are perpendicular, then t^-1 v will be perpendicular to t^T w, that is, the *transpose* of t (when considered as a matrix) applied to w. The proof is simple. Recall that v and w are perpendicular if and only if v . w = v^T w = 0. Thus, (t^-1 v) . (t^T w) = (t^-1 v)^T (t^T w) = v^T t^-T t^T w = v^T w = 0. Now to explain this code: g f v = f v' / (v' `dot` vi) where v' = signorm $ lapp (transp t) v vi = apply (inv t) v In our case, our new envelope function (transformed by t) will be given a query vector v, and we suppose v is perpendicular to the separating hyperplane H. Instead of querying the old envelope function f with t^-1 v, we query it with t^T v (after normalizing), since that vector will be perpendicular to t^-1 H. Finally, to scale the resulting value correctly, we divide by (t^T v . t^-1 v); I forget why. Perhaps I will come back later and complete this explanation. -} ------------------------------------------------------------ -- Enveloped class ------------------------------------------------------------ -- | When dealing with envelopes we often want scalars to be an -- ordered field (i.e. support all four arithmetic operations and be -- totally ordered) so we introduce this constraint as a convenient -- shorthand. type OrderedField s = (Floating s, Ord s) -- | @Enveloped@ abstracts over things which have an envelope. class (Metric (V a), OrderedField (N a)) => Enveloped a where -- | Compute the envelope of an object. For types with an intrinsic -- notion of \"local origin\", the envelope will be based there. -- Other types (e.g. 'Trail') may have some other default -- reference point at which the envelope will be based; their -- instances should document what it is. getEnvelope :: a -> Envelope (V a) (N a) instance (Metric v, OrderedField n) => Enveloped (Envelope v n) where getEnvelope = id instance (OrderedField n, Metric v) => Enveloped (Point v n) where getEnvelope p = moveTo p . mkEnvelope $ const 0 instance Enveloped t => Enveloped (TransInv t) where getEnvelope = getEnvelope . op TransInv instance (Enveloped a, Enveloped b, V a ~ V b, N a ~ N b) => Enveloped (a,b) where getEnvelope (x,y) = getEnvelope x <> getEnvelope y instance Enveloped b => Enveloped [b] where getEnvelope = mconcat . map getEnvelope instance Enveloped b => Enveloped (M.Map k b) where getEnvelope = mconcat . map getEnvelope . M.elems instance Enveloped b => Enveloped (S.Set b) where getEnvelope = mconcat . map getEnvelope . S.elems ------------------------------------------------------------ -- Computing with envelopes ------------------------------------------------------------ -- | Compute the vector from the local origin to a separating -- hyperplane in the given direction, or @Nothing@ for the empty -- envelope. envelopeVMay :: Enveloped a => Vn a -> a -> Maybe (Vn a) envelopeVMay v = fmap ((*^ v) . ($ v)) . appEnvelope . getEnvelope -- | Compute the vector from the local origin to a separating -- hyperplane in the given direction. Returns the zero vector for -- the empty envelope. envelopeV :: Enveloped a => Vn a -> a -> Vn a envelopeV v = fromMaybe zero . envelopeVMay v -- | Compute the point on a separating hyperplane in the given -- direction, or @Nothing@ for the empty envelope. envelopePMay :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> Maybe (Point v n) envelopePMay v = fmap P . envelopeVMay v -- | Compute the point on a separating hyperplane in the given -- direction. Returns the origin for the empty envelope. envelopeP :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> Point v n envelopeP v = P . envelopeV v -- | Equivalent to the norm of 'envelopeVMay': -- -- @ envelopeSMay v x == fmap norm (envelopeVMay v x) @ -- -- (other than differences in rounding error) -- -- Note that the 'envelopeVMay' / 'envelopePMay' functions above should be -- preferred, as this requires a call to norm. However, it is more -- efficient than calling norm on the results of those functions. envelopeSMay :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> Maybe n envelopeSMay v = fmap ((* norm v) . ($ v)) . appEnvelope . getEnvelope -- | Equivalent to the norm of 'envelopeV': -- -- @ envelopeS v x == norm (envelopeV v x) @ -- -- (other than differences in rounding error) -- -- Note that the 'envelopeV' / 'envelopeP' functions above should be -- preferred, as this requires a call to norm. However, it is more -- efficient than calling norm on the results of those functions. envelopeS :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> n envelopeS v = fromMaybe 0 . envelopeSMay v -- | Compute the diameter of a enveloped object along a particular -- vector. Returns zero for the empty envelope. diameter :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> n diameter v a = maybe 0 (\(lo,hi) -> (hi - lo) * norm v) (extent v a) -- | Compute the \"radius\" (1\/2 the diameter) of an enveloped object -- along a particular vector. radius :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> n radius v = (0.5*) . diameter v -- | Compute the range of an enveloped object along a certain -- direction. Returns a pair of scalars @(lo,hi)@ such that the -- object extends from @(lo *^ v)@ to @(hi *^ v)@. Returns @Nothing@ -- for objects with an empty envelope. extent :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> Maybe (n, n) extent v a = (\f -> (-f (negated v), f v)) <$> (appEnvelope . getEnvelope $ a) -- | The smallest positive /axis-parallel/ vector that bounds the -- envelope of an object. size :: (V a ~ v, N a ~ n, Enveloped a, HasBasis v) => a -> v n size d = tabulate $ \(E l) -> diameter (zero & l .~ 1) d diagrams-core-1.5.1.1/src/Diagrams/Core/HasOrigin.hs0000644000000000000000000000717007346545000020215 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -- The UndecidableInstances flag is needed under 6.12.3 for the -- HasOrigin (a,b) instance. ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Core.HasOrigin -- Copyright : (c) 2011 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- Types which have an intrinsic notion of a \"local origin\", -- /i.e./ things which are /not/ invariant under translation. -- ----------------------------------------------------------------------------- module Diagrams.Core.HasOrigin ( HasOrigin(..), moveOriginBy, moveTo, place ) where import qualified Data.Map as M import qualified Data.Set as S import Diagrams.Core.Measure import Diagrams.Core.Points () import Diagrams.Core.V import Linear.Affine import Linear.Vector -- | Class of types which have an intrinsic notion of a \"local -- origin\", i.e. things which are not invariant under translation, -- and which allow the origin to be moved. -- -- One might wonder why not just use 'Transformable' instead of -- having a separate class for 'HasOrigin'; indeed, for types which -- are instances of both we should have the identity -- -- @ -- moveOriginTo (origin .^+ v) === translate (negated v) -- @ -- -- The reason is that some things (e.g. vectors, 'Trail's) are -- transformable but are translationally invariant, i.e. have no -- origin. class HasOrigin t where -- | Move the local origin to another point. -- -- Note that this function is in some sense dual to 'translate' -- (for types which are also 'Transformable'); moving the origin -- itself while leaving the object \"fixed\" is dual to fixing the -- origin and translating the diagram. moveOriginTo :: Point (V t) (N t) -> t -> t -- | Move the local origin by a relative vector. moveOriginBy :: (V t ~ v, N t ~ n, HasOrigin t) => v n -> t -> t moveOriginBy = moveOriginTo . P -- | Translate the object by the translation that sends the origin to -- the given point. Note that this is dual to 'moveOriginTo', i.e. we -- should have -- -- @ -- moveTo (origin .^+ v) === moveOriginTo (origin .^- v) -- @ -- -- For types which are also 'Transformable', this is essentially the -- same as 'translate', i.e. -- -- @ -- moveTo (origin .^+ v) === translate v -- @ moveTo :: (InSpace v n t, HasOrigin t) => Point v n -> t -> t moveTo = moveOriginBy . (origin .-.) -- | A flipped variant of 'moveTo', provided for convenience. Useful -- when writing a function which takes a point as an argument, such -- as when using 'withName' and friends. place :: (InSpace v n t, HasOrigin t) => t -> Point v n -> t place = flip moveTo instance HasOrigin t => HasOrigin (Measured n t) where moveOriginTo = fmap . moveOriginTo instance (Additive v, Num n) => HasOrigin (Point v n) where moveOriginTo (P u) p = p .-^ u instance (HasOrigin t, HasOrigin s, SameSpace s t) => HasOrigin (s, t) where moveOriginTo p (x,y) = (moveOriginTo p x, moveOriginTo p y) instance HasOrigin t => HasOrigin [t] where moveOriginTo = map . moveOriginTo instance (HasOrigin t, Ord t) => HasOrigin (S.Set t) where moveOriginTo = S.map . moveOriginTo instance HasOrigin t => HasOrigin (M.Map k t) where moveOriginTo = M.map . moveOriginTo diagrams-core-1.5.1.1/src/Diagrams/Core/Juxtapose.hs0000644000000000000000000000570107346545000020312 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Core.Juxtapose -- Copyright : (c) 2011 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- Things which can be placed \"next to\" other things, for some -- appropriate notion of \"next to\". -- ----------------------------------------------------------------------------- module Diagrams.Core.Juxtapose ( Juxtaposable(..), juxtaposeDefault ) where import Control.Applicative import qualified Data.Map as M import qualified Data.Set as S import Diagrams.Core.Envelope import Diagrams.Core.Measure import Diagrams.Core.HasOrigin import Diagrams.Core.V import Linear.Metric import Linear.Vector -- | Class of things which can be placed \"next to\" other things, for some -- appropriate notion of \"next to\". class Juxtaposable a where -- | @juxtapose v a1 a2@ positions @a2@ next to @a1@ in the -- direction of @v@. In particular, place @a2@ so that @v@ points -- from the local origin of @a1@ towards the old local origin of -- @a2@; @a1@'s local origin becomes @a2@'s new local origin. The -- result is just a translated version of @a2@. (In particular, -- this operation does not /combine/ @a1@ and @a2@ in any way.) juxtapose :: Vn a -> a -> a -> a -- | Default implementation of 'juxtapose' for things which are -- instances of 'Enveloped' and 'HasOrigin'. If either envelope is -- empty, the second object is returned unchanged. juxtaposeDefault :: (Enveloped a, HasOrigin a) => Vn a -> a -> a -> a juxtaposeDefault v a1 a2 = case (mv1, mv2) of (Just v1, Just v2) -> moveOriginBy (v1 ^+^ v2) a2 _ -> a2 where mv1 = negated <$> envelopeVMay v a1 mv2 = envelopeVMay (negated v) a2 instance (Metric v, OrderedField n) => Juxtaposable (Envelope v n) where juxtapose = juxtaposeDefault instance (Enveloped a, HasOrigin a, Enveloped b, HasOrigin b, V a ~ V b, N a ~ N b) => Juxtaposable (a,b) where juxtapose = juxtaposeDefault instance (Enveloped b, HasOrigin b) => Juxtaposable [b] where juxtapose = juxtaposeDefault instance (Enveloped b, HasOrigin b) => Juxtaposable (M.Map k b) where juxtapose = juxtaposeDefault instance (Enveloped b, HasOrigin b, Ord b) => Juxtaposable (S.Set b) where juxtapose = juxtaposeDefault instance Juxtaposable a => Juxtaposable (b -> a) where juxtapose v f1 f2 b = juxtapose v (f1 b) (f2 b) instance Juxtaposable a => Juxtaposable (Measured n a) where juxtapose v = liftA2 (juxtapose v) diagrams-core-1.5.1.1/src/Diagrams/Core/Measure.hs0000644000000000000000000000746107346545000017736 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- for Data.Semigroup import, which becomes redundant under GHC 8.4 module Diagrams.Core.Measure ( Measured (..) , Measure , fromMeasured , output , local , global , normalized , normalised , scaleLocal , atLeast , atMost ) where import Control.Applicative import Control.Lens import qualified Control.Monad.Reader as R import Data.Distributive import Data.Functor.Rep import Data.Semigroup import Data.Typeable import Diagrams.Core.V import Linear.Vector -- | 'Measured n a' is an object that depends on 'local', 'normalized' -- and 'global' scales. The 'normalized' and 'global' scales are -- calculated when rendering a diagram. -- -- For attributes, the 'local' scale gets multiplied by the average -- scale of the transform. newtype Measured n a = Measured { unmeasure :: (n,n,n) -> a } deriving (Typeable, Functor, Applicative, Monad, Additive, R.MonadReader (n,n,n)) -- (local, global, normalized) -> output type instance V (Measured n a) = V a type instance N (Measured n a) = N a -- | A measure is a 'Measured' number. type Measure n = Measured n n -- | @fromMeasured globalScale normalizedScale measure -> a@ fromMeasured :: Num n => n -> n -> Measured n a -> a fromMeasured g n (Measured m) = m (1,g,n) -- | Output units don't change. output :: n -> Measure n output = pure -- | Local units are scaled by the average scale of a transform. local :: Num n => n -> Measure n local x = views _1 (*x) -- | Global units are scaled so that they are interpreted relative to -- the size of the final rendered diagram. global :: Num n => n -> Measure n global x = views _2 (*x) -- | Normalized units get scaled so that one normalized unit is the size of the -- final diagram. normalized :: Num n => n -> Measure n normalized x = views _3 (*x) -- | Just like 'normalized' but spelt properly. normalised :: Num n => n -> Measure n normalised x = views _3 (*x) -- | Scale the local units of a 'Measured' thing. scaleLocal :: Num n => n -> Measured n a -> Measured n a scaleLocal s = R.local (_1 *~ s) -- | Calculate the larger of two measures. atLeast :: Ord n => Measure n -> Measure n -> Measure n atLeast = liftA2 max -- | Calculate the smaller of two measures. atMost :: Ord n => Measure n -> Measure n -> Measure n atMost = liftA2 min instance Num a => Num (Measured n a) where (+) = (^+^) (-) = (^-^) (*) = liftA2 (*) fromInteger = pure . fromInteger abs = fmap abs signum = fmap signum instance Fractional a => Fractional (Measured n a) where (/) = liftA2 (/) recip = fmap recip fromRational = pure . fromRational instance Floating a => Floating (Measured n a) where pi = pure pi exp = fmap exp sqrt = fmap sqrt log = fmap log (**) = liftA2 (**) logBase = liftA2 logBase sin = fmap sin tan = fmap tan cos = fmap cos asin = fmap asin atan = fmap atan acos = fmap acos sinh = fmap sinh tanh = fmap tanh cosh = fmap cosh asinh = fmap asinh atanh = fmap atanh acosh = fmap acosh instance Semigroup a => Semigroup (Measured n a) where (<>) = liftA2 (<>) instance Monoid a => Monoid (Measured n a) where mempty = pure mempty instance Distributive (Measured n) where distribute a = Measured $ \x -> fmap (\(Measured m) -> m x) a instance Representable (Measured n) where type Rep (Measured n) = (n,n,n) tabulate = Measured index = unmeasure instance Profunctor Measured where lmap f (Measured m) = Measured $ \(l,g,n) -> m (f l, f g, f n) rmap f (Measured m) = Measured $ f . m diagrams-core-1.5.1.1/src/Diagrams/Core/Names.hs0000644000000000000000000001443307346545000017375 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- for Data.Semigroup import, which becomes redundant under GHC 8.4 ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Core.Names -- Copyright : (c) 2011-2015 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- This module defines a type of names which can be used for referring -- to subdiagrams, and related types. -- ----------------------------------------------------------------------------- module Diagrams.Core.Names (-- * Names -- ** Atomic names AName(..) , _AName -- ** Names , Name(..) , IsName(..) , (.>) , eachName -- ** Qualifiable , Qualifiable(..) ) where import Control.Lens hiding ((.>)) import qualified Data.Map as M import Data.Semigroup import qualified Data.Set as S import Data.Typeable import Diagrams.Core.Transform import Diagrams.Core.Measure ------------------------------------------------------------ -- Names ------------------------------------------------- ------------------------------------------------------------ -- | Class for those types which can be used as names. They must -- support 'Typeable' (to facilitate extracting them from -- existential wrappers), 'Ord' (for comparison and efficient -- storage) and 'Show'. -- -- To make an instance of 'IsName', you need not define any methods, -- just declare it. -- -- WARNING: it is not recommended to use -- @GeneralizedNewtypeDeriving@ in conjunction with @IsName@, since -- in that case the underlying type and the @newtype@ will be -- considered equivalent when comparing names. For example: -- -- @ -- newtype WordN = WordN Int deriving (Show, Ord, Eq, Typeable, IsName) -- @ -- -- is unlikely to work as intended, since @(1 :: Int)@ and @(WordN 1)@ -- will be considered equal as names. Instead, use -- -- @ -- newtype WordN = WordN Int deriving (Show, Ord, Eq, Typeable, IsName) -- instance IsName WordN -- @ class (Typeable a, Ord a, Show a) => IsName a where toName :: a -> Name toName = Name . (:[]) . AName instance IsName () instance IsName Bool instance IsName Char instance IsName Int instance IsName Float instance IsName Double instance IsName Integer instance IsName a => IsName [a] instance IsName a => IsName (Maybe a) instance (IsName a, IsName b) => IsName (a,b) instance (IsName a, IsName b, IsName c) => IsName (a,b,c) -- | Atomic names. @AName@ is just an existential wrapper around -- things which are 'Typeable', 'Ord' and 'Show'. data AName where AName :: (Typeable a, Ord a, Show a) => a -> AName deriving Typeable instance IsName AName where toName = Name . (:[]) instance Eq AName where AName a1 == AName a2 = case cast a2 of Nothing -> False Just a2' -> a1 == a2' instance Ord AName where AName a1 `compare` AName a2 = case cast a2 of Just a2' -> a1 `compare` a2' Nothing -> typeOf a1 `compare` typeOf a2 instance Show AName where showsPrec d (AName a) = showParen (d > 10) $ showString "AName " . showsPrec 11 a -- | Prism onto 'AName'. _AName :: (Typeable a, Ord a, Show a) => Prism' AName a _AName = prism' AName (\(AName a) -> cast a) -- | A (qualified) name is a (possibly empty) sequence of atomic names. newtype Name = Name [AName] deriving (Eq, Ord, Semigroup, Monoid, Typeable) instance Rewrapped Name Name instance Wrapped Name where type Unwrapped Name = [AName] _Wrapped' = iso (\(Name ns) -> ns) Name instance Each Name Name AName AName where each = _Wrapped . traversed {-# INLINE each #-} -- | Traversal over each name in a 'Name' that matches the target type. -- -- @ -- >>> toListOf eachName ('a' .> False .> 'b') :: String -- "ab" -- >>> 'a' .> True .> 'b' & eachName %~ not -- 'a' .> False .> 'b' -- @ -- -- Note that the type of the name is very important. -- -- @ -- >>> sumOf eachName ((1::Int) .> (2 :: Integer) .> (3 :: Int)) :: Int -- 4 -- >>> sumOf eachName ((1::Int) .> (2 :: Integer) .> (3 :: Int)) :: Integer -- 2 -- @ eachName :: (Typeable a, Ord a, Show a) => Traversal' Name a eachName = each . _AName instance Show Name where showsPrec d (Name xs) = case xs of [] -> showParen (d > 10) $ showString "toName []" [n] -> showParen (d > 10) $ showString "toName " . showsName 11 n (n:ns) -> showParen (d > 5) $ showsName 6 n . go ns where go (y:ys) = showString " .> " . showsName 6 y . go ys go _ = id where showsName dd (AName a) = showsPrec dd a instance IsName Name where toName = id -- | Convenient operator for writing qualified names with atomic -- components of different types. Instead of writing @toName a1 \<\> -- toName a2 \<\> toName a3@ you can just write @a1 .> a2 .> a3@. (.>) :: (IsName a1, IsName a2) => a1 -> a2 -> Name a1 .> a2 = toName a1 <> toName a2 -- | Instances of 'Qualifiable' are things which can be qualified by -- prefixing them with a name. class Qualifiable q where -- | Qualify with the given name. (.>>) :: IsName a => a -> q -> q -- | Of course, names can be qualified using @(.>)@. instance Qualifiable Name where (.>>) = (.>) instance Qualifiable a => Qualifiable (TransInv a) where (.>>) n = over (_Unwrapping' TransInv) (n .>>) instance (Qualifiable a, Qualifiable b) => Qualifiable (a,b) where n .>> (a,b) = (n .>> a, n .>> b) instance (Qualifiable a, Qualifiable b, Qualifiable c) => Qualifiable (a,b,c) where n .>> (a,b,c) = (n .>> a, n .>> b, n .>> c) instance Qualifiable a => Qualifiable [a] where n .>> as = map (n .>>) as instance (Ord a, Qualifiable a) => Qualifiable (S.Set a) where n .>> s = S.map (n .>>) s instance Qualifiable a => Qualifiable (M.Map k a) where n .>> m = fmap (n .>>) m instance Qualifiable a => Qualifiable (b -> a) where n .>> f = (n .>>) . f instance Qualifiable a => Qualifiable (Measured n a) where n .>> m = fmap (n .>>) m infixr 5 .>> infixr 5 .> diagrams-core-1.5.1.1/src/Diagrams/Core/Points.hs0000644000000000000000000000336607346545000017611 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Core.Points -- Copyright : (c) 2011 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- A type for /points/ (as distinct from vectors). -- ----------------------------------------------------------------------------- module Diagrams.Core.Points ( -- * Points Point(..), origin, (*.), relative, _Point , reflectThrough, mirror, relative2, relative3 ) where import Control.Lens (over) import Linear.Affine import Linear.Vector import Diagrams.Core.V type instance V (Point v n) = v type instance N (Point v n) = n -- | Reflect a point across the origin. mirror :: (Additive v, Num n) => Point v n -> Point v n mirror = reflectThrough origin -- | Scale a point by a scalar. Specialized version of '(*^)'. (*.) :: (Functor v, Num n) => n -> Point v n -> Point v n (*.) = (*^) -- | Apply a transformation relative to the given point. relative2 :: (Additive v, Num n) => Point v n -> (v n -> v n -> v n) -> Point v n -> Point v n -> Point v n relative2 p f x y = (p .+^) $ f (inj x) (inj y) where inj = (.-. p) -- | Apply a transformation relative to the given point. relative3 :: (Additive v, Num n) => Point v n -> (v n -> v n -> v n -> v n) -> Point v n -> Point v n -> Point v n -> Point v n relative3 p f x y z = (p .+^) $ f (inj x) (inj y) (inj z) where inj = (.-. p) -- | Mirror a point through a given point. reflectThrough :: (Additive v, Num n) => Point v n -> Point v n -> Point v n reflectThrough o = over (relative o) negated diagrams-core-1.5.1.1/src/Diagrams/Core/Query.hs0000644000000000000000000000652107346545000017436 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Core.Query -- Copyright : (c) 2011-2015 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- The @Query@ module defines a type for \"queries\" on diagrams, which -- are functions from points in a vector space to some monoid. -- ----------------------------------------------------------------------------- module Diagrams.Core.Query ( Query (..) ) where import Control.Applicative import Control.Lens import Data.Semigroup import Data.Distributive import Data.Functor.Rep import Data.Profunctor import Data.Profunctor.Sieve import Data.Profunctor.Closed import qualified Data.Profunctor.Rep as P import Linear.Affine import Linear.Vector import Diagrams.Core.HasOrigin import Diagrams.Core.Transform import Diagrams.Core.V ------------------------------------------------------------------------ -- Queries ------------------------------------------------------------------------ -- | A query is a function that maps points in a vector space to -- values in some monoid. Queries naturally form a monoid, with -- two queries being combined pointwise. -- -- The idea for annotating diagrams with monoidal queries came from -- the graphics-drawingcombinators package, -- . newtype Query v n m = Query { runQuery :: Point v n -> m } deriving (Functor, Applicative, Monad, Semigroup, Monoid) instance Distributive (Query v n) where distribute a = Query $ \p -> fmap (\(Query q) -> q p) a instance Representable (Query v n) where type Rep (Query v n) = Point v n tabulate = Query index = runQuery instance Functor v => Profunctor (Query v) where lmap f (Query q) = Query $ \p -> q (fmap f p) rmap = fmap instance Functor v => Cosieve (Query v) (Point v) where cosieve = runQuery instance Functor v => Closed (Query v) where closed (Query fab) = Query $ \fxa x -> fab (fmap ($ x) fxa) instance Functor v => Costrong (Query v) where unfirst (Query f) = Query f' where f' fa = b where (b, d) = f ((\a -> (a, d)) <$> fa) unsecond (Query f) = Query f' where f' fa = b where (d, b) = f ((,) d <$> fa) instance Functor v => P.Corepresentable (Query v) where type Corep (Query v) = Point v cotabulate = Query -- | Setter over the input point of a query. queryPoint :: Setter (Query v' n' m) (Query v n m) (Point v n) (Point v' n') queryPoint = sets $ \f (Query q) -> Query $ q . f instance Wrapped (Query v n m) where type Unwrapped (Query v n m) = Point v n -> m _Wrapped' = iso runQuery Query instance Rewrapped (Query v a m) (Query v' a' m') type instance V (Query v n m) = v type instance N (Query v n m) = n instance (Additive v, Num n) => HasOrigin (Query v n m) where moveOriginTo (P u) = queryPoint %~ (.+^ u) instance (Additive v, Num n) => Transformable (Query v n m) where transform t = queryPoint %~ papply (inv t) diagrams-core-1.5.1.1/src/Diagrams/Core/Style.hs0000644000000000000000000003346107346545000017434 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Core.Style -- Copyright : (c) 2011-2015 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- A definition of /styles/ for diagrams as extensible, heterogeneous -- collections of attributes. -- ----------------------------------------------------------------------------- module Diagrams.Core.Style ( -- * Attributes -- $attr AttributeClass , Attribute(..) -- ** Attributes prisms , _Attribute , _MAttribute , _TAttribute -- ** Attributes utilities , unwrapAttribute , unmeasureAttribute , attributeType -- * Styles -- $style , Style(..) -- ** Making styles , attributeToStyle -- ** Extracting attibutes from styles , getAttr , unmeasureAttrs -- ** Attibute lenses , atAttr , atMAttr , atTAttr -- ** Applying styles , applyAttr , applyMAttr , applyTAttr , HasStyle(..) ) where import Control.Applicative import Control.Arrow ((***)) import Control.Lens hiding (transform) import qualified Data.HashMap.Strict as HM import Data.Kind (Type) import qualified Data.Map as M import Data.Monoid.Action as A import Data.Semigroup import qualified Data.Set as S import Data.Typeable import Diagrams.Core.Measure import Diagrams.Core.Transform import Diagrams.Core.V import Linear.Vector ------------------------------------------------------------ -- Attributes -------------------------------------------- ------------------------------------------------------------ -- $attr -- An /attribute/ is anything that determines some aspect of a -- diagram's rendering. The standard diagrams library defines several -- standard attributes (line color, line width, fill color, etc.) but -- additional attributes may easily be created. Additionally, a given -- backend need not handle (or even know about) attributes used in -- diagrams it renders. -- -- The attribute code is inspired by xmonad's @Message@ type, which -- was in turn based on ideas in: -- -- Simon Marlow. -- /An Extensible Dynamically-Typed Hierarchy of Exceptions/. -- Proceedings of the 2006 ACM SIGPLAN workshop on -- Haskell. . -- | Every attribute must be an instance of @AttributeClass@, which -- simply guarantees 'Typeable' and 'Semigroup' constraints. The -- 'Semigroup' instance for an attribute determines how it will combine -- with other attributes of the same type. class (Typeable a, Semigroup a) => AttributeClass a -- | An existential wrapper type to hold attributes. Some attributes -- are simply inert/static; some are affected by transformations; -- and some are affected by transformations and can be modified -- generically. data Attribute (v :: Type -> Type) n :: Type where Attribute :: AttributeClass a => a -> Attribute v n MAttribute :: AttributeClass a => Measured n a -> Attribute v n TAttribute :: (AttributeClass a, Transformable a, V a ~ v, N a ~ n) => a -> Attribute v n type instance V (Attribute v n) = v type instance N (Attribute v n) = n -- | Attributes form a semigroup, where the semigroup operation simply -- returns the right-hand attribute when the types do not match, and -- otherwise uses the semigroup operation specific to the (matching) -- types. instance Typeable n => Semigroup (Attribute v n) where (Attribute a1) <> (preview _Attribute -> Just a2) = Attribute (a1 <> a2) (MAttribute a1) <> (preview _MAttribute -> Just a2) = MAttribute (a1 <> a2) (TAttribute a1) <> (preview _TAttribute -> Just a2) = TAttribute (a1 <> a2) _ <> a2 = a2 -- | 'TAttribute's are transformed directly, 'MAttribute's have their -- local scale multiplied by the average scale of the transform. -- Plain 'Attribute's are unaffected. instance (Additive v, Traversable v, Floating n) => Transformable (Attribute v n) where transform _ (Attribute a) = Attribute a transform t (MAttribute a) = MAttribute $ scaleLocal (avgScale t) a transform t (TAttribute a) = TAttribute $ transform t a -- | Shows the kind of attribute and the type contained in the -- attribute. instance Show (Attribute v n) where showsPrec d attr = showParen (d > 10) $ case attr of Attribute a -> showString "Attribute " . showsPrec 11 (typeOf a) MAttribute a -> showString "MAttribute " . showsPrec 11 (mType a) TAttribute a -> showString "TAttribute " . showsPrec 11 (typeOf a) -- | Unwrap an unknown 'Attribute' type, performing a dynamic (but -- safe) check on the type of the result. If the required type -- matches the type of the attribute, the attribute value is -- returned wrapped in @Just@; if the types do not match, @Nothing@ -- is returned. -- -- Measured attributes cannot be extrated from this function until -- they have been unmeasured with 'unmeasureAttribute'. If you want a -- measured attibute use the '_MAttribute' prism. unwrapAttribute :: AttributeClass a => Attribute v n -> Maybe a unwrapAttribute (Attribute a) = cast a unwrapAttribute (MAttribute _) = Nothing unwrapAttribute (TAttribute a) = cast a {-# INLINE unwrapAttribute #-} -- | Prism onto an 'Attribute'. _Attribute :: AttributeClass a => Prism' (Attribute v n) a _Attribute = prism' Attribute $ \t -> case t of Attribute a -> cast a; _ -> Nothing {-# INLINE _Attribute #-} -- | Prism onto an 'MAttribute'. _MAttribute :: (AttributeClass a, Typeable n) => Prism' (Attribute v n) (Measured n a) _MAttribute = prism' MAttribute $ \t -> case t of MAttribute a -> cast a; _ -> Nothing {-# INLINE _MAttribute #-} -- | Prism onto a 'TAttribute'. _TAttribute :: (V a ~ v, N a ~ n, AttributeClass a, Transformable a) => Prism' (Attribute v n) a _TAttribute = prism' TAttribute $ \t -> case t of TAttribute a -> cast a; _ -> Nothing {-# INLINE _TAttribute #-} -- | Turn an 'MAttribute' into an 'Attribute' using the given 'global' -- and 'normalized' scale. unmeasureAttribute :: (Num n) => n -> n -> Attribute v n -> Attribute v n unmeasureAttribute g n (MAttribute m) = Attribute (fromMeasured g n m) unmeasureAttribute _ _ a = a -- | Type of an attribute that is stored with a style. Measured -- attributes return the type as if it where unmeasured. attributeType :: Attribute v n -> TypeRep attributeType (Attribute a) = typeOf a attributeType (MAttribute a) = mType a attributeType (TAttribute a) = typeOf a -- Note that we use type 'a' not 'Measured n a' so we don't have to rebuild -- when unmeasuring the attributes. mType :: forall n a. Typeable a => Measured n a -> TypeRep mType _ = typeOf (undefined :: a) -- naming convention: "Attribute" deals with the 'AttibuteType' -- directly and "Attr" is for other things (like styles). Users should -- rarely (if at all) deal with the 'Attibute' type directly. ------------------------------------------------------------ -- Styles ------------------------------------------------ ------------------------------------------------------------ -- $style -- A 'Style' is a heterogeneous collection of attributes, containing -- at most one attribute of any given type. This is also based on -- ideas stolen from xmonad, specifically xmonad's implementation of -- user-extensible state. -- | A @Style@ is a heterogeneous collection of attributes, containing -- at most one attribute of any given type. newtype Style v n = Style (HM.HashMap TypeRep (Attribute v n)) -- instances ----------------------------------------------------------- type instance V (Style v n) = v type instance N (Style v n) = n instance Rewrapped (Style v n) (Style v' n') instance Wrapped (Style v n) where type Unwrapped (Style v n) = HM.HashMap TypeRep (Attribute v n) _Wrapped' = iso (\(Style m) -> m) Style {-# INLINE _Wrapped' #-} instance Each (Style v n) (Style v' n') (Attribute v n) (Attribute v' n') where each = _Wrapped . each {-# INLINE each #-} type instance Index (Style v n) = TypeRep type instance IxValue (Style v n) = Attribute v n instance Ixed (Style v n) where ix k = _Wrapped' . ix k {-# INLINE ix #-} instance At (Style v n) where at k = _Wrapped' . at k {-# INLINE at #-} -- | Combine a style by combining the attributes; if the two styles have -- attributes of the same type they are combined according to their -- semigroup structure. instance Typeable n => Semigroup (Style v n) where Style s1 <> Style s2 = Style $ HM.unionWith (<>) s1 s2 -- | The empty style contains no attributes. instance Typeable n => Monoid (Style v n) where mempty = Style HM.empty mappend = (<>) instance (Additive v, Traversable v, Floating n) => Transformable (Style v n) where transform t = over each (transform t) -- | Styles have no action on other monoids. instance A.Action (Style v n) m -- | Show the attributes in the style. instance Show (Style v n) where showsPrec d sty = showParen (d > 10) $ showString "Style " . showsPrec d (sty ^.. each) -- making styles ------------------------------------------------------- -- | Turn an attribute into a style. An easier way to make a style is to -- use the monoid instance and apply library functions for applying -- that attribute: -- -- @ -- myStyle = mempty # fc blue :: Style V2 Double -- @ attributeToStyle :: Attribute v n -> Style v n attributeToStyle a = Style $ HM.singleton (attributeType a) a -- extracting attributes ----------------------------------------------- -- | Extract an attribute from a style of a particular type. If the -- style contains an attribute of the requested type, it will be -- returned wrapped in @Just@; otherwise, @Nothing@ is returned. -- -- Trying to extract a measured attibute will fail. It either has to -- be unmeasured with 'unmeasureAttrs' or use the 'atMAttr' lens. getAttr :: forall a v n. AttributeClass a => Style v n -> Maybe a getAttr (Style s) = HM.lookup ty s >>= unwrapAttribute where ty = typeOf (undefined :: a) -- unwrapAttribute can fail if someone tries to unwrap a measured -- attribute before it gets "unmeasured" -- | Replace all 'MAttribute's with 'Attribute's using the 'global' and -- 'normalized' scales. unmeasureAttrs :: (Num n) => n -> n -> Style v n -> Style v n unmeasureAttrs g n = over each (unmeasureAttribute g n) -- style lenses -------------------------------------------------------- mkAttrLens :: forall v n a. Typeable a => (a -> TypeRep) -> Prism' (Attribute v n) a -> Lens' (Style v n) (Maybe a) mkAttrLens tyF p f sty = f (sty ^? ix ty . p) <&> \mAtt -> sty & at ty .~ (review p <$> mAtt) where ty = tyF (undefined :: a) {-# INLINE mkAttrLens #-} -- | Lens onto a plain attribute of a style. atAttr :: AttributeClass a => Lens' (Style v n) (Maybe a) atAttr = mkAttrLens typeOf _Attribute {-# INLINE atAttr #-} -- | Lens onto a measured attribute of a style. atMAttr :: (AttributeClass a, Typeable n) => Lens' (Style v n) (Maybe (Measured n a)) atMAttr = mkAttrLens mType _MAttribute {-# INLINE atMAttr #-} -- | Lens onto a transformable attribute of a style. atTAttr :: (V a ~ v, N a ~ n, AttributeClass a, Transformable a) => Lens' (Style v n) (Maybe a) atTAttr = mkAttrLens typeOf _TAttribute {-# INLINE atTAttr #-} -- applying styles ----------------------------------------------------- -- | Type class for things which have a style. class HasStyle a where -- | /Apply/ a style by combining it (on the left) with the -- existing style. applyStyle :: Style (V a) (N a) -> a -> a instance Typeable n => HasStyle (Style v n) where applyStyle = mappend instance (HasStyle a, HasStyle b, V a ~ V b, N a ~ N b) => HasStyle (a,b) where applyStyle s = applyStyle s *** applyStyle s instance HasStyle a => HasStyle [a] where applyStyle = fmap . applyStyle instance HasStyle b => HasStyle (a -> b) where applyStyle = fmap . applyStyle instance HasStyle a => HasStyle (M.Map k a) where applyStyle = fmap . applyStyle instance (HasStyle a, Ord a) => HasStyle (S.Set a) where applyStyle = S.map . applyStyle instance HasStyle b => HasStyle (Measured n b) where applyStyle = fmap . applyStyle -- | Apply an attribute to an instance of 'HasStyle' (such as a -- diagram or a style). If the object already has an attribute of -- the same type, the new attribute is combined on the left with the -- existing attribute, according to their semigroup structure. applyAttr :: (AttributeClass a, HasStyle d) => a -> d -> d applyAttr = applyStyle . attributeToStyle . Attribute -- | Apply a measured attribute to an instance of 'HasStyle' (such as a -- diagram or a style). If the object already has an attribute of -- the same type, the new attribute is combined on the left with the -- existing attribute, according to their semigroup structure. applyMAttr :: (AttributeClass a, N d ~ n, HasStyle d) => Measured n a -> d -> d applyMAttr = applyStyle . attributeToStyle . MAttribute -- | Apply a transformable attribute to an instance of 'HasStyle' -- (such as a diagram or a style). If the object already has an -- attribute of the same type, the new attribute is combined on the -- left with the existing attribute, according to their semigroup -- structure. applyTAttr :: (AttributeClass a, Transformable a, V a ~ V d, N a ~ N d, HasStyle d) => a -> d -> d applyTAttr = applyStyle . attributeToStyle . TAttribute diagrams-core-1.5.1.1/src/Diagrams/Core/Trace.hs0000644000000000000000000004044307346545000017370 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- for Data.Semigroup import, which becomes redundant under GHC 8.4 ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Core.Trace -- Copyright : (c) 2012-2015 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- @diagrams-core@ defines the core library of primitives -- forming the basis of an embedded domain-specific language for -- describing and rendering diagrams. -- -- The @Trace@ module defines a data type and type class for -- \"traces\", aka functional boundaries, essentially corresponding to -- embedding a raytracer with each diagram. -- ----------------------------------------------------------------------------- module Diagrams.Core.Trace ( -- * SortedList SortedList , mkSortedList, getSortedList, onSortedList, unsafeOnSortedList -- * Traces , Trace(Trace) , appTrace , mkTrace -- * Traced class , Traced(..) -- * Computing with traces , traceV, traceP , maxTraceV, maxTraceP , getRayTrace , rayTraceV, rayTraceP , maxRayTraceV, maxRayTraceP ) where #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif import Control.Lens import Data.List (sort) import qualified Data.Map as M import Data.Semigroup import qualified Data.Set as S import Diagrams.Core.HasOrigin import Diagrams.Core.Transform import Diagrams.Core.V import Linear.Affine import Linear.Vector ------------------------------------------------------------ -- SortedList -------------------------------------------- ------------------------------------------------------------ -- Traces return sorted lists of intersections, so we define a newtype -- wrapper to represent sorted lists. -- | A newtype wrapper around a list which maintains the invariant -- that the list is sorted. The constructor is not exported; use -- the smart constructor 'mkSortedList' (which sorts the given list) -- instead. newtype SortedList a = SortedList [a] -- | A smart constructor for the 'SortedList' type, which sorts the -- input to ensure the 'SortedList' invariant. mkSortedList :: Ord a => [a] -> SortedList a mkSortedList = SortedList . sort -- | Project the (guaranteed sorted) list out of a 'SortedList' -- wrapper. getSortedList :: SortedList a -> [a] getSortedList (SortedList as) = as -- | Apply a list function to a 'SortedList'. The function need not -- result in a sorted list; the result will be sorted before being -- rewrapped as a 'SortedList'. onSortedList :: Ord b => ([a] -> [b]) -> SortedList a -> SortedList b onSortedList f = unsafeOnSortedList (sort . f) -- | Apply an /order-preserving/ list function to a 'SortedList'. No -- sorts or checks are done. unsafeOnSortedList :: ([a] -> [b]) -> SortedList a -> SortedList b unsafeOnSortedList f (SortedList as) = SortedList (f as) -- | Merge two sorted lists. The result is the sorted list containing -- all the elements of both input lists (with duplicates). merge :: Ord a => SortedList a -> SortedList a -> SortedList a merge (SortedList as) (SortedList bs) = SortedList (merge' as bs) where merge' xs [] = xs merge' [] ys = ys merge' (x:xs) (y:ys) = if x <= y then x : merge' xs (y:ys) else y : merge' (x:xs) ys -- | 'SortedList' forms a semigroup with 'merge' as composition. instance Ord a => Semigroup (SortedList a) where (<>) = merge -- | 'SortedList' forms a monoid with 'merge' and the empty list. instance Ord a => Monoid (SortedList a) where mappend = (<>) mempty = SortedList [] ------------------------------------------------------------ -- Trace ------------------------------------------------- ------------------------------------------------------------ -- > traceEx = mkTraceDia def -- | Every diagram comes equipped with a /trace/. Intuitively, the -- trace for a diagram is like a raytracer: given a line -- (represented as a base point and a direction vector), the trace -- computes a sorted list of signed distances from the base point to -- all intersections of the line with the boundary of the -- diagram. -- -- Note that the outputs are not absolute distances, but multipliers -- relative to the input vector. That is, if the base point is @p@ -- and direction vector is @v@, and one of the output scalars is -- @s@, then there is an intersection at the point @p .+^ (s *^ v)@. -- -- <> newtype Trace v n = Trace { appTrace :: Point v n -> v n -> SortedList n } instance Wrapped (Trace v n) where type Unwrapped (Trace v n) = Point v n -> v n -> SortedList n _Wrapped' = iso appTrace Trace instance Rewrapped (Trace v n) (Trace v' n') mkTrace :: (Point v n -> v n -> SortedList n) -> Trace v n mkTrace = Trace -- | Traces form a semigroup with pointwise minimum as composition. -- Hence, if @t1@ is the trace for diagram @d1@, and -- @e2@ is the trace for @d2@, then @e1 \`mappend\` e2@ -- is the trace for @d1 \`atop\` d2@. deriving instance (Ord n) => Semigroup (Trace v n) deriving instance (Ord n) => Monoid (Trace v n) type instance V (Trace v n) = v type instance N (Trace v n) = n instance (Additive v, Num n) => HasOrigin (Trace v n) where moveOriginTo (P u) = _Wrapping' Trace %~ \f p -> f (p .+^ u) instance Show (Trace v n) where show _ = "" ------------------------------------------------------------ -- Transforming traces ----------------------------------- ------------------------------------------------------------ instance (Additive v, Num n) => Transformable (Trace v n) where transform t = _Wrapped %~ \f p v -> f (papply (inv t) p) (apply (inv t) v) ------------------------------------------------------------ -- Traced class ------------------------------------------ ------------------------------------------------------------ -- | @Traced@ abstracts over things which have a trace. class (Additive (V a), Ord (N a)) => Traced a where -- | Compute the trace of an object. getTrace :: a -> Trace (V a) (N a) instance (Additive v, Ord n) => Traced (Trace v n) where getTrace = id -- | The trace of a single point is the empty trace, /i.e./ the one -- which returns no intersection points for every query. Arguably -- it should return a single finite distance for vectors aimed -- directly at the given point, but due to floating-point inaccuracy -- this is problematic. Note that the envelope for a single point -- is /not/ the empty envelope (see "Diagrams.Core.Envelope"). instance (Additive v, Ord n) => Traced (Point v n) where getTrace = const mempty instance Traced t => Traced (TransInv t) where getTrace = getTrace . op TransInv instance (Traced a, Traced b, SameSpace a b) => Traced (a,b) where getTrace (x,y) = getTrace x <> getTrace y instance (Traced b) => Traced [b] where getTrace = mconcat . map getTrace instance (Traced b) => Traced (M.Map k b) where getTrace = mconcat . map getTrace . M.elems instance (Traced b) => Traced (S.Set b) where getTrace = mconcat . map getTrace . S.elems ------------------------------------------------------------ -- Computing with traces --------------------------------- ------------------------------------------------------------ -- | Compute the vector from the given point @p@ to the \"smallest\" -- boundary intersection along the given vector @v@. The -- \"smallest\" boundary intersection is defined as the one given by -- @p .+^ (s *^ v)@ for the smallest (most negative) value of -- @s@. Return @Nothing@ if there is no intersection. See also -- 'traceP'. -- -- See also 'rayTraceV' which uses the smallest /positive/ -- intersection, which is often more intuitive behavior. -- -- <> traceV :: (n ~ N a, Num n, Traced a) => Point (V a) n -> V a n -> a -> Maybe (V a n) traceV p v a = case getSortedList $ op Trace (getTrace a) p v of (s:_) -> Just (s *^ v) [] -> Nothing -- > traceVEx = mkTraceDiasABC def { drawV = True, sFilter = take 1 } -- | Compute the \"smallest\" boundary point along the line determined -- by the given point @p@ and vector @v@. The \"smallest\" boundary -- point is defined as the one given by @p .+^ (s *^ v)@ for -- the smallest (most negative) value of @s@. Return @Nothing@ if -- there is no such boundary point. See also 'traceV'. -- -- See also 'rayTraceP' which uses the smallest /positive/ -- intersection, which is often more intuitive behavior. -- -- <> traceP :: (n ~ N a, Traced a, Num n) => Point (V a) n -> V a n -> a -> Maybe (Point (V a) n) traceP p v a = (p .+^) <$> traceV p v a -- > tracePEx = mkTraceDiasABC def { sFilter = take 1 } -- | Like 'traceV', but computes a vector to the \"largest\" boundary -- point instead of the smallest. (Note, however, the \"largest\" -- boundary point may still be in the opposite direction from the -- given vector, if all the boundary points are, as in the third -- example shown below.) -- -- <> maxTraceV :: (n ~ N a, Num n, Traced a) => Point (V a) n -> V a n -> a -> Maybe (V a n) maxTraceV p = traceV p . negated -- > maxTraceVEx = mkTraceDiasABC def { drawV = True, sFilter = dropAllBut1 } -- | Like 'traceP', but computes the \"largest\" boundary point -- instead of the smallest. (Note, however, the \"largest\" boundary -- point may still be in the opposite direction from the given -- vector, if all the boundary points are.) -- -- <> maxTraceP :: (n ~ N a, Num n, Traced a) => Point (V a) n -> V a n -> a -> Maybe (Point (V a) n) maxTraceP p v a = (p .+^) <$> maxTraceV p v a -- > maxTracePEx = mkTraceDiasABC def { sFilter = dropAllBut1 } -- | Get a modified 'Trace' for an object which only returns positive -- boundary points, /i.e./ those boundary points given by a positive -- scalar multiple of the direction vector. Note, this property -- will be destroyed if the resulting 'Trace' is translated at all. getRayTrace :: (n ~ N a, Traced a, Num n) => a -> Trace (V a) n getRayTrace a = Trace $ \p v -> unsafeOnSortedList (dropWhile (<0)) $ appTrace (getTrace a) p v -- | Compute the vector from the given point to the closest boundary -- point of the given object in the given direction, or @Nothing@ if -- there is no such boundary point (as in the third example -- below). Note that unlike 'traceV', only /positive/ boundary -- points are considered, /i.e./ boundary points corresponding to a -- positive scalar multiple of the direction vector. This is -- intuitively the \"usual\" behavior of a raytracer, which only -- considers intersections \"in front of\" the camera. Compare the -- second example diagram below with the second example shown for -- 'traceV'. -- -- <> rayTraceV :: (n ~ N a, Traced a, Num n) => Point (V a) n -> V a n -> a -> Maybe (V a n) rayTraceV p v a = case getSortedList $ op Trace (getRayTrace a) p v of (s:_) -> Just (s *^ v) [] -> Nothing -- > rayTraceVEx = mkTraceDiasABC def { drawV = True, sFilter = take 1 . filter (>0) } -- | Compute the boundary point on an object which is closest to the -- given base point in the given direction, or @Nothing@ if there is -- no such boundary point. Note that unlike 'traceP', only /positive/ -- boundary points are considered, /i.e./ boundary points -- corresponding to a positive scalar multiple of the direction -- vector. This is intuitively the \"usual\" behavior of a raytracer, -- which only considers intersection points \"in front of\" the -- camera. -- -- <> rayTraceP :: (n ~ N a, Traced a, Num n) => Point (V a) n -> V a n -> a -> Maybe (Point (V a) n) rayTraceP p v a = (p .+^) <$> rayTraceV p v a -- > rayTracePEx = mkTraceDiasABC def { sFilter = take 1 . filter (>0) } -- | Like 'rayTraceV', but computes a vector to the \"largest\" -- boundary point instead of the smallest. Considers only -- /positive/ boundary points. -- -- <> maxRayTraceV :: (n ~ N a, Traced a, Num n) => Point (V a) n -> V a n -> a -> Maybe (V a n) maxRayTraceV p v a = case getSortedList $ op Trace (getRayTrace a) p v of [] -> Nothing xs -> Just (last xs *^ v) -- > maxRayTraceVEx = mkTraceDiasABC def { drawV = True, sFilter = dropAllBut1 . filter (>0) } -- | Like 'rayTraceP', but computes the \"largest\" boundary point -- instead of the smallest. Considers only /positive/ boundary -- points. -- -- <> maxRayTraceP :: (n ~ N a, Traced a, Num n) => Point (V a) n -> V a n -> a -> Maybe (Point (V a) n) maxRayTraceP p v a = (p .+^) <$> maxRayTraceV p v a -- > maxRayTracePEx = mkTraceDiasABC def { sFilter = dropAllBut1 . filter (>0) } ------------------------------------------------------------ -- Drawing trace diagrams ------------------------------------------------------------ -- > import Data.Default.Class -- > import Control.Lens ((^.)) -- > import Data.Maybe (fromMaybe) -- > -- > thingyT :: Trail V2 Double -- > thingyT = -- > fromOffsets -- > [ 3 *^ unitX, 3 *^ unitY, 2 *^ unit_X, 1 *^ unit_Y -- > , 1 *^ unitX, 1 *^ unit_Y, 2 *^ unit_X, 1 *^ unit_Y ] -- > -- > thingy = strokeTrail thingyT -- > -- > data TraceDiaOpts -- > = TDO { traceShape :: Diagram B -- > , basePt :: P2 Double -- > , dirV :: V2 Double -- > , sFilter :: [Double] -> [Double] -- > , drawV :: Bool -- > } -- > -- > instance Default TraceDiaOpts where -- > def = TDO { traceShape = thingy -- > , basePt = pointB -- > , dirV = 0.3 ^& 0.5 -- > , sFilter = id -- > , drawV = False -- > } -- > -- > pointA = 1 ^& (-1.5) -- > pointB = 1 ^& 1.2 -- > pointC = 2.5 ^& 3.5 -- > -- > dot' = circle 0.05 # lw none -- > -- > mkTraceDia :: TraceDiaOpts -> Diagram B -- > mkTraceDia tdo = mconcat -- > [ mconcat $ map (place (dot' # fc red)) pts -- > , if drawV tdo then resultArrow else mempty -- > , arrowAt (basePt tdo) (dirV tdo) # lc blue -- > , dot' # fc blue # moveTo (basePt tdo) -- > , traceLine (basePt tdo) maxPosPt -- > , traceLine (basePt tdo) minNegPt -- > , traceShape tdo -- > ] -- > # centerXY # pad 1.1 -- > where -- > ss = sFilter tdo . getSortedList -- > $ appTrace (traceShape tdo ^. trace) (basePt tdo) (dirV tdo) -- > pts = map mkPt ss -- > mkPt s = basePt tdo .+^ (s *^ dirV tdo) -- > maxPosPt = (mkPt <$>) . safeLast $ filter (>0) ss -- > minNegPt = (mkPt <$>) . safeHead $ filter (<0) ss -- > minPt = (mkPt <$>) . safeHead $ ss -- > resultArrow = fromMaybe mempty (arrowBetween (basePt tdo) <$> minPt) -- > # lc green -- > -- > safeLast [] = Nothing -- > safeLast xs = Just $ last xs -- > safeHead [] = Nothing -- > safeHead (x:_) = Just x -- > dropAllBut1 [] = [] -- > dropAllBut1 xs = [last xs] -- > -- > traceLine _ Nothing = mempty -- > traceLine p (Just q) = (p ~~ q) # dashingG [0.1,0.1] 0 -- > -- > mkTraceDias :: [TraceDiaOpts] -> Diagram B -- > mkTraceDias = hcat' (with & sep .~ 1) . map mkTraceDia -- > -- > mkTraceDiasABC :: TraceDiaOpts -> Diagram B -- > mkTraceDiasABC tdo = mkTraceDias (map (\p -> tdo { basePt = p }) [pointA, pointB, pointC]) diagrams-core-1.5.1.1/src/Diagrams/Core/Transform.hs0000644000000000000000000003603407346545000020306 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- | -- Module : Diagrams.Core.Transform -- Copyright : (c) 2011-2015 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- "Diagrams" defines the core library of primitives -- forming the basis of an embedded domain-specific language for -- describing and rendering diagrams. -- -- The @Transform@ module defines generic transformations -- parameterized by any vector space. -- ----------------------------------------------------------------------------- module Diagrams.Core.Transform ( -- * Transformations -- ** Invertible linear transformations (:-:)(..), (<->), linv, lapp -- ** General transformations , Transformation(..) , inv, transp, transl , dropTransl , apply , papply , fromLinear , fromOrthogonal , fromSymmetric , basis , dimension , onBasis , listRep , matrixRep , matrixHomRep , determinant , isReflection , avgScale , eye -- * The Transformable class , HasLinearMap , HasBasis , Transformable(..) -- * Translational invariance , TransInv(TransInv) -- * Vector space independent transformations -- | Most transformations are specific to a particular vector -- space, but a few can be defined generically over any -- vector space. , translation, translate , scaling, scale ) where import Control.Lens (Rewrapped, Traversable, Wrapped (..), iso, (&), (.~)) import qualified Data.Map as M import Data.Semigroup import qualified Data.Set as S import Data.Monoid.Action import Data.Monoid.Deletable import Linear.Affine import Linear.Vector import Data.Foldable (Foldable, toList) import Data.Functor.Rep import Diagrams.Core.HasOrigin import Diagrams.Core.Measure import Diagrams.Core.Points () import Diagrams.Core.V ------------------------------------------------------------ -- Transformations --------------------------------------- ------------------------------------------------------------ ------------------------------------------------------- -- Invertible linear transformations ---------------- ------------------------------------------------------- -- | @(v1 :-: v2)@ is a linear map paired with its inverse. data (:-:) u v = (u -> v) :-: (v -> u) infixr 7 :-: -- | Create an invertible linear map from two functions which are -- assumed to be linear inverses. (<->) :: (u -> v) -> (v -> u) -> (u :-: v) f <-> g = f :-: g instance Semigroup (a :-: a) where (f :-: f') <> (g :-: g') = f . g :-: g' . f' -- | Invertible linear maps from a vector space to itself form a -- monoid under composition. instance Monoid (v :-: v) where mempty = id :-: id mappend = (<>) -- | Invert a linear map. linv :: (u :-: v) -> (v :-: u) linv (f :-: g) = g :-: f -- | Apply a linear map to a vector. lapp :: (u :-: v) -> u -> v lapp (f :-: _) = f -------------------------------------------------- -- Affine transformations ---------------------- -------------------------------------------------- -- | General (affine) transformations, represented by an invertible -- linear map, its /transpose/, and a vector representing a -- translation component. -- -- By the /transpose/ of a linear map we mean simply the linear map -- corresponding to the transpose of the map's matrix -- representation. For example, any scale is its own transpose, -- since scales are represented by matrices with zeros everywhere -- except the diagonal. The transpose of a rotation is the same as -- its inverse. -- -- The reason we need to keep track of transposes is because it -- turns out that when transforming a shape according to some linear -- map L, the shape's /normal vectors/ transform according to L's -- inverse transpose. (For a more detailed explanation and proof, -- see .) -- This is exactly what we need when transforming bounding -- functions, which are defined in terms of /perpendicular/ -- (i.e. normal) hyperplanes. -- -- For more general, non-invertible transformations, see -- @Diagrams.Deform@ (in @diagrams-lib@). data Transformation v n = Transformation (v n :-: v n) (v n :-: v n) (v n) type instance V (Transformation v n) = v type instance N (Transformation v n) = n -- | Identity matrix. eye :: (HasBasis v, Num n) => v (v n) eye = tabulate $ \(E e) -> zero & e .~ 1 -- | Invert a transformation. inv :: (Functor v, Num n) => Transformation v n -> Transformation v n inv (Transformation t t' v) = Transformation (linv t) (linv t') (negated (lapp (linv t) v)) -- | Get the transpose of a transformation (ignoring the translation -- component). transp :: Transformation v n -> (v n :-: v n) transp (Transformation _ t' _) = t' -- | Get the translational component of a transformation. transl :: Transformation v n -> v n transl (Transformation _ _ v) = v -- | Drop the translational component of a transformation, leaving only -- the linear part. dropTransl :: (Additive v, Num n) => Transformation v n -> Transformation v n dropTransl (Transformation a a' _) = Transformation a a' zero -- | Transformations are closed under composition; @t1 <> t2@ is the -- transformation which performs first @t2@, then @t1@. instance (Additive v, Num n) => Semigroup (Transformation v n) where Transformation t1 t1' v1 <> Transformation t2 t2' v2 = Transformation (t1 <> t2) (t2' <> t1') (v1 ^+^ lapp t1 v2) instance (Additive v, Num n) => Monoid (Transformation v n) where mempty = Transformation mempty mempty zero mappend = (<>) -- | Transformations can act on transformable things. instance (Transformable a, V a ~ v, N a ~ n) => Action (Transformation v n) a where act = transform -- | Apply a transformation to a vector. Note that any translational -- component of the transformation will not affect the vector, since -- vectors are invariant under translation. apply :: Transformation v n -> v n -> v n apply (Transformation (t :-: _) _ _) = t -- | Apply a transformation to a point. papply :: (Additive v, Num n) => Transformation v n -> Point v n -> Point v n papply (Transformation t _ v) (P p) = P $ lapp t p ^+^ v -- | Create a general affine transformation from an invertible linear -- transformation and its transpose. The translational component is -- assumed to be zero. fromLinear :: (Additive v, Num n) => (v n :-: v n) -> (v n :-: v n) -> Transformation v n fromLinear l1 l2 = Transformation l1 l2 zero -- | An orthogonal linear map is one whose inverse is also its transpose. fromOrthogonal :: (Additive v, Num n) => (v n :-: v n) -> Transformation v n fromOrthogonal t = fromLinear t (linv t) -- | A symmetric linear map is one whose transpose is equal to its self. fromSymmetric :: (Additive v, Num n) => (v n :-: v n) -> Transformation v n fromSymmetric t = fromLinear t t -- | Get the dimension of an object whose vector space is an instance of -- @HasLinearMap@, e.g. transformations, paths, diagrams, etc. dimension :: forall a. (Additive (V a), Traversable (V a)) => a -> Int dimension _ = length (basis :: [V a Int]) -- | Get the matrix equivalent of the linear transform, -- (as a list of columns) and the translation vector. This -- is mostly useful for implementing backends. onBasis :: (Additive v, Traversable v, Num n) => Transformation v n -> ([v n], v n) onBasis (Transformation (f :-: _) _ t) = (map f basis, t) -- Remove the nth element from a list remove :: Int -> [a] -> [a] remove n xs = ys ++ zs where (ys, _ : zs) = splitAt n xs -- Minor matrix of cofactor C(i,j) minor :: Int -> Int -> [[a]] -> [[a]] minor i j xs = remove j $ map (remove i) xs -- The determinant of a square matrix represented as a list of lists -- representing column vectors, that is [column]. det :: Num a => [[a]] -> a det [a : _] = a det m@(c1 : _) = sum [(-1) ^ i * (c1 !! i) * det (minor i 0 m) | i <- [0 .. (n - 1)]] where n = length m -- | Convert a vector v to a list of scalars. listRep :: Foldable v => v n -> [n] listRep = toList -- | Convert the linear part of a `Transformation` to a matrix -- representation as a list of column vectors which are also lists. matrixRep :: (Additive v, Traversable v, Num n) => Transformation v n -> [[n]] matrixRep (Transformation (f :-: _) _ _) = map (toList . f) basis -- | Convert a `Transformation v` to a homogeneous matrix representation. -- The final list is the translation. -- The representation leaves off the last row of the matrix as it is -- always [0,0, ... 1] and this representation is the defacto standard -- for backends. matrixHomRep :: (Additive v, Traversable v, Num n) => Transformation v n -> [[n]] matrixHomRep t = mr ++ [toList tl] where mr = matrixRep t tl = transl t -- | The determinant of (the linear part of) a `Transformation`. determinant :: (Additive v, Traversable v, Num n) => Transformation v n -> n determinant = det . matrixRep -- | Determine whether a `Transformation` includes a reflection -- component, that is, whether it reverses orientation. isReflection :: (Additive v, Traversable v, Num n, Ord n) => Transformation v n -> Bool isReflection = (<0) . determinant -- | Compute the \"average\" amount of scaling performed by a -- transformation. Satisfies the properties -- -- @ -- avgScale (scaling k) == k -- avgScale (t1 <> t2) == avgScale t1 * avgScale t2 -- @ -- avgScale :: (Additive v, Traversable v, Floating n) => Transformation v n -> n avgScale t = (abs . determinant) t ** (recip . fromIntegral . dimension) t {- avgScale is computed as the nth root of the positive determinant. This works because the determinant is the factor by which a transformation scales area/volume. See http://en.wikipedia.org/wiki/Determinant. Proofs for the specified properties: 1. |det (scaling k)|^(1/n) = (k^n)^(1/n) = k 2. |det t1|^(1/n) * |det t2|^(1/n) = (|det t1| * |det t2|)^(1/n) = |det t1 * det t2|^(1/n) = |det (t1 <> t2)|^(1/n) -} ------------------------------------------------------------ -- The Transformable class ------------------------------- ------------------------------------------------------------ -- | 'HasLinearMap' is a constraint synonym, just to -- help shorten some of the ridiculously long constraint sets. type HasLinearMap v = (HasBasis v, Traversable v) -- | An 'Additive' vector space whose representation is made up of basis elements. type HasBasis v = (Additive v, Representable v, Rep v ~ E v) -- | Type class for things @t@ which can be transformed. class Transformable t where -- | Apply a transformation to an object. transform :: Transformation (V t) (N t) -> t -> t instance (Additive v, Num n) => Transformable (Transformation v n) where transform t1 t2 = t1 <> t2 instance (Additive v, Num n) => HasOrigin (Transformation v n) where moveOriginTo p = translate (origin .-. p) instance (Transformable t, Transformable s, V t ~ V s, N t ~ N s) => Transformable (t, s) where transform t (x,y) = ( transform t x , transform t y ) instance (Transformable t, Transformable s, Transformable u, V s ~ V t, N s ~ N t, V s ~ V u, N s ~ N u) => Transformable (t,s,u) where transform t (x,y,z) = ( transform t x , transform t y , transform t z ) -- Transform functions by conjugation. That is, reverse-transform argument and -- forward-transform result. Intuition: If someone shrinks you, you see your -- environment enlarged. If you rotate right, you see your environment -- rotating left. Etc. This technique was used extensively in Pan for modular -- construction of image filters. Works well for curried functions, since all -- arguments get inversely transformed. instance ( V t ~ v, N t ~ n, V t ~ V s, N t ~ N s, Functor v, Num n , Transformable t, Transformable s) => Transformable (s -> t) where transform tr f = transform tr . f . transform (inv tr) instance Transformable t => Transformable [t] where transform = map . transform instance (Transformable t, Ord t) => Transformable (S.Set t) where transform = S.map . transform instance Transformable t => Transformable (M.Map k t) where transform = M.map . transform instance (Additive v, Num n) => Transformable (Point v n) where transform = papply instance Transformable m => Transformable (Deletable m) where transform = fmap . transform ------------------------------------------------------------ -- Translational invariance ------------------------------ ------------------------------------------------------------ -- | @TransInv@ is a wrapper which makes a transformable type -- translationally invariant; the translational component of -- transformations will no longer affect things wrapped in -- @TransInv@. newtype TransInv t = TransInv t deriving (Eq, Ord, Show, Semigroup, Monoid) instance Wrapped (TransInv t) where type Unwrapped (TransInv t) = t _Wrapped' = iso (\(TransInv t) -> t) TransInv instance Rewrapped (TransInv t) (TransInv t') type instance V (TransInv t) = V t type instance N (TransInv t) = N t instance HasOrigin (TransInv t) where moveOriginTo = const id instance (Num (N t), Additive (V t), Transformable t) => Transformable (TransInv t) where transform (Transformation a a' _) (TransInv t) = TransInv (transform (Transformation a a' zero) t) instance (InSpace v n t, Transformable t, HasLinearMap v, Floating n) => Transformable (Measured n t) where transform t = scaleLocal n . fmap (transform t') where t' = t <> scaling (1 / avgScale t) n = avgScale t ------------------------------------------------------------ -- Generic transformations ------------------------------- ------------------------------------------------------------ -- | Create a translation. translation :: v n -> Transformation v n translation = Transformation mempty mempty -- | Translate by a vector. translate :: (Transformable t) => Vn t -> t -> t translate = transform . translation -- | Create a uniform scaling transformation. scaling :: (Additive v, Fractional n) => n -> Transformation v n scaling s = fromSymmetric lin where lin = (s *^) <-> (^/ s) -- | Scale uniformly in every dimension by the given scalar. scale :: (InSpace v n a, Eq n, Fractional n, Transformable a) => n -> a -> a scale 0 = error "scale by zero! Halp!" -- XXX what should be done here? scale s = transform $ scaling s diagrams-core-1.5.1.1/src/Diagrams/Core/Types.hs0000644000000000000000000011521707346545000017440 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- We have some orphan Action instances here, but since Action is a multi-param -- class there is really no better place to put them. ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Core.Types -- Copyright : (c) 2011-2015 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- The core library of primitives forming the basis of an embedded -- domain-specific language for describing and rendering diagrams. -- -- "Diagrams.Core.Types" defines types and classes for -- primitives, diagrams, and backends. -- ----------------------------------------------------------------------------- {- ~~~~ Note [breaking up Types module] Although it's not as bad as it used to be, this module has a lot of stuff in it, and it might seem a good idea in principle to break it up into smaller modules. However, it's not as easy as it sounds: everything in this module cyclically depends on everything else. -} module Diagrams.Core.Types ( -- * Diagrams -- ** Annotations -- *** Static annotations Annotation(Href, OpacityGroup, KeyVal) , applyAnnotation, href, opacityGroup, groupOpacity, keyVal -- *** Dynamic (monoidal) annotations , UpAnnots, DownAnnots, transfToAnnot, transfFromAnnot -- ** Basic type definitions , QDiaLeaf(..), withQDiaLeaf , QDiagram(..), Diagram -- * Operations on diagrams -- ** Creating diagrams , mkQD, mkQD', pointDiagram -- ** Extracting information , envelope, trace, subMap, names, query -- ** Combining diagrams -- | For many more ways of combining diagrams, see -- "Diagrams.Combinators" and "Diagrams.TwoD.Combinators" -- from the diagrams-lib package. , atop -- ** Modifying diagrams -- *** Names , nameSub , lookupName , withName , withNameAll , withNames , localize -- *** Other , setEnvelope , setTrace -- * Subdiagrams , Subdiagram(..), mkSubdiagram , getSub, rawSub , location , subPoint -- * Subdiagram maps , SubMap(..) , fromNames, rememberAs, lookupSub -- * Primtives -- $prim , Prim(..) , _Prim -- * Backends , Backend(..) , DTree , DNode(..) , RTree , RNode(..) , _RStyle , _RAnnot , _RPrim , _REmpty -- ** Null backend , NullBackend, D -- ** Number classes , TypeableFloat -- * Renderable , Renderable(..) ) where import Control.Arrow (first, second, (***)) import Control.Lens (Lens', Prism', Rewrapped, Wrapped (..), iso, lens, over, prism', view, (^.), _Wrapped, _Wrapping) import Control.Monad (mplus) import Data.Kind (Type) import Data.List (isSuffixOf) import qualified Data.Map as M import Data.Maybe (fromMaybe, listToMaybe) import Data.Semigroup import qualified Data.Traversable as T import Data.Tree import Data.Typeable import Data.Monoid.Action import Data.Monoid.Coproduct import Data.Monoid.Deletable import Data.Monoid.MList import Data.Monoid.WithSemigroup import qualified Data.Tree.DUAL as D import Diagrams.Core.Envelope import Diagrams.Core.HasOrigin import Diagrams.Core.Juxtapose import Diagrams.Core.Names import Diagrams.Core.Points import Diagrams.Core.Query import Diagrams.Core.Style import Diagrams.Core.Trace import Diagrams.Core.Transform import Diagrams.Core.V import Linear.Affine import Linear.Metric import Linear.Vector -- XXX TODO: add lots of actual diagrams to illustrate the -- documentation! Haddock supports \<\\>. -- | Constraint for numeric types that are 'RealFloat' and 'Typeable', -- which often occur together. This is used to shorten shorten type -- constraint contexts. type TypeableFloat n = (Typeable n, RealFloat n) ------------------------------------------------------------ -- Diagrams ---------------------------------------------- ------------------------------------------------------------ -- | Monoidal annotations which travel up the diagram tree, /i.e./ which -- are aggregated from component diagrams to the whole: -- -- * envelopes (see "Diagrams.Core.Envelope"). -- The envelopes are \"deletable\" meaning that at any point we can -- throw away the existing envelope and replace it with a new one; -- sometimes we want to consider a diagram as having a different -- envelope unrelated to its \"natural\" envelope. -- -- * traces (see "Diagrams.Core.Trace"), also -- deletable. -- -- * name/subdiagram associations (see "Diagrams.Core.Names") -- -- * query functions (see "Diagrams.Core.Query") type UpAnnots b v n m = Deletable (Envelope v n) ::: Deletable (Trace v n) ::: Deletable (SubMap b v n m) ::: Query v n m ::: () -- | Monoidal annotations which travel down the diagram tree, -- /i.e./ which accumulate along each path to a leaf (and which can -- act on the upwards-travelling annotations): -- -- * styles (see "Diagrams.Core.Style") -- -- * names (see "Diagrams.Core.Names") type DownAnnots v n = (Transformation v n :+: Style v n) ::: Name ::: () -- Note that we have to put the transformations and styles together -- using a coproduct because the transformations can act on the -- styles. -- | Inject a transformation into a default downwards annotation -- value. transfToAnnot :: Transformation v n -> DownAnnots v n transfToAnnot = inj . (inL :: Transformation v n -> Transformation v n :+: Style v n) -- | Extract the (total) transformation from a downwards annotation -- value. transfFromAnnot :: (Additive v, Num n) => DownAnnots v n -> Transformation v n transfFromAnnot = maybe mempty killR . fst -- | A leaf in a 'QDiagram' tree is either a 'Prim', or a \"delayed\" -- @QDiagram@ which expands to a real @QDiagram@ once it learns the -- \"final context\" in which it will be rendered. For example, in -- order to decide how to draw an arrow, we must know the precise -- transformation applied to it (since the arrow head and tail are -- scale-invariant). data QDiaLeaf b v n m = PrimLeaf (Prim b v n) | DelayedLeaf (DownAnnots v n -> n -> n -> QDiagram b v n m) -- ^ The @QDiagram@ produced by a @DelayedLeaf@ function /must/ -- already apply any transformation in the given -- @DownAnnots@ (that is, the transformation will not -- be applied by the context). deriving Functor withQDiaLeaf :: (Prim b v n -> r) -> ((DownAnnots v n -> n -> n -> QDiagram b v n m) -> r) -> QDiaLeaf b v n m -> r withQDiaLeaf f _ (PrimLeaf p) = f p withQDiaLeaf _ g (DelayedLeaf dgn) = g dgn -- | Static annotations which can be placed at a particular node of a -- diagram tree. data Annotation = Href String -- ^ Hyperlink | OpacityGroup Double | KeyVal (String, String) deriving Show -- | Apply a static annotation at the root of a diagram. applyAnnotation :: (Metric v, OrderedField n, Semigroup m) => Annotation -> QDiagram b v n m -> QDiagram b v n m applyAnnotation an (QD dt) = QD (D.annot an dt) -- | Make a diagram into a hyperlink. Note that only some backends -- will honor hyperlink annotations. href :: (Metric v, OrderedField n, Semigroup m) => String -> QDiagram b v n m -> QDiagram b v n m href = applyAnnotation . Href -- | Change the transparency of a 'Diagram' as a group. opacityGroup, groupOpacity :: (Metric v, OrderedField n, Semigroup m) => Double -> QDiagram b v n m -> QDiagram b v n m opacityGroup = applyAnnotation . OpacityGroup groupOpacity = applyAnnotation . OpacityGroup -- | Apply a general Key-Value annotation keyVal :: (Metric v, OrderedField n, Semigroup m) => (String, String) -> QDiagram b v n m -> QDiagram b v n m keyVal = applyAnnotation . KeyVal -- | The fundamental diagram type. The type variables are as follows: -- -- * @b@ represents the backend, such as @SVG@ or @Cairo@. Note -- that each backend also exports a type synonym @B@ for itself, -- so the type variable @b@ may also typically be instantiated by -- @B@, meaning \"use whatever backend is in scope\". -- -- * @v@ represents the vector space of the diagram. Typical -- instantiations include @V2@ (for a two-dimensional diagram) or -- @V3@ (for a three-dimensional diagram). -- -- * @n@ represents the numerical field the diagram uses. Typically -- this will be a concrete numeric type like @Double@. -- -- * @m@ is the monoidal type of \"query annotations\": each point -- in the diagram has a value of type @m@ associated to it, and -- these values are combined according to the 'Monoid' instance -- for @m@. Most often, @m@ is simply instantiated to 'Any', -- associating a simple @Bool@ value to each point indicating -- whether the point is inside the diagram; 'Diagram' is a synonym -- for @QDiagram@ with @m@ thus instantiated to @Any@. -- -- Diagrams can be combined via their 'Monoid' instance, transformed -- via their 'Transformable' instance, and assigned attributes via -- their 'HasStyle' instance. -- -- Note that the @Q@ in @QDiagram@ stands for \"Queriable\", as -- distinguished from 'Diagram', where @m@ is fixed to @Any@. This -- is not really a very good name, but it's probably not worth -- changing it at this point. newtype QDiagram b v n m = QD (D.DUALTree (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m)) #if __GLASGOW_HASKELL__ >= 707 deriving Typeable #else instance forall b v. (Typeable b, Typeable1 v) => Typeable2 (QDiagram b v) where typeOf2 _ = mkTyConApp (mkTyCon3 "diagrams-core" "Diagrams.Core.Types" "QDiagram") [] `mkAppTy` typeOf (undefined :: b) `mkAppTy` typeOf1 (undefined :: v n) #endif instance Wrapped (QDiagram b v n m) where type Unwrapped (QDiagram b v n m) = D.DUALTree (DownAnnots v n) (UpAnnots b v n m) Annotation (QDiaLeaf b v n m) _Wrapped' = iso (\(QD d) -> d) QD instance Rewrapped (QDiagram b v n m) (QDiagram b' v' n' m') type instance V (QDiagram b v n m) = v type instance N (QDiagram b v n m) = n -- | @Diagram b@ is a synonym for @'QDiagram' b (V b) (N b) 'Any'@. That is, -- the default sort of diagram is one where querying at a point -- simply tells you whether the diagram contains that point or not. -- Transforming a default diagram into one with a more interesting -- query can be done via the 'Functor' instance of @'QDiagram' b v n@ or -- the 'value' function. type Diagram b = QDiagram b (V b) (N b) Any -- | Create a \"point diagram\", which has no content, no trace, an -- empty query, and a point envelope. pointDiagram :: (Metric v, Fractional n) => Point v n -> QDiagram b v n m pointDiagram p = QD $ D.leafU (inj . toDeletable $ pointEnvelope p) -- | A useful variant of 'getU' which projects out a certain -- component. getU' :: (Monoid u', u :>: u') => D.DUALTree d u a l -> u' getU' = maybe mempty (maybe mempty id . get) . D.getU -- | Lens onto the 'Envelope' of a 'QDiagram'. envelope :: (OrderedField n, Metric v, Monoid' m) => Lens' (QDiagram b v n m) (Envelope v n) envelope = lens (unDelete . getU' . view _Wrapped') (flip setEnvelope) -- | Replace the envelope of a diagram. setEnvelope :: forall b v n m. ( OrderedField n, Metric v , Monoid' m) => Envelope v n -> QDiagram b v n m -> QDiagram b v n m setEnvelope e = over _Wrapped' ( D.applyUpre (inj . toDeletable $ e) . D.applyUpre (inj (deleteL :: Deletable (Envelope v n))) . D.applyUpost (inj (deleteR :: Deletable (Envelope v n))) ) -- | Lens onto the 'Trace' of a 'QDiagram'. trace :: (Metric v, OrderedField n, Semigroup m) => Lens' (QDiagram b v n m) (Trace v n) trace = lens (unDelete . getU' . view _Wrapped') (flip setTrace) -- | Replace the trace of a diagram. setTrace :: forall b v n m. ( OrderedField n, Metric v , Semigroup m) => Trace v n -> QDiagram b v n m -> QDiagram b v n m setTrace t = over _Wrapped' ( D.applyUpre (inj . toDeletable $ t) . D.applyUpre (inj (deleteL :: Deletable (Trace v n))) . D.applyUpost (inj (deleteR :: Deletable (Trace v n))) ) -- | Lens onto the 'SubMap' of a 'QDiagram' (/i.e./ an association from -- names to subdiagrams). subMap :: (Metric v, Semigroup m, OrderedField n) => Lens' (QDiagram b v n m) (SubMap b v n m) subMap = lens (unDelete . getU' . view _Wrapped') (flip setMap) where setMap :: (Metric v, Semigroup m, OrderedField n) => SubMap b v n m -> QDiagram b v n m -> QDiagram b v n m setMap m = over _Wrapped' ( D.applyUpre . inj . toDeletable $ m) -- | Get a list of names of subdiagrams and their locations. names :: (Metric v, Semigroup m, OrderedField n) => QDiagram b v n m -> [(Name, [Point v n])] names = (map . second . map) location . M.assocs . view (subMap . _Wrapped') -- | Attach an atomic name to a certain subdiagram, computed from the -- given diagram /with the mapping from name to subdiagram -- included/. The upshot of this knot-tying is that if @d' = d # -- named x@, then @lookupName x d' == Just d'@ (instead of @Just -- d@). nameSub :: (IsName nm , Metric v, OrderedField n, Semigroup m) => (QDiagram b v n m -> Subdiagram b v n m) -> nm -> QDiagram b v n m -> QDiagram b v n m nameSub s n d = d' where d' = over _Wrapped' (D.applyUpre . inj . toDeletable $ fromNames [(n,s d')]) d -- | Lookup the most recent diagram associated with (some -- qualification of) the given name. lookupName :: (IsName nm, Metric v, Semigroup m, OrderedField n) => nm -> QDiagram b v n m -> Maybe (Subdiagram b v n m) lookupName n d = lookupSub (toName n) (d^.subMap) >>= listToMaybe -- | Given a name and a diagram transformation indexed by a -- subdiagram, perform the transformation using the most recent -- subdiagram associated with (some qualification of) the name, -- or perform the identity transformation if the name does not exist. withName :: (IsName nm, Metric v , Semigroup m, OrderedField n) => nm -> (Subdiagram b v n m -> QDiagram b v n m -> QDiagram b v n m) -> QDiagram b v n m -> QDiagram b v n m withName n f d = maybe id f (lookupName n d) d -- | Given a name and a diagram transformation indexed by a list of -- subdiagrams, perform the transformation using the -- collection of all such subdiagrams associated with (some -- qualification of) the given name. withNameAll :: (IsName nm, Metric v , Semigroup m, OrderedField n) => nm -> ([Subdiagram b v n m] -> QDiagram b v n m -> QDiagram b v n m) -> QDiagram b v n m -> QDiagram b v n m withNameAll n f d = f (fromMaybe [] (lookupSub (toName n) (d^.subMap))) d -- | Given a list of names and a diagram transformation indexed by a -- list of subdiagrams, perform the transformation using the -- list of most recent subdiagrams associated with (some qualification -- of) each name. Do nothing (the identity transformation) if any -- of the names do not exist. withNames :: (IsName nm, Metric v , Semigroup m, OrderedField n) => [nm] -> ([Subdiagram b v n m] -> QDiagram b v n m -> QDiagram b v n m) -> QDiagram b v n m -> QDiagram b v n m withNames ns f d = maybe id f ns' d where nd = d^.subMap ns' = T.sequence (map ((listToMaybe=<<) . ($ nd) . lookupSub . toName) ns) -- | \"Localize\" a diagram by hiding all the names, so they are no -- longer visible to the outside. localize :: forall b v n m. (Metric v, OrderedField n, Semigroup m) => QDiagram b v n m -> QDiagram b v n m localize = over _Wrapped' ( D.applyUpre (inj (deleteL :: Deletable (SubMap b v n m))) . D.applyUpost (inj (deleteR :: Deletable (SubMap b v n m))) ) -- | Get the query function associated with a diagram. query :: Monoid m => QDiagram b v n m -> Query v n m query = getU' . view _Wrapped' -- | Create a diagram from a single primitive, along with an envelope, -- trace, subdiagram map, and query function. mkQD :: Prim b v n -> Envelope v n -> Trace v n -> SubMap b v n m -> Query v n m -> QDiagram b v n m mkQD p = mkQD' (PrimLeaf p) -- | Create a diagram from a generic QDiaLeaf, along with an envelope, -- trace, subdiagram map, and query function. mkQD' :: QDiaLeaf b v n m -> Envelope v n -> Trace v n -> SubMap b v n m -> Query v n m -> QDiagram b v n m mkQD' l e t n q = QD $ D.leaf (toDeletable e *: toDeletable t *: toDeletable n *: q *: ()) l ------------------------------------------------------------ -- Instances ------------------------------------------------------------ ---- Monoid -- | Diagrams form a monoid since each of their components do: the -- empty diagram has no primitives, an empty envelope, an empty -- trace, no named subdiagrams, and a constantly empty query -- function. -- -- Diagrams compose by aligning their respective local origins. The -- new diagram has all the primitives and all the names from the two -- diagrams combined, and query functions are combined pointwise. -- The first diagram goes on top of the second. \"On top of\" -- probably only makes sense in vector spaces of dimension lower -- than 3, but in theory it could make sense for, say, 3-dimensional -- diagrams when viewed by 4-dimensional beings. instance (Metric v, OrderedField n, Semigroup m) => Monoid (QDiagram b v n m) where mempty = QD D.empty mappend = (<>) instance (Metric v, OrderedField n, Semigroup m) => Semigroup (QDiagram b v n m) where (QD d1) <> (QD d2) = QD (d2 <> d1) -- swap order so that primitives of d2 come first, i.e. will be -- rendered first, i.e. will be on the bottom. -- | 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). atop :: (OrderedField n, Metric v, Semigroup m) => QDiagram b v n m -> QDiagram b v n m -> QDiagram b v n m atop = (<>) infixl 6 `atop` ---- Functor instance Functor (QDiagram b v n) where fmap f = over (_Wrapping QD) ( (D.mapU . second . second) ( (first . fmap . fmap . fmap) f . (second . first . fmap . fmap) f ) . (fmap . fmap) f ) ---- Applicative -- XXX what to do with this? -- A diagram with queries of result type @(a -> b)@ can be \"applied\" -- to a diagram with queries of result type @a@, resulting in a -- combined diagram with queries of result type @b@. In particular, -- all components of the two diagrams are combined as in the -- @Monoid@ instance, except the queries which are combined via -- @(<*>)@. -- instance (Backend b v n, Num n, Ord n) -- => Applicative (QDiagram b v n) where -- pure a = Diagram mempty mempty mempty (Query $ const a) -- -- (Diagram ps1 bs1 ns1 smp1) <*> (Diagram ps2 bs2 ns2 smp2) -- = Diagram (ps1 <> ps2) (bs1 <> bs2) (ns1 <> ns2) (smp1 <*> smp2) ---- HasStyle instance (Metric v, OrderedField n, Semigroup m) => HasStyle (QDiagram b v n m) where applyStyle = over _Wrapped' . D.applyD . inj . (inR :: Style v n -> Transformation v n :+: Style v n) ---- Juxtaposable instance (Metric v, OrderedField n, Monoid' m) => Juxtaposable (QDiagram b v n m) where juxtapose = juxtaposeDefault ---- Enveloped instance (Metric v, OrderedField n, Monoid' m) => Enveloped (QDiagram b v n m) where getEnvelope = view envelope ---- Traced instance (Metric v, OrderedField n, Semigroup m) => Traced (QDiagram b v n m) where getTrace = view trace ---- HasOrigin -- | Every diagram has an intrinsic \"local origin\" which is the -- basis for all combining operations. instance (Metric v, OrderedField n, Semigroup m) => HasOrigin (QDiagram b v n m) where moveOriginTo = translate . (origin .-.) ---- Transformable -- | Diagrams can be transformed by transforming each of their -- components appropriately. instance (OrderedField n, Metric v, Semigroup m) => Transformable (QDiagram b v n m) where transform = over _Wrapped' . D.applyD . transfToAnnot ---- Qualifiable -- | Diagrams can be qualified so that all their named points can -- now be referred to using the qualification prefix. instance (Metric v, OrderedField n, Semigroup m) => Qualifiable (QDiagram b v n m) where (.>>) = over _Wrapped' . D.applyD . inj . toName ------------------------------------------------------------ -- Subdiagrams ------------------------------------------------------------ -- | A @Subdiagram@ represents a diagram embedded within the context -- of a larger diagram. Essentially, it consists of a diagram -- paired with any accumulated information from the larger context -- (transformations, attributes, etc.). data Subdiagram b v n m = Subdiagram (QDiagram b v n m) (DownAnnots v n) type instance V (Subdiagram b v n m) = v type instance N (Subdiagram b v n m) = n -- | Turn a diagram into a subdiagram with no accumulated context. mkSubdiagram :: QDiagram b v n m -> Subdiagram b v n m mkSubdiagram d = Subdiagram d empty -- | Create a \"point subdiagram\", that is, a 'pointDiagram' (with no -- content and a point envelope) treated as a subdiagram with local -- origin at the given point. Note this is not the same as -- @mkSubdiagram . pointDiagram@, which would result in a subdiagram -- with local origin at the parent origin, rather than at the given -- point. subPoint :: (Metric v, OrderedField n) => Point v n -> Subdiagram b v n m subPoint p = Subdiagram (pointDiagram origin) (transfToAnnot $ translation (p .-. origin)) instance Functor (Subdiagram b v n) where fmap f (Subdiagram d a) = Subdiagram (fmap f d) a instance (OrderedField n, Metric v, Monoid' m) => Enveloped (Subdiagram b v n m) where getEnvelope (Subdiagram d a) = transform (transfFromAnnot a) $ getEnvelope d instance (OrderedField n, Metric v, Semigroup m) => Traced (Subdiagram b v n m) where getTrace (Subdiagram d a) = transform (transfFromAnnot a) $ getTrace d instance (Metric v, OrderedField n) => HasOrigin (Subdiagram b v n m) where moveOriginTo = translate . (origin .-.) instance Transformable (Subdiagram b v n m) where transform t (Subdiagram d a) = Subdiagram d (transfToAnnot t <> a) -- | Get the location of a subdiagram; that is, the location of its -- local origin /with respect to/ the vector space of its parent -- diagram. In other words, the point where its local origin -- \"ended up\". location :: (Additive v, Num n) => Subdiagram b v n m -> Point v n location (Subdiagram _ a) = transform (transfFromAnnot a) origin -- | Turn a subdiagram into a normal diagram, including the enclosing -- context. Concretely, a subdiagram is a pair of (1) a diagram and -- (2) a \"context\" consisting of an extra transformation and -- attributes. @getSub@ simply applies the transformation and -- attributes to the diagram to get the corresponding \"top-level\" -- diagram. getSub :: (Metric v, OrderedField n, Semigroup m) => Subdiagram b v n m -> QDiagram b v n m getSub (Subdiagram d a) = over _Wrapped' (D.applyD a) d -- | Extract the \"raw\" content of a subdiagram, by throwing away the -- context. rawSub :: Subdiagram b v n m -> QDiagram b v n m rawSub (Subdiagram d _) = d ------------------------------------------------------------ -- Subdiagram maps --------------------------------------- ------------------------------------------------------------ -- | A 'SubMap' is a map associating names to subdiagrams. There can -- be multiple associations for any given name. newtype SubMap b v n m = SubMap (M.Map Name [Subdiagram b v n m]) -- See Note [SubMap Set vs list] instance Wrapped (SubMap b v n m) where type Unwrapped (SubMap b v n m) = M.Map Name [Subdiagram b v n m] _Wrapped' = iso (\(SubMap m) -> m) SubMap instance Rewrapped (SubMap b v n m) (SubMap b' v' n' m') -- ~~~~ [SubMap Set vs list] -- In some sense it would be nicer to use -- Sets instead of a list, but then we would have to put Ord -- constraints on v everywhere. =P type instance V (SubMap b v n m) = v type instance N (SubMap b v n m) = n instance Functor (SubMap b v n) where fmap = over _Wrapped . fmap . map . fmap instance Semigroup (SubMap b v n m) where SubMap s1 <> SubMap s2 = SubMap $ M.unionWith (++) s1 s2 -- | 'SubMap's form a monoid with the empty map as the identity, and -- map union as the binary operation. No information is ever lost: -- if two maps have the same name in their domain, the resulting map -- will associate that name to the concatenation of the information -- associated with that name. instance Monoid (SubMap b v n m) where mempty = SubMap M.empty mappend = (<>) instance (OrderedField n, Metric v) => HasOrigin (SubMap b v n m) where moveOriginTo = over _Wrapped' . moveOriginTo instance Transformable (SubMap b v n m) where transform = over _Wrapped' . transform -- | 'SubMap's are qualifiable: if @ns@ is a 'SubMap', then @a |> -- ns@ is the same 'SubMap' except with every name qualified by -- @a@. instance Qualifiable (SubMap b v n m) where a .>> (SubMap m) = SubMap $ M.mapKeys (a .>>) m -- | Construct a 'SubMap' from a list of associations between names -- and subdiagrams. fromNames :: IsName a => [(a, Subdiagram b v n m)] -> SubMap b v n m fromNames = SubMap . M.fromListWith (++) . map (toName *** (:[])) -- | Add a name/diagram association to a submap. rememberAs :: IsName a => a -> QDiagram b v n m -> SubMap b v n m -> SubMap b v n m rememberAs n b = over _Wrapped' $ M.insertWith (++) (toName n) [mkSubdiagram b] -- | A name acts on a name map by qualifying every name in it. instance Action Name (SubMap b v n m) where act = (.>>) instance Action Name a => Action Name (Deletable a) where act n (Deletable l a r) = Deletable l (act n a) r -- Names do not act on other things. instance Action Name (Query v n m) instance Action Name (Envelope v n) instance Action Name (Trace v n) -- | Look for the given name in a name map, returning a list of -- subdiagrams associated with that name. If no names match the -- given name exactly, return all the subdiagrams associated with -- names of which the given name is a suffix. lookupSub :: IsName nm => nm -> SubMap b v n m -> Maybe [Subdiagram b v n m] lookupSub a (SubMap m) = M.lookup n m `mplus` (flattenNames . filter ((n `nameSuffixOf`) . fst) . M.assocs $ m) where (Name n1) `nameSuffixOf` (Name n2) = n1 `isSuffixOf` n2 flattenNames [] = Nothing flattenNames xs = Just . concatMap snd $ xs n = toName a ------------------------------------------------------------ -- Primitives -------------------------------------------- ------------------------------------------------------------ -- $prim -- Ultimately, every diagram is essentially a tree whose leaves are /primitives/, -- basic building blocks which can be rendered by backends. However, -- not every backend must be able to render every type of primitive; -- the collection of primitives a given backend knows how to render is -- determined by instances of 'Renderable'. -- | A value of type @Prim b v n@ is an opaque (existentially quantified) -- primitive which backend @b@ knows how to render in vector space @v@. data Prim b v n where Prim :: (Transformable p, Typeable p, Renderable p b) => p -> Prim b (V p) (N p) _Prim :: (Typeable p, Renderable p b) => Prism' (Prim b (V p) (N p)) p _Prim = prism' Prim (\(Prim p) -> cast p) type instance V (Prim b v n) = v type instance N (Prim b v n) = n -- | The 'Transformable' instance for 'Prim' just pushes calls to -- 'transform' down through the 'Prim' constructor. instance Transformable (Prim b v n) where transform t (Prim p) = Prim (transform t p) -- | The 'Renderable' instance for 'Prim' just pushes calls to -- 'render' down through the 'Prim' constructor. instance Renderable (Prim b v n) b where render b (Prim p) = render b p ------------------------------------------------------------ -- Backends ----------------------------------------------- ------------------------------------------------------------ -- | A 'DTree' is a raw tree representation of a 'QDiagram', with all -- the @u@-annotations removed. It is used as an intermediate type -- by diagrams-core; backends should not need to make use of it. -- Instead, backends can make use of 'RTree', which 'DTree' gets -- compiled and optimized to. type DTree b v n a = Tree (DNode b v n a) data DNode b v n a = DStyle (Style v n) | DTransform (Transformation v n) | DAnnot a | DDelay -- ^ @DDelay@ marks a point where a delayed subtree -- was expanded. Such subtrees already take all -- non-frozen transforms above them into account, -- so when later processing the tree, upon -- encountering a @DDelay@ node we must drop any -- accumulated non-frozen transformation. | DPrim (Prim b v n) | DEmpty -- | An 'RTree' is a compiled and optimized representation of a -- 'QDiagram', which can be used by backends. They have the -- following invariant which backends may rely upon: -- -- * @RPrim@ nodes never have any children. type RTree b v n a = Tree (RNode b v n a) data RNode b v n a = RStyle (Style v n) -- ^ A style node. | RAnnot a | RPrim (Prim b v n) -- ^ A primitive. | REmpty -- | Prism onto a style of an 'RNode'. _RStyle :: Prism' (RNode b v n a) (Style v n) _RStyle = prism' RStyle $ \n -> case n of RStyle s -> Just s; _ -> Nothing -- | Prism onto an annotation of an 'RNode'. _RAnnot :: Prism' (RNode b v n a) a _RAnnot = prism' RAnnot $ \n -> case n of RAnnot a -> Just a; _ -> Nothing -- | Prism onto a 'Prim' of an 'RNode'. _RPrim :: Prism' (RNode b v n a) (Prim b v n) _RPrim = prism' RPrim $ \n -> case n of RPrim p -> Just p; _ -> Nothing -- | Prism onto an empty 'RNode'. _REmpty :: Prism' (RNode b v n a) () _REmpty = prism' (const REmpty) $ \n -> case n of REmpty -> Just (); _ -> Nothing -- | Abstract diagrams are rendered to particular formats by -- /backends/. Each backend/vector space combination must be an -- instance of the 'Backend' class. -- -- A minimal complete definition consists of 'Render', 'Result', -- 'Options', and 'renderRTree'. However, most backends will want to -- implement 'adjustDia' as well; the default definition does -- nothing. Some useful standard definitions are provided in the -- @Diagrams.TwoD.Adjust@ module from the @diagrams-lib@ package. class Backend b v n where -- | An intermediate representation used for rendering primitives. -- (Typically, this will be some sort of monad, but it need not -- be.) The 'Renderable' class guarantees that a backend will be -- able to convert primitives into this type; how these rendered -- primitives are combined into an ultimate 'Result' is completely -- up to the backend. data Render b v n :: Type -- | The result of running/interpreting a rendering operation. type Result b v n :: Type -- | Backend-specific rendering options. data Options b v n :: Type -- | 'adjustDia' allows the backend to make adjustments to the final -- diagram (e.g. to adjust the size based on the options) before -- rendering it. It returns a modified options record, the -- transformation applied to the diagram (which can be used to -- convert attributes whose value is @Measure@, or transform -- /e.g./ screen coordinates back into local diagram coordinates), -- and the adjusted diagram itself. -- -- See the diagrams-lib package (particularly the -- @Diagrams.TwoD.Adjust@ module) for some useful implementations. adjustDia :: (Additive v, Monoid' m, Num n) => b -> Options b v n -> QDiagram b v n m -> (Options b v n, Transformation v n, QDiagram b v n m) adjustDia _ o d = (o,mempty,d) -- | Given some options, take a representation of a diagram as a -- tree and render it. The 'RTree' has already been simplified -- and has all measurements converted to @Output@ units. renderRTree :: b -> Options b v n -> RTree b v n Annotation -> Result b v n -- See Note [backend token] -- | The @D@ type is provided for convenience in situations where you -- must give a diagram a concrete, monomorphic type, but don't care -- which one. Such situations arise when you pass a diagram to a -- function which is polymorphic in its input but monomorphic in its -- output, such as 'width', 'height', 'phantom', or 'names'. Such -- functions compute some property of the diagram, or use it to -- accomplish some other purpose, but do not result in the diagram -- being rendered. If the diagram does not have a monomorphic type, -- GHC complains that it cannot determine the diagram's type. -- -- For example, here is the error we get if we try to compute the -- width of an image (this example requires @diagrams-lib@): -- -- @ -- ghci> width (image (uncheckedImageRef \"foo.png\" 200 200)) -- \:11:8: -- No instance for (Renderable (DImage n0 External) b0) -- arising from a use of `image' -- The type variables `n0', `b0' are ambiguous -- Possible fix: add a type signature that fixes these type variable(s) -- Note: there is a potential instance available: -- instance Fractional n => Renderable (DImage n a) NullBackend -- -- Defined in `Diagrams.TwoD.Image' -- Possible fix: -- add an instance declaration for -- (Renderable (DImage n0 External) b0) -- In the first argument of `width', namely -- `(image (uncheckedImageRef \"foo.png\" 200 200))' -- In the expression: -- width (image (uncheckedImageRef \"foo.png\" 200 200)) -- In an equation for `it': -- it = width (image (uncheckedImageRef \"foo.png\" 200 200)) -- @ -- -- GHC complains that there is no instance for @Renderable (DImage n0 -- External) b0@; what is really going on is that it does not have enough -- information to decide what backend to use (hence the -- uninstantiated @n0@ and @b0@). This is annoying because /we/ know that the -- choice of backend cannot possibly affect the width of the image -- (it's 200! it's right there in the code!); /but/ there is no way -- for GHC to know that. -- -- The solution is to annotate the call to 'image' with the type -- @'D' 'V2' 'Double'@, like so: -- -- @ -- ghci> width (image (uncheckedImageRef \"foo.png\" 200 200) :: D V2 Double) -- 200.00000000000006 -- @ -- -- (It turns out the width wasn't 200 after all...) -- -- As another example, here is the error we get if we try to compute -- the width of a radius-1 circle: -- -- @ -- ghci> width (circle 1) -- \:12:1: -- Couldn't match expected type `V2' with actual type `V a0' -- The type variable `a0' is ambiguous -- Possible fix: add a type signature that fixes these type variable(s) -- In the expression: width (circle 1) -- In an equation for `it': it = width (circle 1) -- @ -- -- There's even more ambiguity here. Whereas 'image' always returns -- a 'Diagram', the 'circle' function can produce any 'TrailLike' -- type, and the 'width' function can consume any 'Enveloped' type, -- so GHC has no idea what type to pick to go in the middle. -- However, the solution is the same: -- -- @ -- ghci> width (circle 1 :: D V2 Double) -- 1.9999999999999998 -- @ type D v n = QDiagram NullBackend v n Any -- | A null backend which does no actual rendering. It is provided -- mainly for convenience in situations where you must give a -- diagram a concrete, monomorphic type, but don't actually care -- which one. See 'D' for more explanation and examples. -- -- It is courteous, when defining a new primitive @P@, to make an instance -- -- > instance Renderable P NullBackend where -- > render _ _ = mempty -- -- This ensures that the trick with 'D' annotations can be used for -- diagrams containing your primitive. data NullBackend deriving Typeable -- Note: we can't make a once-and-for-all instance -- -- > instance Renderable a NullBackend where -- > render _ _ = mempty -- -- because it overlaps with the Renderable instance for NullPrim. instance Semigroup (Render NullBackend v n) where _ <> _ = NullBackendRender instance Monoid (Render NullBackend v n) where mempty = NullBackendRender #if !MIN_VERSION_base(4,11,0) mappend = (<>) #endif instance Backend NullBackend v n where data Render NullBackend v n = NullBackendRender type Result NullBackend v n = () data Options NullBackend v n renderRTree _ _ _ = () -- | The Renderable type class connects backends to primitives which -- they know how to render. class Transformable t => Renderable t b where render :: b -> t -> Render b (V t) (N t) -- ^ Given a token representing the backend and a -- transformable object, render it in the appropriate rendering -- context. -- See Note [backend token] {- ~~~~ Note [backend token] A bunch of methods here take a "backend token" as an argument. The backend token is expected to carry no actual information; it is solely to help out the type system. The problem is that all these methods return some associated type applied to b (e.g. Render b) and unifying them with something else will never work, since type families are not necessarily injective. -} diagrams-core-1.5.1.1/src/Diagrams/Core/V.hs0000644000000000000000000000561207346545000016536 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Core.V -- Copyright : (c) 2011-2015 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- Type family for identifying associated vector spaces. -- ----------------------------------------------------------------------------- module Diagrams.Core.V ( V , N , Vn , InSpace, SameSpace ) where import Data.Kind (Type) import Data.Map import Data.Monoid.Coproduct import Data.Monoid.Deletable import Data.Monoid.Split import Data.Semigroup import Data.Set import Linear.Vector ------------------------------------------------------------ -- Vector spaces ------------------------------------------- ------------------------------------------------------------ -- | Many sorts of objects have an associated vector space in which -- they \"live\". The type function @V@ maps from object types to -- the associated vector space. The resulting vector space has kind @* -> *@ -- which means it takes another value (a number) and returns a concrete -- vector. For example 'V2' has kind @* -> *@ and @V2 Double@ is a vector. type family V a :: Type -> Type -- Note, to use these instances one often needs a constraint of the form -- V a ~ V b, etc. type instance V (a,b) = V a type instance V (a,b,c) = V a type instance V (a -> b) = V b type instance V [a] = V a type instance V (Maybe a) = V a type instance V (Set a) = V a type instance V (Map k a) = V a type instance V (Deletable m) = V m type instance V (Split m) = V m type instance V (m :+: n) = V m -- | The numerical field for the object, the number type used for calculations. type family N a :: Type type instance N (a,b) = N a type instance N (a,b,c) = N a type instance N (a -> b) = N b type instance N [a] = N a type instance N (Maybe a) = N a type instance N (Set a) = N a type instance N (Map k a) = N a type instance N (Deletable m) = N m type instance N (Split m) = N m type instance N (m :+: n) = N m -- | Convenient type alias to retrieve the vector type associated with an -- object's vector space. This is usually used as @Vn a ~ v n@ where @v@ is -- the vector space and @n@ is the numerical field. type Vn a = V a (N a) -- | @InSpace v n a@ means the type @a@ belongs to the vector space @v n@, -- where @v@ is 'Additive' and @n@ is a 'Num'. type InSpace v n a = (V a ~ v, N a ~ n, Additive v, Num n) -- | @SameSpace a b@ means the types @a@ and @b@ belong to the same -- vector space @v n@. type SameSpace a b = (V a ~ V b, N a ~ N b)