Highlight next transitions

2 files changed, 29 insertions, 4 deletions

diff --git a/Handler/Home.hs b/Handler/Home.hs
index 0ee0882..a0eb24f 100644
--- a/Handler/Home.hs
+++ b/Handler/Home.hs
@@ -3,8 +3,10 @@ module Handler.Home where
 
 import Import
 
-import qualified Data.Text as T
 import Data.Aeson
+import qualified Data.Text as T
+import qualified Data.Map.Strict as Map
+import Data.Maybe (fromMaybe)
 import Text.Julius
 import Yesod.WebSockets
 import Turing.Examples
@@ -12,7 +14,7 @@ import Turing.Machine
 
 data Cmd = Beginning | Backward | Forward | Poll | MHello | MSub deriving Read
 
-data UpdM = UpdTape String | UpdTrans String | Stop
+data UpdM = UpdTape String | UpdTrans String | Stop | Bold Int
 -- instance FromJSON UpdM where
 --   parseJSON (Object v) = cons =<< (v .: "type")
 --     where cons :: String -> Parser UpdM
@@ -24,6 +26,7 @@ instance ToJSON UpdM where
                      UpdTape s -> ("tape"::String, s)
                      UpdTrans s -> ("trans", s)
                      Stop -> ("stop", "")
+                     Bold n -> ("bold", show n)
 
 wsTuring :: WebSocketsT Handler ()
 wsTuring = startMachine mHello defaultConfig
@@ -35,9 +38,10 @@ wsTuring = startMachine mHello defaultConfig
           defaultConfig = mkConfig . map charToSym $  "_"
           evalLoop m ic [] = evalLoop m ic [ic]
           evalLoop m ic cfgs@(c:cs) = do
+            sendTextData . encode $ Bold transRow
             sendTextData . encode . UpdTape . show $ c
             cmd <- receiveData
-            case (read . T.unpack $ cmd) of
+            case read . T.unpack $ cmd of
               Beginning -> evalLoop m ic [ic]
               Backward -> evalLoop m ic cs
               Forward -> case step c (delta m) of
@@ -47,6 +51,13 @@ wsTuring = startMachine mHello defaultConfig
               Poll -> evalLoop m ic cfgs
               MHello -> startMachine mHello defaultConfig
               MSub -> startMachine mSub mSubConfig
+            where transRow = fIdx (state c, tape c !! pos c) (Map.toList (trans m))
+                  fIdx y xs = fromMaybe (-1) (fIdx' y xs)
+                  fIdx' _ [] = Nothing
+                  fIdx' (st1,sym1) (((st2,sym2),_):xs) =
+                    if st1 == st2 && (sym1 == sym2 || sym2 == SymWild)
+                    then Just 0
+                    else fmap (+1) (fIdx' (st1,sym1) xs)
 
 getHomeR :: Handler Html
 getHomeR = do
diff --git a/templates/home.julius b/templates/home.julius
index b8c4231..ce1f513 100644
--- a/templates/home.julius
+++ b/templates/home.julius
@@ -12,6 +12,7 @@ $(function() {
   var pollInterval = 10000;
   var playing = false;
   var timeout = 150;
+  var transBak = "";
   function poll() {
     sock.send("Poll");
     setTimeout(poll, pollInterval);
@@ -78,9 +79,22 @@ $(function() {
     if (data["type"] === "tape") {
       ui.prTape.html(data["value"]);
     } else if (data["type"] === "trans") {
-      ui.prTrans.html(data["value"]);
+      transBak = data["value"];
+      ui.prTrans.html(transBak);
     } else if (data["type"] === "stop") {
       togglePlay();
+    } else if (data["type"] === "bold") {
+      var idx = parseInt(data["value"]);
+      if (idx >= 0) {
+        var trans = transBak.split("\n");
+        idx = idx+3;
+        trans[idx] = "<div style=\"display: inline; color: #ffffff; " +
+                     "background-color: #000000\">" + trans[idx] + "</div>";
+        trans[idx+1] = trans[idx+1]
+        ui.prTrans.html(trans.join("\n"));
+      } else {
+        ui.prTrans.html(transBak);
+      }
     }
   };
   sock.onerror = function (e) {