summaryrefslogtreecommitdiff
path: root/testsuite/tests/dph/quickhull/SVG.hs
blob: c750fb06f54d08f37999e6da3a3609a5d33c8920 (plain)
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

module SVG where

-- Making a SVG diagram of the points and hull
makeSVG :: [(Int, Int)] -> [(Int, Int)] -> String
makeSVG points hull
        = unlines
        $  [ "<svg width=\"100%\" height=\"100%\" version=\"1.1\" xmlns=\"http://www.w3.org/2000/svg\">" ]
        ++ [svgPolygon hull]
        ++ map svgPoint points
        ++ map svgPointHull hull
        ++ ["</svg>"]

svgPolygon  :: [(Int, Int)] -> String
svgPolygon points
        =  "<polygon"
        ++ " points=\"" ++ (concat [show x ++ "," ++ show y ++ " " | (x, y) <- points]) ++ "\""
        ++ " style=\"fill:#d0d0ff;stroke:#000000;stroke-width:1\""
        ++ "/>"

svgPoint :: (Int, Int) -> String
svgPoint (x, y)
        = "<circle cx=\"" ++ show x ++ "\" cy=\"" ++ show y ++ "\" r=\"0.5\""
        ++ " style=\"stroke:#000000\""
        ++ "/>"

svgPointHull :: (Int, Int) -> String
svgPointHull (x, y)
        = "<circle cx=\"" ++ show x ++ "\" cy=\"" ++ show y ++ "\" r=\"1\""
        ++ " style=\"stroke:#ff0000\""
        ++ "/>"

roundPoints :: [(Double, Double)] -> [(Int, Int)]
roundPoints ps = [(round x, round y) | (x, y) <- ps]