-
Notifications
You must be signed in to change notification settings - Fork 63
/
clipTo.hs
52 lines (40 loc) · 1.27 KB
/
clipTo.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
import Data.Maybe
import Diagrams.Prelude
import Diagrams.Backend.SVG.CmdLine
clipPath :: Path R2
clipPath = square 2 # alignR
loopyStar :: Diagram B R2
loopyStar = mconcat
. map (cubicSpline True)
. pathVertices
. star (StarSkip 3)
$ regPoly 7 1
clippedStar :: Diagram B R2
clippedStar = clipTo clipPath (loopyStar # fc lightgray)
example :: Diagram B R2
example = position (zip pts dots)
<> traceArrows # lc cyan
<> clippedStar
<> loopyStar
pts :: [P2]
pts = [ (-1) ^& 0.9, (-0.65) ^& 0.65, (-0.25) ^& 0.65, (-0.25) ^& 0.4
, (-0.1) ^& 0.9, 0.1 ^& 0.9, 0.25 ^& 0.4, 0.25 ^& 0.65
, 0.65 ^& 0.65, 1 ^& 0.9 ]
vecs :: [R2]
vecs = [unitX, unitY, unit_X, unit_Y]
tracePt :: P2 -> [Double]
tracePt p = map (maybe 0 magnitude) vs where
vs = (rayTraceV p) <$> vecs <*> [clippedStar]
traceArrows :: Diagram B R2
traceArrows = mconcat $ map ptArrows pts where
ptArrows p = mconcat $
map (arrowAt' (with & headSize .~ 0.1) p)
. catMaybes $ rayTraceV p <$> vecs <*> [clippedStar]
traces :: [[Double]]
traces = map tracePt pts
dots :: [Diagram B R2]
dots = repeat (circle 0.015 # fc red # lw 0)
main :: IO ()
main = do
putStr $ unlines $ map show traces
mainWith $ example # centerXY # pad 1.1