Merge pull request #72 from stefan-hoeck/with_metrics

[ new ] additional TextMeasure utilities

src/Web/MVC/Canvas/Scene.idr

@@ -123,8 +123,14 @@ measureText :
   -> TextMetrics
 measureText d a b f t = m.measure_ (show d) (show a) (show b) f t
 
+||| Supplies the given function with a `TextMeasure` implicit, derived
+||| from the given rendering context.
+export %inline
+withMetrics : CanvasRenderingContext2D -> (TextMeasure => a) -> a
+withMetrics cd f = f @{TM $ prim__measureText cd}
+
 ||| Alternative version of `apply` for those cases where we need to
 ||| work with text metrics.
 export
 applyWithMetrics : CanvasRenderingContext2D -> (TextMeasure => Scene) -> JSIO ()
-applyWithMetrics cd f = apply cd (f @{TM $ prim__measureText cd})
+applyWithMetrics cd f = withMetrics cd $ apply cd f

src/Web/MVC/View.idr

@@ -327,3 +327,13 @@ focus r = cmd_ (castElementByRef {t = HTMLElement} r >>= HTMLOrSVGElement.focus)
 export %inline
 blur : Ref t -> Cmd e
 blur r = cmd_ (castElementByRef {t = HTMLElement} r >>= HTMLOrSVGElement.blur)
+
+||| Provides a `TextMeasure` utility from the given `Canvas` to run the given
+||| command.
+export
+withMetricsFor : Ref Tag.Canvas -> (TextMeasure => Cmd e) -> Cmd e
+withMetricsFor ref c =
+  C $ \h => do
+    canvas <- castElementByRef {t = HTMLCanvasElement} ref
+    ctxt   <- context2D canvas
+    run (withMetrics ctxt c) h