0 | module Web.Canvas
 1 |
 2 | import Derive.Prelude
 3 | import JS
 4 | import Text.HTML
 5 | import Web.Async.Util
 6 |
 7 | import public Web.Canvas.Angle
 8 | import public Web.Canvas.Hints
 9 | import public Web.Canvas.Scene
10 | import public Web.Canvas.Shape
11 | import public Web.Canvas.Style
12 | import public Web.Canvas.Transformation
13 |
14 | %default total
15 | %language ElabReflection
16 |
17 | %foreign "browser:lambda:(x,w)=>x.height"
18 | prim__height : HTMLCanvasElement -> PrimIO Double
19 |
20 | %foreign "browser:lambda:(x,v,w)=>{x.height = v}"
21 | prim__setHeight : HTMLCanvasElement -> Double -> PrimIO ()
22 |
23 | %foreign "browser:lambda:(x,w)=>x.width"
24 | prim__width : HTMLCanvasElement -> PrimIO Double
25 |
26 | %foreign "browser:lambda:(x,v,w)=>{x.width = v}"
27 | prim__setWidth : HTMLCanvasElement -> Double -> PrimIO ()
28 |
29 | %foreign "browser:lambda:(x,w)=>x.getContext('2d')"
30 | prim__context2D : HTMLCanvasElement -> PrimIO (Nullable CanvasRenderingContext2D)
31 |
32 | ||| Canvas dimensions
33 | public export
34 | record CanvasDims where
35 |   [noHints]
36 |   constructor CD
37 |   cwidth  : Double
38 |   cheight : Double
39 |
40 | %runElab derive "CanvasDims" [Show,Eq]
41 |
42 | parameters {auto has : Has JSErr es}
43 |   export
44 |   canvasDims : Ref Canvas -> JS es CanvasDims
45 |   canvasDims r = do
46 |     canvas <- castElementByRef {t = HTMLCanvasElement} r
47 |     w <- primIO (prim__width canvas)
48 |     h <- primIO (prim__height canvas)
49 |     pure (CD w h)
50 |
51 |   export
52 |   setCanvasDims : Ref Canvas -> CanvasDims -> JS es ()
53 |   setCanvasDims r (CD w h) = do
54 |     canvas <- castElementByRef {t = HTMLCanvasElement} r
55 |     primIO (prim__setWidth canvas w)
56 |     primIO (prim__setHeight canvas h)
57 |
58 |   export
59 |   context2D : HTMLCanvasElement -> JS es CanvasRenderingContext2D
60 |   context2D canvas = do
61 |   m <- primIO (prim__context2D canvas)
62 |   case nullableToMaybe m of
63 |     Just v  => pure v
64 |     Nothing => throw $ Caught "Web.Canvas.context2D: No 2D rendering context for canvas"
65 |
66 |   ||| Render a scene in a canvas in the DOM.
67 |   export
68 |   render : Ref Canvas -> (CanvasRenderingContext2D => IO1 ()) -> JS es ()
69 |   render ref scene = do
70 |   canvas <- castElementByRef {t = HTMLCanvasElement} ref
71 |   ctxt   <- context2D canvas
72 |   w      <- primIO (prim__width canvas)
73 |   h      <- primIO (prim__height canvas)
74 |   lift1 (clearRect 0 0 w h)
75 |   lift1 scene
76 |