0 | module Web.MVC.Canvas.Transformation
 1 |
 2 | import JS
 3 | import Web.Html
 4 | import Web.MVC.Canvas.Angle
 5 |
 6 | --------------------------------------------------------------------------------
 7 | --          Transformation
 8 | --------------------------------------------------------------------------------
 9 |
10 | public export
11 | data Transformation : Type where
12 |   Id        : Transformation
13 |   Transform : (a,b,c,d,e,f : Double) -> Transformation
14 |
15 | export
16 | scale : (h,w : Double) -> Transformation
17 | scale h w = Transform h 0 0 w 0 0
18 |
19 | export
20 | rotate : Angle -> Transformation
21 | rotate phi =
22 |   let r := toRadians phi
23 |       c := cos r
24 |       s := sin r
25 |    in Transform c s (-s) c 0 0
26 |
27 | export
28 | translate : (dx,dy : Double) -> Transformation
29 | translate dx dy = Transform 0 0 0 0 dx dy
30 |
31 | export
32 | mult : Transformation -> Transformation -> Transformation
33 | mult Id x  = x
34 | mult x  Id = x
35 | mult (Transform a1 b1 c1 d1 e1 f1) (Transform a2 b2 c2 d2 e2 f2) =
36 |   Transform
37 |     (a1 * a2 + c1 * b2)
38 |     (b1 * a2 + d1 * b2)
39 |     (a1 * c2 + c1 * d2)
40 |     (b1 * c2 + d1 * d2)
41 |     (a1 * e2 + c1 * f2 + e1)
42 |     (b1 * e2 + d1 * f2 + f1)
43 |
44 | export %inline
45 | Semigroup Transformation where
46 |   (<+>) = mult
47 |
48 | export %inline
49 | Monoid Transformation where
50 |   neutral = Id
51 |
52 | --------------------------------------------------------------------------------
53 | --          IO
54 | --------------------------------------------------------------------------------
55 |
56 | export
57 | apply : CanvasRenderingContext2D -> Transformation -> JSIO ()
58 | apply ctxt Id                      = pure ()
59 | apply ctxt (Transform a b c d e f) = setTransform ctxt a b c d e f
60 |