Initial working command line
authorGerd Flaig <gefla@gefla-mac-zrh>
Sun, 14 Dec 2008 22:35:07 +0000 (23:35 +0100)
committerGerd Flaig <gefla@gefla-mac-zrh>
Sun, 14 Dec 2008 22:35:07 +0000 (23:35 +0100)
empire.lisp
package.lisp
static/eow.js
static/login.html [new file with mode: 0644]
static/test.html
web.lisp

index 7685f5582a7ff93d4ed2acf5d5a1713c690566fe..5d1b950b5cfa6a81fb24066239f3de0438f7bb72 100644 (file)
@@ -139,7 +139,8 @@ this stream.")
 (defmethod handle-data ((m play-mode) message)
   (let* ((c (connection m))
         (log (logging-stream c)))
-    (format log "handle-data ~a~%" message)))
+    (format log "handle-data ~a~%" message)
+    (empire-web:data message)))
 
 (defmethod handle-prompt ((m play-mode) message)
   (let* ((c (connection m))
index 26d0ebb91af4e59006ee750ee24512a46ffc2777..5cf8ad0cf40d6a31ad1cd51392dd4c5cea099e0c 100644 (file)
       (:use :cl)
     (:export :read-message-loop
              :read-message
-            :make-connection))
+            :make-connection
+            :connect
+            :send-message))
   (defpackage :locked-queue
     (:use :cl :sb-thread)
     (:export :create :enqueue :dequeue))
   (defpackage :empire-web
     (:use :cl :hunchentoot)
-    (:export :start :send :prompt)))
+    (:export :start :send :prompt :data)))
 
index 55fb20c134b5db38691cbeaaf3d57ee7d4113724..31a21f2fe3b8adf39a977251187314c679b7f65b 100644 (file)
@@ -34,7 +34,54 @@ function get_next_update() {
   });
 }
 
+function submit_cmdline(cmdline_form) {
+  dojo.xhrGet( {
+    // The following URL must match that used to test the server.
+    url: "/eow/command", 
+    handleAs: "text",
+
+    timeout: 30000, // Time in milliseconds
+
+    // The LOAD function will be called on a successful response.
+    load: function(response, ioArgs) {
+       console.log(response);
+       return response;
+      },
+
+    // The ERROR function will be called in an error case.
+    error: function(response, ioArgs) {
+       if (response.dojoType == "timeout") {
+         ioArgs.xhr.abort();
+         return response;
+       }
+
+       console.error("HTTP status code: ", ioArgs.xhr.status);
+       return response;
+      },
+
+    form: cmdline_form
+  });
+}
+
 function prompt(minutes, btus) {
   eowOut("[" + minutes + "," + btus + "]: ");
   get_next_update();
 }
+
+function msg(m) {
+  eowOut(m);
+  get_next_update();
+}
+
+function setup_client() {
+  var input = dojo.byId("inputfield");
+  input.focus();
+}
+
+function inputfield_keyup(e) {
+  console.log(e);
+  if (e.keyCode == 13) { // Enter
+    submit_cmdline(e.target.form.id);
+    e.target.value = "";
+  }
+}
diff --git a/static/login.html b/static/login.html
new file mode 100644 (file)
index 0000000..2dd2944
--- /dev/null
@@ -0,0 +1,20 @@
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
+<html> <head>
+<title>Login</title>
+</head>
+
+<body>
+<h1>Login</h1>
+
+<form action="/eow/login" method="POST">
+<table>
+<tr><td>Username<td><input name="username" type="text">
+<tr><td>Password<td><input name="password" type="password">
+</table>
+<input type="submit" value=" Login ">
+</form>
+
+<hr>
+<address></address>
+<!-- hhmts start --> Last modified: Sun Dec 14 22:16:18 CET 2008 <!-- hhmts end -->
+</body> </html>
index 867d52408c30c3f2095ef6851496a903c7f5c325..28f676c60e2a7fe0355efaf204d8a2e79c084566 100644 (file)
@@ -9,6 +9,7 @@
 <script type="text/javascript">
 var init = function(){
   console.log("I run after the page is ready. See this in the console");
+  setup_client();
   get_next_update();
 };
 dojo.addOnLoad(init);
@@ -24,12 +25,15 @@ dojo.addOnLoad(init);
 <span class="info">Welcome to the Empire over the Web client (EOW).</span>
 </div>
 <div id="input">
-<form name='f' onsubmit='return false;' class='cmdline' action=''>
-<table class="inputtable"><tr><td><div id='prompt' class='less'>> </div></td><td class="inputtd"><input id='inputfield' name='q' type='text' class='cmdline' autocomplete='off' value="" /></td></tr></table>
+<form id="cmdline" name='f' onsubmit='return false;' class='cmdline' action=''>
+<table class="inputtable"><tr><td><div id='prompt' class='less'>>
+</div></td><td class="inputtd"><input id='inputfield' name='q'
+  type='text' class='cmdline' autocomplete='off' value=""
+  onkeyup="inputfield_keyup(event);" /></td></tr></table>
 </form>
 </div>
 
 <hr>
 <address></address>
-<!-- hhmts start --> Last modified: Sat Nov 29 23:06:08 CET 2008 <!-- hhmts end -->
+<!-- hhmts start --> Last modified: Sun Dec 14 23:04:50 CET 2008 <!-- hhmts end -->
 </body> </html>
index 20e27510d2a67c37764967dd29b271b141479ee6..0f6a0c8966fed615898f2b3baa4a289d7233f063 100644 (file)
--- a/web.lisp
+++ b/web.lisp
@@ -16,6 +16,7 @@
 (defparameter +web-root+ (concatenate 'string +web-root-base+ "/"))
 (defparameter +static-web-root+ (concatenate 'string +web-root+ "static/"))
 (defparameter +static-files-root+ (concatenate 'string +templates-root+ "static/"))
+(defparameter +login-page+ (concatenate 'string +static-web-root+ "login.html"))
 
 (defun string-starts-with (string prefix)
   ;; (from Hunchentoot)
 (defun prompt (minutes btus)
   (send (format nil "prompt(~a,~a);~%" minutes btus)))
 
+(defun data (message)
+  (send (parenscript:ps* `(msg ,message))))
+
+(defun login ()
+  (let ((connection (session-value 'connection)))
+    (if connection
+       (redirect +root-url+)
+       (redirect +login-page+))))
+
+;; destination of login-form
+(defun login-action ()
+  (let ((connection (empire:connect :user (post-parameter "username")
+                                   :password (post-parameter "password"))))
+    (setf (session-value 'connection) connection)
+    (redirect +root-url+)))
+
+(defun command-action ()
+  (let ((connection (session-value 'connection)))
+    (empire:send-message connection (get-parameter "q"))))
+
 (defun dispatch (request)
   (let ((script-name (script-name request)))
     (cond
       ((not (string-starts-with script-name +web-root+)) nil) ; do not handle this request
       ((string= script-name "/eow/update") 'update)
+      ((string= script-name "/eow/login") 'login-action)
+      ((string= script-name "/eow/command") 'command-action)
       ((or (string-equal script-name +web-root-base+)
-           (string-equal script-name +web-root+)) (redirect +root-url+)) ; go to the start page
+           (string-equal script-name +web-root+)) 'login) ; go to the start page
       ((string-starts-with script-name +static-web-root+) 'serve-static)))) ; serve static file