diff --git a/Graphics/Diagrams.hs b/Graphics/Diagrams.hs new file mode 100644 --- /dev/null +++ b/Graphics/Diagrams.hs @@ -0,0 +1,134 @@ +-- | Diagrams user API +module Graphics.Diagrams + ( Point + , (*.), (.*.), (.+.), (.-.) + , Color + , color, rgb + , red, green, blue, black, white, gray, yellow + , Diagram + , rect, rectangle, circle, polygon, (>-<), (~~), polyline + , textFrom, textTo, textAt, fontFamily, link + , move, rotate, scale, scaleXY, clip + , fill, stroke, strokeWidth + , union, (<|>), empty + , pack + ) where + +import Graphics.Diagrams.Types + +--------------------- + +infixl 7 .*., *. +infixl 6 .+., .-. +infix 4 >-<, ~~ +infixl 3 `move`, `rotate`, `scale`, `scaleXY`, `fill`, `stroke`, `strokeWidth`, `textFrom`, `textTo`, `textAt`, `fontFamily`, `link` +infixl 2 <|> + +-------------------- + +empty :: Diagram +empty = EmptyDiagram + +(>-<), (~~), line :: Point -> Point -> Diagram +(>-<) = line +(~~) = line +line a b = polyline [a,b] + +rect :: Double -> Double -> Diagram +rect = Rect + +rectangle :: Point -> Point -> Diagram +rectangle (a1,a2) (b1,b2) = rect (b1-a1) (b2-a2) `move` (a1+(b1-a1)/2, a2+(b2-a2)/2) + +--dot :: Diagram +--dot = circle 0.5 `strokeWidth` 0 `fill` black + +circle :: Double -> Diagram +circle = Circle + +polygon, polyline :: [Point] -> Diagram +polygon = Polyline True +polyline = Polyline False + +text :: Position -> String -> Diagram +text x = TransformMatrix 0.1 0 0 (-0.1) 0 0 . Text x + +textAt, textFrom, textTo :: String -> Point -> Diagram +textAt t x = text Middle t `move` x +textFrom t x = text Start t `move` x +textTo t x = text End t `move` x + +fontFamily :: Diagram -> String -> Diagram +fontFamily = flip FontFamily + +link :: Diagram -> String -> Diagram +link = flip Link + +pack :: Diagram -> (Diagram -> Diagram) -> Diagram +pack = Pack + +clip :: Point -> Point -> Diagram -> Diagram +clip = Clip + +(<|>) :: Diagram -> Diagram -> Diagram +(<|>) = Overlay + + +move :: Diagram -> Point -> Diagram +x `move` p = Move p x + +rotate :: Diagram -> Double -> Diagram +x `rotate` d = Rotate d x + +scale :: Diagram -> Double -> Diagram +x `scale` t = Scale t x + +scaleXY :: Diagram -> (Double, Double) -> Diagram +d `scaleXY` (x, y) = ScaleXY x y d + +fill :: Diagram -> Color -> Diagram +x `fill` c = Fill c x + +stroke :: Diagram -> Color -> Diagram +x `stroke` c = Stroke c x + +strokeWidth :: Diagram -> Double -> Diagram +x `strokeWidth` c = StrokeWidth c x + +union :: [Diagram] -> Diagram +union = foldr Overlay EmptyDiagram + + +------------------------- + +color :: String -> Color +color = Color + +rgb :: Double -> Double -> Double -> Color +rgb = RGB + +red, green, blue, black, white, gray, yellow :: Color +red = color "red" +green = color "green" +blue = color "blue" +black = color "black" +white = color "white" +gray = color "gray" +yellow = color "yellow" + + +-- type Point = (Double, Double) + +-- | Point type as defined in the diagrams package +-- Scalar multiplication. +(*.) :: Double -> Point -> Point +s *. (x,y) = (s*x, s*y) + +-- | Elementwise addition, subtraction and multiplication for 'Point's. +(.+.), (.-.), (.*.) :: Point -> Point -> Point +(x1,y1) .+. (x2,y2) = (x1 + x2, y1 + y2) +(x1,y1) .*. (x2,y2) = (x1 * x2, y1 * y2) +a .-. b = a .+. ((-1) *. b) + + + diff --git a/Graphics/Diagrams/Types.hs b/Graphics/Diagrams/Types.hs new file mode 100644 --- /dev/null +++ b/Graphics/Diagrams/Types.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE DeriveDataTypeable #-} +-- | Diagrams data types +module Graphics.Diagrams.Types where + +import Data.Data (Data, Typeable, dataTypeOf, mkDataType, gunfold, toConstr) +import Control.DeepSeq (NFData, rnf) + +----------------------- + +type Point = (Double, Double) + +-- | Diagram data type +data Diagram + = EmptyDiagram -- ^ empty diagram + | Circle Double -- ^ circle with radius + | Rect Double Double -- ^ rectangle; width and height + | Polyline Bool [Point] -- ^ True: polygon; False: polyline + | Text Position String -- ^ text at a given position + + | Move Point Diagram -- ^ move + | Scale Double Diagram -- ^ scale + | ScaleXY Double Double Diagram -- ^ scale differently at x and y axes + | Rotate Double Diagram -- ^ rotate (radian) + | TransformMatrix Double Double Double Double Double Double Diagram -- ^ used internally + | Clip Point Point Diagram -- ^ clip a rectangle region (lower-left and upper-right corners) + + | Fill Color Diagram -- ^ fill with color + | Stroke Color Diagram -- ^ set stroke color +-- | FillOpacity Double Diagram -- ^ set fill opacity +-- | StrokeOpacity Double Diagram -- ^ set stroke opacity + | StrokeWidth Double Diagram -- ^ set stroke width + | FontFamily String Diagram -- ^ set font family + | Link String Diagram -- ^ add a html link + + | Overlay Diagram Diagram -- ^ overlay (the second is diagram over the first one) + | Pack Diagram (Diagram -> Diagram) -- ^ pack a diagram (kind of let-construct to save resources) + + | Group Diagram Int Diagram -- ^ used internally + | Ref Int -- ^ used internally + | Error String Diagram -- ^ used internally + deriving (Typeable) + +instance Data Diagram where + dataTypeOf _ = mkDataType "Diagram" [] + gunfold _ _ = error "gunfold is not defined on the Diagram datatype" + toConstr _ = error "toConstr is not defined on the Diagram datatype" + +-- | Text positions +data Position + = Start -- ^ begginning of text is fixed + | Middle -- ^ middle of text is fixed + | End -- ^ end of text is fixed + deriving (Eq, Ord, Show, Data, Typeable) + +instance NFData Position where + rnf x = x `seq` () + +-- | colors +data Color + = Color String -- ^ named color + | RGB Double Double Double -- ^ RGB color (components are between 0 and 1) + deriving (Eq, Ord, Show, Data, Typeable) + +instance NFData Color where + rnf (Color s) = rnf s + rnf (RGB r g b) = rnf (r, g, b) + + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright Péter Diviánszky 2010-2011 + +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 Péter Diviánszky 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. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/dia-base.cabal b/dia-base.cabal new file mode 100644 --- /dev/null +++ b/dia-base.cabal @@ -0,0 +1,31 @@ +name: dia-base +version: 0.1 +category: Graphics, Education +synopsis: An EDSL for teaching Haskell with diagrams - data types +description: + This package contains the Diagram data type + and the user API to construct diagrams. + . + See also the dia-functions package. + . + For exaples see +stability: alpha +license: BSD3 +license-file: LICENSE +author: Péter Diviánszky +maintainer: divip@aszt.inf.elte.hu +cabal-version: >=1.2 +build-type: Simple + +library + GHC-Options: -Wall -fwarn-tabs -fno-warn-incomplete-patterns -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-unused-matches + + Exposed-Modules: + Graphics.Diagrams.Types, + Graphics.Diagrams + + Build-Depends: + base >= 4.0 && < 4.4, + deepseq >= 1.1 && < 1.2 + +