0 | module Web.MVC.Canvas
 1 |
 2 | import Derive.Prelude
 3 | import JS
 4 | import Text.HTML.Ref
 5 | import Text.HTML.Tag
 6 | import Web.Html
 7 | import Web.MVC.Util
 8 |
 9 | import public Web.MVC.Canvas.Angle
10 | import public Web.MVC.Canvas.Scene
11 | import public Web.MVC.Canvas.Shape
12 | import public Web.MVC.Canvas.Style
13 | import public Web.MVC.Canvas.Transformation
14 |
15 | %default total
16 | %language ElabReflection
17 |
18 | ||| Canvas dimensions
19 | public export
20 | record CanvasDims where
21 |   [noHints]
22 |   constructor CD
23 |   cwidth  : Double
24 |   cheight : Double
25 |
26 | %runElab derive "CanvasDims" [Show,Eq]
27 |
28 | export
29 | canvasDims : Ref Canvas -> JSIO CanvasDims
30 | canvasDims r = do
31 |   canvas <- castElementByRef {t = HTMLCanvasElement} r
32 |   w      <- cast <$> get canvas width
33 |   h      <- cast <$> get canvas height
34 |   pure $ CD w h
35 |
36 | export
37 | setCanvasDims : Ref Canvas -> CanvasDims -> JSIO ()
38 | setCanvasDims r (CD w h) = do
39 |   canvas <- castElementByRef {t = HTMLCanvasElement} r
40 |   set (width  canvas) (cast w)
41 |   set (height canvas) (cast h)
42 |
43 | export
44 | context2D : HTMLCanvasElement -> JSIO CanvasRenderingContext2D
45 | context2D canvas = do
46 |   m      <- getContext canvas "2d"
47 |   case m >>= project CanvasRenderingContext2D of
48 |     Just c  => pure c
49 |     Nothing => throwError $ Caught "Web.MVC.Canvas.context2d: No rendering context for canvas"
50 |
51 | ||| Render a scene in a canvas in the DOM.
52 | export
53 | renderWithMetrics : Ref Canvas -> (TextMeasure => CanvasDims -> Scene) -> JSIO ()
54 | renderWithMetrics ref scene = do
55 |   canvas <- castElementByRef {t = HTMLCanvasElement} ref
56 |   ctxt   <- context2D canvas
57 |   w      <- cast <$> get canvas width
58 |   h      <- cast <$> get canvas height
59 |   apply ctxt $ Rect 0 0 w h Clear
60 |   applyWithMetrics ctxt (scene (CD w h))
61 |
62 | ||| Render a scene in a canvas in the DOM.
63 | export %inline
64 | render : Ref Canvas -> (CanvasDims -> Scene) -> JSIO ()
65 | render ref scene = renderWithMetrics ref scene
66 |