├── Snowflake.png
├── .gitignore
├── html
└── index.html
├── package.json
├── bower.json
├── README.md
├── .travis.yml
├── example
└── Main.purs
├── generated-docs
└── Graphics
│ ├── Drawing
│ └── Font.md
│ └── Drawing.md
└── src
└── Graphics
├── Drawing
└── Font.purs
└── Drawing.purs
/Snowflake.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/paf31/purescript-drawing/HEAD/Snowflake.png
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | bower_components/
2 | node_modules/
3 | output/
4 | html/index.js
5 | .pulp-cache/
6 | .psc-ide-port
7 | .psc-package/
8 |
--------------------------------------------------------------------------------
/html/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | purescript-drawing demo
5 |
6 |
7 |
8 |
9 |
10 |
11 |
--------------------------------------------------------------------------------
/package.json:
--------------------------------------------------------------------------------
1 | {
2 | "private": true,
3 | "scripts": {
4 | "clean": "rimraf output && rimraf .pulp-cache",
5 | "build": "pulp build -- --censor-lib --strict",
6 | "example": "pulp build -I example -O --to html/index.js"
7 | },
8 | "devDependencies": {
9 | "pulp": "^12.2.0",
10 | "purescript-psa": "^0.6.0",
11 | "rimraf": "^2.6.2"
12 | }
13 | }
14 |
--------------------------------------------------------------------------------
/bower.json:
--------------------------------------------------------------------------------
1 | {
2 | "name": "purescript-drawing",
3 | "authors": [
4 | "Phil Freeman "
5 | ],
6 | "license": "MIT",
7 | "ignore": [
8 | "**/.*",
9 | "node_modules",
10 | "bower_components",
11 | "test",
12 | "tests"
13 | ],
14 | "repository": {
15 | "type": "git",
16 | "url": "git://github.com/paf31/purescript-drawing.git"
17 | },
18 | "dependencies": {
19 | "purescript-canvas": "^4.0.0",
20 | "purescript-lists": "^5.0.0",
21 | "purescript-math": "^2.1.1",
22 | "purescript-integers": "^4.0.0",
23 | "purescript-colors": "^5.0.0"
24 | }
25 | }
26 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # purescript-drawing
2 |
3 | [](https://travis-ci.org/purescript-contrib/purescript-drawing)
4 | [](https://github.com/purescript-contrib/purescript-drawing/releases)
5 | [](http://github.com/paf31)
6 |
7 | Functional rendering using PureScript and HTML 5 Canvas
8 |
9 | - [Module Documentation](generated-docs/Graphics/Drawing.md)
10 | - [Example](test/Main.purs)
11 |
12 | Run the example with `npm run example`.
13 |
14 | 
15 |
--------------------------------------------------------------------------------
/.travis.yml:
--------------------------------------------------------------------------------
1 | language: node_js
2 | dist: trusty
3 | sudo: required
4 | node_js: stable
5 | env:
6 | - PATH=$HOME/purescript:$PATH
7 | install:
8 | - TAG=$(wget -q -O - https://github.com/purescript/purescript/releases/latest --server-response --max-redirect 0 2>&1 | sed -n -e 's/.*Location:.*tag\///p')
9 | - wget -O $HOME/purescript.tar.gz https://github.com/purescript/purescript/releases/download/$TAG/linux64.tar.gz
10 | - tar -xvf $HOME/purescript.tar.gz -C $HOME/
11 | - chmod a+x $HOME/purescript
12 | - npm install -g bower
13 | - npm install
14 | - bower install
15 | script:
16 | - npm run -s build
17 | after_success:
18 | - >-
19 | test $TRAVIS_TAG &&
20 | echo $GITHUB_TOKEN | pulp login &&
21 | echo y | pulp publish --no-push
22 |
--------------------------------------------------------------------------------
/example/Main.purs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Prelude
4 |
5 | import Color (black)
6 | import Color.Scale (sample)
7 | import Color.Scale.Perceptual (magma)
8 | import Data.Array ((..))
9 | import Data.Foldable (fold)
10 | import Data.Int (toNumber)
11 | import Data.Maybe (fromJust)
12 | import Effect (Effect)
13 | import Graphics.Canvas (getCanvasElementById, getContext2D)
14 | import Graphics.Drawing (scale, translate, shadowBlur, shadowColor, shadow, render, rotate, closed, fillColor, filled)
15 | import Math (sin, cos, pi)
16 | import Partial.Unsafe (unsafePartial)
17 |
18 | main :: Effect Unit
19 | main = do
20 | mcanvas <- getCanvasElementById "canvas"
21 | let canvas = unsafePartial (fromJust mcanvas)
22 | ctx <- getContext2D canvas
23 |
24 | render ctx $
25 | shadow (shadowColor black <> shadowBlur 10.0) $
26 | translate 400.0 400.0 $
27 | scale 200.0 200.0 $
28 | go 6
29 | where
30 | s = 0.375
31 |
32 | go 0 = mempty
33 | go n =
34 | let dr = scale s s (go (n - 1))
35 | in filled (fillColor (sample magma (1.0 - toNumber (n - 1) / 5.0))) (closed pentagon)
36 | <> fold do i <- 0..4
37 | pure (rotate (pi / 2.5 * (toNumber i + 0.5)) (translate 0.0 (cos (pi / 5.0) * (1.0 + s)) dr))
38 |
39 | pentagon = do
40 | i <- 0..5
41 | let theta = pi / 2.5 * toNumber i
42 | pure { x: sin theta, y: cos theta }
43 |
--------------------------------------------------------------------------------
/generated-docs/Graphics/Drawing/Font.md:
--------------------------------------------------------------------------------
1 | ## Module Graphics.Drawing.Font
2 |
3 | This module defines preset fonts, and functions for creating fonts.
4 |
5 | #### `Font`
6 |
7 | ``` purescript
8 | data Font
9 | ```
10 |
11 | Fonts.
12 |
13 | ##### Instances
14 | ``` purescript
15 | Eq Font
16 | ```
17 |
18 | #### `font`
19 |
20 | ``` purescript
21 | font :: FontFamily -> Int -> FontOptions -> Font
22 | ```
23 |
24 | Create a `Font`.
25 |
26 | #### `fontString`
27 |
28 | ``` purescript
29 | fontString :: Font -> String
30 | ```
31 |
32 | Turn a `Font` into a `String` which can be used with `Graphics.Canvas.setFont`.
33 |
34 | #### `FontFamily`
35 |
36 | ``` purescript
37 | newtype FontFamily
38 | ```
39 |
40 | Font family.
41 |
42 | ##### Instances
43 | ``` purescript
44 | Eq FontFamily
45 | ```
46 |
47 | #### `serif`
48 |
49 | ``` purescript
50 | serif :: FontFamily
51 | ```
52 |
53 | Serif font
54 |
55 | #### `sansSerif`
56 |
57 | ``` purescript
58 | sansSerif :: FontFamily
59 | ```
60 |
61 | Sans serif font
62 |
63 | #### `monospace`
64 |
65 | ``` purescript
66 | monospace :: FontFamily
67 | ```
68 |
69 | Monospaced font
70 |
71 | #### `cursive`
72 |
73 | ``` purescript
74 | cursive :: FontFamily
75 | ```
76 |
77 | Cursive font
78 |
79 | #### `fantasy`
80 |
81 | ``` purescript
82 | fantasy :: FontFamily
83 | ```
84 |
85 | Fantasy font
86 |
87 | #### `customFont`
88 |
89 | ``` purescript
90 | customFont :: String -> FontFamily
91 | ```
92 |
93 | Use a custom font
94 |
95 | #### `FontOptions`
96 |
97 | ``` purescript
98 | newtype FontOptions
99 | ```
100 |
101 | Encapsulates font options.
102 |
103 | ##### Instances
104 | ``` purescript
105 | Eq FontOptions
106 | Semigroup FontOptions
107 | Monoid FontOptions
108 | ```
109 |
110 | #### `bold`
111 |
112 | ``` purescript
113 | bold :: FontOptions
114 | ```
115 |
116 | Use a bold font.
117 |
118 | #### `bolder`
119 |
120 | ``` purescript
121 | bolder :: FontOptions
122 | ```
123 |
124 | Use a bolder font.
125 |
126 | #### `light`
127 |
128 | ``` purescript
129 | light :: FontOptions
130 | ```
131 |
132 | Use a light font.
133 |
134 | #### `italic`
135 |
136 | ``` purescript
137 | italic :: FontOptions
138 | ```
139 |
140 | Use an italic style.
141 |
142 | #### `oblique`
143 |
144 | ``` purescript
145 | oblique :: FontOptions
146 | ```
147 |
148 | Use an oblique style.
149 |
150 | #### `smallCaps`
151 |
152 | ``` purescript
153 | smallCaps :: FontOptions
154 | ```
155 |
156 | Use small caps.
157 |
158 |
159 |
--------------------------------------------------------------------------------
/src/Graphics/Drawing/Font.purs:
--------------------------------------------------------------------------------
1 | -- | This module defines preset fonts, and functions for creating fonts.
2 |
3 | module Graphics.Drawing.Font
4 | ( Font, font, fontString
5 | , FontFamily, serif, sansSerif, monospace, cursive, fantasy, customFont
6 | , FontOptions, bold, bolder, light, italic, oblique, smallCaps
7 | ) where
8 |
9 | import Prelude
10 |
11 | import Control.Alt ((<|>))
12 | import Data.Foldable (fold, intercalate)
13 | import Data.Maybe (Maybe(..))
14 |
15 | -- | Fonts.
16 | data Font = Font FontFamily Int FontOptions
17 |
18 | derive instance eqFont :: Eq Font
19 |
20 | -- | Create a `Font`.
21 | font :: FontFamily -> Int -> FontOptions -> Font
22 | font = Font
23 |
24 | -- | Turn a `Font` into a `String` which can be used with `Graphics.Canvas.setFont`.
25 | fontString :: Font -> String
26 | fontString (Font (FontFamily family) px opts) = optionsString opts <> " " <> show px <> "px " <> family
27 |
28 | -- | Font family.
29 | newtype FontFamily = FontFamily String
30 |
31 | derive instance eqFontFamily :: Eq FontFamily
32 |
33 | -- | Serif font
34 | serif :: FontFamily
35 | serif = FontFamily "serif"
36 |
37 | -- | Sans serif font
38 | sansSerif :: FontFamily
39 | sansSerif = FontFamily "sans-serif"
40 |
41 | -- | Monospaced font
42 | monospace :: FontFamily
43 | monospace = FontFamily "monospace"
44 |
45 | -- | Cursive font
46 | cursive :: FontFamily
47 | cursive = FontFamily "cursive"
48 |
49 | -- | Fantasy font
50 | fantasy :: FontFamily
51 | fantasy = FontFamily "fantasy"
52 |
53 | -- | Use a custom font
54 | customFont :: String -> FontFamily
55 | customFont = FontFamily
56 |
57 | -- | Encapsulates font options.
58 | newtype FontOptions = FontOptions
59 | { style :: Maybe String
60 | , variant :: Maybe String
61 | , weight :: Maybe String
62 | }
63 |
64 | instance eqFontOptions :: Eq FontOptions where
65 | eq (FontOptions a) (FontOptions a') = a.style == a'.style
66 | && a.variant == a'.variant
67 | && a.weight == a'.weight
68 |
69 | optionsString :: FontOptions -> String
70 | optionsString (FontOptions opts) = intercalate " "
71 | [ fold opts.style
72 | , fold opts.variant
73 | , fold opts.weight
74 | ]
75 |
76 | -- | Use a bold font.
77 | bold :: FontOptions
78 | bold = FontOptions { style: Nothing, variant: Nothing, weight: Just "bold" }
79 |
80 | -- | Use a bolder font.
81 | bolder :: FontOptions
82 | bolder = FontOptions { style: Nothing, variant: Nothing, weight: Just "bolder" }
83 |
84 | -- | Use a light font.
85 | light :: FontOptions
86 | light = FontOptions { style: Nothing, variant: Nothing, weight: Just "lighter" }
87 |
88 | -- | Use an italic style.
89 | italic :: FontOptions
90 | italic = FontOptions { style: Just "italic", variant: Nothing, weight: Nothing }
91 |
92 | -- | Use an oblique style.
93 | oblique :: FontOptions
94 | oblique = FontOptions { style: Just "oblique", variant: Nothing, weight: Nothing }
95 |
96 | -- | Use small caps.
97 | smallCaps :: FontOptions
98 | smallCaps = FontOptions { style: Nothing, variant: Just "small-caps", weight: Nothing }
99 |
100 | instance semigroupFontOptions :: Semigroup FontOptions where
101 | append (FontOptions fo1) (FontOptions fo2) =
102 | FontOptions { style: fo1.style <|> fo2.style
103 | , variant: fo1.variant <|> fo2.variant
104 | , weight: fo1.weight <|> fo2.weight
105 | }
106 |
107 | instance monoidFontOptions :: Monoid FontOptions where
108 | mempty = FontOptions { style: Nothing
109 | , variant: Nothing
110 | , weight: Nothing
111 | }
112 |
--------------------------------------------------------------------------------
/generated-docs/Graphics/Drawing.md:
--------------------------------------------------------------------------------
1 | ## Module Graphics.Drawing
2 |
3 | This module defines a type `Drawing` for creating vector graphics.
4 |
5 | #### `Point`
6 |
7 | ``` purescript
8 | type Point = { x :: Number, y :: Number }
9 | ```
10 |
11 | A `Point` consists of `x` and `y` coordinates.
12 |
13 | #### `Shape`
14 |
15 | ``` purescript
16 | data Shape
17 | ```
18 |
19 | A single shape.
20 |
21 | ##### Instances
22 | ``` purescript
23 | Eq Shape
24 | Semigroup Shape
25 | Monoid Shape
26 | ```
27 |
28 | #### `path`
29 |
30 | ``` purescript
31 | path :: forall f. Foldable f => f Point -> Shape
32 | ```
33 |
34 | Create a path.
35 |
36 | #### `closed`
37 |
38 | ``` purescript
39 | closed :: forall f. Foldable f => f Point -> Shape
40 | ```
41 |
42 | Create a _closed_ path.
43 |
44 | #### `rectangle`
45 |
46 | ``` purescript
47 | rectangle :: Number -> Number -> Number -> Number -> Shape
48 | ```
49 |
50 | Create a rectangle from the left, top, width and height parameters.
51 |
52 | #### `circle`
53 |
54 | ``` purescript
55 | circle :: Number -> Number -> Number -> Shape
56 | ```
57 |
58 | Create a circle from the left, top and radius parameters.
59 |
60 | #### `arc`
61 |
62 | ``` purescript
63 | arc :: Number -> Number -> Number -> Number -> Number -> Shape
64 | ```
65 |
66 | Create a circular arc from the left, top, start angle, end angle and
67 | radius parameters.
68 |
69 | #### `FillStyle`
70 |
71 | ``` purescript
72 | newtype FillStyle
73 | ```
74 |
75 | Encapsulates fill color etc.
76 |
77 | ##### Instances
78 | ``` purescript
79 | Semigroup FillStyle
80 | Monoid FillStyle
81 | Eq FillStyle
82 | ```
83 |
84 | #### `fillColor`
85 |
86 | ``` purescript
87 | fillColor :: Color -> FillStyle
88 | ```
89 |
90 | Set the fill color.
91 |
92 | #### `OutlineStyle`
93 |
94 | ``` purescript
95 | newtype OutlineStyle
96 | ```
97 |
98 | Encapsulates outline color etc.
99 |
100 | ##### Instances
101 | ``` purescript
102 | Semigroup OutlineStyle
103 | Monoid OutlineStyle
104 | Eq OutlineStyle
105 | ```
106 |
107 | #### `outlineColor`
108 |
109 | ``` purescript
110 | outlineColor :: Color -> OutlineStyle
111 | ```
112 |
113 | Set the outline color.
114 |
115 | #### `lineWidth`
116 |
117 | ``` purescript
118 | lineWidth :: Number -> OutlineStyle
119 | ```
120 |
121 | Set the line width.
122 |
123 | #### `Shadow`
124 |
125 | ``` purescript
126 | newtype Shadow
127 | ```
128 |
129 | Encapsulates shadow settings etc.
130 |
131 | ##### Instances
132 | ``` purescript
133 | Eq Shadow
134 | Semigroup Shadow
135 | Monoid Shadow
136 | ```
137 |
138 | #### `shadowOffset`
139 |
140 | ``` purescript
141 | shadowOffset :: Number -> Number -> Shadow
142 | ```
143 |
144 | Set the shadow blur.
145 |
146 | #### `shadowBlur`
147 |
148 | ``` purescript
149 | shadowBlur :: Number -> Shadow
150 | ```
151 |
152 | Set the shadow blur.
153 |
154 | #### `shadowColor`
155 |
156 | ``` purescript
157 | shadowColor :: Color -> Shadow
158 | ```
159 |
160 | Set the shadow color.
161 |
162 | #### `shadow`
163 |
164 | ``` purescript
165 | shadow :: Shadow -> Drawing -> Drawing
166 | ```
167 |
168 | Apply a `Shadow` to a `Drawing`.
169 |
170 | #### `Drawing`
171 |
172 | ``` purescript
173 | data Drawing
174 | ```
175 |
176 | A vector `Drawing`.
177 |
178 | ##### Instances
179 | ``` purescript
180 | Semigroup Drawing
181 | Monoid Drawing
182 | Eq Drawing
183 | ```
184 |
185 | #### `filled`
186 |
187 | ``` purescript
188 | filled :: FillStyle -> Shape -> Drawing
189 | ```
190 |
191 | Fill a `Shape`.
192 |
193 | #### `outlined`
194 |
195 | ``` purescript
196 | outlined :: OutlineStyle -> Shape -> Drawing
197 | ```
198 |
199 | Draw the outline of a `Shape`.
200 |
201 | #### `clipped`
202 |
203 | ``` purescript
204 | clipped :: Shape -> Drawing -> Drawing
205 | ```
206 |
207 | Clip a `Drawing` to a `Shape`.
208 |
209 | #### `scale`
210 |
211 | ``` purescript
212 | scale :: Number -> Number -> Drawing -> Drawing
213 | ```
214 |
215 | Apply a scale transformation by providing the x and y scale factors.
216 |
217 | #### `translate`
218 |
219 | ``` purescript
220 | translate :: Number -> Number -> Drawing -> Drawing
221 | ```
222 |
223 | Apply a translation by providing the x and y distances.
224 |
225 | #### `rotate`
226 |
227 | ``` purescript
228 | rotate :: Number -> Drawing -> Drawing
229 | ```
230 |
231 | Apply a rotation by providing the angle.
232 |
233 | #### `text`
234 |
235 | ``` purescript
236 | text :: Font -> Number -> Number -> FillStyle -> String -> Drawing
237 | ```
238 |
239 | Render some text.
240 |
241 | #### `everywhere`
242 |
243 | ``` purescript
244 | everywhere :: (Drawing -> Drawing) -> Drawing -> Drawing
245 | ```
246 |
247 | Modify a `Drawing` by applying a transformation to every subdrawing.
248 |
249 | #### `render`
250 |
251 | ``` purescript
252 | render :: Context2D -> Drawing -> Effect Unit
253 | ```
254 |
255 | Render a `Drawing` to a canvas.
256 |
257 |
258 | ### Re-exported from Color:
259 |
260 | #### `Color`
261 |
262 | ``` purescript
263 | data Color
264 | ```
265 |
266 | The representation of a color.
267 |
268 | Note:
269 | - The `Eq` instance compares two `Color`s by comparing their (integer) RGB
270 | values. This is different from comparing the HSL values (for example,
271 | HSL has many different representations of black (arbitrary hue and
272 | saturation values).
273 | - Colors outside the sRGB gamut which cannot be displayed on a typical
274 | computer screen can not be represented by `Color`.
275 |
276 |
277 | ##### Instances
278 | ``` purescript
279 | Show Color
280 | Eq Color
281 | ```
282 |
283 | ### Re-exported from Graphics.Drawing.Font:
284 |
285 | #### `Font`
286 |
287 | ``` purescript
288 | data Font
289 | ```
290 |
291 | Fonts.
292 |
293 | ##### Instances
294 | ``` purescript
295 | Eq Font
296 | ```
297 |
298 |
--------------------------------------------------------------------------------
/src/Graphics/Drawing.purs:
--------------------------------------------------------------------------------
1 | -- | This module defines a type `Drawing` for creating vector graphics.
2 |
3 | module Graphics.Drawing
4 | ( Point
5 | , Shape, path, closed, rectangle, circle, arc
6 | , FillStyle, fillColor
7 | , OutlineStyle, outlineColor, lineWidth
8 | , Shadow, shadowOffset, shadowBlur, shadowColor, shadow
9 | , Drawing, filled, outlined, clipped, scale, translate, rotate, text
10 | , everywhere
11 | , render
12 | , module Color
13 | , module Font
14 | ) where
15 |
16 | import Prelude
17 |
18 | import Color (Color, cssStringHSLA)
19 | import Color (Color) as Color
20 | import Control.Alt ((<|>))
21 | import Data.Foldable (class Foldable, for_)
22 | import Data.List (List(..), singleton, (:), fromFoldable)
23 | import Data.Maybe (Maybe(..))
24 | import Effect (Effect)
25 | import Graphics.Canvas as Canvas
26 | import Graphics.Drawing.Font (Font, fontString)
27 | import Graphics.Drawing.Font (Font) as Font
28 | import Math (pi)
29 |
30 | -- | A `Point` consists of `x` and `y` coordinates.
31 | type Point = { x :: Number, y :: Number }
32 |
33 | -- | A single shape.
34 | data Shape
35 | -- | A path is a list of points joined by line segments
36 | = Path Boolean (List Point)
37 | -- | A rectangle consisting of the numbers left, top, width and height
38 | | Rectangle Canvas.Rectangle
39 | -- | A circular arc consisting of the numbers center-x, center-y, start angle, end angle and radius
40 | | Arc Canvas.Arc
41 | -- | A composite shape
42 | | Composite (List Shape)
43 |
44 | derive instance eqShape :: Eq Shape
45 |
46 | instance semigroupShape :: Semigroup Shape where
47 | append (Composite ds) d = Composite (ds <> singleton d)
48 | append d (Composite ds) = Composite (d : ds)
49 | append d1 d2 = Composite (Cons d1 (Cons d2 Nil))
50 |
51 | instance monoidShape :: Monoid Shape where
52 | mempty = Composite mempty
53 |
54 | -- | Create a path.
55 | path :: forall f. (Foldable f) => f Point -> Shape
56 | path = Path false <<< fromFoldable
57 |
58 | -- | Create a _closed_ path.
59 | closed :: forall f. (Foldable f) => f Point -> Shape
60 | closed = Path true <<< fromFoldable
61 |
62 | -- | Create a rectangle from the left, top, width and height parameters.
63 | rectangle :: Number -> Number -> Number -> Number -> Shape
64 | rectangle x y width height = Rectangle { x, y, width, height }
65 |
66 | -- | Create a circle from the left, top and radius parameters.
67 | circle :: Number -> Number -> Number -> Shape
68 | circle x y = arc x y 0.0 (pi * 2.0)
69 |
70 | -- | Create a circular arc from the left, top, start angle, end angle and
71 | -- | radius parameters.
72 | arc :: Number -> Number -> Number -> Number -> Number -> Shape
73 | arc x y start end radius = Arc { x, y, start, end, radius }
74 |
75 | -- | Encapsulates fill color etc.
76 | newtype FillStyle = FillStyle
77 | { color :: Maybe Color
78 | }
79 |
80 | instance semigroupFillStyle :: Semigroup FillStyle where
81 | append (FillStyle f1) (FillStyle f2) = FillStyle { color: f1.color <|> f2.color }
82 |
83 | instance monoidFillStyle :: Monoid FillStyle where
84 | mempty = FillStyle { color: Nothing }
85 |
86 | derive instance eqFillStyle :: Eq FillStyle
87 |
88 | -- | Set the fill color.
89 | fillColor :: Color -> FillStyle
90 | fillColor c = FillStyle { color: Just c }
91 |
92 | -- | Encapsulates outline color etc.
93 | newtype OutlineStyle = OutlineStyle
94 | { color :: Maybe Color
95 | , lineWidth :: Maybe Number
96 | }
97 |
98 | -- | Set the outline color.
99 | outlineColor :: Color -> OutlineStyle
100 | outlineColor c = OutlineStyle { color: Just c, lineWidth: Nothing }
101 |
102 | -- | Set the line width.
103 | lineWidth :: Number -> OutlineStyle
104 | lineWidth c = OutlineStyle { color: Nothing, lineWidth: Just c }
105 |
106 | instance semigroupOutlineStyle :: Semigroup OutlineStyle where
107 | append (OutlineStyle f1) (OutlineStyle f2) = OutlineStyle { color: f1.color <|> f2.color
108 | , lineWidth: f1.lineWidth <|> f2.lineWidth
109 | }
110 |
111 | instance monoidOutlineStyle :: Monoid OutlineStyle where
112 | mempty = OutlineStyle { color: Nothing
113 | , lineWidth: Nothing
114 | }
115 |
116 | derive instance eqOutlineStyle :: Eq OutlineStyle
117 |
118 | -- | Encapsulates shadow settings etc.
119 | newtype Shadow = Shadow
120 | { color :: Maybe Color
121 | , blur :: Maybe Number
122 | , offset :: Maybe { x :: Number, y :: Number }
123 | }
124 |
125 | derive instance eqShadow :: Eq Shadow
126 |
127 | -- | Set the shadow color.
128 | shadowColor :: Color -> Shadow
129 | shadowColor c = Shadow { color: Just c, blur: Nothing, offset: Nothing }
130 |
131 | -- | Set the shadow blur.
132 | shadowBlur :: Number -> Shadow
133 | shadowBlur b = Shadow { color: Nothing, blur: Just b, offset: Nothing }
134 |
135 | -- | Set the shadow blur.
136 | shadowOffset :: Number -> Number -> Shadow
137 | shadowOffset x y = Shadow { color: Nothing, blur: Nothing, offset: Just { x: x, y: y } }
138 |
139 | instance semigroupShadow :: Semigroup Shadow where
140 | append (Shadow s1) (Shadow s2) = Shadow { color: s1.color <|> s2.color
141 | , blur: s1.blur <|> s2.blur
142 | , offset: s1.offset <|> s2.offset
143 | }
144 |
145 | instance monoidShadow :: Monoid Shadow where
146 | mempty = Shadow { color: Nothing
147 | , blur: Nothing
148 | , offset: Nothing
149 | }
150 |
151 | -- | A vector `Drawing`.
152 | data Drawing
153 | = Fill Shape FillStyle
154 | | Outline Shape OutlineStyle
155 | | Text Font Number Number FillStyle String
156 | | Many (List Drawing)
157 | | Scale { scaleX :: Number, scaleY :: Number } Drawing
158 | | Translate { translateX :: Number, translateY :: Number } Drawing
159 | | Rotate Number Drawing
160 | | Clipped Shape Drawing
161 | | WithShadow Shadow Drawing
162 |
163 | instance semigroupDrawing :: Semigroup Drawing where
164 | append (Many ds) d = Many (ds <> singleton d)
165 | append d (Many ds) = Many (d : ds)
166 | append d1 d2 = Many (Cons d1 (Cons d2 Nil))
167 |
168 | instance monoidDrawing :: Monoid Drawing where
169 | mempty = Many mempty
170 |
171 | derive instance eqDrawing :: Eq Drawing
172 |
173 | -- | Fill a `Shape`.
174 | filled :: FillStyle -> Shape -> Drawing
175 | filled = flip Fill
176 |
177 | -- | Draw the outline of a `Shape`.
178 | outlined :: OutlineStyle -> Shape -> Drawing
179 | outlined = flip Outline
180 |
181 | -- | Clip a `Drawing` to a `Shape`.
182 | clipped :: Shape -> Drawing -> Drawing
183 | clipped = Clipped
184 |
185 | -- | Apply a `Shadow` to a `Drawing`.
186 | shadow :: Shadow -> Drawing -> Drawing
187 | shadow = WithShadow
188 |
189 | -- | Apply a scale transformation by providing the x and y scale factors.
190 | scale :: Number -> Number -> Drawing -> Drawing
191 | scale sx sy = Scale { scaleX: sx, scaleY: sy }
192 |
193 | -- | Apply a translation by providing the x and y distances.
194 | translate :: Number -> Number -> Drawing -> Drawing
195 | translate tx ty = Translate { translateX: tx, translateY: ty }
196 |
197 | -- | Apply a rotation by providing the angle.
198 | rotate :: Number -> Drawing -> Drawing
199 | rotate = Rotate
200 |
201 | -- | Render some text.
202 | text :: Font -> Number -> Number -> FillStyle -> String -> Drawing
203 | text = Text
204 |
205 | -- | Modify a `Drawing` by applying a transformation to every subdrawing.
206 | everywhere :: (Drawing -> Drawing) -> Drawing -> Drawing
207 | everywhere f = go
208 | where
209 | go (Many ds) = f (Many (map go ds))
210 | go (Scale s d) = f (Scale s (go d))
211 | go (Translate t d) = f (Translate t (go d))
212 | go (Rotate r d) = f (Rotate r (go d))
213 | go (Clipped s d) = f (Clipped s (go d))
214 | go (WithShadow s d) = f (WithShadow s (go d))
215 | go other = f other
216 |
217 | -- | Render a `Drawing` to a canvas.
218 | render :: Canvas.Context2D -> Drawing -> Effect Unit
219 | render ctx = go
220 | where
221 | go (Fill sh style) = void $ Canvas.withContext ctx do
222 | applyFillStyle style
223 | Canvas.fillPath ctx $
224 | renderShape sh
225 | go (Outline sh style) = void $ Canvas.withContext ctx do
226 | applyOutlineStyle style
227 | Canvas.strokePath ctx $
228 | renderShape sh
229 | go (Many ds) = for_ ds go
230 | go (Scale s d) = void $ Canvas.withContext ctx do
231 | _ <- Canvas.scale ctx s
232 | go d
233 | go (Translate t d) = void $ Canvas.withContext ctx do
234 | _ <- Canvas.translate ctx t
235 | go d
236 | go (Rotate r d) = void $ Canvas.withContext ctx do
237 | _ <- Canvas.rotate ctx r
238 | go d
239 | go (Clipped sh d) = void $ Canvas.withContext ctx do
240 | renderShape sh
241 | _ <- Canvas.clip ctx
242 | go d
243 | go (WithShadow sh d) = void $ Canvas.withContext ctx do
244 | applyShadow sh
245 | go d
246 | go (Text font x y style s) = void $ Canvas.withContext ctx do
247 | _ <- Canvas.setFont ctx (fontString font)
248 | applyFillStyle style
249 | Canvas.fillText ctx s x y
250 |
251 | applyShadow :: Shadow -> Effect Unit
252 | applyShadow (Shadow s) = do
253 | for_ s.color \color -> Canvas.setShadowColor ctx (cssStringHSLA color)
254 | for_ s.blur \blur -> Canvas.setShadowBlur ctx blur
255 | for_ s.offset \offset -> do
256 | _ <- Canvas.setShadowOffsetX ctx offset.x
257 | Canvas.setShadowOffsetY ctx offset.y
258 |
259 | applyFillStyle :: FillStyle -> Effect Unit
260 | applyFillStyle (FillStyle fs) = do
261 | for_ fs.color $ \color -> Canvas.setFillStyle ctx (cssStringHSLA color)
262 |
263 | applyOutlineStyle :: OutlineStyle -> Effect Unit
264 | applyOutlineStyle (OutlineStyle fs) = do
265 | for_ fs.color $ \color -> Canvas.setStrokeStyle ctx (cssStringHSLA color)
266 | for_ fs.lineWidth $ \width -> Canvas.setLineWidth ctx width
267 |
268 | renderShape :: Shape -> Effect Unit
269 | renderShape (Path _ Nil) = pure unit
270 | renderShape (Path cl (Cons p rest)) = do
271 | _ <- Canvas.moveTo ctx p.x p.y
272 | for_ rest \pt -> Canvas.lineTo ctx pt.x pt.y
273 | when cl $ void $ Canvas.closePath ctx
274 | renderShape (Rectangle r) = void $ Canvas.rect ctx r
275 | renderShape (Arc a) = void $ Canvas.arc ctx a
276 | renderShape (Composite ds) = for_ ds renderShape
277 |
--------------------------------------------------------------------------------