From 3e18d13c523b9c537eb53f9b926ce9f2ff201fd9 Mon Sep 17 00:00:00 2001 From: Guillermo Ramos Date: Thu, 5 Feb 2015 17:40:53 +0100 Subject: Examples --- Handler/Home.hs | 44 ++++++++++++++++++++++++++------------------ config/settings.yml | 2 +- templates/home.hamlet | 7 ++++++- templates/home.julius | 19 +++++++++++++++---- 4 files changed, 48 insertions(+), 24 deletions(-) diff --git a/Handler/Home.hs b/Handler/Home.hs index 1eff93d..aa4a6f1 100644 --- a/Handler/Home.hs +++ b/Handler/Home.hs @@ -12,37 +12,43 @@ import Yesod.WebSockets import Turing.Examples import Turing.Machine -data Cmd = Beginning | Backward | Forward | Poll deriving Read +data Cmd = Beginning | Backward | Forward | Poll | MHello | MSub deriving Read -data UpdM = UpdTape String | UpdTrans String -instance FromJSON UpdM where - parseJSON (Object v) = cons =<< (v .: "type") - where cons :: String -> Parser UpdM - cons t = (if t == "tape" then UpdTape else UpdTrans) <$> v .: "value" - parseJSON _ = mzero +data UpdM = UpdTape String | UpdTrans String | Stop +-- instance FromJSON UpdM where +-- parseJSON (Object v) = cons =<< (v .: "type") +-- where cons :: String -> Parser UpdM +-- cons t = (if t == "tape" then UpdTape else UpdTrans) <$> v .: "value" +-- parseJSON _ = mzero instance ToJSON UpdM where toJSON um = object ["type" .= ty, "value" .= v] where (ty, v) = case um of UpdTape s -> ("tape"::String, s) UpdTrans s -> ("trans", s) + Stop -> ("stop", "") wsTuring :: WebSocketsT Handler () -wsTuring = do sendTextData . encode . UpdTrans . showTrans . trans $ - defaultMachine - evalLoop defaultMachine [defaultConfig] - where defaultMachine = mWriteStr "Hello!" +wsTuring = startMachine mHello defaultConfig + where startMachine m ic = do + sendTextData . encode . UpdTrans . showTrans . trans $ m + evalLoop m ic [ic] + mHello = mWriteStr "Hello!" + mSubConfig = mkConfig . map charToSym $ "_aaaaaa_aaa" defaultConfig = mkConfig . map charToSym $ "_" - evalLoop m [] = evalLoop m [defaultConfig] - evalLoop m cfgs@(c:cs) = do + evalLoop m ic [] = evalLoop m ic [ic] + evalLoop m ic cfgs@(c:cs) = do sendTextData . encode . UpdTape . show $ c cmd <- receiveData case (read . T.unpack $ cmd) of - Beginning -> evalLoop defaultMachine [defaultConfig] - Backward -> evalLoop m cs + Beginning -> evalLoop m ic [ic] + Backward -> evalLoop m ic cs Forward -> case step c (delta m) of - Just c' -> evalLoop m (c':cfgs) - Nothing -> evalLoop m cfgs - Poll -> evalLoop m cfgs + Just c' -> evalLoop m ic (c':cfgs) + Nothing -> do sendTextData . encode $ Stop + evalLoop m ic cfgs + Poll -> evalLoop m ic cfgs + MHello -> startMachine mHello defaultConfig + MSub -> startMachine mSub mSubConfig getHomeR :: Handler Html getHomeR = do @@ -64,5 +70,7 @@ getHomeR = do butForward <- newIdent prTape <- newIdent prTrans <- newIdent + eHello <- newIdent + eSub <- newIdent $(widgetFile "home") diff --git a/config/settings.yml b/config/settings.yml index 6ff875a..d980a6b 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -2,7 +2,7 @@ Default: &defaults host: "*4" # any IPv4 host port: 3000 approot: "http://localhost:3000" - copyright: © 2014 Guillermo Ramos + copyright: © 2014-2015 Guillermo Ramos (guillermo.ramos@imdea.org) #analytics: UA-YOURCODE Development: diff --git a/templates/home.hamlet b/templates/home.hamlet index 9b429b5..6eb2991 100644 --- a/templates/home.hamlet +++ b/templates/home.hamlet @@ -1,7 +1,12 @@
-

Turing Machine simulator! +

Turing Machine simulator
+
+
+

Some examples: # + Hello, # + Unary substraction (5-2) 

diff --git a/templates/home.julius b/templates/home.julius
index e679e40..b8c4231 100644
--- a/templates/home.julius
+++ b/templates/home.julius
@@ -5,7 +5,9 @@ $(function() {
     bTogglePlay : $("##{rawJS butTogglePlay}"),
     bForward    : $("##{rawJS butForward}"),
     prTape      : $("##{rawJS prTape}"),
-    prTrans     : $("##{rawJS prTrans}")
+    prTrans     : $("##{rawJS prTrans}"),
+    eHello      : $("##{rawJS eHello}"),
+    eSub        : $("##{rawJS eSub}"),
   };
   var pollInterval = 10000;
   var playing = false;
@@ -32,6 +34,7 @@ $(function() {
   };
   function togglePlay() {
     var btns = [ui.bBeginning, ui.bBackward, ui.bForward];
+    ui.bTogglePlay.children().toggleClass("glyphicon-play glyphicon-stop");
     playing = !playing;
     if (playing === true) {
       disableButtons(btns);
@@ -47,13 +50,18 @@ $(function() {
     sock.send("Backward");
   });
   ui.bTogglePlay.on("click", function () {
-    ui.bTogglePlay.children().toggleClass("glyphicon-play glyphicon-stop");
     togglePlay();
   });
   ui.bForward.on("click", function () {
     sock.send("Forward");
   });
   sock = new WebSocket("wss://" + window.location.host);
+  ui.eHello.on("click", function () {
+    sock.send("MHello");
+  });
+  ui.eSub.on("click", function () {
+    sock.send("MSub");
+  });
   sock.onopen = function (e) {
     enableButtons([ui.bBeginning, ui.bBackward,
                    ui.bTogglePlay, ui.bForward]);
@@ -62,7 +70,8 @@ $(function() {
   sock.onclose = function (e) {
     disableButtons([ui.bBeginning, ui.bBackward,
                     ui.bTogglePlay, ui.bForward]);
-    alert("SOCKET CLOSED! D: (" + e.code + ")");
+    alert("WEBSOCKET CLOSED. At this point, reloading the page " +
+          "is probably the wise thing to do.");
   };
   sock.onmessage = function (e) {
     var data = JSON.parse(e.data);
@@ -70,9 +79,11 @@ $(function() {
       ui.prTape.html(data["value"]);
     } else if (data["type"] === "trans") {
       ui.prTrans.html(data["value"]);
+    } else if (data["type"] === "stop") {
+      togglePlay();
     }
   };
   sock.onerror = function (e) {
-    alert("ERROR! D: (" + e + ")");
+    console.debug("ERROR: " + e.data);
   };
 });
-- 
cgit v1.2.3