From 74a0c13b0ff72c755ac9402e0a873f628fa3a518 Mon Sep 17 00:00:00 2001
From: opyapeus <opyapeus@gmail.com>
Date: Thu, 7 Feb 2019 13:00:23 +0900
Subject: [PATCH] Add TextBaseline

---
 src/Graphics/Canvas.js   | 14 +++++++++++
 src/Graphics/Canvas.purs | 50 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 64 insertions(+)

diff --git a/src/Graphics/Canvas.js b/src/Graphics/Canvas.js
index 7e78ea1..1cae278 100644
--- a/src/Graphics/Canvas.js
+++ b/src/Graphics/Canvas.js
@@ -321,6 +321,20 @@ exports.setTextAlignImpl = function(ctx) {
     }
 };
 
+exports.textBaselineImpl = function (ctx) {
+    return function () {
+        return ctx.textBaseline;
+    }
+};
+
+exports.setTextBaselineImpl = function (ctx) {
+    return function (textBaseline) {
+        return function () {
+            ctx.textBaseline = textBaseline;
+        }
+    }
+};
+
 exports.font = function(ctx) {
     return function() {
         return ctx.font;
diff --git a/src/Graphics/Canvas.purs b/src/Graphics/Canvas.purs
index b24f13d..f59a597 100644
--- a/src/Graphics/Canvas.purs
+++ b/src/Graphics/Canvas.purs
@@ -17,6 +17,7 @@ module Graphics.Canvas
   , Transform
   , TranslateTransform
   , TextAlign(..)
+  , TextBaseline(..)
   , CanvasPattern
   , PatternRepeat(..)
   , CanvasGradient
@@ -75,6 +76,8 @@ module Graphics.Canvas
 
   , textAlign
   , setTextAlign
+  , textBaseline
+  , setTextBaseline
   , font
   , setFont
   , fillText
@@ -521,6 +524,53 @@ setTextAlign ctx textalign =
     toString AlignStart = "start"
     toString AlignEnd = "end"
 
+-- | Enumerates types of text baseline.
+data TextBaseline
+  = BaselineTop
+  | BaselineHanging
+  | BaselineMiddle
+  | BaselineAlphabetic
+  | BaselineIdeographic
+  | BaselineBottom
+
+instance showTextBaseline :: Show TextBaseline where
+  show BaselineTop = "BaselineTop"
+  show BaselineHanging = "BaselineHanging"
+  show BaselineMiddle = "BaselineMiddle"
+  show BaselineAlphabetic = "BaselineAlphabetic"
+  show BaselineIdeographic = "BaselineIdeographic"
+  show BaselineBottom = "BaselineBottom"
+
+foreign import textBaselineImpl :: Context2D -> Effect String
+
+-- | Get the current text baseline.
+textBaseline :: Context2D -> Effect TextBaseline
+textBaseline ctx = unsafeParseTextBaseline <$> textBaselineImpl ctx
+  where
+  unsafeParseTextBaseline :: String -> TextBaseline
+  unsafeParseTextBaseline "top" = BaselineTop
+  unsafeParseTextBaseline "hanging" = BaselineHanging
+  unsafeParseTextBaseline "middle" = BaselineMiddle
+  unsafeParseTextBaseline "alphabetic" = BaselineAlphabetic
+  unsafeParseTextBaseline "ideographic" = BaselineIdeographic
+  unsafeParseTextBaseline "bottom" = BaselineBottom
+  unsafeParseTextBaseline align = unsafeThrow $ "invalid TextBaseline: " <> align
+  -- ^ dummy to silence compiler warnings
+
+foreign import setTextBaselineImpl :: Context2D -> String -> Effect Unit
+
+-- | Set the current text baseline.
+setTextBaseline :: Context2D -> TextBaseline -> Effect Unit
+setTextBaseline ctx textbaseline =
+  setTextBaselineImpl ctx (toString textbaseline)
+  where
+    toString BaselineTop = "top"
+    toString BaselineHanging = "hanging"
+    toString BaselineMiddle = "middle"
+    toString BaselineAlphabetic = "alphabetic"
+    toString BaselineIdeographic = "ideographic"
+    toString BaselineBottom = "bottom"
+
 -- | Text metrics:
 -- |
 -- | - The text width in pixels.