Bezier.hs/approaches.hs at master · hrldcpr/Bezier.hs · GitHub

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

type Time = Float
type Point = [Float]


--
-- Simple
--

bezier :: [Point] -> Time -> Point
bezier [p] t = p
bezier ps  t = line (bezier (init ps) t) (bezier (tail ps) t) t

line :: Point -> Point -> Float -> Point
line p q = \t -> zipWith line1d p q
  where line1d a b = (1 - t)*a + t*b


--
-- Applicative Functor
--

import Control.Applicative (<*>)

type Parametric a = Float -> a

bezier :: [Point] -> Parametric Point
bezier [p] = const p
bezier ps  = line <*> (bezier (init ps)) <*> (bezier (tail ps))

line :: Parametric (Point -> Point -> Point)
line t p q = zipWith line1d p q
  where line1d a b = (1 - t)*a + t*b


--
-- Reader Monad
--

import Control.Monad.Reader

type Parametric a = Reader Float a

bezier :: [Point] -> Parametric Point
bezier [p] = return p
bezier ps  = do l <- bezier (init ps)
                r <- bezier (tail ps)
                line l r

line :: Point -> Point -> Parametric Point
line p q = zipWithM line1d p q

line1d :: Float -> Float -> Parametric Float
line1d a b = reader $ \t -> (1 - t)*a + t*b


--
-- Function Monad
--

import Control.Monad (zipWithM)

type Parametric a = Float -> a

bezier :: [Point] -> Parametric Point
bezier [p] = return p
bezier ps  = do l <- bezier (init ps)
                r <- bezier (tail ps)
                line l r

line :: Point -> Point -> Parametric Point
line p q = zipWithM line1d p q

line1d :: Float -> Float -> Parametric Float
line1d a b = \t -> (1 - t)*a + t*b


--
-- Applicative Function Monad
--

import Control.Monad (join, zipWithM)

type Parametric a = Float -> a

bezier :: [Point] -> Parametric Point
bezier [p] = const p
bezier ps  = join $ line <$> bezier (init ps) <*> bezier (tail ps)

line :: Point -> Point -> Parametric Point
line p q = zipWithM line1d p q

line1d :: Float -> Float -> Parametric Float
line1d a b = \t -> (1 - t)*a + t*b


--
-- De Casteljau, from Wikipedia
--

bezier :: [Point] -> Parametric Point
bezier [p] = return p
bezier ps = bezier =<< zipWithM line ps (tail ps)