-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathrender.hs
71 lines (55 loc) · 2.08 KB
/
render.hs
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
-- | A module for rendering lines as an HTML5 file containing an SVG image.
-- This can be used to visualize the denotational semantics of a MiniLogo
-- program.
--
-- NOTE: You should not change the definitions in this file!
--
module Render (Point,Line,toHTML) where
import Data.List (intercalate)
-- | A point is a cartesian pair (x,y).
type Point = (Int,Int)
-- | A line is defined by its endpoints.
type Line = (Point,Point)
-- | Output a list of lines as an HTML5 file containing an SVG image.
toHTML :: [Line] -> IO ()
toHTML ls = writeFile "MiniMiniLogo.html" (header ++ content ls ++ footer)
--
-- Private definitions. All definitions below this point will not be visible
-- from within a module that imports this module.
--
scale, margin, width, height :: Int
scale = 10
margin = 10
width = 800
height = 400
style = "fill:white;stroke:red;stroke-width:2"
title = "<head><title>MiniLogo Semantics Viewer</title></head>"
view = "<svg width='100%' viewBox='0 0 "
++ show (width + 2*margin) ++ " "
++ show (height + 2*margin) ++ "'>"
border = "<rect x='" ++ show (margin-3) ++
"' y='" ++ show (margin-3) ++
"' width='" ++ show (width +6) ++
"' height='" ++ show (height+5) ++
"' style='fill:none;stroke:black;stroke-width:2'/>"
header = unlines ["<!DOCTYPE html>", "<html>", title, "<body>", view, border]
footer = unlines ["</svg>","</body>","</html>"]
content :: [Line] -> String
content = unlines . map poly . chunk
-- | A canvas-adjusted point as a string.
point :: Point -> String
point (x,y) = show xp ++ "," ++ show yp
where xp = x*scale + margin
yp = height - y*scale + margin
-- | Chunk a bunch of lines into sequences of connected points.
chunk :: [Line] -> [[Point]]
chunk [] = []
chunk [(p,q)] = [[p,q]]
chunk ((p,q):ls) | q == head ps = (p:ps) : pss
| otherwise = [p,q] : ps : pss
where (ps:pss) = chunk ls
-- | Draw a sequence of connected points.
poly :: [Point] -> String
poly ps = "<polyline points='"
++ intercalate " " (map point ps)
++ "' style='" ++ style ++ "'/>"