From ff13105bf90757c775a33493df62314b3f40a40d Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Sun, 10 Jan 2021 21:49:27 +1300
Subject: [PATCH] Add sound effects to clarification prompt.

---
 src/Links.hs  | 25 +++++++++++++++++++++++++
 src/Render.hs |  4 ----
 src/main.c    |  7 ++++---
 3 files changed, 29 insertions(+), 7 deletions(-)

diff --git a/src/Links.hs b/src/Links.hs
index 6dd2535..c69bad7 100644
--- a/src/Links.hs
+++ b/src/Links.hs
@@ -6,6 +6,7 @@ import qualified Data.Map as M
 import Network.MIME.Info as MIME
 import Network.URI
 import Data.Text (Text, unpack, append, pack, replace, strip)
+import qualified Data.Text.Lazy as LTxt
 import qualified Data.Text.Foreign as FTxt
 import Data.Maybe
 
@@ -190,3 +191,27 @@ c_extractLinks c_page = do
     newArray0 nil $ concat ret
 
 text2cstring txt = FTxt.withCStringLen txt $ \s -> (peekCStringLen s >>= newCString)
+
+foreign export ccall c_formatLink :: CString -> CString -> CString -> IO CString
+
+c_formatLink c_label c_title c_url = do
+    label <- ctext c_label
+    title <- ctext c_title
+    url <- ctext c_url
+
+    sfx <- getXdgDirectory XdgCache "rhapsode"
+    let bulletpoint_el = audio (sfx </> "bulletpoint.wav")
+    let label_el = prosody [("pitch", "low")] label
+    let title_el = prosody [("volume", "soft")] title
+    let link_el = audio (sfx </> "link.wav")
+    let url_el = style "punctuation" "all" $ style "capital_letters" "pitch" $ prosody [("rate", "fast")] url
+    let root = el "speak" [] $ map NodeElement [bulletpoint_el, label_el, title_el, link_el, url_el]
+
+    let ssml = renderText def $ Document (Prologue [] Nothing []) root []
+    newCString $ LTxt.unpack ssml
+  where
+    ctext cstr = pack <$> peekCString cstr
+    el name attrs childs = Element name (M.fromList attrs) childs
+    audio src = el "audio" [("src", pack src)] []
+    prosody attrs txt = el "prosody" attrs [NodeContent txt]
+    style field mode inner = el "tts:style" [("field", field), ("mode", mode)] [NodeElement inner]
diff --git a/src/Render.hs b/src/Render.hs
index d9ba67a..1fcea65 100644
--- a/src/Render.hs
+++ b/src/Render.hs
@@ -181,7 +181,3 @@ c_renderDoc c_session c_page rewriteURLs = do
     B.toStrict ssml `useAsCString` \cstr -> do
         str <- peekCString cstr
         newCString str
-
-foreign export ccall c_cachedir :: IO CString
-
-c_cachedir = Dir.getXdgDirectory Dir.XdgCache "rhapsode" >>= newCString
diff --git a/src/main.c b/src/main.c
index 51363c2..e9b649f 100644
--- a/src/main.c
+++ b/src/main.c
@@ -34,6 +34,7 @@ char *c_renderDoc(struct session*, struct page*, _Bool);
 char **c_extractLinks(struct page*);
 char **c_docLinksAndRendering(struct session*, struct page*, _Bool); // FIXME segfaults.
 int c_ssmlHasMark(char*, char*);
+char *c_formatLink(char *label, char *title, char *url);
 
 char *c_lastVisited(char*);
 
@@ -215,9 +216,9 @@ char *select_link(char **links, char *command) {
 
         // Communicate 
         printf("%s\t%s\t%s\n", links[i+2], links[i], links[i+1]);
-        speak_text(links[i+2], espeakRATE, 20); // URL, fast
-        speak_text(links[i], espeakPITCH, -40); // Label, low
-        speak_text(links[i+1], espeakVOLUME, -40); // Title, quite
+        char *ssml = c_formatLink(links[i], links[i+1], links[i+2]);
+        speak(ssml, NULL, NULL);
+        free(ssml);
     }
 
     return NULL;
-- 
2.30.2