1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
--
-- Miguel's Simple SVG Generator
--
-- Author: Michal Idziorek <m.i@gmx.at>
-- Last Update: May 11th, 2018
--
{-# LANGUAGE ExistentialQuantification #-}
module SimpleSvg (
svgGenerate -- canvas to svg
,svgEmpty -- empty canvas
,svgAdd -- add to canvas (single)
,svgAddList -- add to canvas (list)
,svgCircle -- circle
,svgLine -- line
,svgTriangle -- trianvle
,svgFilledCircle -- filled circle
,svgFilledLine -- filled line
,svgFilledTriangle -- filled trianvle
,svgColor -- colors and shades of gray
,svgRed
,svgGreen
,svgBlue
,svgWhite
,svgBlack
,svgShGray
,svgRedLine -- red line
,svgBluePoint -- small blue circle
,svgGreenTriangle -- green triangle
) where
-- CONFIG --
svgStrokeWidth = 2
-- SHAPES --
-- A few predefined shapes easing a quickstart as well as serving as an
-- example, for how to define them in your own code.
svgRedLine = svgLine svgRed
svgBluePoint pos = svgCircle svgBlue pos 2
svgGreenTriangle = svgTriangle svgGreen
-- Shape construction
svgLine c (x1,y1) (x2,y2) =
svgShape c (SvgLine (svgCoord x1 y1) (svgCoord x2 y2))
svgCircle c (x,y) r =
svgShape c (SvgCircle (svgCoord x y) r)
svgTriangle c (x1,y1) (x2,y2) (x3,y3)=
svgShape c (SvgTriangle (svgCoord x1 y1) (svgCoord x2 y2) (svgCoord x3 y3))
svgFilledLine c1 c2 (x1,y1) (x2,y2) =
svgFilledShape c1 c2 (SvgLine (svgCoord x1 y1) (svgCoord x2 y2))
svgFilledCircle c1 c2 (x,y) r =
svgFilledShape c1 c2 (SvgCircle (svgCoord x y) r)
svgFilledTriangle c1 c2 (x1,y1) (x2,y2) (x3,y3)=
svgFilledShape c1 c2 (SvgTriangle (svgCoord x1 y1) (svgCoord x2 y2) (svgCoord x3 y3))
svgShape c1 = SvgPrim c1 (svgNoFill)
svgFilledShape c1 c2 = SvgPrim c1 (svgFill c2)
-- CANVAS --
data SvgCanvas = SvgCanvas SvgColor Int Int [SvgPrim]
svgEmpty c w h = SvgCanvas c w h []
svgAdd (SvgCanvas c w h xs) x = SvgCanvas c w h (x:xs)
svgAddList (SvgCanvas c w h xs) ys = SvgCanvas c w h (reverse ys++xs)
svgGenerate (SvgCanvas col width height prims) =
xml_enc "svg" [("height",show height),("width", show width),
("style","background-color:"++svgGenColor col)]
body
where body = foldl f "" prims
f a x = primToSvg x++a
-- COLORS --
-- color type along with a few predefined colors to work with
newtype SvgColor = SvgColor (Int,Int,Int)
svgColor r g b = SvgColor (r,g,b)
svgRed = svgColor 255 0 0
svgBlue = svgColor 0 0 255
svgGreen = svgColor 0 255 0
svgShGray v = svgColor v v v
svgBlack = svgShGray 0
svgWhite = svgShGray 255
svgGenColor (SvgColor (r,g,b)) = "rgb("++show r++","++show g++","++show b++")"
-- the fill color is wrapped inside a Maybe type, since it is optional
newtype SvgFill = SvgFill (Maybe SvgColor)
svgFill col = SvgFill (Just col)
svgNoFill = SvgFill Nothing
-- SHAPES --
-- A class for shapes that we want to transform into SVG
-- We define instances for circle, line and triangle
-- The 2D coordinates are wrapped inside a newtype SvgCoord
newtype SvgCoord = SvgCoord (Double,Double)
svgCoord x y = SvgCoord (x,y)
data SvgPrim = forall a.SvgPrimClass a => SvgPrim SvgColor SvgFill a
class SvgPrimClass a where
getSvg :: a->(String,[(String,String)])
data SvgCircle = SvgCircle SvgCoord Double
instance SvgPrimClass SvgCircle where
getSvg (SvgCircle (SvgCoord (x,y)) r) =
("circle", [("cx",show x),("cy",show y),("r",show r)])
data SvgLine = SvgLine SvgCoord SvgCoord
instance SvgPrimClass SvgLine where
getSvg (SvgLine (SvgCoord (x1,y1)) (SvgCoord (x2,y2))) =
("line", [("x1",show x1),("y1",show y1),
("x2",show x2),("y2",show y2)])
data SvgTriangle = SvgTriangle SvgCoord SvgCoord SvgCoord
instance SvgPrimClass SvgTriangle where
getSvg (SvgTriangle (SvgCoord (x1,y1)) (SvgCoord (x2,y2)) (SvgCoord (x3,y3))) =
("polygon", [("points",pts)])
where pts=show x1++","++show y1++" "++
show x2++","++show y2++" "++
show x3++","++show y3
-- transform single primitve to SVG
primToSvg (SvgPrim col (SvgFill fill) prim) = xml_enc tag (attrs++attrs2) ""
where (tag, attrs)=getSvg prim
attrs2=[ ("fill",maybe "none" svgGenColor fill)
,("stroke",svgGenColor col)
,("stroke-width",show svgStrokeWidth)]
-- XML ENCODER --
xml_enc tag attrs body = "<"++tag++" "++xml_attrs++">"++body++"</"++tag++">"
where xml_attrs = unlines $ map xml_attr attrs
xml_attr (a,v) = a++"=\""++v++"\" "
|
